import Data.Char
import Data.List hiding (foldr, foldl, foldr1, foldl1)
import Data.List.Split
import Data.Ord
import Data.Maybe
import Data.Functor
import Data.Foldable hiding (concat, elem)
import Prelude hiding (foldr,foldl,foldr1, foldl1, concat)
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Tree as T


-- Sandro Gržičić
-- Haskell FER DZ07
-- 2011-12

-- === PUH-LEKCIJA-10 =================================================================

-- 1.
data Sex = Male | Female deriving (Show,Read,Eq,Ord)

data Person = Unknown | Person {
   idNumber :: String,
   forename :: String,
   surname  :: String,
   sex      :: Sex,
   mother   :: Person,
   father   :: Person,
   age      :: Int,
   partner  :: Maybe Person,
   children :: [Person]
} deriving Read

instance Eq Person where
  Unknown == Unknown = False
  Unknown == _       = False
  _       == Unknown = False
  p1      == p2      = idNumber p1 == idNumber p2

instance Ord Person where
  compare Unknown Unknown        = EQ
  compare Unknown _              = LT
  compare _       Unknown        = GT
  compare p1     p2
    | surname p1 < surname p2    = LT
    | surname p1 > surname p2    = GT
    | forename p1 < forename p2  = LT
    | forename p1 > forename p2  = GT
    | otherwise                  = EQ

-- 1.1.
partnersMother :: Person -> Maybe Person
partnersMother Unknown = Nothing
partnersMother p
  | partner p == Nothing                     = Nothing
  | mother (fromJust $ partner p) == Unknown = Nothing
  | otherwise                                = Just $ mother $ fromJust $ partner p

-- 1.2.
parentCheck :: Person -> Bool
parentCheck Unknown = False
parentCheck p = inMothersChildren || inFathersChildren
  where
    inMothersChildren = mother p /= Unknown && elem p (children $ mother p)
    inFathersChildren = father p /= Unknown && elem p (children $ father p)

-- 1.3.
sister :: Person -> [Person]
sister Unknown = []
sister p = femaleChildren $ bothParentsChildren p
  where
    femaleChildren = filter (\p -> sex p == Female)

parentsChildren :: (Person -> Person) -> Person -> [Person]
parentsChildren parentFunc p = if parentFunc p /= Unknown then children $ parentFunc p else []

bothParentsChildren :: Person -> [Person]
bothParentsChildren p = nub $ (parentsChildren mother p ++ parentsChildren father p)

-- 1.4.
descendant :: Person -> [Person]
descendant Unknown = []
descendant p = concat $ map descendant (bothParentsChildren p)

-- 2.
data MyList a = Empty | Cons a (MyList a) deriving (Show,Read,Ord)

-- 2.1
listHead :: MyList a -> Maybe a
listHead Empty = Nothing
listHead (Cons a _) = Just a

-- 2.2.
listMap :: (a -> b) -> MyList a -> MyList b
listMap _ Empty = Empty
listMap f (Cons a xs) = Cons (f a) (listMap f xs)

-- 3.
data Tree a = Null | Node a (Tree a) (Tree a) deriving Show

t = Node 0 (Node 1 (Node 2 Null Null) (Node 3 Null Null)) (Node 4 Null (Node 5 (Node 6 Null Null) Null))

-- 3.1.
treeMax :: Ord a => Tree a -> a
treeMax Null = error "Prazno stablo!"
treeMax (Node m l r) = max (treeMax' m l) (treeMax' m r)
  where
    treeMax' :: Ord a => a -> Tree a -> a
    treeMax' m Null = m
    treeMax' m (Node e l r) = max m (max (treeMax' e l) (treeMax' e r))

-- 3.2.
-- jako kratka neakumulatorska verzija.
treeElems :: Tree a -> [a]
treeElems Null = []
treeElems (Node e l r) = treeElems l ++ [e] ++ treeElems r

-- 3.3.
levelCut :: Int -> Tree a -> Tree a
levelCut _ Null = Null
levelCut cut t
  | cut < 0 = error "Razina mora biti >= 0!"
  | otherwise = levelCut' cut t
  where
    levelCut' :: Int -> Tree a -> Tree a
    levelCut' _ Null = Null
    levelCut' 0 (Node e l r) = Node e Null Null
    levelCut' lvl (Node e l r) = Node e (levelCut' (lvl - 1) l) (levelCut' (lvl - 1) r)

-- 4.
treeInsert :: Ord a => a -> Tree a -> Tree a
treeInsert x Null = Node x Null Null
treeInsert x t@(Node y l r)
  | x < y     = Node y (treeInsert x l) r
  | x > y     = Node y l (treeInsert x r)
  | otherwise = t


-- 4.1.
listToTree :: Ord a => [a] -> Tree a
listToTree [] = Null
listToTree ls = listToTree' ls Null
  where
    listToTree' [] t = t
    listToTree' (x:xs) t = listToTree' xs (treeInsert x t)

-- 4.2.
treeToList :: Tree a -> [a]
treeToList = treeElems

-- 4.3.
sortAndNub :: Ord a => [a] -> [a]
sortAndNub = treeToList . listToTree

-- 5.
data Weekday =
  Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
  deriving (Show,Enum)

-- 5.1.
instance Eq Weekday where
  Monday    == Monday    = True
  Tuesday   == Tuesday   = True
  Wednesday == Wednesday = True
  Thursday  == Thursday  = True
  Friday    == Friday    = False
  Saturday  == Saturday  = True
  Sunday    == Sunday    = True
  _         == _         = False

-- 5.2.
instance Show Person where
  show Unknown = "Unknown"
  show (Person idNumber' forename' surname' sex' mother' father' age' partner' children') =
    idNumber' ++ " " ++ forename' ++ " " ++ surname' ++ " " ++ show sex' ++ " " ++
    name mother' ++ " " ++ name father' ++ " " ++ show age' ++ " " ++ show (fromMaybe Unknown partner') ++ " " ++ show children'
   where
     name Unknown = "Unknown"
     name p = (forename p) ++ " " ++ (surname p)

-- 6.

-- 6.1.
instance Eq a => Eq (MyList a) where -- hvala Siniši! :)
  l1 == l2 = listHead l1 == listHead l2

-- 6.2.
instance Ord a => Eq (Tree a) where -- hvala Siniši! :)
  Null == Null = False
  Null == _    = False
  _    == Null = False
  t1   == t2   = (sortAndNub . treeToList) t1 == (sortAndNub . treeToList) t2 -- uspoređivanje listi

-- === PUH-LEKCIJA-11 =================================================================

class Ageing a where
  currentAge :: a -> Int
  maxAge :: a -> Int
  makeOlder :: a -> a

instance Ageing Person where
  currentAge = age
  makeOlder p = p { age = age p + 1 }
  maxAge _ = 123

data Breed = Beagle | Husky | Pekingese deriving (Eq, Ord, Show, Read)

data Dog = Dog {
  dogName :: String,
  dogBreed :: Breed,
  dogAge :: Int
} deriving (Eq, Ord, Show, Read)

instance Ageing Dog where
  currentAge = dogAge
  makeOlder d = d {dogAge = dogAge d + 1}
  maxAge d = case dogBreed d of
    Husky -> 29
    _     -> 20

-- 1.1.
compareRelativeAge :: (Ageing a, Ageing b) => a -> b -> Ordering
compareRelativeAge a b | ages a < ages b = LT
                       | ages a > ages b = GT
                       | otherwise = EQ
  where
    ages x = currentAge x * maxAge x

-- 1.2.
class Nameable a where
  name :: a -> String

instance Nameable Person where
  name a = forename a ++ " " ++ surname a

instance Nameable Dog where
  name a = dogName a ++ " The Dog"

-- 2.
class Pushable t where
  push :: a -> t a -> t a
  peek :: t a -> a
  pop :: t a -> t a

instance Pushable [] where
  push x xs = x : xs
  peek (x:_) = x
  peek [] = error "Empty List"
  pop (_:xs) = xs

instance Pushable MyList where
  push x xs = x `Cons` xs
  peek (x `Cons` _) = x
  peek Empty = error "Empty List"
  pop (_ `Cons` xs) = xs

instance Pushable Tree where
  push x t = Node x t Null
  pop (Node _ t _) = t
  peek (Node x _ _ ) = x
  peek Null = error "Empty Tree"

-- 2.1.
stablo = Node 0 (Node 1 Null Null) (Node 2 (Node 3 (Node 4 Null Null) (Node 5 Null Null)) (Node 9 Null Null))

class Takeable t where
  takeSome :: Int -> t a -> [a]

instance Takeable Tree where
  takeSome n Null = []
  takeSome (-1) _ = []
  takeSome 0 _ = []
  takeSome n (Node e l r) = take n $ (takeSome (n `div` 2) l) ++ [e] ++ (takeSome ((n `div` 2)) r)

instance Takeable [] where
  takeSome = take

-- 2.2.
class Headed t where
  headOf :: t a -> a
  headOff :: t a -> t a

instance Headed [] where
  headOf l = head l
  headOff l = tail l

instance Headed Tree where
  headOf (Node x _ _) = x
  headOff (Node _ a Null) = a
  headOff (Node _ Null b) = b
  headOff (Node _ a b) = undefined -- ??? ovo nema smisla.. (kako ukloniti glavu stablu i vratiti samo jednu granu? random? :D)

instance Headed Maybe where
  headOf Nothing = error "nema glave"
  headOf (Just a) = a
  headOff _ = Nothing

-- 3.
treeMap :: (a -> b) -> Tree a -> Tree b
treeMap _ Null = Null
treeMap f (Node x l r) = Node (f x) (treeMap f l) (treeMap f r)

maybeMap :: (a -> b) -> Maybe a -> Maybe b
maybeMap _ Nothing = Nothing
maybeMap f (Just x) = Just $ f x

instance Functor Tree where
  fmap _ Null = Null
  fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r)

-- 3.1.
mapOnTreeMaybe _ Null = Null
mapOnTreeMaybe f (Node (Just x) l r) = Node (Just (f x)) (mapOnTreeMaybe f l) (mapOnTreeMaybe f r)
mapOnTreeMaybe f (Node Nothing l r) = Node Nothing (mapOnTreeMaybe f l) (mapOnTreeMaybe f r)

stablo' = Node (Just 5) (Node (Just 5) Null Null) (Node (Just 5) (Node (Just 2) (Node (Just 2) Null Null) (Node (Just 1) Null Null)) (Node (Just 8) Null Null))

-- 3.2.
data RoseTree a = RoseEmpty | RoseTree a [RoseTree a] deriving (Show,Read,Eq,Ord)

instance Functor RoseTree where
  fmap _ RoseEmpty = RoseEmpty
  fmap f (RoseTree a xs) = RoseTree (f a) (map (fmap f) xs)

ruza = RoseTree 1 [RoseTree 2 [], RoseTree 3 [], RoseTree 4 [RoseTree 4 [], RoseTree 9 []]]

-- 4.
instance Foldable Tree where
  foldr f z Null = z
  foldr f z (Node e l r) = f e (foldr f (foldr f z r) l)

-- 4.1 -- thx Siniša!
sumPositive :: (Foldable t, Num a) => t a -> a -- općenitiji a umjesto Int
sumPositive = foldr (\e s -> if signum e /= -1 then e + s else s) 0

-- 4.2 - kul stvarčica :)
size :: Foldable t => t a -> Int
size = foldr (\e s -> s + 1) 0

-- 4.3 - yay foldanje! :)
eqElems :: (Foldable t, Eq a) => t a -> Bool
eqElems str = length (eqElemsFold str) < 2
  where
    eqElemsFold = foldr eqElems'[]
    eqElems' :: Eq a => a -> [a] -> [a]
    eqElems' e a@[_, _] = a -- ništa novo: nisu jednaki, nastavi foldati
    eqElems' e a
      | a == []   = [e]     -- prvi korak
      | [e] == a  = [e]     -- jednaki elementi
      | otherwise = (e:a)   -- nađen različit element

-- 4.4
instance Foldable RoseTree where
  foldr f z RoseEmpty       = z
  foldr f z (RoseTree e []) = f e (foldr f z RoseEmpty)
  --foldr f z (RoseTree e (x:xs)) = f z (foldr f e (foldr f x xs)) -- ne radi.. možda treba umjesto zadnjeg F.folda onaj obični?

-- 5.

-- 5.1

-- 5.2
-- === DZ ============================================================================