-- 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 :: Maybe a}  -- first Just
newtype Last  a = Last  { getLast  :: Maybe a}  -- last Just

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 Nothing <> First (Just 10) <> First (Just 1)
First { getFirst = Just 10 }
ghci> Last (Just 2) <> Last (Just 1) <> Last Nothing
Last { getLast = Just 1 }

class Semigroup a => 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)

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> fmap (+3) (Just 2)
Just 5
ghci> fmap (+3) Nothing
Nothing

1. fmap id      ≡ id
2. fmap (f . g) ≡ fmap f . fmap g

instance Functor Maybe where
    fmap :: (a -> b) -> Maybe a -> Maybe b
    fmap f (Just x) =
    fmap f Nothing  =

instance Functor Maybe where
    fmap :: (a -> b) -> Maybe a -> Maybe b
    fmap f (Just x) = Just (f x)
    fmap _ Nothing  = Nothing

findPost     :: PostId -> Maybe Post
getPostTitle :: Post -> Title


firstPostTitle :: Maybe Title
firstPostTitle = fmap getPostTitle (findPost 1)

infixl 4 <$>
(<$>) :: Functor f => (a -> b) -> f a -> f b
(<$>) = fmap

firstPostTitle = getPostTitle <$> findPost 1

instance Functor [] where
    fmap :: (a -> b) -> [a] -> [b]
    fmap = map

ghci> fmap (*2) [1..3]
[2,4,6]
ghci> map (*2) [1..3]
[2,4,6]
ghci> fmap (*2) []  -- ?

instance Functor ((->) r)  where
    fmap :: (a -> b) -> (r -> a) -> r -> b
    fmap f g =

instance Functor ((->) r)  where
    fmap :: (a -> b) -> (r -> a) -> r -> b
    fmap = (.)

ghci> let foo = fmap (+3) (+2)
ghci> foo 10
15

ghci> let a = fmap (*) [1,2,3,4]
ghci> :t a
a :: [Integer -> Integer]
ghci> fmap (\f -> f 9) a
[9,18,27,36]

class Functor f => Applicative f where  -- f :: * -> *
    pure  :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

ghci> :t fmap (++) (Just "hey")
fmap (++) (Just "hey") :: Maybe ([Char] -> [Char])

ghci> :t fmap compare (Just 'a')
fmap compare (Just 'a') :: Maybe (Char -> Ordering)

    liftA2 :: (a -> b -> c) -> f a -> f b -> f c  -- since GHC 8.2.1

instance Applicative Maybe where
    pure :: a -> Maybe a
    pure  =

    (<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b
    (<*>) =

instance Applicative Maybe where
    pure :: a -> Maybe a
    pure = Just
    
    (<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b
    Nothing <*> _         = Nothing
    Just f  <*> something = fmap f something

ghci> Just (+3) <*> Just 9
Just 12
ghci> pure (+3) <*> Just 10
Just 13
ghci> Just (++"hahah") <*> Nothing
Nothing
?ghci> pure (++"what") <*> pure "lol"

ghci> Just (+3) <*> Just 9
Just 12
ghci> pure (+3) <*> Just 10
Just 13
ghci> Just (++"hahah") <*> Nothing
Nothing
ghci> pure (++"what") <*> pure "lol"
"lolwhat"

instance Applicative [] where
    pure :: a -> [a]
    pure x    =

    (<*>) :: [a -> b] -> [a] -> [b]
    fs <*> xs =

instance Applicative [] where
    pure :: a -> [a]
    pure x    = [x]

    (<*>) :: [a -> b] -> [a] -> [b]
    fs <*> xs = [f x | f <- fs, x <- xs]

ghci> [ x*y | x <- [2,5,10], y <- [8,10,11]]
[16,20,22,40,50,55,80,100,110]

ghci> (*) <$> [2,5,10] <*> [8,10,11]
[16,20,22,40,50,55,80,100,110]

ghci> (pure 3) "blah"
3

instance Applicative ((->) r) where
    pure :: a -> r -> a
    pure x  =
    
    (<*>) :: (r -> a -> b) -> (r -> a) -> r -> b
    f <*> g =

instance Applicative ((->) r) where
    pure :: a -> r -> a
    pure x  = \_ -> x

    (<*>) :: (r -> a -> b) -> (r -> a) -> r -> b
    f <*> g = \x -> f x (g x)

ghci> :t (+) <$> (+3) <*> (*100)
(+) <$> (+3) <*> (*100) :: (Num a) => a -> a

ghci> (+) <$> (+3) <*> (*100) $ 5
508

ghci> (\x y z -> [x,y,z]) <$> (+3) <*> (*2) <*> (/2) $ 5
[8.0,10.0,2.5]

ghci> (*) <$> Just 5 <*> Just 3
Just 15
ghci> liftA2 (*) (Just 5) (Just 3)
Just 15
?ghci> :t liftA3

ghci> (*) <$> Just 5 <*> Just 3
Just 15
ghci> liftA2 (*) (Just 5) (Just 3)
Just 15
ghci> :t liftA3
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d

ghci> import Data.Char (isUpper, isDigit)
ghci> import Control.Applicative (liftA2)
ghci> let isUpperOrDigit = liftA2 (||) isUpper isDigit
ghci> :t isUpperOrDigit 
isUpperOrDigit :: Char -> Bool
ghci> isUpperOrDigit 'A'
True
ghci> isUpperOrDigit '3'
True
ghci> isUpperOrDigit 'a'
False

data User = User
    { userFirstName :: String
    , userLastName  :: String
    , userEmail     :: String
    }

type Profile = [(String, String)]

profileExample = 
    [ ("first_name", "Pat"            )
    , ("last_name" , "Brisbin"        )
    , ("email"     , "me@pbrisbin.com")
    ]

lookup "first_name" p :: Maybe String

buildUser :: Profile -> Maybe User
buildUser p = User
    <$> lookup "first_name" p
    <*> lookup "last_name"  p
    <*> lookup "email"      p

-- using liftA* common pattern
buildUser :: Profile -> Maybe User
buildUser p = liftA3 User
                     (lookup "first_name" p)
                     (lookup "last_name"  p)
                     (lookup "email"      p)

-- full point free version
buildUser :: Profile -> Maybe User
buildUser = liftA3 (liftA3 User)
                   (lookup "first_name")
                   (lookup "last_name")
                   (lookup "email")

instance Alternative Maybe where
    empty :: Maybe a
    empty = Nothing

    (<|>) :: Maybe a -> Maybe a -> Maybe a
    Nothing <|> r = r
    l       <|> _ = l

ghci> Nothing <|> Just 3 <|> empty <|> Just 5
Just 3

instance Alternative [] where
    empty :: [a]
    empty = []
    
    (<|>) :: [a] -> [a] -> [a]
    (<|>) = (++)

ghci> [] <|> [1,2,3] <|> [4]
[1,2,3,4]

ghci> let half x = if even x then Just (x `div` 2) else Nothing
ghci> traverse half [2,4..10]
Just [1,2,3,4,5]
ghci> traverse half [1..10]
Nothing

instance Traversable Maybe where
    traverse :: Applicative f => (a -> f b) -> Maybe a -> f (Maybe b)
    traverse _ Nothing  =
    traverse f (Just x) =

instance Traversable Maybe where
    traverse :: Applicative f => (a -> f b) -> Maybe a -> f (Maybe b)
    traverse _ Nothing  = pure Nothing
    traverse f (Just x) = Just <$> f x

instance Traversable [] where
    traverse :: Applicative f => (a -> f b) -> [a] -> f [b]
    traverse f = foldr consF (pure [])
      where 
        consF x ys = (:) <$> f x <*> ys

instance Traversable [] where
    traverse :: Applicative f => (a -> f b) -> [a] -> f [b]
    traverse f l =

{-# LANGUAGE DeriveFunctor     #-}  -- generates `fmap`
{-# LANGUAGE DeriveFoldable    #-}  -- generates `foldr` and `foldMap`
{-# LANGUAGE DeriveTraversable #-}  -- generates `traverse`

data Tree a = Leaf | Node a (Tree a) (Tree a)
    deriving (Functor, Foldable, Traversable)

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)

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

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

instance Semigroup a => Semigroup (Maybe a) where
    Nothing <> b       = b
    a       <> Nothing = a
    Just a  <> Just b  = Just (a <> b)

instance Semigroup a => Monoid (Maybe a) where
    mempty                    = Nothing

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> (flip take [3, 2, 1] <> replicate 2) 1
[3, 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
        }

ghci> :t fmap
fmap :: Functor f => (a -> b) -> f a -> f b

ghci> :t fmap fmap
fmap fmap
  :: (Functor f, Functor f1) => f1 (a -> b) -> f1 (f a -> f b)

ghci> :t fmap fmap fmap
fmap fmap fmap
  :: (Functor f, Functor f1) => (a -> b) -> f1 (f a) -> f1 (f b)

ghci> :t fmap fmap fmap fmap
fmap fmap fmap fmap
  :: (Functor f, Functor f1, Functor f2) =>
     f2 (f1 (a -> b)) -> f2 (f1 (f a -> f b))

ghci> :t fmap fmap fmap fmap fmap
fmap fmap fmap fmap fmap
  :: Functor f => (a1 -> b) -> (a -> a1) -> f a -> f b

ghci> let fmap5 = fmap fmap fmap fmap fmap 
ghci> fmap5 (+1) (*2) [1..5]
[3, 5, 7, 9, 11]

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