113 lines
2.5 KiB
Haskell
113 lines
2.5 KiB
Haskell
{-# LANGUAGE LambdaCase, DeriveFunctor, DeriveFoldable, MultiParamTypeClasses #-}
|
|
import Prelude hiding (length, sum, fix)
|
|
|
|
length :: [a] -> Int
|
|
length [] = 0
|
|
length (_:xs) = 1 + length xs
|
|
|
|
lengthF :: ([a] -> Int) -> [a] -> Int
|
|
lengthF rec [] = 0
|
|
lengthF rec (_:xs) = 1 + rec xs
|
|
|
|
lengthF' = \rec -> \case
|
|
[] -> 0
|
|
_:xs -> 1 + rec xs
|
|
|
|
fix f = let x = f x in x
|
|
|
|
length' = fix lengthF
|
|
|
|
data MyList = MyNil | MyCons Int MyList
|
|
data MyListF a = MyNilF | MyConsF Int a
|
|
|
|
newtype Fix f = Fix { unFix :: f (Fix f) }
|
|
|
|
testList :: Fix MyListF
|
|
testList = Fix (MyConsF 1 (Fix (MyConsF 2 (Fix (MyConsF 3 (Fix MyNilF))))))
|
|
|
|
myOut :: MyList -> MyListF MyList
|
|
myOut MyNil = MyNilF
|
|
myOut (MyCons i xs) = MyConsF i xs
|
|
|
|
myIn :: MyListF MyList -> MyList
|
|
myIn MyNilF = MyNil
|
|
myIn (MyConsF i xs) = MyCons i xs
|
|
|
|
instance Functor MyListF where
|
|
fmap f MyNilF = MyNilF
|
|
fmap f (MyConsF i a) = MyConsF i (f a)
|
|
|
|
mySumF :: MyListF Int -> Int
|
|
mySumF MyNilF = 0
|
|
mySumF (MyConsF i rest) = i + rest
|
|
|
|
mySum :: MyList -> Int
|
|
mySum = mySumF . fmap mySum . myOut
|
|
|
|
myCata :: (MyListF a -> a) -> MyList -> a
|
|
myCata f = f . fmap (myCata f) . myOut
|
|
|
|
myLength = myCata $ \case
|
|
MyNilF -> 0
|
|
MyConsF _ l -> 1 + l
|
|
|
|
myMax = myCata $ \case
|
|
MyNilF -> 0
|
|
MyConsF x y -> max x y
|
|
|
|
myMin = myCata $ \case
|
|
MyNilF -> 0
|
|
MyConsF x y -> min x y
|
|
|
|
myTestList = MyCons 2 (MyCons 1 (MyCons 3 MyNil))
|
|
|
|
pack :: a -> (Int -> a -> a) -> MyListF a -> a
|
|
pack b f MyNilF = b
|
|
pack b f (MyConsF x y) = f x y
|
|
|
|
unpack :: (MyListF a -> a) -> (a, Int -> a -> a)
|
|
unpack f = (f MyNilF, \i a -> f (MyConsF i a))
|
|
|
|
class Functor f => Cata a f where
|
|
out :: a -> f a
|
|
|
|
cata :: Cata a f => (f b -> b) -> a -> b
|
|
cata f = f . fmap (cata f) . out
|
|
|
|
instance Cata MyList MyListF where
|
|
out = myOut
|
|
|
|
data ListF a b = Nil | Cons a b deriving Functor
|
|
|
|
instance Cata [a] (ListF a) where
|
|
out [] = Nil
|
|
out (x:xs) = Cons x xs
|
|
|
|
sum :: Num a => [a] -> a
|
|
sum = cata $ \case
|
|
Nil -> 0
|
|
Cons x xs -> x + xs
|
|
|
|
data BinaryTree a = Node a (BinaryTree a) (BinaryTree a) | Leaf deriving (Show, Foldable)
|
|
data BinaryTreeF a b = NodeF a b b | LeafF deriving Functor
|
|
|
|
instance Cata (BinaryTree a) (BinaryTreeF a) where
|
|
out (Node a l r) = NodeF a l r
|
|
out Leaf = LeafF
|
|
|
|
invert :: BinaryTree a -> BinaryTree a
|
|
invert = cata $ \case
|
|
LeafF -> Leaf
|
|
NodeF a l r -> Node a r l
|
|
|
|
data MaybeF a b = NothingF | JustF a deriving Functor
|
|
|
|
instance Cata (Maybe a) (MaybeF a) where
|
|
out Nothing = NothingF
|
|
out (Just x) = JustF x
|
|
|
|
getOrDefault :: a -> Maybe a -> a
|
|
getOrDefault d = cata $ \case
|
|
NothingF -> d
|
|
JustF a -> a
|