module Fix where
import Prelude hiding   ( repeat
                        , map
                        , foldr
                        , foldl
                        , iterate
                        , zip
                        , zipWith
                        , cycle
                        )
import Data.Function
import Nat

data BinTree a = Leaf a | Node ( BinTree a) ( BinTree a)

map :: (a -> b) -> [a] -> [b]
map f = fix $ \m xs -> case xs of
    []   -> []
    y:ys -> f y : m ys

-- правая свертка через fix
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f = fix $ \fr ini xs -> case xs of
    []      -> ini
    y:ys    -> y `f` fr ini ys

-- левая свертка через fix
foldl :: (b -> a -> b) -> b -> [a] -> b
foldl f = fix $ \fl ini xs -> case xs of
    []      -> ini
    y:ys    -> f ini y `fl` ys

-- zip'ы через fix
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith f = fix $ \z x y -> if null x || null y
    then []
    else f (head x) (head y) : z (tail x) (tail y)

zip :: [a] -> [b] -> [(a, b)]
zip = zipWith (,)

-- repeat через fix
repeat :: a -> [a]
repeat = fix . (:)

--iterate через fix
iterate :: (a -> a) -> a -> [a]
iterate f = fix $ \i x -> x : i (f x)

cycle :: [a] -> [a]
cycle = fix . (++)

instance Num a => Num (BinTree a) where
    (+) (Leaf _) x = x
    (+) (Node l r) x = Node (l + x) r
    (*) (Leaf a) (Leaf b) = Leaf (a*b)
    (*) (Node l r) (Node l1 r1) = Node(l*l1) (r*r1)
    (*) _ _ = error "oshibka"

sumTree :: (a -> a -> a) -> BinTree a -> BinTree b -> BinTree c
sumTree f = fix $ \s x y -> case x of
    (Leaf _)  -> s x
    (Node l r)  -> s l+y r