-- Examples of functors (and not) and applicatives
-- Venanzio Capretta, February 2016

-- Pairs of elements of type a

newtype Pair a = Pair (a,a)
  deriving (Eq,Ord,Show,Read)

instance Functor Pair where
  fmap f (Pair (x,y)) = Pair (f x, f y)

-- But we can't make an instance of Applicatvie for Pair.
-- Try it and understand why.

-------------------------------------

-- Node Trees: trees with data on the nodes

data NTree a = NLeaf | NNode a (NTree a) (NTree a)
  deriving (Eq,Ord,Show,Read)

instance Functor NTree where
  fmap f NLeaf = NLeaf
  fmap f (NNode x left right) = NNode (f x) (fmap f left) (fmap f right)

-- What about Applicative?
-- Is it possible to define and instance of Applicative for NTree?

-------------------------------------

-- Leaf Trees: trees with data on the leaves

data LTree a = LLeaf a | LNode (LTree a) (LTree a)
  deriving (Eq,Ord,Show,Read)

instance Functor LTree where
  fmap f (LLeaf x) = LLeaf (f x)
  fmap f (LNode left right) = LNode (fmap f left) (fmap f right)

instance Applicative LTree where
  pure = LLeaf
  LLeaf f <*> xs = fmap f xs
  LNode left right <*> xs = LNode (left <*> xs) (right <*> xs)

-------------------------------------

-- Finitely branching trees (with data on the nodes and leaves)

data FTree a = FNode a [FTree a]
  deriving (Eq,Ord,Show,Read)

instance Functor FTree where
  fmap f (FNode x ts) = FNode (f x) (map (fmap f) ts)

-- Applicative?

-------------------------------------

-- a-branching trees
-- NOT a functor

data ATree a = ALeaf | ANode (a -> ATree a)

-- It's impossible to define an instance of Functor for ATree
-- Think about why this is not a functor

-------------------------------------

-- FIFO lists (first in first out)

data Queue a = Queue [a] [a]
  deriving (Eq,Ord,Show,Read)

-- Think of a pair of lists (Queue [x0,..,xn] [y0,..,ym])
-- as a single queue x0,..,xn,ym,..y0
-- Elements are pushed in front and popped from the end

emptyQ :: Queue a
emptyQ = Queue [] []

push :: a -> Queue a -> Queue a
push x (Queue xs ys) = Queue (x:xs) ys

pop :: Queue a -> (Maybe a, Queue a)
pop (Queue [] []) = (Nothing, emptyQ)
pop (Queue xs (y:ys)) = (Just y, Queue xs ys)
pop (Queue xs []) = pop (Queue [] (reverse xs))

instance Functor Queue where
  fmap g (Queue xs ys) = Queue (fmap g xs) (fmap g ys)

-- Exercise: make an instance of Applicative for Queue

-------------------------------------

-- Wrong fmap for lists

newtype MList a = MList [a]
  deriving (Eq,Ord,Show,Read)

app :: MList a -> MList a -> MList a
app (MList xs) (MList ys) = MList (xs ++ ys)

instance Functor MList where
  fmap g (MList []) = MList []
  fmap g (MList (x:xs)) = fmap g (MList xs) `app` (MList [g x])

-- This definition doesn't satisfy the functor laws

-------------------------------------

-- IO is also a functor, the instance is defined in the Prelude

readInt :: IO Int
readInt = putStrLn "Write a number: " >> readLn

-- Try to run first readInt, then fmap (+13) readInt

-- IO is also an applicative
-- Try: (\x y z -> (x+y)*z) <$> readInt <*> readInt <*> readInt