FP_HSE2020Fall_08
{-# 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) | |
-} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment