module FunctorsApplicatives where

import Control.Applicative (liftA2)
import Data.List (delete)

fmap_List :: (a -> b) -> [] a -> [] b
-- "[] a" means "[a]" in types.
fmap_List f [] = []
fmap_List f (x:xs) = f x : fmap_List f xs

fmap_Maybe :: (a -> b) -> Maybe a -> Maybe b
fmap_Maybe f Nothing = Nothing
fmap_Maybe f (Just a) = Just (f a)

fmap_Either :: (a -> b) -> (Either e) a -> (Either e) b
fmap_Either f (Left e) = Left e
fmap_Either f (Right a) = Right (f a)

data BinTree a = BTNil | BTNode a (BinTree a) (BinTree a) deriving Show

instance Functor BinTree where
    -- fmap :: (a -> b) -> BinTree a -> BinTree b
    fmap f BTNil = BTNil
    fmap f (BTNode a lt rt) = BTNode (f a) (fmap f lt) (fmap f rt)


liftA2_List :: (a -> b -> c) -> [a] -> [b] -> [c]
liftA2_List f [] _ = []
liftA2_List f (a:as) bs = map (f a) bs ++ liftA2_List f as bs

liftA2_Maybe :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
liftA2_Maybe f Nothing _ = Nothing
liftA2_Maybe f (Just a) Nothing = Nothing
liftA2_Maybe f (Just a) (Just b) = Just (f a b)
-- The last two lines could be merged into:
-- liftA2_Maybe f (Just a) mb = fmap (f a) mb

liftA2_Either :: (a -> b -> c) -> Either e a -> Either e b -> Either e c
liftA2_Either f (Left e) _ = Left e
liftA2_Either f (Right a) (Left e) = Left e
liftA2_Either f (Right a) (Right b) = Right (f a b)
-- The last two lines could be merged into:
-- liftA2_Either f (Right a) eb = fmap (f a) eb

liftA3_List :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
liftA3_List f as bs cs =
    let gs = liftA2_List f as bs
        -- Think f :: a -> b -> (c -> d)
        -- So gs :: [c -> d]
        ds = liftA2_List (\g c -> g c) gs cs  -- [d]
    in ds

liftA4_List :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
liftA4_List f as bs cs ds =
    let gs = liftA2_List f as bs              -- [c -> d -> e]
        hs = liftA2_List (\g c -> g c) gs cs  -- [d -> e]
        es = liftA2_List (\h d -> h d) hs ds  -- [e]
    in es


-- Actually already in Control.Applicative
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 f as bs cs = (fmap f as <*> bs) <*> cs

liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 f as bs cs ds = ((fmap f as <*> bs) <*> cs) <*> ds


recipMay :: Double -> Maybe Double
recipMay a | a == 0 = Nothing
           | otherwise = Just (1 / a)    -- or: pure (1 / a)

addRecipV1 x y =
    case recipMay x of
      Nothing -> Nothing
      Just x_recip -> case recipMay y of
        Nothing -> Nothing
        Just y_recip -> Just (x_recip + y_recip)

addRecipV2 :: Double -> Double -> Maybe Double
addRecipV2 x y = liftA2 (+) (recipMay x) (recipMay y)


sqrts :: Double -> [Double]
sqrts a | a < 0 = []
        | a == 0 = [0]    -- or: pure 0
        | otherwise = [- sqrt a, sqrt a]

addSqrts :: Double -> Double -> [Double]
addSqrts x y = liftA2 (+) (sqrts x) (sqrts y)