FP_HSE2020Fall_08

Fp08.hs

{-# LANGUAGE InstanceSigs #-}
module Fp08 where
import Data.Functor ( (<$>), ($>), (<$) )
import Control.Applicative

data Tree a = Leaf a | Branch (Tree a) a (Tree a) 
  deriving Show

instance Functor Tree where
  fmap :: (a -> b) -> Tree a -> Tree b
  fmap g (Leaf x)       = Leaf (g x)
  fmap g (Branch l x r) = Branch (fmap g l) (g x) (fmap g r)
  
testTree = Branch (Leaf 2) 3 (Leaf 4)
{-
GHCi> testTree = Branch (Leaf 2) 3 (Leaf 4)
GHCi> fmap (^2) testTree
Branch (Leaf 4) 9 (Leaf 16)
GHCi> (^3) <$> testTree
Branch (Leaf 8) 27 (Leaf 64)
-}


{-
GHCi> Nothing $> "foo"
Nothing
GHCi> Just 42 $> "foo"
Just "foo"
-}

{-
instance Functor (Either e) where
  fmap :: (a -> b) -> Either e a -> Either e b
  fmap _ (Left x)  = Left x
  fmap g (Right y) = Right (g y)

instance Functor ((,) s) where
  fmap :: (a -> b) -> (s,a) -> (s,b)
  fmap g (x,y) = (x, g y)

instance Functor ((->) e) where
  fmap :: (a -> b) -> ((->) e a) -> ((->) e b)
  fmap = (.)

-- Плохой представитель класса Functor для списка
instance Functor [] where
  fmap _ []     = []
  fmap g (x:xs) = g x : g x : fmap g xs

newtype Endo a = Endo { appEndo :: a -> a }

instance Functor Endo where
  fmap :: (a -> b) -> Endo a -> Endo b
  fmap _ (Endo _)   = Endo id
-}

newtype Arr c a = Arr { appArr :: c -> a }

newtype RevArr c a = RevArr { appRevArr :: a -> c }

instance Functor (RevArr c) where 
  fmap :: (a -> b) -> RevArr c a -> RevArr c b
  fmap g (RevArr f) = RevArr (\x -> undefined)
  -- g :: a -> b
  -- f :: a -> c
  -- x :: b

{-
class Functor f => Pointed f where
  pure :: a -> f a -- aka singleton, return, unit, point

instance Pointed Maybe where
  pure :: a -> Maybe a
  pure x  = Just x

instance Pointed [] where
  pure :: a -> [a]
  pure x  = [x]

instance Pointed ((->) e) where
  pure :: a -> e -> a
  pure = const

-- не очень-то хорошо, контекст Monoid s => может спасти дело 
instance Pointed ((,) s) where
  pure :: a -> (s, a)
  pure x = (undefined, x)

instance Pointed (Either e) where
  pure :: a -> Either e a
  pure x = Right x

instance Pointed Tree where
  pure :: a -> Tree a
  pure x = Leaf x -- как для деревьев другой структуры, например с Nil?
-}


{-

GHCi> Just (+) <*> Just 2 <*> Just 5
Just 7
GHCi> pure (+) <*> Just 2 <*> Just 5
Just 7
GHCi> (+) <$> Just 2 <*> Just 5
Just 7

GHCi> let fs = [\x->2*x, \x->3+x, \x->4-x]
GHCi> let as = [1,2]
GHCi> fs <*> as
[2,4,4,5,3,2]

GHCi> let fs = [\x->2*x, \x->3+x, \x->4-x]
GHCi> let as = [1,2]
GHCi> getZipList $ ZipList fs <*> ZipList as
[2,5]

GHCi> ("Answer to ",(*)) <*> ("the Ultimate ",6) <*> ("Question",7)
("Answer to the Ultimate Question",42)
-}

(<***>) :: Applicative f => f a -> f (a -> b) -> f b
(<***>) = flip (<*>)

{-
GHCi> ("Answer to ",5) <**> ("the Ultimate ",(*8)) <**> ("Question",(+2))
("Answer to the Ultimate Question",42)
GHCi> ("Answer to ",5) <***> ("the Ultimate ",(*8)) <***> ("Question",(+2))
("Questionthe Ultimate Answer to ",42)
-}