-
-
Save atopuzov/2c652c7b3f1832ef507cf3010a7d72ce to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DeriveFunctor #-} | |
newtype Fix f = Fix { unFix :: f (Fix f)} | |
data IntListF a = | |
Cons Int a | |
| Nil | |
deriving Functor | |
type IntList = Fix IntListF | |
myList :: IntList | |
myList = Fix $ Cons 1 $ Fix $ Cons 2 $ Fix $ Cons 3 $ Fix Nil | |
cata :: Functor f | |
=> (f a -> a) | |
-> Fix f | |
-> a | |
-- fmap m | |
-- f (Fix f) --------> f a | |
-- ^ | | |
-- | unFix | alg | |
-- | Y | |
-- Fix f ----------> a | |
-- m | |
cata alg x = alg | |
. fmap (cata alg) | |
. unFix | |
$ x | |
toList :: IntList -> [Int] | |
toList = cata alg | |
where | |
alg :: IntListF [Int] -> [Int] | |
alg Nil = [] | |
alg (Cons x acc) = x : acc | |
sumList :: IntList -> Int | |
sumList = cata alg | |
where | |
alg :: IntListF Int -> Int | |
alg Nil = 0 | |
alg (Cons x acc) = x + acc | |
prodList :: IntList -> Int | |
prodList = cata alg | |
where | |
alg :: IntListF Int -> Int | |
alg Nil = 1 | |
alg (Cons x acc) = x * acc | |
reverseList :: IntList -> [Int] | |
reverseList = cata alg | |
where | |
alg :: IntListF [Int] -> [Int] | |
alg Nil = [] | |
alg (Cons x acc) = acc ++ [x] | |
maxList :: IntList -> Int | |
maxList = cata alg | |
where | |
alg :: IntListF Int -> Int | |
alg Nil = minBound | |
alg (Cons x acc) = if x > acc then x else acc | |
minList :: IntList -> Int | |
minList = cata alg | |
where | |
alg :: IntListF Int -> Int | |
alg Nil = maxBound | |
alg (Cons x acc) = if x < acc then x else acc | |
-- fmap m | |
-- ??? <------------ f a | |
-- | ^ | |
-- | Fix | coalg | |
-- Y | | |
-- Fix f <---------- a | |
-- m | |
ana :: Functor f | |
=> (a -> f a) | |
-> a | |
-> Fix f | |
ana coalg x = | |
Fix . | |
fmap (ana coalg) | |
. coalg | |
$ x | |
fromList :: [Int] -> IntList | |
fromList = ana coalg | |
where | |
coalg :: [Int] -> IntListF [Int] | |
coalg [] = Nil | |
coalg (x:xs) = Cons x xs | |
-- Expression evaluator | |
data ExprF a = | |
Val Int | |
| Sum a a | |
| Product a a | |
deriving Functor | |
type Expr = Fix ExprF | |
evalExp :: Expr -> Int | |
evalExp = cata alg | |
where | |
alg :: ExprF Int -> Int | |
alg (Val x) = x | |
alg (Sum x y) = x + y | |
alg (Product x y) = x * y | |
two = Fix $ Val 2 | |
five = Fix $ Val 5 | |
seven = Fix $ Sum two five | |
ten = Fix $ Product two five | |
seventeen = Fix $ Sum seven ten |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment