eval : Expr -> Eff Integer [STDIO, EXCEPTION String, RND, STATE Env]

data Expr = Val Integer
          | Var String
          | Add Expr Expr
          | Random Integer

data RandomGen = RandomGen
data WriteLn = WriteLn { unWriteLn :: String }

type instance EffectRes RandomGen = Int
type instance EffectRes WriteLn = ()

myExecution :: Free (MyF '[ RandomGen , WriteLn ]) Int
myExecution = do
  rand1 <- effect RandomGen
  rand2 <- effect RandomGen
  effect $ WriteLn $ "Generated two random numbers: "
    <> show rand1 <> " " <> show rand2
  pure $ rand1 ^ 2 + rand2

runExecution :: IO Int
runExecution = iterM (runMyF handlers) myExecution
  where
    handlers = Handler (const randomIO) :& Handler (putStrLn . unWriteLn) :& RNil

ghci> :kind Int
Int :: *
ghci> :kind Char
Char :: *

ghci> :kind Maybe
Maybe :: * -> *
ghci> :kind Maybe String
Maybe :: *

ghci> :kind (Maybe Maybe)  -- ??

data MapTree k v 
  = Leaf 
  | Node k v (MapTree k v) (MapTree k v)

MapTree          :: * -> * -> *
MapTree a        :: * -> *
MapTree String v :: *

ghci> :info []
data [] a = [] | a : [a] 	-- Defined in ‘GHC.Types’
...

ghci> :kind []
[] :: * -> *                    -- kind of list
ghci> :kind [] Int
[] Int :: *                     -- `[] a` is the same as [a]
ghci> :kind [String]
[String] :: *

ghci> :info (->)
data (->) t1 t2 	-- Defined in ‘GHC.Prim’
infixr 0 `(->)`
...

ghci> :k (->)
(->) :: * -> * -> *  -- kind of function
ghci> :k (->) Int
(->) Int :: * -> *     

-- ((->) Int) is the same as (Int -> )

newtype ReaderT r (m :: * -> *) (a :: *) = ReaderT {runReaderT :: r -> m a}

ghci> :kind ReaderT
ReaderT :: * -> (* -> *) -> * -> *

ghci> :kind ReaderT String
ReaderT String :: (* -> *) -> * -> *

ghci> :kind ReaderT String IO
ReaderT String IO :: * -> *

ghci :kind ReaderT String IO Int
ReaderT String IO Int :: *

ghci> :kind ReaderT String Int

<interactive>:1:16: error:
    • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
    • In the second argument of ‘ReaderT’, namely ‘Int’
      In the type ‘ReaderT String Int’

instance Monad m => Monad (ReaderT r m)

class Monad (m :: * -> *) where
  return :: a -> m a
  (>>=)  :: m a -> (a -> m b) -> m b

class Num a where ...

ghci> :kind Num
??

ghci> :kind Num
Num :: * -> Constraint

{-# LANGUAGE ConstraintKinds #-}

type MyConstraints a = (Read a, Num a, Show a)

foo :: MyConstraints a => String -> a -> a

ghci> :set -XRankNTypes 
ghci> type ConstraintEndomorphism p a = p a => a -> a
ghci> :kind ConstraintEndomorphism 
ConstraintEndomorphism :: (* -> Constraint) -> * -> *

ghci> data a * b = Mult a b

    Illegal declaration of a type or class operator ‘*’
      Use TypeOperators to declare operators in type and declarations

ghci> :set -XTypeOperators 
ghci> data a * b = Mult a b
ghci> :t (*)
(*) :: Num a => a -> a -> a
ghci> :k (*)
(*) :: * -> * -> *

ghci> let x = Mult @Int 3 True
ghci> :t x 
x :: Int * Bool

-- Defined at Data.Type.Equality
data a :~: b where
    Refl :: a :~: a

data Z
data S n

data Vec :: * -> * -> * where
    Nil  :: Vec a Z
    Cons :: a -> Vec a n -> Vec a (S n)

v2 :: Vec Int (S (S Z))
v2 = 1 `Cons` (2 `Cons` Nil)

{-# LANGUAGE DataKinds #-}

data Nat = Z | S Nat

data Vec :: * -> Nat -> * where
    Nil  :: Vec a Z
    Cons :: a -> Vec a n -> Vec a (S n)

v3 :: Vec Int Char
v3 = ??

data Nat = Zero | Succ Nat

ghci> :t Succ
Succ :: Nat -> Nat
ghci> :k Nat
Nat :: *

ghci> :k Succ
    Not in scope: type constructor or class ‘Succ’
    A data constructor of that name is in scope; did you mean DataKinds?

ghci> :set -XDataKinds 
ghci> :k Succ
Succ :: Nat -> Nat

ghci> type Two = Succ (Succ Zero)
ghci> :k Two
Two :: Nat

ghci> type Two = 'Succ ('Succ 'Zero) -- due to ambiguity of type and constructor
ghci> :k Two
Two :: Nat

ghci> :k '[]
'[] :: [k]
ghci> :k '[Int, Bool]
'[Int, Bool] :: [*]
ghci> :k '[Maybe, Either String]
'[Maybe, Either String] :: [* -> *]
ghci> :k (Int ': '[Bool])
(Int ': '[Bool]) :: [*]

data Vec :: * -> Nat -> * where
    Nil  :: Vec a 'Z
    (:>) :: a -> Vec a n -> Vec a ('S n)

zipV :: Vec a n -> Vec b n -> Vec (a, b) n
zipV       Nil       Nil = Nil
zipV (x :> xs) (y :> ys) = (x, y) :> zipV xs ys

ghci> let x = 3    :> Nil
ghci> let y = True :> Nil
ghci> :t x
x :: Num a => Vec a ('S 'Z)
ghci> :t y
y :: Vec Bool ('S 'Z)

ghci> :t zipV x y
zipV x y :: Num a => Vec (a, Bool) ('S 'Z)

ghci> :t zipV x (4 :> y)
    • Couldn't match type ‘'S 'Z’ with ‘'Z’
      Expected type: Vec Bool ('S 'Z)
        Actual type: Vec Bool ('S ('S 'Z))
    • In the second argument of ‘zipV’, namely ‘(4 :> y)’
      In the expression: zipV x (4 :> y)

data HList :: [*] -> * where
    HNil :: HList '[]
    (:^) :: a -> HList t -> HList (a ': t)

infixr 2 :^

foo0 :: HList '[]
foo0 = HNil

foo1 :: HList '[Int]
foo1 = 3 :^ HNil

foo2 :: HList '[Int, Bool]
foo2 = 5 :^ False :^ HNil

instance Show (HList '[]) where
    show _ = "H[]"

instance (Show e, Show (HList l)) => Show (HList (e ': l)) where
    show (x :^ l) = let 'H':'[':s = show l
                    in "H[" ++ show x ++ (if s == "]" then s else ", " ++ s)

ghci> foo0
H[]
ghci> foo2
H[5, False]

data Vec :: * -> Nat -> * where
    Nil  :: Vec a 0
    (:>) :: a -> Vec a n -> Vec a (n + 1)

ghci> :t True :> False :> Nil
True :> False :> Nil :: Vec Bool 2

newtype ArrPtr (n :: Nat) a = ArrPtr (Ptr a)

clearPage :: ArrPtr 4096 Word8 -> IO ()
clearPage (ArrPtr p) = ...

import GHC.TypeLits

ghci> :t (+)
(+) :: Num a => a -> a -> a
ghci> :k (+)
(+) :: Nat -> Nat -> Nat

ghci> :i +
class Num a where
  ...
infixl 6 +

type family (+) (a :: Nat) (b :: Nat) :: Nat
infixl 6 +

newtype Foo bar = MkFoo { unFoo :: bar }

MkFoo :: bar -> Foo bar    (term level)
Foo :: * -> *              (type level)

data Foo a where
  Foo :: Int -> Foo Int
  Bar :: Char -> Foo Double

Foo :: Int -> Foo Int      (term level)
Bar :: Char -> Foo Double  (term level)
Foo :: * -> *              (type level)

type fun Foo a where
  | a == Char = Double
  | otherwise = a

type family Foo bar :: * where
  Foo Char = Double
  Foo b = b

type family Foo bar :: *
type instance Foo Char = Double
type instance Foo Int = Int

type family Foo bar :: *
type instance Foo Char = Double
type instance Foo a = a

error:
  Conflicting family instance declarations

data family Foo bar :: *
data instance Foo Int = MkFoo Int

class Foo p where
  type AType p :: *
  data BType p :: *

  make :: AType p -> BType p

instance Foo Int where
  type AType Int = Int
  data BType Int = B Integer
  
  make = B . toInteger

type family FromMaybe
     (m :: Maybe *) (def :: *) :: * where
  FromMaybe ('Just t) def = t
  FromMaybe 'Nothing def = def

FromMaybe ('Just Int) Bool ~ Int

{-# LANGUAGE PolyKinds #-}

type family FromMaybe
     (m :: Maybe k) (def :: k) :: k where
  FromMaybe ('Just t) def = t
  FromMaybe 'Nothing def = def

show' :: Show (Foo a)
      => Foo a -> String
show' = show

type family Foo bar :: * where
  Foo Char = Double
  Foo b = b

error:
  • Couldn't match type ‘Foo a0’ with ‘Foo a’
    Expected type: Foo a -> String
    Actual type: Foo a0 -> String
    NB: ‘Foo’ is a non-injective type family

{-# LANGUAGE TypeFamilyDependencies #-}

type family Foo a = r | r -> a where
  Foo Char = Double
  Foo a = a

error:
  • Type family equations violate injectivity:
    Foo Char = Double
    Foo a = a

{-# LANGUAGE TypeFamilyDependencies #-}

type family Foo a = r | r -> a where
  Foo Char = Double
  Foo Int = Int

ghci> show' (1 :: Int)
"1"

ghci> (show' :: _) (1 :: Double)
 • Found type wildcard for ‘Foo Char -> String’

type family Foo bar :: *

newtype FooWrapped bar = Foo { unFoo :: Foo bar }

data Union (f :: u -> *) (as :: [u]) where
  This :: !(f a) -> Union f (a ': as)
  That :: !(Union f as) -> Union f (a ': as)

data Rec :: (u -> *) -> [u] -> * where
  RNil :: Rec f '[]
  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)

one3 :: Union Identity '[Int, Char, Int]
one3 = That (This (Identity 'a'))

tup3 :: Rec Identity '[Int, Char, Int]
tup3 = Identity 1 :& Identity 'a'
                  :& Identity 5 :& RNil

tup3 :: Rec Maybe '[Int, Char, Int]
tup3 = Just 1 :& Nothing
                  :& Just 5 :& RNil

data Free f a = Pure a | Free (f (Free f a))

data Action a =
  PrintLn String a | ReadInt (Int -> a)
  

justPrint :: Free Action Int
justPrint = Free $ PrintLn "poid" (Pure 5)

readIncPrint :: Free Action ()
readIncPrint =
  Free $ ReadInt $ \i ->
    Free $ PrintLn (show $ i + 1) (Pure ())

runAction :: Free Action a -> IO a
runAction (Pure x) = pure x
runAction (Free (PrintLn s cont)) =
  putStrLn s *> runAction cont
runAction (Free (ReadInt cont)) = do
  i <- fmap read getLine
  runAction (cont i)

ghci> runAction readIncPrint
5
6

data Action a =
  PrintLn String a | ReadInt (Int -> a)
  deriving Functor

printLn :: String -> Free Action ()
printLn s = Free $ PrintLn s (Pure ())

readInt :: Free Action Int
readInt = Free $ ReadInt Pure

readIncPrint :: Free Action ()
readIncPrint = do
  i <- readInt
  printLn $ show (i + 1)

type family EffectRes s :: *

data MyFEl a s = MyFEl s (EffectRes s -> a)

newtype MyF xs a = MyF ( Union (MyFEl a) xs)

instance Functor (MyF xs) where (..)

effect
  :: (UElem s xs (RIndex s xs))
  => s -> Free (MyF xs) (EffectRes s)
effect = Free . MyF . ulift . flip MyFEl pure

newtype Handler m s = Handler ( s -> m (EffectRes s) )

runMyF
  :: Monad m
  => Rec (Handler m) xs -> MyF xs (m a) -> m a
runMyF (Handler h1 :& hRest) (MyF u) =
  union (runMyF hRest . MyF) handle u
  where
    handle (MyFEl e resH) = resH =<< h1 e
runMyF RNil (MyF u) = absurdUnion u

data RandomGen = RandomGen
data WriteLn = WriteLn { unWriteLn :: String }

type instance EffectRes RandomGen = Int
type instance EffectRes WriteLn = ()

myExecution :: Free (MyF '[ RandomGen , WriteLn ]) Int
myExecution = do
  rand1 <- effect RandomGen
  rand2 <- effect RandomGen
  effect $ WriteLn $ "Generated two random numbers: "
    <> show rand1 <> " " <> show rand2
  pure $ rand1 ^ 2 + rand2

runExecution :: IO Int
runExecution = iterM (runMyF handlers) myExecution
  where
    handlers = Handler (const randomIO) :& Handler (putStrLn . unWriteLn) :& RNil