-- | Recursive Data Types 1
-- Examples to introduce recursive data types
-- Introduction Functional Programming 2019.

{-
This started as a skeleton, the definitions were filled in
during the lecture.
-}

--------------------------------------------------------------------------------
-- * Familiar data types for use in the examples below

data Suit = Hearts | Spades | Diamonds | Clubs       deriving (Eq, Show)
data Rank = Numeric Int | Jack | Queen | King | Ace  deriving (Eq, Show)
data Card = Card Rank Suit                           deriving (Eq, Show)

suit (Card r s) = s

cards = [Card Jack Clubs, Card Queen Hearts, Card King Clubs, Card Ace Spades]

--------------------------------------------------------------------------------
-- * Lists of cards (instead of using the list type)

--type Hand = [Card]

data Hand = Empty | Add Card Hand   deriving Show

size :: Hand -> Int
size Empty = 0
size (Add c h) = 1 + size h

fromHand :: Hand -> [Card]
fromHand Empty     = []
fromHand (Add c h) = c : fromHand h

toHand :: [Card] -> Hand
toHand []     = Empty
toHand (c:cs) = Add c (toHand cs)





--------------------------------------------------------------------------------
-- * Our own list type

data List a = Nil | Cons a (List a)   deriving (Eq,Show)

toList :: [a] -> List a
toList [] = Nil
toList (x:xs) = Cons x (toList xs)

toList' :: [a] -> List a
toList' = foldr Cons Nil

fromList :: List a -> [a]
fromList Nil = []
fromList (Cons x xs) = x:fromList xs

prop_List xs = fromList (toList xs) == xs
prop_List2 xs = toList (fromList xs) == xs




--------------------------------------------------------------------------------
-- * Natural numbers (Peano numbers)

-- | A natural number is either zero, or the successor of a natural number
data Nat = Zero | Succ Nat   deriving (Eq,Ord,Show)

-- | The length of a list is a natural number (it can not be negative)
len :: [a] -> Nat
len [] = Zero
len (_:xs) = Succ (len xs)

-- | We can not take a negative number of elements from a list
take' :: Nat -> [a] -> [a]
take' (Succ n) (x:xs) = x : take' n xs
take' _        _      = []

instance Num Nat where
    Zero   + b = b
    Succ n + b = Succ (n + b)   -- (1+n)+b == 1+(n+b)

    Zero   * b = Zero
    Succ n * b = b + n*b        -- (1+n)*b == b + n*b

    abs n = n

    signum Zero = Zero
    signum _    = Succ Zero
    
    fromInteger 0 = Zero
    fromInteger n | n>0 = Succ (fromInteger (n-1))

    negate = error "natural numbers can not be negated"

infinity = Succ infinity





--------------------------------------------------------------------------------
-- * Tree-shaped data types (branching data structures)

-- | Action Diagrams
data Diagram = Question String Diagram Diagram -- question, ifYes, ifNo
             | Action String Diagram
             | Done
             deriving Show

isSunny = Question "Is it sunny?" park work
park = Action "Go to the park!" Done
work = Action "Write a Haskell program!" Done

-- | "play" a diagram
play :: Diagram -> IO ()
play (Question q ifYes ifNo) = do putStrLn q
                                  answer <- getLine
                                  case answer of
                                    'y':_ -> play ifYes
                                    'n':_ -> play ifNo
                                    _     -> play (Question q ifYes ifNo)
play (Action a d)            = do putStrLn a
                                  play d
play Done                    = return ()

--------------------------------------------------------------------------------
-- * Pictionary flowchart

pictionary = Action "Draw a picture" guessedIt
guessedIt  = Question "Did they guess it?" win point
win        = Action "You win!" Done
point      = Action "Point repeatedly to the same picture!" guessedIt


--------------------------------------------------------------------------------
-- * Binary trees

-- | Binary trees with numbers in the nodes
data BTree = Leaf | Node BTree Int BTree    deriving Show

-- | The sum of the numbers in a binary tree
sumTree :: BTree -> Int
sumTree Leaf = 0
sumTree (Node lt n rt) = sumTree lt + n + sumTree rt

-- | The height of a binary tree
height :: BTree -> Int
height Leaf = 0
height (Node lt _ rt) = 1 + max (height lt) (height rt)

tree = Node Leaf 5 (Node Leaf 2 Leaf)