In Haskell
isOdd :: Int -> Bool
isOdd n = False
type family IsOdd (n :: GHC.TypeLits.Nat) :: Bool where
IsOdd n = 'False
{-# LANGUAGE UndecidableInstances, KitchenSink #-}
import Fcf -- (=<<), Eval, Not, TyEq
import GHC.TypeLits -- Mod, Nat(0..)
------------------------------------
-- Term Level
isOdd :: Int -> Bool
isOdd n = (mod n 2) /= 0
-- λ> isOdd 11
-- True
------------------------------------
-- Type Level
type family IsOdd (n :: Nat) :: Bool where
IsOdd n = Eval (Not =<< (TyEq (Mod n 2) (0)))
-- λ> :kind! IsOdd 10
-- IsOdd 11 :: Bool
-- = 'True
Constructing programs which execute at compile time taking types as input and return as output both new types and runtime functionality
data Bool = True | False
data [a] = [] | a : [a]
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
data Bool = True | False
data [a] = [] | a : [a]
data Three a b c = Three a b c
false = False :: Bool
fives = [5,5,5,5,5] :: [Int]
three = Three 10 (-10) 9001 :: Three Int Int Int
data Bool = True | False
data [a] = [] | a : [a]
data Three a b c = Three a b c
false = False :: Bool
fives = [5,5,5,5,5] :: [Int]
three = Three 10 (-10) 9001 :: Three Int Int Int
Type Constructor
Data Constructor
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
Type Signature
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
Parametric Polymorphism
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
Higher Order Function
filter :: (a -> Bool) -> [a] -> [a]
filter pred [] = []
filter pred (x:xs) =
case pred x of
False -> x : filter pred xs
True -> filter pred xs
Patterns
class Num a where
(+) :: a -> a -> a
(-) :: a -> a -> a
(*) :: a -> a -> a
instance Num Int where
(+) :: Int -> Int -> Int
a + b = plusInt a b
(-) :: Int -> Int -> Int
a - b = minusInt a b
(*) :: Int -> Int -> Int
a * b = timesInt a b
square :: Num a => a -> a
square x = x * x
class Num a where
(+) :: a -> a -> a
(-) :: a -> a -> a
(*) :: a -> a -> a
instance Num Int where
(+) :: Int -> Int -> Int
a + b = plusInt a b
(-) :: Int -> Int -> Int
a - b = minusInt a b
(*) :: Int -> Int -> Int
a * b = timesInt a b
square :: Num a => a -> a
square x = x * x
Context / Constraint
Ad Hoc Polymorphism
data Void
data () = ()
data Bool = False | True
data Alphabet a c = Alphabet a Bool c
data Maybe a = Nothing | Just a
-- 0
data Void
-- 1
data () = ()
-- 1 + 1 = 2
data Bool = False | True
-- |a| * 2 * |c|
data Alpha a c = Alphabet a Bool c
-- 1 + |a|
data Maybe a = Nothing | Just a
|Void| = 0
|()| = 1
|Bool|= 2
|Alpha Bool Bool| = 8
|Maybe ()| = 2
s t
to :: s -> t
to = _
from :: t -> s
from = _
to . from = id
from . to = id
s t
data S = S deriving Show
data T = T deriving Show
λ> (toT . fromT) T
T
λ> (fromT . toT) S
S
toT :: S -> T
toT S = T
fromT :: T -> S
fromT T = S
s t
data S = S deriving Show
data T = T deriving Show
λ> (fromT . toT) S
S
λ> (toT . fromT) T
T
toT :: S -> T
toT S = T
fromT :: T -> S
fromT T = S
toS :: T -> S
toS T = S
fromS :: S -> T
fromS S = T
λ> (fromS . toS) T
T
λ> (toS . fromS) S
S
prodUnitTo :: a -> (a, ())
prodUnitTo a = (a, ())
prodUnitFrom :: (a, ()) -> a
prodUnitFrom (a, ()) = a
sumUnitTo :: Either a Void -> a
sumUnitTo (Left a) = a
sumUnitTo (Right v) = absurd v
sumUnitFrom :: a -> Either a Void
sumUnitFrom = Left
|a -> b| = |b| × |b| × · · · × |b| = |b|^|a|
Basically states that for every value in a, there is a mapping to any value in b
id :: Bool -> Bool
id b = b
not :: Bool -> Bool
not = \case
False -> True
True -> False
constTrue :: Bool -> Bool
constTrue = const True
constFalse :: Bool -> Bool
constFalse = const False
|Bool -> Bool| = |Bool| * |Bool| = |2| ^ |2| = 4
Algebra |
Logic |
Types |
a + b |
a ∨ b |
Either a b |
a × b |
a ∧ b |
(a, b) |
b ^ a |
a ⇒ b |
a -> b |
a = b |
a ⇐⇒ b |
isomorphism |
0 |
⊥ |
Void |
1 |
⊤ |
() |
{#- LANGUAGE PolyKinds -#}
{#- LANGUAGE KindSignatures -#}
{#- LANGUAGE DataKinds -#}
{#- LANGUAGE ConstraintKinds -#}
show :: Show a => a -> String
type ReadShow a = (Read a, Show a)
{#- LANGUAGE PolyKinds -#}
{#- LANGUAGE DataKinds -#}
data Bool = False | True
-- Produces kind `Bool` and types `'True` and `'False`
-- λ> :k 'True
-- 'True :: Bool
-- λ> :k 'False
-- 'False :: Bool
{#- LANGUAGE GADTs -#}
five :: Int
five = 5
five_ :: (a ∼ Int) => a
five_ = 5
{#- LANGUAGE GADTs -#}
data Maybe a where
Nothing :: Maybe a
Just :: a -> Maybe a
just5 = Just 5
data HList (xs :: [*]) where
HNil :: HList '[]
(:#) :: a -> HList as -> HList (a ': as)
infixr 5 :#
things :: HList '[Bool, Int, Int]
things = True :# 0 :# 10 :# HNil
data HList (xs :: [*]) where
HNil :: HList '[]
(:#) :: a -> HList as -> HList (a ': as)
infixr 5 :#
things :: HList '[Bool, Int, Int]
things = True :# 0 :# 10 :# HNil
instance Show (HList '[]) where
show HNil = "HNil"
instance (Show t, Show (HList ts))
=> Show (HList (t ': ts)) where
show (a :# as) = show a <> " :' " <> show as
-- λ> show things
-- "True :' 0 :' 10 :' HNil"
{#- LANGUAGE GADTs -#}
data Expr a where
LitInt :: Int -> Expr Int
LitBool :: Bool -> Expr Bool
Add :: Expr Int -> Expr Int -> Expr Int
Not :: Expr Bool -> Expr Bool
If :: Expr Bool -> Expr a -> Expr a -> Expr a
evalExpr :: Expr a -> a
evalExpr (LitInt i) = i
evalExpr (LitBool b) = b
evalExpr (Add x y) = evalExpr x + evalExpr y
evalExpr (Not x) = not $ evalExpr x
evalExpr (If b x y) =
if evalExpr b then evalExpr x else evalExpr y
-- λ> evalExpr $ If (LitBool False)
-- (LitInt 1) (Add (LitInt 5) (LitInt 1))
-- 6
-- λ> evalExpr . Not $ LitBool True
-- False
{#- LANGUAGE GADTs -#}
data Expr a where
LitInt :: Int -> Expr Int
LitBool :: Bool -> Expr Bool
Add :: Expr Int -> Expr Int -> Expr Int
Not :: Expr Bool -> Expr Bool
If :: Expr Bool -> Expr a -> Expr a -> Expr a
data Expr_ a =
(a ∼ Int) => LitInt_ Int
| (a ∼ Bool) => LitBool_ Bool
| (a ∼ Int) => Add_ (Expr_ Int) (Expr_ Int)
| (a ∼ Bool) => Not_ (Expr_ Bool)
| If_ (Expr_ Bool) (Expr_ a) (Expr_ a)
{#- LANGUAGE TypeFamilies -#}
or :: Bool -> Bool -> Bool
or True _ = True
or False y = y
type family Or (x :: Bool) (y :: Bool) :: Bool where
Or 'True y = 'True
Or 'False y = y
or :: Bool -> Bool -> Bool
or True _ = True
or False y = y
type family Or (x :: Bool) (y :: Bool) :: Bool
type instance Or 'True y = 'True
type instance Or 'False y = y
type family Map (x :: a -> b) (i :: [a]) :: [b] where
Map f '[] = '[]
Map f (x ': xs) = f x ': Map f xs
-- λ> :t undefined :: Proxy (Map (Or 'True)
-- '[ 'True, 'False , 'False ])
-- <interactive>:1:14: error:
-- • The type family ‘Or’ should have 2 arguments,
-- but has been given 1....
class Collection c where
type Elem c :: *
firstElem :: c -> Elem c
instance Collection [a] where
type Elem [a] = a
firstElem (x:xs) = x
instance Collection (a,b) where
type Elem (a,b) = a
firstElem (x,y) = x
class Collection c where
type Elem c :: *
firstElem :: c -> Elem c
instance Collection [a] where
type Elem [a] = a
firstElem (x:xs) = x
instance Collection (a,b) where
firstElem _ = undefined
-- <interactive>:614:1: warning: [-Wmissing-methods]
-- • No explicit associated type or default...
Scope and Application
λ> :t fmap
fmap :: Functor f => (a -> b) -> f a -> f b
λ> :t fmap @_ @Int @Bool
fmap @_ @Int @Bool :: Functor w => (Int -> Bool)
-> w Int
-> w Bool
{#- LANGUAGE TypeApplications -#}
This compiles :)
prefix :: a -> [[a]] -> [[a]]
prefix x yss = map xcons yss
where xcons ys = x : ys
This doesn't compile!! Why?
prefix :: a -> [[a]] -> [[a]]
prefix x yss = map xcons yss
where xcons :: [a] -> [a]
xcons ys = x : ys
Fixed!
{-# LANGUAGE ScopedTypeVariables #-}
prefix :: forall a. a -> [[a]] -> [[a]]
prefix x yss = map xcons yss
where xcons :: [a] -> [a]
xcons ys = x : ys
{#- LANGUAGE ScopedTypeVariables -#}
{-# LANGUAGE ScopedTypeVariables #-}
prefix :: forall a. a -> [[a]] -> [[a]]
prefix x yss = map xcons yss
where xcons :: [a] -> [a]
xcons ys = x : ys
normalize :: String -> String
normalize s = show (read s)
normalize s = show (read s :: Int)
Doesn't compile
COMPILES!!!!!!!!!!!!!!!!!!!!!!
λ> :t read
read :: Read a => String -> a
λ> :t show
show :: Show a => a -> String
λ> :t show . read
show . read :: String -> String
Consider:
data T a = Leaf a | Node (T [a]) (T [a])
leaves :: T a -> [a]
leaves (Leaf x) = [x]
leaves (Node t1 t2) = concat (leaves t1 ++ leaves t2)
-- λ> leaves (Leaf x) = [x]
-- λ> leaves (Node t1 t2) = concat (leaves t1 ++ leaves t2)
--
-- <interactive>:152:1: error:
-- • Occurs check: cannot construct the infinite type: a ~ [a]
-- Expected type: T [a] -> [[a1]]
-- Actual type: T a -> [a1]
-- • Relevant bindings include
-- leaves :: T [a] -> [[a1]] (bound at <interactive>:152:1)
data G a where
MkInt :: G Int
MkFun :: G (Int -> Int)
matchG :: G a -> a
matchG MkInt = 5
matchG MkFun = (+10)
type family F a
type instance F Bool = Char
ambig :: Typeable a => F a -> Int
ambig _ = 5
test :: Char -> Int
test x = ambig @Bool x
{#- LANGUAGE RankNTypes -#}
applyToFive :: (a -> a) -> Int
applyToFive f = f 5
-- <interactive>:650:17: error:
-- • Couldn't match expected type
-- ‘Int’ with actual type ‘a’
Won't compile :(
applyToFive :: (forall a. a -> a) -> Int
applyToFive f = f 5
-- λ> applyToFive id
-- 5
Compiles! :)
Consider:
foo :: forall r. (forall a. a -> r) -> r
foo fn = _
We get to determine the return type r, but we never get implementation of whatever fn is get to decide what a is
What are the ranks of foo, bar, and baz?
foo :: Int -> forall a. a -> a
bar :: (a -> b) -> (forall c. c -> a) -> b
baz :: ((forall x. m x -> b (z m x))
-> b (z m a))
-> m a
foo :: Int -> forall a. a -> a -- rank 1
bar :: (a -> b) -> (forall c. c -> a) -> b -- rank-2
baz :: ((forall x. m x -> b (z m x)) -- rank-3
-> b (z m a))
-> m a
fst :: (a, b) -> a
fst (a, b) = a
-- Defunctionalized
data Fst a b = Fst (a, b)
class Eval l t | l -> t where
eval :: l -> t
instance Eval (Fst a b) a where
eval (Fst (a, b)) = a
-- λ> eval $ Fst (10,20)
-- 10
type family Map (x :: a -> b) (i :: [a]) :: [b] where
Map f '[] = '[]
Map f (x ': xs) = f x ': Map f xs
type Exp a = a -> Type
type family Eval (e :: Exp a) :: a
data Snd :: (a, b) -> Exp b
type instance Eval (Snd '(a, b)) = b
-- λ> :kind! Eval (Snd '(1, " hello " ))
-- Eval (Snd '(1, " hello " )) :: Symbol
-- = " hello "
-------------------------------------------
-- Term Level
data Optional a = Missing | Present a
fromOptional :: a -> Optional a -> a
fromOptional deflt Missing = deflt
fromOptional deflt (Present a) = a
-------------------------------------------
-- Type Level
import qualified GHC.TypeLits as TL
data FromOptional :: k -> Optional k -> Exp k
type instance Eval (FromOptional a 'Missing) = a
type instance Eval (FromOptional _a ('Present b)) = b
data Plus :: TL.Nat -> TL.Nat -> Exp TL.Nat
type instance Eval (Plus a b) = a TL.+ b
-------------------------------------------
-- Term Level
data Optional a = Missing | Present a
fromOptional :: a -> Optional a -> a
fromOptional deflt Missing = deflt
fromOptional deflt (Present a) = a
-------------------------------------------
-- Type Level
import qualified GHC.TypeLits as TL
data FromOptional :: k -> Optional k -> Exp k
type instance Eval (FromOptional a 'Missing) = a
type instance Eval (FromOptional _a ('Present b)) = b
data Plus :: TL.Nat -> TL.Nat -> Exp TL.Nat
type instance Eval (Plus a b) = a TL.+ b
data Optional a = Missing | Present a
data FromOptional :: k -> Optional k -> Exp k
type instance Eval (FromOptional a 'Missing) = a
type instance Eval (FromOptional _a ('Present b)) = b
-- λ> :kind! Eval (Map (FromOptional 3)
-- [ 'Present 1, 'Present 2, 'Missing])
-- Eval (Map (FromOptional 3)
-- [ 'Present 1, 'Present 2, 'Missing]) :: [GHC.Types.Nat]
-- = '[1, 2, 3]
λ> :kind! Eval ((Snd <=< FromMaybe '(0, 0))
=<< Pure (Just '(1,2)))
Eval ((Snd <=< FromMaybe '(0, 0))
=<< Pure (Just '(1,2))) :: Nat
= 2
{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies,
TypeInType, TypeOperators, UndecidableInstances #-}