{- 6.2 -}

data Nat = Zero | Succ Nat -- deriving Show

-- hodnoty typu Nat:
-- Zero, Succ Zero, Succ (Succ Zero), Succ (Succ (Succ Zero)), ...

{- ak chceme explicitne uviest Nat ako typ, ktory je mozne
 - zobrazit, t.j. uviest ho ako clena typovej triedy Show,
 - musime definovat funkcie, ktore kazdy typ v triede Show
 - musi podporovat
 - zaroven musime zrusit klauzulu 'deriving Show', kedze
 - nenechame ghc odvodit funkciu show, ale spravime to sami
 -}
instance Show Nat where
    show Zero       = "Zero"
    show (Succ x)   = "Succ (" ++ show x ++ ")"

-- ukazka funkcie prevadzajucej Nat na Int intuitivnym sposobom
shownat :: Nat -> Int
shownat Zero = 0
shownat (Succ x) = 1 + shownat x

-- takto by slo definovat nekonecno v Nat
natInf :: Nat
natInf = Succ natInf
-- je tu podobnost s funkciou repeat:
-- natInf ~> Succ (Succ (Succ (...)))
-- repeat x = x : repeat x ~> [x,x,x,...]
-- ones = 1 : ones ~> [1,1,1,...]

{- 6.3 -}

nfold :: (a -> a) -> a -> Nat -> a
nfold _ z Zero      = z
nfold s z (Succ x)  = s (nfold s z x)
-- nfoldsz (Succ x) = s (nfoldsz x)

{- nfoldsz ukazuje, ze ak by sme zafixovali parametre s a z,
 - potom nfold vlastne len prechadza do vnutra hodnoty Nat
 - a namiesto kazdeho Succ "vypluje" von s
 - ide o rovnaky proces ako u foldr
 -}

{- 6.4 -}

data Expr = Con Float
            | Add Expr Expr | Sub Expr Expr
            | Mul Expr Expr | Div Expr Expr
            deriving Show

eval :: Expr -> Float
eval (Con x)    = x
eval (Add x y)  = eval x + eval y

{- pomocna funkcia pre evaluate; budeme ju pouzivat iba
 - pre hodnoty, o ktorych vieme, ze su tvaru Just nieco;
 - ak by sme ju zavolali na Nothing, dostali by sme chybu
 - unexhaustive pattern matching
 -}
fromJust :: Maybe a -> a
fromJust (Just x) = x

evaluate :: Expr -> Maybe Float
evaluate (Con x) = Just x
evaluate (Add x y) = if evx /= Nothing && evy /= Nothing then
                        Just (fromJust evx + fromJust evy)
                     else
                        Nothing
    where
        evx = evaluate x
        evy = evaluate y
{- nemozeme spravit iba evx + evy, pretoze evx, evy :: Expr
 - a operacia (+) na datovom type Expr definovana nie je (pozn.)
 - preto musime evx a evy najprv vytiahnut z Just, hodnoty scitat,
 - a kedze vysledok musi byt typu Maybe Float, musime ho opat
 - vlozit do Just
 -
 - (pozn. - ale mohli by sme si ju definovat pomocou vclenenia Expr do typovej
 - triedy Num, podobne ako Show Nat v priklade 6.2; bolo by na to treba
 - definovat funkcie (+), (-), (*), negate, abs, signum, fromInteger:
 - http://hackage.haskell.org/package/base-4.6.0.1/docs/Prelude.html#t:Num )
 -
 - ((este hlbsia poznamka pre hlbokych zaujemcov: existuje abstrakcia, ktora
 - umoznuje priamo pracovat napriklad s Just - vola sa aplikativ (Applicative)
 - a vyzeralo by to takto:
 - (*) <$> Just 4 <*> Just 6 ~> Just 24
 - http://learnyouahaskell.com/functors-applicative-functors-and-monoids ))
 -}

evaluate (Div x y) = if evx /= Nothing && evy /= Nothing then
                        if fromJust evy == 0 then
                            Nothing
                        else
                            -- evx / evy    (nefunguje (tip: aplikativ))
                            Just (fromJust evx / fromJust evy)
                     else
                        Nothing
    where
        evx = evaluate x
        evy = evaluate y

{- 6.5 d) -}

data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving Show

size :: BinTree a -> Int
size Empty = 0
size (Node x l r) = 1 + size l + size r

{- pripomienka: u rekurzivne definovanych funkcii, je dobre nenechat sa zmiast
 - a nehladat nejake zlozite riesenie... jedinou ulohou je toto:
 - chceme zistit hodnotu fun (Node x l r) a mame k dispozicii hodnoty
 - x, fun l, fun r, z ktorych treba tuto hodnotu poskladat
 -}

{- 6.6 -}

height :: BinTree a -> Int
height Empty = 0
height (Node x l r) = 1 + max (height l) (height r)
--    if height l > height r then 1 + height l else 1 + height r

fulltree :: Int -> a -> BinTree a
fulltree 0 _ = Empty
fulltree n x = Node x (fulltree (n-1) x) (fulltree (n-1) x)

treerepeat :: a -> BinTree a
treerepeat x = Node x (treerepeat x) (treerepeat x)
-- repeat x = x : repeat x