import Control.Applicative
import Data.Monoid
import Data.Maybe

-- Task 1
data Tree a = Nil | Branch (Tree a) a (Tree a) deriving Show

instance Functor Tree where
    fmap f Nil = Nil
    fmap f (Branch (left) root (right)) = Branch (fmap f left) (f root) (fmap f right)

instance Applicative Tree where
    pure x = Branch (pure x) x (pure x)
    Nil <*> _ = Nil
    _ <*> Nil = Nil
    (Branch (left_f) root_f (right_f)) <*> (Branch (left) root (right)) =
        Branch (left_f <*> left) (root_f root) (right_f <*> right)

check1 = (+) <$> (Branch (Branch Nil 1 Nil) 2 Nil) <*> (Branch (Branch Nil 3 Nil) 4 (Branch Nil 5 Nil))

-- Task 2
x1 >$< x2 = getZipList(x1 <$> ZipList x2)
x1 >*< x2 = getZipList(ZipList x1 <*> ZipList x2)

-- Task 3
newtype Compose f g x = Compose {getCompose :: f (g x)} deriving Show

example :: Compose Tree [] Integer
example = Compose (Branch (Branch (Nil) [1] (Nil)) [2] (Branch (Nil) [3] (Nil)))

ffmap h = getCompose . fmap h . Compose
-- ffmap :: Functor (Compose f g) => (a -> x) -> f (g a) -> f (g x)
{--
    Получили почти fmap, только на этот раз у нас имеется однопараметрический контейнер,
    составленный из композиции f и g.
--}

-- ffmap (+42) $ Just [1,2,3]
-- Нужно объявить Functor для Compose f g
instance (Functor f, Functor g) => Functor (Compose f g) where
    fmap f = Compose . fmap (fmap f) . getCompose

check2 = ffmap (+42) $ Just [1,2,3]
check3 = ffmap (+42) $ [Just 1,Just 2,Nothing]

instance (Applicative f, Applicative g) => Applicative (Compose f g) where
    pure x = (Compose . pure . pure) x
    xs <*> ys = Compose ((<*>) <$> (getCompose xs) <*> (getCompose ys))

check4 =  getCompose $ (+) <$> Compose [Just 1,Just 2] <*> Compose [Nothing,Just 40]
check5 = getCompose $ (+) <$> Compose [Just 1,Just 2] <*> Compose [Just 30,Just 40]
check6 = getCompose $ Compose [[(+1)],[(+2),(+3)]] <*> Compose [[10,20],[]]

-- Task 4
{--
    Maybe:

    instance Applicative Maybe where
        pure = Just
        Nothing <*> _ = Nothing
        (Just g) <*> x = fmap g x

    instance Functor Maybe where
        fmap _ Nothing = Nothing
        fmap g (Just a) = Just (g a)

    1) pure id <*> v = v
        pure id <*> v = Just id <*> v = fmap id v
        1.1) v == Nothing => fmap id Nothing = Nothing
        1.2) v == Just a => fmap id (Just a) = Just (id a) = Just a = v

    2) pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
        2.1) u == Nothing || v == Nothing || w == Nothing => Nothing == Nothing
        2.2) u = Just a, v = Just b, w = Just c
            левая часть:
            pure (.) <*> (Just a) <*> (Just b) <*> (Just c) =
            Just (.) <*> (Just a) <*> (Just b) <*> (Just c) =
            fmap (.) (Just a) <*> (Just b) <*> (Just c) =
            (Just ((.) a)) <*> (Just b) <*> (Just c) =
            (fmap ((. a)) (Just b))) <*> (Just c) =
            (Just ((. a) (Just b))) <*> (Just c) =
            (Just (a . b)) <*> (Just c) =
            fmap (a . b) (Just c) =
            Just ((a . b) c) =
            Just (a (b c))

            правая часть:
            (Just a) <*> ((Just b) <*> (Just c)) =
            fmap a ((Just b) <*> (Just c)) =
            fmap a (fmap b (Just c)) =
            fmap a (Just (b c)) =
            Just (a (b c))

    3) pure g <*> pure x = pure (g x)
        левая часть:
        pure g <*> pure x = Just g <*> Just x = fmap g (Just x) = Just (g x) = pure (Just x)

    4) g <*> pure x = pure ($ x) <*> g
        4.1) g == Nothing => с обоих сторон Nothing
        4.2) g == Just a
        левая часть:
        g <*> pure x = g <*> Just x = Just a <*> Just x = fmap a (Just x) = Just (a x)

        правая часть:
        pure ($ x) <*> g = Just ($ x) <*> g = fmap ($ x) g =
        fmap ($ x) (Just a) = Just (($ x) a) = Just (a x)


    List

    instance Functor [] where
        fmap _ [] = []
        fmap g (x:xs) = g x : fmap g xs

    instance Applicative [] where
        pure x = [x]
        gs <*> xs = [ g x | g <- gs, x <- xs ]

    1) pure id <*> v = v
        pure id <*> v = [id] <*> v = [id x | x <- v] = [x | x <- v] = v

    2) pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
        левая часть:
        pure (.) <*> u <*> v <*> w =
        [(.)] <*> u <*> v <*> w =
        [(. x) | x <- u] <*> v <*> w =
        [(x . y) | x <- u, y <- v] <*> w =
        [(x . y) z | x <- u, y <- v, z <- w] =
        [x (y z) | x <- u, y <- v, z <- w]

        правая часть:
        u <*> (v <*> w) =
        u <*> [y z | y <- v, z <- w] =
        [x (y z) | x <- u, y <- v, z <- w]

    3) pure g <*> pure x = pure (g x)
        левая часть:
        pure g <*> pure x = [g] <*> [x] = [g x]

        правая часть:
        pure (g x) = [g x]

    4) g <*> pure x = pure ($ x) <*> g
        левая часть:
        g <*> pure x = g <*> [x] =
        [G x | G <- g]

        правая часть:
        pure ($ x) <*> g =
        [$ x] <*> g =
        [($ x) G | G <- g] =
        [G x | G <- g]
--}