-- obecny fold jeste jednou (catamorfismy, anamorfismy, a podobne obludy)

-- (neprilis souvisejici) uvodni priklad -- operator pevneho bodu pro funkce:

fix :: (t->t)->t
fix f = f (fix f)

-- ulozka -- zkuste napsat operator fix bez pouziti rekurze
-- pouziti op. pevneho bodu pro odstraneni rekurze:

len::[a]->Int
len [] = 0
len (_:t) = 1 + len t

lenNR'::([a]->Int)->[a]->Int
lenNR' _ [] = 0
lenNR' f (_:t) = 1 + f t

lenNR::[a]->Int
lenNR = fix lenNR'

-- operator pevneho bodu pro typy
-- In a out jsou isomorfismy, tj. (Mu f) a (f (Mu f)) jsou "skoro" to same

data Mu f = In (f (Mu f))
out::Mu f -> f (Mu f)
out (In x) = x

-- lze odstranit rekurzi z rekurzivnich typu

data ListF a x = Nil | Cons a x deriving (Show)
type List a = Mu (ListF a)

nil = In Nil
cons h t = In (Cons h t)

data TreeF a x = Node a [x] deriving (Show)
type Tree a = Mu (TreeF a)

node a xs = In (Node a xs)

instance Functor (ListF a) where
  fmap f Nil = Nil
  fmap f (Cons a x) = Cons a (f x)

instance Functor (TreeF a) where
  fmap f (Node a xs) = Node a (map f xs)

-- catamorfismus (zobecneni foldu) a anamorfismus (zobecneni unfoldu)

cata::Functor f => (f x -> x) -> Mu f -> x
cata fn (In str) = fn $ fmap (cata fn) str

ana::Functor f => (x -> f x) -> x -> Mu f
ana fn b = In $ fmap (ana fn) (fn b)

len2 = cata (\fa -> case fa of
                       Nil -> 0
		       Cons _ xs -> xs + 1)

instance Show a => Show (List a) where
  show s = '[' : elts ++ "]"
    where
      elts = cata (\fa -> case fa of
  			    Nil -> ""
			    Cons h "" -> show h
			    Cons h r -> show h ++ ", " ++ r) s

spoj x y = cata (\fa -> case fa of
			  Nil -> y
			  Cons h t -> cons h t) x

cisla k s = ana (\n -> if n <= k then Cons n (n+1) else Nil) s

