Skip to content

Instantly share code, notes, and snippets.

@atopuzov
Last active June 28, 2019 06:41
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save atopuzov/2c652c7b3f1832ef507cf3010a7d72ce to your computer and use it in GitHub Desktop.
Save atopuzov/2c652c7b3f1832ef507cf3010a7d72ce to your computer and use it in GitHub Desktop.
{-# 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