Skip to content

Instantly share code, notes, and snippets.

@deniok

deniok/Fp08.hs Secret

Created Oct 25, 2020
Embed
What would you like to do?
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
You can’t perform that action at this time.