import Data.List

-- Pair 1 2
-- HeadList 1 [2,3]
l = HeadList 1 [Atom 2, HeadList 3 [Atom 4, Atom 5], Atom 6]

data Pair a = P a a
data NestedList a   =   Atom a |    HeadList a [NestedList a] deriving Read


headElement (Atom x) = x
headElement (HeadList h _) = h

data MultiTuplu a = 
                      Nimic
                    | Unul {
                        value :: a
                        }
                    | Pereche {
                        first :: a,
                        second :: a
                        }
                    | Triplu a a a
                deriving (Show, Read)

middle (Triplu _ x _) = x

{- Răspuns la întrebarea: de ce nu merge read
    Merge, dar aparent trebuie 
    (a) să fie forțat tipul întors, e.g. prin funcția readT de mai jos, cu tip dat explicit, și 
    (b) nu merge (n-am reușit să meargă) pentru constructori cu câmpuri.
    e.g. merge pentru > readT "Triplu 'a' 'b' 'c'"
    dar merge pentru > readT "Pereche 'a' 'b'" 
    numai dacă Pereche nu are câmpuri, și este definit doar ca Pereche a a
--}
readT :: String -> MultiTuplu Char
readT t = read t

instance Show a => Show (NestedList a) where
    show (Atom a) = "<" ++ show a ++ ">"
    show (HeadList h list) = "{" ++ show h ++ concatMap show list ++ "}"


instance Show a => Show (Pair a) where
    show (P x y) = "<" ++ show x ++ ", " ++ show y ++ ">"


class Invertible a where
    invert  ::  a -> a
    invert  =   id

{- Răspuns la întrebare: de ce nu pot pune context Invertible a?

Pot, dar la numere apar probleme de ambiguitate.

Merge dacă la consolă forțez tipul:
invert $ P 1 2 :: Pair Int

Altfel, pe alte tipuri merge mai bine:

invert $ P "abc" "def"
--}
instance Invertible a => Invertible (Pair a) where
    invert (P x y) = P (invert y) (invert x)

instance Invertible (NestedList a) where 
    --    invert (Atom x)   = Atom x
    invert a@(Atom _)   = a
    invert (HeadList h l)       = HeadList h $ reverse $ map invert l
instance Invertible a =>    Invertible [a] where
    invert l = reverse $ map invert l

-- TODO de ce nu pot pune context de invertible
instance Invertible Int
instance Invertible Char

number :: Int
number = 5
-- pot face invert number


--instance Eq (Pair a)


--class Container (t a) where  -- nu așa e sintaxa
class Container t where -- în argumentul dat definiției clasei trebuie să fie
                        -- un constructor de tip
    contents :: t a -> [a] -- contents primește un tip obținut prin aplicarea
        -- constructorului de tip t peste un tip a

{-
class Container constructor_tip where
    contents :: constructor_tip tip_interior -> [tip_interior]
-}

instance Container [] where -- dau un constructor de tip
    contents = id
    {- Răspuns la întrebare: nu merge să fac contents și pe elemente pentru 
    că ar trebui să pot exprima faptul că și elementele din interior aderă 
    la clasa Container, dar nu am acces în definiție la tipul acestora.

    Plus, ar duce la o problemă ciclică: dacă ce primesc este o listă de
    containers, ce tip conțin aceste containers?
    -}
instance Container Pair where
    contents (P x y) = [x, y]
instance Container NestedList where
    contents (Atom x) = [x]
    contents (HeadList h list) = h : concatMap contents list
    --contents (HeadList h list) = h : concat (map contents list)
    --contents (HeadList h list) = h : (concat . map contents) list

--------------------------- partea asta din cursul anterior
-- atenție! Definiție ineficientă (semnatic) în care se suprapun semantic constructorii de date
data Tree a         -- construiesc tipul Tree peste un alt tip, a
                    -- o valoare de tip Tree a va fi un arbore care conține valori de tipul a
                = Nil
                | Leaf a
                | Node a [Tree a] -- copiii au tot tipul Tree a


-- limit primește un nivel și un arbore și taie arborele la nivelul respectiv
limit 0 _ = Nil
limit level t = case t of
        Node val children -> Node val $ map (limit (level-1)) children
        _ -> t


instance Show a => Show (Tree a) where
    show tree = pt 0 tree where
                pt level tree = case tree of
                    Nil -> space level ++ "- \n"
                    Leaf val -> space level ++ show val ++ "\n"
                    Node val children -> space level ++ show val ++ "\n" ++ 
                        if all isNil children then "" else
                            concatMap (pt $ level + 1) children
                space sp = [' ' | _ <- [1..sp * 2]]
                isNil Nil = True
                isNil _ = False

treeOnes = Node 1 [treeOnes, treeOnes]
treeB = build 1 
--    where build n = Node n [build $ n * 2, build $ n * 2 + 1]
--    where build n = Node n $ map (\x -> build $ n * 2 + x) [0, 1]
    where build n = Node n $ map build $ map (+(2*n)) [0, 1]
    

preord Nil = []
preord (Leaf x) = [x]
--preord (Node x children) = x : concat (map preord children)
preord (Node x children) = x : concatMap preord children


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

-- clasa tuturor tipurilor care au (pot avea) o structură arborescentă
class TreeLike t where -- t este constructor de tip
    makeOne :: a -> t a
    toTree :: Eq a => (t a) -> Tree a


instance TreeLike Tree where
    toTree = id
    makeOne = Leaf
    --makeOne x = Leaf x

instance TreeLike NestedList where
    toTree (Atom x) = Leaf x
    toTree (HeadList h list) = Node h $ map toTree list
    makeOne = Atom


{-
instance Invertible a => Invertible (Pair a) where
    invert (P x y) = P (invert y) (invert x)

instance Invertible a =>    Invertible [a] where
    invert l = reverse $ map invert l

class Container t where
    contents :: t a -> [a]
--}

f1 :: Eq a => a -> a -> a -> a
f1 x y z    =   if x == y then x else z

{-
f1 :: a -> b -> c -> d

x==y
    (==) :: Eq a => a -> a -> Bool
    a=b
    Eq a -- tipul a instanțiază Eq

if
    ~~ if :: Bool -> a -> a -> a
    a=c=d
-}


f2 :: (Eq (t1 h), Invertible (t1 h), Container t1) => t1 h -> t1 h -> [h]
f2 x y      =   if (invert x) == (invert y)
                    then contents x
                    else contents y
{-
f2 x y
    f2 :: g -> b -> c
    x :: g
    y :: b

invert x, invert y
    invert :: Invertible a => a -> a

    invert x :: d
    invert y :: e
    din tipul lui invert:
        g = d
        b = e
        Invertible g
        Invertible b

(invert x) == (invert y)
    (==) :: Eq a => a -> a -> Bool
    d = e = g = b
    Eq g

contents x, contents y
    contents :: Container t => t a -> [a]
    x :: g
    g = t1 h
    y :: b = g
    b = t2 i = t1 h
    t1 = t2
    Container t1
    contents x :: [h]
    contents y :: [i]
if ....
    ~~ if :: Bool -> a -> a -> a
    (invert x) == (invert y) :: Bool
    [h] = [i]
    h = i
    c = [h]

-}

f3 x y      =   if head x > head y
                    then (invert x) ++ (invert y)
                    else [head y - head x]

{-
f3 :: c -> d -> e

head x, head y
    c = [g]
    d = [h]

head x > head y
    g = h
    Ord g

invert x, invert y
    Invertible [g] - este întotdeauna adevărat dacă Invertible g
    am condiția Invertible g
    
head y - head x
    Num g

f3 :: (Invertible g, Ord g, Num g) => [g] -> [g] -> [g]

-}

f4 x y z    =   if x == y then z else 
                    if x > y then x else y
{-
f4 :: c -> d -> e -> g

x == y
    c = d
    Eq c
x > y
    Ord c
if + if
    c = d = e = g

f4 :: (Ord c, Eq c) => c -> c -> c -> c

 dar Eq a => Ord a
 
f4 :: Ord c => c -> c -> c -> c
-}
 

--f [a:b] = 0 -- match pe o listă formată dintr-un element x, unde x este o listă nevidă

f [x@(a:b)] = show x ++ "|" ++ show a ++ "|" ++ show b
    -- dacă primesc [[1,2,3]], x se leagă la [1,2,3], a se leagă la 1, b se leagă la [2,3]
{-
:t f
f :: Num a => [[t]] -> a
\ f [[5]]
"[5]|5|[]"
\ f [[5,6,7]]
"[5,6,7]|5|[6,7]"
\ f [[]]
*** Exception: Non-exhaustive patterns in function f
\ f [[5], [5,6]]
*** Exception: Non-exhaustive patterns in function f
-}


f5 :: [a] -> a -- *tipul* [a] -- listă de oricâte elemente de tip a, inclusiv zero elemente
f5 [x] = x -- [x] -- pattern care exprimă o listă dintr-un singur element


f6 (x@(_:_:_)) = x -- p-m doar pe listă cu cel puțin 2 elemente

f7 ((_:_):_) = 0 -- p-m pe o listă nevidă de liste, unde prima listă este o listă nevidă

{-
 f7 [[1]]
0
\ f7 [[1,2], [2]]
0
\ f7 []
*** Exception: Non-exhaustive patterns in function f7
\ f7 [[], [1]]
*** Exception: Non-exhaustive patterns in function f7
-}


data Graph a = G { edges :: [(a, a)] }

graph = G [(3, 8), (3, 10), (3, 5), (5, 11), (7, 8), (7, 11),
        (8, 3), (8, 8), (8, 9), (11, 2), (11, 5), (11, 9), (11, 10), (7, 12)]

nodes g = foldr (\n acc -> if elem n acc then acc else n : acc) []
    $ concat $ map (\(x, y) -> [x, y]) $ edges g

{-
data Tree a = Nil
                | Leaf a
                | Node a [Tree a] -- copiii au tot tipul Tree a

-}

outgoing v g = map snd $ filter (\(x, y) -> x == v) $ edges g

instance TreeLike Graph where
    makeOne x = G [(x, x)]
    
    toTree g = build [] (head $ nodes g) where
        build visited node = -- consider că visited sunt noduri din graf pentru care am construit deja noduri în arbore (am apelat Node)
            Node node $ foldl (\previousTrees -- arborii pentru frații anteriori, copii ai lui node
                                    child -> -- copilul curent al lui node pentru care construiesc
                                let
                                    visitedInSiblings = concatMap preord previousTrees -- nodurile din frați
                                    visitedAll = node : visited ++ visitedInSiblings -- toate nodurile deja vizitate: node, anterior apelului build pentru node, și în frații deja vizitați
                                    in if elem child visitedAll
                                        then previousTrees -- testez dacă am vizitat nodul deja
                                        else build visitedAll child -- construiesc subarborele pentru child
                                            : previousTrees -- și întorc noul acumulator (subarborele curent plus subarborii anteriori)
                        )
                    []
                    (outgoing node g)