newtype Hash = MkHash String

class Hashable a where
    hash :: a -> Hash

hashPair :: Int -> Hash
hashPair n = hash (n, n)

hashPair :: Int -> Hash
hashPair n = hash n  -- oops, this is valid definition!

newtype Hash a = MkHash String -- `a` is a phantom type, not present in constructor

class Hashable a where
    hash :: a -> Hash a

hashPair :: Int -> Hash (Int, Int)
hashPair n = hash (n, n)

hashPair :: Int -> Hash (Int, Int)
hashPair n = hash n  -- This is no longer a valid definition!

Hash.hs:7:14: error:
    • Couldn't match type ‘Int’ with ‘(Int, Int)’
      Expected type: Hash (Int, Int)
        Actual type: Hash Int
    • In the expression: hash n
      In an equation for ‘hashPair’: hashPair n = hash n

newtype Signature a = Signature ByteString

sign :: Binary t => SecretKey -> t -> Signature t

data Abs  -- absolute path
data Rel  -- relative path

data Dir  -- directory
data File -- file

newtype Path b t = Path FilePath

-- appending paths
(</>) :: Path b Dir -> Path Rel t -> Path b t

data Second
data Microsecond  -- rough approximation

newtype Time unit = Time (Ratio Natural)

ghci> showAll [2, 3]
["2", "3"]

ghci> showAll [1, "ABA"]  -- ??

    No instance for (Num [Char]) arising from the literal ‘1’
    In the expression: 1
    In the first argument of ‘showAll’, namely ‘[1, "ABA"]’
    In the expression: showAll [1, "ABA"]

ghci> [False, "ABA"]  -- fails
  Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
  In the expression: "ABA"
  In the expression: [False, "ABA"]
  In an equation for ‘it’: it = [False, "ABA"]

applyTwo :: ([Int], [Bool])
applyTwo = let call f = (f [2, 1, 3], f [True, False]) in call reverse  -- (*)

-- but we get:
(*):29:
    No instance for (Num Bool) arising from the literal ‘2’
    In the expression: 2
    In the first argument of ‘f’, namely ‘[2, 1, 3]’
    In the expression: f [2, 1, 3]

(*):15:
    Couldn't match type ‘Int’ with ‘Bool’
    Expected type: ([Int], [Bool])
      Actual type: ([Int], [Int])
    In the expression: call reverse
    In the expression: let call f = (f ..., f ...) in call reverse

(*):20:
    Couldn't match type ‘Bool’ with ‘Int’
    Expected type: [Bool] -> [Int]
      Actual type: [Int] -> [Int]
    In the first argument of ‘call’, namely ‘reverse’
    In the expression: call reverse

-- and we want
gchi> applyTwo
([3,1,2], [False,True])

id :: a -> a
id x = x

-- real type with explicit forall
id :: forall a . a -> a
id x = x

ghci> applyTwo id        -- works like magic
([2,1,3],[True,False])
ghci> applyTwo reverse
([3,1,2],[False,True])

applyTwo :: (forall a . [a] -> [a]) -> ([Int], [Bool])
applyTwo f = (f [2, 1, 3], f [True, False])

applyTwo :: ([a] -> [a]) -> ([Int], [Bool])             -- doesn't compile
applyTwo f = (f [2, 1, 3], f [True, False])

ghci> (\(a, b) -> (reverse a, reverse b)) ("hello", [2, 1, 3])  -- ??

applyTwo :: forall a . ([a] -> [a]) -> ([Int], [Bool])  -- equivalent form ^
applyTwo f = (f [2, 1, 3], f [True, False])

applyTwo :: ([a] -> [a]) -> [b] -> [c] -> ([b], [c])
applyTwo f x y = (f x, f y)

    • Couldn't match type ‘b’ with ‘a’
      ‘b’ is a rigid type variable bound by
        the type signature for:
          applyTwo :: forall a b c. ([a] -> [a]) -> [b] -> [c] -> ([b], [c])

ghci> applyTwo id [2,1,3] [True,False]
([2,1,3],[True,False])
ghci> applyTwo reverse [True,False] "patak"
([False,True],"katap")

applyTwo :: (forall a . [a] -> [a]) -> [b] -> [c] -> ([b], [c])
applyTwo f x y = (f x, f y)

reverse :: forall a . [a] -> [a]

applyTwo :: forall b c . (forall a . [a] -> [a]) -> [b] -> [c] -> ([b], [c])
applyTwo f x y = (f x, f y)

undefined :: forall a . a  -- intersection of all types
undefined = ⊥

Rank 0: Int
Rank 1: forall a . a -> Int
Rank 2: (forall a . a -> Int) -> Int           -- could be enabled by Rank2Types
Rank 3: ((forall a . a -> Int) -> Int) -> Int

Int -> Int

Int -> Int                                   -- rank 0

forall a . a -> a

(forall a . a -> a) -> Int

(forall a . a -> a) -> Int                   -- rank 2

Int -> (forall a . a -> a) 

forall a b . a -> b -> a

forall a b . a -> b -> a                     -- rank 1 

showAll :: Show a => [a] -> [String]
showAll = map show

showAll :: forall a . Show a => [a] -> [String]
showAll = map show

showAll :: Show a => [forall a . a] -> [String]  -- 'a' not in scope for Show
showAll = map show

showAll :: [forall a . Show a => a] -> [String]  -- only bottoms
showAll = map show

{-# LANGUAGE ExistentialQuantification #-}

data ShowBox = forall a . Show a => SB a  -- existental constructor

showAll :: [ShowBox] -> [String]
showAll = map (\(SB a) -> show a)

ghci> showAll [SB (), SB 1, SB True]  -- again, this magic works
["()","1","True"]

showAll :: forall a . [Show a => a] -> [String]  -- ImpredicativeTypes (broken)
showAll = map show

ghci> incShow "3"  -- why does this work at all?
"4"

ghci> incShow "3.0"
"*** Exception: Prelude.read: no parse

-- incShow :: ???
incShow = show . (+1) . read

ghci> :t read  -- our simple 'deserialize' function
read :: Read a => String -> a
ghci> :t show  -- our simple 'serialize' function
show :: Show a => a -> String

incShow :: String -> String
incShow = show . (+1) . read

-- v1.0.0: also compiles
prepend2 :: Int -> [Int] -> [Int]
prepend2 x xs = pair ++ xs 
  where pair = [x, x]

-- v3.0.0: doesn't compile!
prepend2 :: a -> [a] -> [a]
prepend2 x xs = pair ++ xs 
  where pair :: [a]
        pair = [x, x] 

-- v0.0.0: this compiles
prepend2 :: Int -> [Int] -> [Int]
prepend2 x xs = pairFun x ++ xs 
  where pairFun y = [y, y]

-- v2.0.0: compiles or not?
prepend2 :: a -> [a] -> [a]
prepend2 x xs = pair ++ xs 
  where pair = [x, x]

-- v2.1.0: everything works!
prepend2 :: a -> [a] -> [a]
prepend2 x xs = pairFun x ++ xs 
  where pairFun :: a -> [a]
        pairFun y = [y, y] 

prepend2 :: a -> [a] -> [a]
prepend2 x xs = pair ++ xs 
  where 
    pair :: [a]
    pair = [x, x] 

id :: a -> a

id :: forall . a -> a

prepend2 :: forall a . a -> [a] -> [a]
prepend2 x xs = pair ++ xs 
  where 
    pair :: forall a . [a]
    pair = [x, x] 

-- it's basically the same reason why this doesn't compile
prepend2 :: forall a b . b -> [a] -> [a]
prepend2 x xs = [x, x] ++ xs 

{-# LANGUAGE ScopedTypeVariables #-}

prepend2 :: forall a . a -> [a] -> [a]
prepend2 x xs = pair ++ xs 
  where 
    pair :: [a]  -- uses same type variable 'a'
    pair = [x, x] 

ghci> read "3"   :: Int
3
ghci> read "3.0" :: Double
3.0

-- in some artifical syntax...
read :: (a :: Type) -> (_ :: String) -> (x :: a)

read :: forall a . Read a => String -> a

ghci> :t read
read :: Read a => String -> a
ghci> read @Int "3"
3
ghci> read @Double "3.0"
3.0
ghci> :t read @Int
read @Int :: String -> Int

ghci> read "3"   :: Int  -- so, here we basically just pass Int type
3
ghci> read "3.0" :: Double
3.0

-- do you see problems with this code?
class Size a where
    size :: Int

    • Could not deduce (Size a)
      from the context: Size a
        bound by the type signature for:
                   size :: forall a. Size a => Int

{-# LANGUAGE AllowAmbiguousTypes #-}

class Size a where size :: Int
instance Size Int    where size = 8
instance Size Double where size = 16

ghci> size  -- this all looks great, but how can I call 'size' function??????

    • Ambiguous type variable ‘a0’ arising from a use of ‘size’
      prevents the constraint ‘(Size a0)’ from being solved.
      Probable fix: use a type annotation to specify what ‘a0’ should be.
      These potential instances exist:
        instance [safe] Size Double -- Defined at Forall.hs:12:10
        instance [safe] Size Int -- Defined at Forall.hs:9:10

ghci> size @Double  -- use -XTypeApplications
16

-- simple plain haskell
class Size a where
    size :: a -> Int

-- v0.0.0: this doesn't work obviously
incShow :: String -> String
incShow = show . (+1) . read

ghci> incShow @Int "3"
"4"
ghci> incShow @Double "3.2"
"4.2"
ghci> incShow @Rational "3 % 5"
"8 % 5"

-- v0.0.1: why this doesn't work?
incShow :: (Read a, Show a, Num a) => String -> String
incShow = show . (+1) . read

{-# LANGUAGE AllowAmbiguousTypes #-}

-- v0.0.2: why still doesn't work??
incShow :: (Read a, Show a, Num a) => String -> String
incShow = show . (+1) . read

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications    #-}

-- v0.0.3: why still this doesn't work???
incShow :: (Read a, Show a, Num a) => String -> String
incShow = show . (+1) . read @a

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

-- v1.0.0: this works!
incShow :: forall a . (Read a, Show a, Num a) => String -> String
incShow = show . (+1) . read @a

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 -> )

ghci> data Computable a f = Computation (f a) a
ghci> :kind Computable
Computable :: * -> (* -> *) -> *

ghci> :kind Computable String
Computable String :: (* -> *) -> *
ghci> :kind Computable Int Maybe
Computable Int Maybe :: *
ghci> :kind Computable (Maybe String) ((->) Int)
Computable (Maybe String) ((->) Int) :: *

newtype IntComputation f = MkIntComp (f Int)    -- option 1: new data type
type    IntComputation f = Computable Int f     -- option 2: specialization

ghci> :k IntComputation  -- in both cases
IntComputation :: (* -> *) -> *

ghci> :set -XKindSignatures
ghci> :set -XPolyKinds
ghci> data PolyComputable (f :: k -> *) (a :: k) = PolyComputation (f a)
ghci> :kind PolyComputable 
PolyComputable :: (k -> *) -> k -> *

ghci> :k PolyComputable Maybe
PolyComputable Maybe :: * -> *

ghci> :k PolyComputable IntComputation 
PolyComputable IntComputation :: (* -> *) -> *

class Box b where  -- b :: * -> *
    box   :: a -> b a
    unbox :: b a -> a

instance Box Maybe where  -- "instance Box (Maybe a) where" is compilation error
    box = Just            -- η-reduce from: box a = Just a
    
    unbox (Just a) = a
    unbox Nothing  = error "Can't unbox from empty context"

instance Box [] where
    box :: a -> [a]
    box x     = [x]

    unbox :: [a] -> a
    unbox [x] = x

boxCall :: Box m => (a -> b) -> m a -> m b
boxCall f b = box $ f $ unbox b

ghci> boxCall (+1) (Just 4)
Just 5

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) -> * -> *

-- not in Haskell standard libraries
class Magma m where
    meld :: m -> m -> m

1. (++)
2. max/min
3. x ○ y = xy + x^2 - y

-- actually in 'base'
class Semigroup m where
    (<>) :: m -> m -> m

Associativity law for Semigroup: 
  1. (x <> y) <> z ≡ x <> (y <> z)

1. (++)
2. max/min

-- also in 'base' but...
class Semigroup m => Monoid m where
    mempty :: m

Identity laws for Monoid: 
  2. x <> mempty ≡ x
  3. mempty <> x ≡ x

1. (++)

class Semigroup a where
    (<>)    :: a -> a -> a
    sconcat :: NonEmpty a -> a
    stimes  :: Integral b => b -> a -> a

instance Semigroup [a] where
    (<>) = (++)

ghci> [1..5] <> [2,4..10]
[1,2,3,4,5,2,4,6,8,10]

>>> 3 * list(range(1,6))
[1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5]

ghci> concat (replicate 3 [1..5])
[1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5]

ghci> 3 `stimes` [1..5]
[1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5]

instance Semigroup Int where
    -- Which one to choose?
    1. (<>) = (+)
    2. (<>) = (*)

newtype Sum     a = Sum     { getSum     :: a }
newtype Product a = Product { getProduct :: a }

instance Num a => Semigroup (Sum a) where
  Sum x <> Sum y = Sum (x + y)

instance Num a => Semigroup (Product a) where
  Product x <> Product y = Product (x * y)

ghci> 3 <> 5 :: Sum Int
Sum { getSum = 8 }
ghci> 3 <> 5 :: Product Int
Product { getProduct = 15 }

newtype Max   a = Max   { getMax   :: a    }  -- max
newtype Min   a = Min   { getMin   :: a    }  -- min
newtype Any     = Any   { getAny   :: Bool }  -- ||
newtype All     = All   { getAll   :: Bool }  -- &&
newtype First a = First { getFirst :: a    }  -- fst
newtype Last  a = Last  { getLast  :: a    }  -- snd

ghci> Max 3 <> Max 10 <> Max 2
Max { getMax = 10 }
ghci> Min 3 <> Min 10 <> Min 2
Min { getMin = 2 }

ghci> Any True <> Any False <> Any True
Any { getAny = True }
ghci> All True <> All False <> All True
All { getAll = False }

ghci> First 5 <> First 10 <> First 1
First { getFirst = 5 }
ghci> Last 5 <> Last 10 <> Last 1
Last { getLast = 1 }

-- not a descendant of Semigroup for now
class Monoid a where
    mempty  :: a
    mappend :: a -> a -> a
    mconcat :: [a] -> a

instance Monoid [a] where
    mempty          = []
    l1 `mappend` l2 = l1 ++ l2

instance (Monoid a, Monoid b) => Monoid (a,b) where
    mempty                    = (         mempty,          mempty)
    (a1,b1) `mappend` (a2,b2) = (a1 `mappend` a2, b1 `mappend` b2)

newtype First a = First { getFirst :: a }
newtype Last  a = Last  { getLast  :: a }

instance Semigroup a => Monoid (Maybe a) where
    mempty                    = Nothing
    Nothing `mappend` m       = m
    m       `mappend` Nothing = m
    Just m1 `mappend` Just m2 = Just (m1 <> m2)

newtype First a = First { getFirst :: Maybe a }
newtype Last  a = Last  { getLast  :: Maybe a }

instance Monoid b => Monoid (a -> b) where
    mempty _ = mempty
    mappend f g x = f x `mappend` g x

ghci> (replicate 3 <> replicate 2) 1
[1, 1, 1, 1, 1]

data Ordering = LT | EQ | GT

instance Monoid Ordering where
    mempty         = EQ
    LT `mappend` _ = LT
    EQ `mappend` y = y
    GT `mappend` _ = GT

module Data.Ord (comparing, ...) where

comparing :: Ord a => (b -> a) -> b -> b -> Ordering
comparing p x y = compare (p x) (p y)

data ErrorPosition = ErrorPosition 
    { path   :: String
    , line   :: Int
    , offset :: Int 
    } deriving (Eq)

-- this implementation uses Monoid instances of (->) and Ordering
instance Ord ErrorPosition where
    compare = comparing path <> comparing line <> comparing offset

data Options = Options
  { oRetryCount    :: Int
  , oHost          :: String
  , oCharacterCode :: Maybe Char
  } deriving (Show, Eq)

data PartialOptions = PartialOptions
   { poRetryCount    :: Last Int
   , poHost          :: Last String
   , poCharacterCode :: Last (Maybe Char)
   } deriving (Show, Eq)

instance Monoid PartialOptions where
    mempty = PartialOptions mempty mempty mempty
    mappend x y = PartialOptions 
        { poRetryCount    = poRetryCount    x <> poRetryCount    y
        , poHost          = poHost          x <> poHost          y
        , poCharacterCode = poCharacterCode x <> poCharacterCode y
        }

newtype HoleyMonoid m r a = HoleyMonoid { runHM :: (m -> r) -> a }

ghci> format ("Person's name is " % text %  ", age is " % hex) "Dave" 58
"Person's name is Dave, age is 3a"

foldr :: (a -> b -> b) -> b -> [a] -> b
foldl :: (b -> a -> b) -> b -> [a] -> b 

foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b 

ghci> foldr (+) 0 [2, 1, 10]
13
ghci> foldr (*) 3 [2, 1, 10]
60

foldr (\s rest -> rest + length s) 0 ["aaa", "bbb", "s"]
foldr (\rest s -> rest + length s) 0 ["aaa", "bbb", "s"]

-- | Simplified version of Foldable
class Foldable t where
    {-# MINIMAL foldMap | foldr #-}

    fold    :: Monoid m => t m -> m
    foldMap :: Monoid m => (a -> m) -> t a -> m
    foldr   :: (a -> b -> b) -> b -> t a -> b

instance Foldable [] where
    foldr :: (a -> b -> b) -> b -> [a] -> b
    foldr _ z []     =  z
    foldr f z (x:xs) =  x `f` foldr f z xs

instance Foldable Maybe where
    foldr :: (a -> b -> b) -> b -> Maybe a -> b
    foldr _ z Nothing  = z
    foldr f z (Just x) = f x z

ghci> length (4, [1,2,3])
???

ghci> foldr (+) 1 (Just 3)
4
ghci> foldr (+) 0 Nothing
0

ghci> length (4, [1,2,3])
1

foldr (+) 0 (1:2:3:[]) ≡ 1+2+3+0

ghci> import Debug.SimpleReflect
ghci> sum [1..5] :: Expr 
0 + 1 + 2 + 3 + 4 + 5

ghci> foldr f x [a,b,c]
f a ( f b ( f c x ) )

ghci> balanced "(())"
True
ghci> balanced "(())("
False
ghci> balanced ")(())("
False

data B = B Int Int

instance Monoid B where
    mempty = B 0 0
    mappend (B a b) (B c d)
        | b <= c    = B (a + c - b) d
        | otherwise = B a (d + b - c)

parse :: Char -> B
parse '(' = B 0 1
parse ')' = B 1 0
parse _   = B 0 0

balanced :: String -> Bool
balanced xs = foldMap parse xs == mempty