commit 096ca08e9ca3b8cc987fdb2d15f3bd2cad9f318d
parent 476fac03ea40cc28644acb2fe6d63e80b406ab78
Author: Robert Russell <robert@rr3.xyz>
Date: Thu, 24 Sep 2026 09:57:22 -0700
Todo: rename files to avoid LSP errors
Diffstat:
5 files changed, 582 insertions(+), 583 deletions(-)
diff --git a/Todo/Category.hs b/Todo/Category.hs.txt
diff --git a/Todo/Const.hs b/Todo/Const.hs.txt
diff --git a/Todo/Lude.hs b/Todo/Lude.hs
@@ -1,583 +0,0 @@
-module Lude (
--- Types,
--- Constraint,
--- Levity (..),
--- RuntimeRep (..),
--- Thunked,
--- LRep,
--- URep,
--- Type,
--- BoxedType,
--- LType,
--- UType,
--- Kind,
--- Unlift (..),
--- Function
--- const,
--- fix,
--- flip,
--- ($),
--- ($!),
--- (&),
--- (&!),
--- Bool
--- IsBool (..),
--- Bool (..),
--- (&&),
--- (||),
--- not,
--- Category
--- Category (identity, compose),
--- (<.),
--- (.>),
--- Functor
-{-
-Functor,
-void,
-Compose (Compose, getCompose),
-Const (Const, getConst),
-Identity (Identity, runIdentity),
-map,
-($^),
-for,
-(^&),
-flap,
-(^$),
-flor,
-(&^),
-(<<^),
-(^>>),
-(^<<),
-(>>^),
--- Applicative
-Applicative (pure),
-pass,
-ap,
-(^$^),
-plug,
-(^&^),
-(^<<^),
-(^>>^),
--- Monad
-Monad,
-map',
-($!^),
-for',
-(^&!),
-flap',
-(^$!),
-flor',
-(&!^),
-ap',
-(^$!^),
-plug',
-(^&!^),
--}
-
-) where
-
-{-
-
--- import Control.Applicative (Alternative (empty, (<|>)), Applicative (liftA2, pure, (<*>)), (<**>))
--- import Control.Monad (Monad ((>>=)))
--- import Data.Bool (Bool (..), not, (&&), (||))
--- import Data.Foldable (Foldable)
--- import Data.Function (const, fix, flip)
--- import Data.Functor (Functor (fmap), void)
--- import Data.Functor.Compose (Compose (Compose, getCompose))
--- import Data.Functor.Const (Const (Const, getConst))
--- import Data.Functor.Identity (Identity (Identity, runIdentity))
--- import Data.Maybe (Maybe (..))
--- import Data.Traversable (Traversable (sequenceA))
-
--- TODO: SIMD: VecCount (..) and VecElem (..)
-import GHC.Exts (Constraint, Levity (..), RuntimeRep (..))
-import GHC.Exts qualified as GHC
-
---------------------------------------------------------------------------------
--- Types
-
--- | Types with an unlifted alternative.
---
--- Laws:
--- - @force (lift x) = x@
-class Unlift a where
- type U a :: UType
- force :: a -> U a
- lift :: U a -> a
-
---------------------------------------------------------------------------------
-
--- type Functor :: forall r s. (Type r -> Type s) -> Constraint
--- class Functor @r f where
--- map :: forall (a :: Type r) (b :: Type r). (a -> b) -> f a -> f b
-
--- type SemiApplicative :: forall r s. (Type r -> Type s) -> Constraint
--- class (Functor f) => SemiApplicative @r f where
--- map2 :: forall (a :: Type r) (b :: Type r) (c :: Type r). (a -> b -> c) -> f a -> f b -> f c
-
--- type Applicative :: forall r s. (Type r -> Type s) -> Constraint
--- class (SemiApplicative f) => Applicative @r f where
--- pure :: forall (a :: Type r). a -> f a
-
--- type SemiMonad :: forall r s. (Type r -> Type s) -> Constraint
--- class (SemiApplicative f) => SemiMonad @r f where
--- bind :: forall (a :: Type r) (b :: Type r). (a -> f b) -> f a -> f b
-
--- type Monad :: forall r s. (Type r -> Type s) -> Constraint
--- class (Applicative f, SemiMonad f) => Monad @r f
-
--- type SemiComonad :: forall r s.
-
---------------------------------------------------------------------------------
--- Function
-
--- Note how the associativities and (relative) precedences differ with the
--- infix operators in Data.Function.
--- infixl 0 &, &!
--- infixl 1 $, $!
-
--- | Function application.
--- ($) :: (a -> b) -> a -> b
--- f $ x = f x
-
--- | Strict function application.
--- ($!) :: (a -> b) -> a -> b
--- f $! !x = f x
-
--- Flipped function application, or "pipe".
--- (&) :: a -> (a -> b) -> b
--- x & f = f x
-
--- Strict flipped function application, or "pipe".
--- (&!) :: a -> (a -> b) -> b
--- !x &! f = f x
-
---------------------------------------------------------------------------------
--- Bool
-
--- class IsBool (bool :: Type r) where
--- true :: (Thunked) => bool
--- false :: (Thunked) => bool
--- bool :: a -> a -> bool -> a
-
--- instance IsBool Bool where
--- true = True
--- false = False
--- bool t f = \case
--- True -> t
--- False -> f
-
--- data UBool :: UType where
--- UTrue :: UBool
--- UFalse :: UBool
-
--- instance IsBool UBool where
--- true = UTrue
--- false = UFalse
--- bool t f = \case
--- UTrue -> t
--- UFalse -> f
-
--- instance Unlift Bool where
--- type U Bool = UBool
-
--- force True = UTrue
--- force False = UFalse
-
--- lift UTrue = True
--- lift UFalse = False
-
---------------------------------------------------------------------------------
--- Maybe
-
--- class IsMaybe (maybe :: Type s -> Type r) where
--- just :: a -> maybe a
--- nothing :: (Thunked) => maybe a
--- maybe :: b -> (a -> b) -> maybe a -> b
-
--- instance IsMaybe Maybe where
--- just = Just
--- nothing = Nothing
--- maybe n j = \case
--- Just a -> j a
--- Nothing -> n
-
--- data UMaybe :: LType -> UType where
--- UJust :: a -> UMaybe a
--- UNothing :: UMaybe a
-
--- instance IsMaybe UMaybe where
--- just = UJust
--- nothing = UNothing
--- maybe n j = \case
--- UJust a -> j a
--- UNothing -> n
-
--- instance Unlift (Maybe a) where
--- type U (Maybe a) = UMaybe a
-
--- force (Just a) = UJust a
--- force Nothing = UNothing
-
--- lift (UJust a) = Just a
--- lift UNothing = Nothing
-
--- data Maybe' :: UType -> LType where
--- Just' :: a -> Maybe' a
--- Nothing' :: Maybe' a
-
--- instance IsMaybe Maybe' where
--- just = Just'
--- nothing = Nothing'
--- maybe n j = \case
--- Just' a -> j a
--- Nothing' -> n
-
--- data UMaybe' :: UType -> UType where
--- UJust' :: a -> UMaybe' a
--- UNothing' :: UMaybe' a
-
--- instance IsMaybe UMaybe' where
--- just = UJust'
--- nothing = UNothing'
--- maybe n j = \case
--- UJust' a -> j a
--- UNothing' -> n
-
--- instance Unlift (Maybe' a) where
--- type U (Maybe' a) = UMaybe' a
-
--- force (Just' a) = UJust' a
--- force Nothing' = UNothing'
-
--- lift (UJust' a) = Just' a
--- lift UNothing' = Nothing'
-
--- isJust :: forall s r (maybe :: Type s -> Type r) a. (IsMaybe maybe) => maybe a -> Bool
--- isJust = maybe False (const True)
-
--- isNothing :: (IsMaybe maybe) => maybe a -> Bool
--- isNothing = maybe True (const False)
-
--- type family Maybe# (r :: RuntimeRep) (l :: Levity) :: Type r -> BoxedType l
--- type instance Maybe# LRep Lifted = Maybe
--- type instance Maybe# URep Lifted = Maybe'
--- type instance Maybe# LRep Unlifted = UMaybe
--- type instance Maybe# URep Unlifted = UMaybe'
-
--- type family Lower (a :: Kind) :: Kind where
--- Lower (BoxedType l) = TypeU
--- Lower (k -> l) = k -> Lower l
--- type family X (a :: k) :: Lower k
--- type instance X (MaybeL @l) = MaybeL @Unlifted
-
---------------------------------------------------------------------------------
--- Numeric types
-
--- TODO
-
---------------------------------------------------------------------------------
--- Category
-
--- infixr 9 ∘
-
--- infixr 2 <.
--- infixl 2 .>
-
--- (⊲⊳)
--- (⋖⋗)
--- (⩹⩺)
--- (⨟)
--- (⦂)
--- (⋄)
--- (∧∨)
--- (⩓⩔)
--- (∩∪)
--- (=≠≡≢≈≉)
--- (<>≤≥≮≯≰≱)
--- (≺≻≼≽⊀⊁⋠⋡)
--- (⊂⊃⊆⊇⊄⊅⊈⊉)
--- (⊏⊐⊑⊒)
--- (⊢⊣⊤⊥)
--- y = h ∘ g ∘ f ∙^ x
--- (f ⦾ g ⦿ x)
--- y = h ◁ g ◁ f ◀ x
--- y = x ▶ f ▷ g ▷ h
--- (⧑⧒⧓⧔⧕⧖⧗⋈⋉⋊)
--- (↑↓↔↕↖↗↘↙)
--- (⥼⥽⥾⥿)
--- (⊰⊱)
--- (⭘∘)
--- (⦁∙⋅)
--- (⊙)
--- (⊚)
--- (⬬⬭⬮⬯)
--- (⬝⬞)
--- (⋆)
--- (⬥⬦⬧⬨⬩⬪⬫)
--- (◖◗)
--- (◐◑)
--- (⫾)
--- (■▪▬▮▰▲▶▼◀◆)
--- (∙⋆⋄*≀⌑▫)
--- y = x ▪ f ▫ g ▫ h
--- y = x ⦂ f ⨟ g ⨟ h
-
--- TODO: Op, Products, Sums, Clown, Joker
-
-{-
-
-class (Bifunctor f, LDomOf f ~ Hask ρ, RDomOf f ~ Hask ρ) => Monoidal (f :: Type ρ -> Type ρ -> Type ρ) where
- type UnitOf f :: Type ρ
- unitl :: Iso (Hask ρ) (f (UnitOf f) a) a
- unitr :: Iso (Hask ρ) (f a (UnitOf f)) a
- assoc :: Iso (Hask ρ) (f (f a b) c) (f a (f b c))
-
--- TODO: Having this only work for Hask sucks and is needlessly specialized.
--- We can generalize this and some above definitions to any category whose
--- objects have kind Type ρ, which isn't just Hask (e.g., Kleisli).
-class (Monoidal f) => Cartesian (f :: Type ρ -> Type ρ -> Type ρ) where
- fst :: forall (a :: Type ρ) (b :: Type ρ). f a b -> a
- snd :: forall (a :: Type ρ) (b :: Type ρ). f a b -> b
-
- pair :: forall (a :: Type ρ) (b :: Type ρ) (c :: Type ρ). (a -> b) -> (a -> c) -> a -> f b c
- pair f g = bimap f g ∘ diag
-
- diag :: forall (a :: Type ρ). a -> f a a
- diag = pair identity identity
-
--}
-
--- | Right-to-left composition.
---
--- This operator is right associative to exploit laziness in the case where
--- the outer function doesn't need its argument:
---
--- > (const x <. (f <. g)) y ---> const x ((f <. g) y) ---> x
---
--- Note that @f <. g@ is never evaluated.
--- (<.) :: (Category v) => v b c -> v a b -> v a c
--- (<.) = (.)
-
--- | Left-to-right composition.
---
--- This operator is left associative to exploit laziness in the case where
--- the outer function doesn't need its argument:
---
--- > ((g .> f) .> const x) y ---> const x ((g .> f) y) ---> x
---
--- Note that @g .> f@ is never evaluated.
--- (.>) :: (Category v) => v a b -> v b c -> v a c
--- (.>) = flip (.)
-
--- TODO: (.:), (<.:), (.:>)
-
---------------------------------------------------------------------------------
--- Functor
-
-{-
-infixl 0 ^&, &^, ~^&, ^&~, ~&^, &^~
-infixl 1 $^, ^$, $^~, ~$^, ^$~, ~^$
-infixr 2 <<^, ^>>, ^<<, >>^
-
--- | The action of a functor on a function.
-map, ($^) :: (Functor f) => (a -> b) -> f a -> f b
-map = fmap
-($^) = map
-
--- | The action of a functor on a function, flipped.
---
--- With the BlockArguments extension, expressions like "@for xs \\x -> ...@"
--- look like for-loops, hence the name "for".
-for, (^&) :: (Functor f) => f a -> (a -> b) -> f b
-for = flip map
-(^&) = for
-
--- | Application of a function in a functor to a pure value.
-flap, (^$) :: (Functor f) => f (a -> b) -> a -> f b
-flap f a = f ^& ($ a)
-(^$) = flap
-
--- | Flipped application of a function in a functor to a pure value.
-flor, (&^) :: (Functor f) => a -> f (a -> b) -> f b
-flor = flip flap
-(&^) = flor
-
-($^~) :: (Functor f, Functor g) => (a -> b) -> g (f a) -> g (f b)
-f $^~ a = (f $^) $^ a
-
-(~^&) :: (Functor f, Functor g) => g (f a) -> (a -> b) -> g (f b)
-(~^&) = flip ($^~)
-
-(~$^) :: (Functor f, Functor g) => g (a -> b) -> f a -> g (f b)
-f ~$^ a = f ^& ($^ a)
-
-(^&~) :: (Functor f, Functor g) => f a -> g (a -> b) -> g (f b)
-(^&~) = flip (~$^)
-
-(^$~) :: (Functor f, Functor g) => f (a -> b) -> g a -> g (f b)
-f ^$~ a = (f ^$) $^ a
-
-(~&^) :: (Functor f, Functor g) => g a -> f (a -> b) -> g (f b)
-(~&^) = flip (^$~)
-
-(~^$) :: (Functor f, Functor g) => g (f (a -> b)) -> a -> g (f b)
-f ~^$ a = f ^& (^$ a)
-
-(&^~) :: (Functor f, Functor g) => a -> g (f (a -> b)) -> g (f b)
-(&^~) = flip (~^$)
-
--- TODO
-
--- | Right-to-left composition with the first function in a functor.
-(<<^) :: (Functor f, Category v) => v b c -> f (v a b) -> f (v a c)
-g <<^ f = (g <.) $^ f
-
--- TODO
-
--- | Left-to-right composition with the first function in a functor.
-(^>>) :: (Functor f, Category v) => f (v a b) -> v b c -> f (v a c)
-f ^>> g = f ^& (.> g)
-
--- TODO
-
--- | Right-to-left composition with the second function in a functor.
-(^<<) :: (Functor f, Category v) => f (v b c) -> v a b -> f (v a c)
-g ^<< f = g ^& (<. f)
-
--- TODO
-
--- | Left-to-right composition with the second function in a functor.
-(>>^) :: (Functor f, Category v) => v a b -> f (v b c) -> f (v a c)
-f >>^ g = (f .>) $^ g
-
--- TODO: *^, ^*
-
---------------------------------------------------------------------------------
--- Applicative
-
-infixl 0 ^&^, ~^&^~
-infixl 1 ^$^, ~^$^~
-infixr 2 ^<<^, ^>>^
-
--- | Functions with applicative effects.
-newtype Appy f a b = Appy {runAppy :: f (a -> b)}
-
-instance (Functor f) => Functor (Appy f a) where
- fmap f (Appy a) = Appy (f $^~ a)
-
-instance (Applicative f) => Applicative (Appy f a) where
- pure = Appy . pure . const
- Appy f <*> Appy a = Appy (f ~^$^~ a)
-
-hom :: (a -> b) -> (b -> b -> c) -> a -> a -> c
-hom f g x y = g (f x) (f y)
-
-instance (Alternative f) => Alternative (Appy f a) where
- empty = Appy empty
-
--- Appy x <|> Appy y = Appy (x <|> y)
--- (<|>) = hom runAppy (<|>)
-
-instance (Applicative f) => Category (Appy f) where
- id = Appy (pure id)
- Appy f . Appy g = Appy ((.) $^ f ^$^ g)
-
--- TODO: Remove ap and plug?
--- TODO: liftA{,1,2,3,4}
-
--- | An alias for @pure ()@.
-pass :: (Applicative f) => f ()
-pass = pure ()
-
--- | Application in an applicative functor.
-ap, (^$^) :: (Applicative f) => f (a -> b) -> f a -> f b
-ap = (<*>)
-(^$^) = ap
-
--- | Flipped application in an applicative functor (with effects resolved as
--- they appear, left-to-right).
-plug, (^&^) :: (Applicative f) => f a -> f (a -> b) -> f b
-plug = (<**>)
-(^&^) = plug
-
-(~^$^~) :: (Applicative f, Applicative g) => g (f (a -> b)) -> g (f a) -> g (f b)
-f ~^$^~ a = (^$^) $^ f ^$^ a
-
-(~^&^~) :: (Applicative f, Applicative g) => g (f a) -> g (f (a -> b)) -> g (f b)
-f ~^&^~ a = (^&^) $^ f ^$^ a
-
--- TODO: document
-(^<<^) :: (Applicative f, Category v) => f (v b c) -> f (v a b) -> f (v a c)
-(^<<^) = liftA2 (<.)
-
--- TODO: document
-(^>>^) :: (Applicative f, Category v) => f (v a b) -> f (v b c) -> f (v a c)
-(^>>^) = liftA2 (.>)
-
--- TODO: "semicolons"
-
---------------------------------------------------------------------------------
--- Monad
-
-infixl 0 ^&!, &!^, ^&!^
-infixl 1 $!^, ^$!, ^$!^
-
-map', ($!^) :: (Monad m) => (a -> b) -> m a -> m b
-map' f mx = mx >>= \x -> pure $! f x
-($!^) = map'
-
-for', (^&!) :: (Monad m) => m a -> (a -> b) -> m b
-for' = flip map'
-(^&!) = for
-
-flap', (^$!) :: (Monad m) => m (a -> b) -> a -> m b
-flap' mf x = mf >>= \f -> pure $! f x
-(^$!) = flap'
-
-flor', (&!^) :: (Monad m) => a -> m (a -> b) -> m b
-flor' = flip flap'
-(&!^) = flor'
-
-ap', (^$!^) :: (Monad m) => m (a -> b) -> m a -> m b
-ap' mf mx = do
- f <- mf
- x <- mx
- pure $! f x
-(^$!^) = ap'
-
-plug', (^&!^) :: (Monad m) => m a -> m (a -> b) -> m b
-plug' mx mf = do
- x <- mx
- f <- mf
- pure $! f x
-(^&!^) = plug'
--}
-
--- (.) :: (b0 -> c) -> (a0 -> b0) -> (a0 -> c)
--- (g . f) a0 = g (f a0)
--- (^.) :: (b0 -> b1 -> c) -> (a0 -> b1) -> (b0 -> a0 -> c)
--- (g ^. f) b0 a0 = g b0 (f a0)
--- (^^.) :: (b0 -> b1 -> b2 -> c) -> (a0 -> b2) -> (b0 -> b1 -> a0 -> c)
--- (g ^^. f) b0 b1 a0 = g b0 b1 (f a0)
--- (^^^.) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> b3) -> (b0 -> b1 -> b2 -> a0 -> c)
--- (g ^^^. f) b0 b1 b2 a0 = g b0 b1 b2 (f a0)
--- (.^) :: (b0 -> c) -> (a0 -> a1 -> b0) -> (a0 -> a1 -> c)
--- (g .^ f) a0 a1 = g (f a0 a1)
--- (^.^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> b1) -> (b0 -> a0 -> a1 -> c)
--- (g ^.^ f) b0 a0 a1 = g b0 (f a0 a1)
--- (^^.^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> b2) -> (b0 -> b1 -> a0 -> a1 -> c)
--- (g ^^.^ f) b0 b1 a0 a1 = g b0 b1 (f a0 a1)
--- (^^^.^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> c)
--- (g ^^^.^ f) b0 b1 b2 a0 a1 = g b0 b1 b2 (f a0 a1)
--- (.^^) :: (b0 -> c) -> (a0 -> a1 -> a2 -> b0) -> (a0 -> a1 -> a2 -> c)
--- (^.^^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> a2 -> b1) -> (b0 -> a0 -> a1 -> a2 -> c)
--- (^^.^^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> a2 -> b2) -> (b0 -> b1 -> a0 -> a1 -> a2 -> c)
--- (^^^.^^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> a2 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> a2 -> c)
--- (.^^^) :: (b0 -> c) -> (a0 -> a1 -> a2 -> a3 -> b0) -> (a0 -> a1 -> a2 -> a3 -> c)
--- (^.^^^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> a2 -> a3 -> b1) -> (b0 -> a0 -> a1 -> a2 -> a3 -> c)
--- (^^.^^^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> a2 -> a3 -> b2) -> (b0 -> b1 -> a0 -> a1 -> a2 -> a3 -> c)
--- (^^^.^^^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> a2 -> a3 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> a2 -> a3 -> c)
-
--}
diff --git a/Todo/Lude.hs.txt b/Todo/Lude.hs.txt
@@ -0,0 +1,582 @@
+-- module Lude (
+-- Types,
+-- Constraint,
+-- Levity (..),
+-- RuntimeRep (..),
+-- Thunked,
+-- LRep,
+-- URep,
+-- Type,
+-- BoxedType,
+-- LType,
+-- UType,
+-- Kind,
+-- Unlift (..),
+-- Function
+-- const,
+-- fix,
+-- flip,
+-- ($),
+-- ($!),
+-- (&),
+-- (&!),
+-- Bool
+-- IsBool (..),
+-- Bool (..),
+-- (&&),
+-- (||),
+-- not,
+-- Category
+-- Category (identity, compose),
+-- (<.),
+-- (.>),
+-- Functor
+{-
+Functor,
+void,
+Compose (Compose, getCompose),
+Const (Const, getConst),
+Identity (Identity, runIdentity),
+map,
+($^),
+for,
+(^&),
+flap,
+(^$),
+flor,
+(&^),
+(<<^),
+(^>>),
+(^<<),
+(>>^),
+-- Applicative
+Applicative (pure),
+pass,
+ap,
+(^$^),
+plug,
+(^&^),
+(^<<^),
+(^>>^),
+-- Monad
+Monad,
+map',
+($!^),
+for',
+(^&!),
+flap',
+(^$!),
+flor',
+(&!^),
+ap',
+(^$!^),
+plug',
+(^&!^),
+-}
+-- ) where
+
+{-
+
+-- import Control.Applicative (Alternative (empty, (<|>)), Applicative (liftA2, pure, (<*>)), (<**>))
+-- import Control.Monad (Monad ((>>=)))
+-- import Data.Bool (Bool (..), not, (&&), (||))
+-- import Data.Foldable (Foldable)
+-- import Data.Function (const, fix, flip)
+-- import Data.Functor (Functor (fmap), void)
+-- import Data.Functor.Compose (Compose (Compose, getCompose))
+-- import Data.Functor.Const (Const (Const, getConst))
+-- import Data.Functor.Identity (Identity (Identity, runIdentity))
+-- import Data.Maybe (Maybe (..))
+-- import Data.Traversable (Traversable (sequenceA))
+
+-- TODO: SIMD: VecCount (..) and VecElem (..)
+import GHC.Exts (Constraint, Levity (..), RuntimeRep (..))
+import GHC.Exts qualified as GHC
+
+--------------------------------------------------------------------------------
+-- Types
+
+-- | Types with an unlifted alternative.
+--
+-- Laws:
+-- - @force (lift x) = x@
+class Unlift a where
+ type U a :: UType
+ force :: a -> U a
+ lift :: U a -> a
+
+--------------------------------------------------------------------------------
+
+-- type Functor :: forall r s. (Type r -> Type s) -> Constraint
+-- class Functor @r f where
+-- map :: forall (a :: Type r) (b :: Type r). (a -> b) -> f a -> f b
+
+-- type SemiApplicative :: forall r s. (Type r -> Type s) -> Constraint
+-- class (Functor f) => SemiApplicative @r f where
+-- map2 :: forall (a :: Type r) (b :: Type r) (c :: Type r). (a -> b -> c) -> f a -> f b -> f c
+
+-- type Applicative :: forall r s. (Type r -> Type s) -> Constraint
+-- class (SemiApplicative f) => Applicative @r f where
+-- pure :: forall (a :: Type r). a -> f a
+
+-- type SemiMonad :: forall r s. (Type r -> Type s) -> Constraint
+-- class (SemiApplicative f) => SemiMonad @r f where
+-- bind :: forall (a :: Type r) (b :: Type r). (a -> f b) -> f a -> f b
+
+-- type Monad :: forall r s. (Type r -> Type s) -> Constraint
+-- class (Applicative f, SemiMonad f) => Monad @r f
+
+-- type SemiComonad :: forall r s.
+
+--------------------------------------------------------------------------------
+-- Function
+
+-- Note how the associativities and (relative) precedences differ with the
+-- infix operators in Data.Function.
+-- infixl 0 &, &!
+-- infixl 1 $, $!
+
+-- | Function application.
+-- ($) :: (a -> b) -> a -> b
+-- f $ x = f x
+
+-- | Strict function application.
+-- ($!) :: (a -> b) -> a -> b
+-- f $! !x = f x
+
+-- Flipped function application, or "pipe".
+-- (&) :: a -> (a -> b) -> b
+-- x & f = f x
+
+-- Strict flipped function application, or "pipe".
+-- (&!) :: a -> (a -> b) -> b
+-- !x &! f = f x
+
+--------------------------------------------------------------------------------
+-- Bool
+
+-- class IsBool (bool :: Type r) where
+-- true :: (Thunked) => bool
+-- false :: (Thunked) => bool
+-- bool :: a -> a -> bool -> a
+
+-- instance IsBool Bool where
+-- true = True
+-- false = False
+-- bool t f = \case
+-- True -> t
+-- False -> f
+
+-- data UBool :: UType where
+-- UTrue :: UBool
+-- UFalse :: UBool
+
+-- instance IsBool UBool where
+-- true = UTrue
+-- false = UFalse
+-- bool t f = \case
+-- UTrue -> t
+-- UFalse -> f
+
+-- instance Unlift Bool where
+-- type U Bool = UBool
+
+-- force True = UTrue
+-- force False = UFalse
+
+-- lift UTrue = True
+-- lift UFalse = False
+
+--------------------------------------------------------------------------------
+-- Maybe
+
+-- class IsMaybe (maybe :: Type s -> Type r) where
+-- just :: a -> maybe a
+-- nothing :: (Thunked) => maybe a
+-- maybe :: b -> (a -> b) -> maybe a -> b
+
+-- instance IsMaybe Maybe where
+-- just = Just
+-- nothing = Nothing
+-- maybe n j = \case
+-- Just a -> j a
+-- Nothing -> n
+
+-- data UMaybe :: LType -> UType where
+-- UJust :: a -> UMaybe a
+-- UNothing :: UMaybe a
+
+-- instance IsMaybe UMaybe where
+-- just = UJust
+-- nothing = UNothing
+-- maybe n j = \case
+-- UJust a -> j a
+-- UNothing -> n
+
+-- instance Unlift (Maybe a) where
+-- type U (Maybe a) = UMaybe a
+
+-- force (Just a) = UJust a
+-- force Nothing = UNothing
+
+-- lift (UJust a) = Just a
+-- lift UNothing = Nothing
+
+-- data Maybe' :: UType -> LType where
+-- Just' :: a -> Maybe' a
+-- Nothing' :: Maybe' a
+
+-- instance IsMaybe Maybe' where
+-- just = Just'
+-- nothing = Nothing'
+-- maybe n j = \case
+-- Just' a -> j a
+-- Nothing' -> n
+
+-- data UMaybe' :: UType -> UType where
+-- UJust' :: a -> UMaybe' a
+-- UNothing' :: UMaybe' a
+
+-- instance IsMaybe UMaybe' where
+-- just = UJust'
+-- nothing = UNothing'
+-- maybe n j = \case
+-- UJust' a -> j a
+-- UNothing' -> n
+
+-- instance Unlift (Maybe' a) where
+-- type U (Maybe' a) = UMaybe' a
+
+-- force (Just' a) = UJust' a
+-- force Nothing' = UNothing'
+
+-- lift (UJust' a) = Just' a
+-- lift UNothing' = Nothing'
+
+-- isJust :: forall s r (maybe :: Type s -> Type r) a. (IsMaybe maybe) => maybe a -> Bool
+-- isJust = maybe False (const True)
+
+-- isNothing :: (IsMaybe maybe) => maybe a -> Bool
+-- isNothing = maybe True (const False)
+
+-- type family Maybe# (r :: RuntimeRep) (l :: Levity) :: Type r -> BoxedType l
+-- type instance Maybe# LRep Lifted = Maybe
+-- type instance Maybe# URep Lifted = Maybe'
+-- type instance Maybe# LRep Unlifted = UMaybe
+-- type instance Maybe# URep Unlifted = UMaybe'
+
+-- type family Lower (a :: Kind) :: Kind where
+-- Lower (BoxedType l) = TypeU
+-- Lower (k -> l) = k -> Lower l
+-- type family X (a :: k) :: Lower k
+-- type instance X (MaybeL @l) = MaybeL @Unlifted
+
+--------------------------------------------------------------------------------
+-- Numeric types
+
+-- TODO
+
+--------------------------------------------------------------------------------
+-- Category
+
+-- infixr 9 ∘
+
+-- infixr 2 <.
+-- infixl 2 .>
+
+-- (⊲⊳)
+-- (⋖⋗)
+-- (⩹⩺)
+-- (⨟)
+-- (⦂)
+-- (⋄)
+-- (∧∨)
+-- (⩓⩔)
+-- (∩∪)
+-- (=≠≡≢≈≉)
+-- (<>≤≥≮≯≰≱)
+-- (≺≻≼≽⊀⊁⋠⋡)
+-- (⊂⊃⊆⊇⊄⊅⊈⊉)
+-- (⊏⊐⊑⊒)
+-- (⊢⊣⊤⊥)
+-- y = h ∘ g ∘ f ∙^ x
+-- (f ⦾ g ⦿ x)
+-- y = h ◁ g ◁ f ◀ x
+-- y = x ▶ f ▷ g ▷ h
+-- (⧑⧒⧓⧔⧕⧖⧗⋈⋉⋊)
+-- (↑↓↔↕↖↗↘↙)
+-- (⥼⥽⥾⥿)
+-- (⊰⊱)
+-- (⭘∘)
+-- (⦁∙⋅)
+-- (⊙)
+-- (⊚)
+-- (⬬⬭⬮⬯)
+-- (⬝⬞)
+-- (⋆)
+-- (⬥⬦⬧⬨⬩⬪⬫)
+-- (◖◗)
+-- (◐◑)
+-- (⫾)
+-- (■▪▬▮▰▲▶▼◀◆)
+-- (∙⋆⋄*≀⌑▫)
+-- y = x ▪ f ▫ g ▫ h
+-- y = x ⦂ f ⨟ g ⨟ h
+
+-- TODO: Op, Products, Sums, Clown, Joker
+
+{-
+
+class (Bifunctor f, LDomOf f ~ Hask ρ, RDomOf f ~ Hask ρ) => Monoidal (f :: Type ρ -> Type ρ -> Type ρ) where
+ type UnitOf f :: Type ρ
+ unitl :: Iso (Hask ρ) (f (UnitOf f) a) a
+ unitr :: Iso (Hask ρ) (f a (UnitOf f)) a
+ assoc :: Iso (Hask ρ) (f (f a b) c) (f a (f b c))
+
+-- TODO: Having this only work for Hask sucks and is needlessly specialized.
+-- We can generalize this and some above definitions to any category whose
+-- objects have kind Type ρ, which isn't just Hask (e.g., Kleisli).
+class (Monoidal f) => Cartesian (f :: Type ρ -> Type ρ -> Type ρ) where
+ fst :: forall (a :: Type ρ) (b :: Type ρ). f a b -> a
+ snd :: forall (a :: Type ρ) (b :: Type ρ). f a b -> b
+
+ pair :: forall (a :: Type ρ) (b :: Type ρ) (c :: Type ρ). (a -> b) -> (a -> c) -> a -> f b c
+ pair f g = bimap f g ∘ diag
+
+ diag :: forall (a :: Type ρ). a -> f a a
+ diag = pair identity identity
+
+-}
+
+-- | Right-to-left composition.
+--
+-- This operator is right associative to exploit laziness in the case where
+-- the outer function doesn't need its argument:
+--
+-- > (const x <. (f <. g)) y ---> const x ((f <. g) y) ---> x
+--
+-- Note that @f <. g@ is never evaluated.
+-- (<.) :: (Category v) => v b c -> v a b -> v a c
+-- (<.) = (.)
+
+-- | Left-to-right composition.
+--
+-- This operator is left associative to exploit laziness in the case where
+-- the outer function doesn't need its argument:
+--
+-- > ((g .> f) .> const x) y ---> const x ((g .> f) y) ---> x
+--
+-- Note that @g .> f@ is never evaluated.
+-- (.>) :: (Category v) => v a b -> v b c -> v a c
+-- (.>) = flip (.)
+
+-- TODO: (.:), (<.:), (.:>)
+
+--------------------------------------------------------------------------------
+-- Functor
+
+{-
+infixl 0 ^&, &^, ~^&, ^&~, ~&^, &^~
+infixl 1 $^, ^$, $^~, ~$^, ^$~, ~^$
+infixr 2 <<^, ^>>, ^<<, >>^
+
+-- | The action of a functor on a function.
+map, ($^) :: (Functor f) => (a -> b) -> f a -> f b
+map = fmap
+($^) = map
+
+-- | The action of a functor on a function, flipped.
+--
+-- With the BlockArguments extension, expressions like "@for xs \\x -> ...@"
+-- look like for-loops, hence the name "for".
+for, (^&) :: (Functor f) => f a -> (a -> b) -> f b
+for = flip map
+(^&) = for
+
+-- | Application of a function in a functor to a pure value.
+flap, (^$) :: (Functor f) => f (a -> b) -> a -> f b
+flap f a = f ^& ($ a)
+(^$) = flap
+
+-- | Flipped application of a function in a functor to a pure value.
+flor, (&^) :: (Functor f) => a -> f (a -> b) -> f b
+flor = flip flap
+(&^) = flor
+
+($^~) :: (Functor f, Functor g) => (a -> b) -> g (f a) -> g (f b)
+f $^~ a = (f $^) $^ a
+
+(~^&) :: (Functor f, Functor g) => g (f a) -> (a -> b) -> g (f b)
+(~^&) = flip ($^~)
+
+(~$^) :: (Functor f, Functor g) => g (a -> b) -> f a -> g (f b)
+f ~$^ a = f ^& ($^ a)
+
+(^&~) :: (Functor f, Functor g) => f a -> g (a -> b) -> g (f b)
+(^&~) = flip (~$^)
+
+(^$~) :: (Functor f, Functor g) => f (a -> b) -> g a -> g (f b)
+f ^$~ a = (f ^$) $^ a
+
+(~&^) :: (Functor f, Functor g) => g a -> f (a -> b) -> g (f b)
+(~&^) = flip (^$~)
+
+(~^$) :: (Functor f, Functor g) => g (f (a -> b)) -> a -> g (f b)
+f ~^$ a = f ^& (^$ a)
+
+(&^~) :: (Functor f, Functor g) => a -> g (f (a -> b)) -> g (f b)
+(&^~) = flip (~^$)
+
+-- TODO
+
+-- | Right-to-left composition with the first function in a functor.
+(<<^) :: (Functor f, Category v) => v b c -> f (v a b) -> f (v a c)
+g <<^ f = (g <.) $^ f
+
+-- TODO
+
+-- | Left-to-right composition with the first function in a functor.
+(^>>) :: (Functor f, Category v) => f (v a b) -> v b c -> f (v a c)
+f ^>> g = f ^& (.> g)
+
+-- TODO
+
+-- | Right-to-left composition with the second function in a functor.
+(^<<) :: (Functor f, Category v) => f (v b c) -> v a b -> f (v a c)
+g ^<< f = g ^& (<. f)
+
+-- TODO
+
+-- | Left-to-right composition with the second function in a functor.
+(>>^) :: (Functor f, Category v) => v a b -> f (v b c) -> f (v a c)
+f >>^ g = (f .>) $^ g
+
+-- TODO: *^, ^*
+
+--------------------------------------------------------------------------------
+-- Applicative
+
+infixl 0 ^&^, ~^&^~
+infixl 1 ^$^, ~^$^~
+infixr 2 ^<<^, ^>>^
+
+-- | Functions with applicative effects.
+newtype Appy f a b = Appy {runAppy :: f (a -> b)}
+
+instance (Functor f) => Functor (Appy f a) where
+ fmap f (Appy a) = Appy (f $^~ a)
+
+instance (Applicative f) => Applicative (Appy f a) where
+ pure = Appy . pure . const
+ Appy f <*> Appy a = Appy (f ~^$^~ a)
+
+hom :: (a -> b) -> (b -> b -> c) -> a -> a -> c
+hom f g x y = g (f x) (f y)
+
+instance (Alternative f) => Alternative (Appy f a) where
+ empty = Appy empty
+
+-- Appy x <|> Appy y = Appy (x <|> y)
+-- (<|>) = hom runAppy (<|>)
+
+instance (Applicative f) => Category (Appy f) where
+ id = Appy (pure id)
+ Appy f . Appy g = Appy ((.) $^ f ^$^ g)
+
+-- TODO: Remove ap and plug?
+-- TODO: liftA{,1,2,3,4}
+
+-- | An alias for @pure ()@.
+pass :: (Applicative f) => f ()
+pass = pure ()
+
+-- | Application in an applicative functor.
+ap, (^$^) :: (Applicative f) => f (a -> b) -> f a -> f b
+ap = (<*>)
+(^$^) = ap
+
+-- | Flipped application in an applicative functor (with effects resolved as
+-- they appear, left-to-right).
+plug, (^&^) :: (Applicative f) => f a -> f (a -> b) -> f b
+plug = (<**>)
+(^&^) = plug
+
+(~^$^~) :: (Applicative f, Applicative g) => g (f (a -> b)) -> g (f a) -> g (f b)
+f ~^$^~ a = (^$^) $^ f ^$^ a
+
+(~^&^~) :: (Applicative f, Applicative g) => g (f a) -> g (f (a -> b)) -> g (f b)
+f ~^&^~ a = (^&^) $^ f ^$^ a
+
+-- TODO: document
+(^<<^) :: (Applicative f, Category v) => f (v b c) -> f (v a b) -> f (v a c)
+(^<<^) = liftA2 (<.)
+
+-- TODO: document
+(^>>^) :: (Applicative f, Category v) => f (v a b) -> f (v b c) -> f (v a c)
+(^>>^) = liftA2 (.>)
+
+-- TODO: "semicolons"
+
+--------------------------------------------------------------------------------
+-- Monad
+
+infixl 0 ^&!, &!^, ^&!^
+infixl 1 $!^, ^$!, ^$!^
+
+map', ($!^) :: (Monad m) => (a -> b) -> m a -> m b
+map' f mx = mx >>= \x -> pure $! f x
+($!^) = map'
+
+for', (^&!) :: (Monad m) => m a -> (a -> b) -> m b
+for' = flip map'
+(^&!) = for
+
+flap', (^$!) :: (Monad m) => m (a -> b) -> a -> m b
+flap' mf x = mf >>= \f -> pure $! f x
+(^$!) = flap'
+
+flor', (&!^) :: (Monad m) => a -> m (a -> b) -> m b
+flor' = flip flap'
+(&!^) = flor'
+
+ap', (^$!^) :: (Monad m) => m (a -> b) -> m a -> m b
+ap' mf mx = do
+ f <- mf
+ x <- mx
+ pure $! f x
+(^$!^) = ap'
+
+plug', (^&!^) :: (Monad m) => m a -> m (a -> b) -> m b
+plug' mx mf = do
+ x <- mx
+ f <- mf
+ pure $! f x
+(^&!^) = plug'
+-}
+
+-- (.) :: (b0 -> c) -> (a0 -> b0) -> (a0 -> c)
+-- (g . f) a0 = g (f a0)
+-- (^.) :: (b0 -> b1 -> c) -> (a0 -> b1) -> (b0 -> a0 -> c)
+-- (g ^. f) b0 a0 = g b0 (f a0)
+-- (^^.) :: (b0 -> b1 -> b2 -> c) -> (a0 -> b2) -> (b0 -> b1 -> a0 -> c)
+-- (g ^^. f) b0 b1 a0 = g b0 b1 (f a0)
+-- (^^^.) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> b3) -> (b0 -> b1 -> b2 -> a0 -> c)
+-- (g ^^^. f) b0 b1 b2 a0 = g b0 b1 b2 (f a0)
+-- (.^) :: (b0 -> c) -> (a0 -> a1 -> b0) -> (a0 -> a1 -> c)
+-- (g .^ f) a0 a1 = g (f a0 a1)
+-- (^.^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> b1) -> (b0 -> a0 -> a1 -> c)
+-- (g ^.^ f) b0 a0 a1 = g b0 (f a0 a1)
+-- (^^.^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> b2) -> (b0 -> b1 -> a0 -> a1 -> c)
+-- (g ^^.^ f) b0 b1 a0 a1 = g b0 b1 (f a0 a1)
+-- (^^^.^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> c)
+-- (g ^^^.^ f) b0 b1 b2 a0 a1 = g b0 b1 b2 (f a0 a1)
+-- (.^^) :: (b0 -> c) -> (a0 -> a1 -> a2 -> b0) -> (a0 -> a1 -> a2 -> c)
+-- (^.^^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> a2 -> b1) -> (b0 -> a0 -> a1 -> a2 -> c)
+-- (^^.^^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> a2 -> b2) -> (b0 -> b1 -> a0 -> a1 -> a2 -> c)
+-- (^^^.^^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> a2 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> a2 -> c)
+-- (.^^^) :: (b0 -> c) -> (a0 -> a1 -> a2 -> a3 -> b0) -> (a0 -> a1 -> a2 -> a3 -> c)
+-- (^.^^^) :: (b0 -> b1 -> c) -> (a0 -> a1 -> a2 -> a3 -> b1) -> (b0 -> a0 -> a1 -> a2 -> a3 -> c)
+-- (^^.^^^) :: (b0 -> b1 -> b2 -> c) -> (a0 -> a1 -> a2 -> a3 -> b2) -> (b0 -> b1 -> a0 -> a1 -> a2 -> a3 -> c)
+-- (^^^.^^^) :: (b0 -> b1 -> b2 -> b3 -> c) -> (a0 -> a1 -> a2 -> a3 -> b3) -> (b0 -> b1 -> b2 -> a0 -> a1 -> a2 -> a3 -> c)
+
+-}
diff --git a/Todo/Wip.hs b/Todo/Wip.hs.txt
