rec

Main.purs

module Main where

import Prelude

import Data.List.Types (List(..), (:))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Class.Console (logShow)


fold1 :: forall a b. b -> (a -> b -> b) -> List a -> b
fold1 z _ Nil         = z
fold1 z f (Cons a as) = f a $ fold1 z f as
-- fold1 1 (*) (1 : 5 : Nil)

fold2 :: forall a b. (Maybe (Tuple a b) -> b) -> List a -> b
fold2 f Nil         = f Nothing
fold2 f (Cons a as) = f $ Just $ Tuple a (fold2 f as)
-- fold2 prodF (1: 5: 10: Nil)

prodF :: Maybe (Tuple Int Int) -> Int
prodF Nothing             = 1
prodF (Just (Tuple a b )) = a * b


fold3 :: forall a b. (Maybe (Tuple a b) -> b) -> List a -> b
fold3 f = f <<< step2 <<< step1
  where
    step1 :: List a -> Maybe (Tuple a (List a))
    step1 Nil         = Nothing
    step1 (Cons a as) = Just $ Tuple a as

    step2 :: Maybe (Tuple a (List a)) -> Maybe (Tuple a b)
    step2 Nothing             = Nothing
    step2 (Just (Tuple a as)) = Just $ Tuple a $ fold3 f as
-- fold3 prodF (1: 5: 10: Nil)


newtype ListF a b = ListF (Maybe (Tuple a b))
-- derive newtype instance functorListF :: Functor (ListF a)
instance functorListFA :: Functor (ListF c) where
  map f (ListF Nothing)            = ListF Nothing
  map f (ListF (Just (Tuple c a))) = ListF $ Just $ Tuple c $ f a


projectList :: forall a. List a -> ListF a (List a)
projectList Nil         = ListF Nothing
projectList (Cons a as) = ListF $ Just $ Tuple a as


prodListF :: ListF Int Int -> Int
prodListF (ListF Nothing)             = 1
prodListF (ListF (Just (Tuple a b ))) = a * b


embedList :: forall a. ListF a (List a) -> List a
embedList (ListF Nothing)             = Nil
embedList (ListF (Just (Tuple a as))) = a : as


range :: Int -> ListF Int Int
range n | n <= 0     = ListF Nothing
        | otherwise  = ListF (Just (Tuple n (n-1)))


fold'
  :: forall f s b. Functor f
  => (f b -> b)
  -> (s -> f s)
  -> s -> b
fold' op project init =
  op $ fold' op project <$> project init
-- fold' prodListF projectList (1: 5: 10: Nil)


unfold'
  :: forall f s a. Functor f
  => (a -> f a)
  -> (f s -> s)
  -> a -> s
unfold' op embed init =
  embed $ unfold' op embed <$> op init
-- unfold' range embedList 10

type Algebra f a = f a -> a
type Coalgebra f a = a -> f a

cata
  :: forall f s b. Functor f
  => Algebra f b
  -> Coalgebra f s
  -> s -> b
cata alg proj init =
  alg $ go <$> proj init
  where go = cata alg proj


ana
  :: forall f s a. Functor f
  => Coalgebra f a 
  -> Algebra f s
  -> a -> s
ana coalg embed init =
  embed $ go <$> coalg init
  where go = ana coalg embed


hylo
  :: forall f a b. Functor f
  => Algebra f b
  -> Coalgebra f a
  -> a -> b
hylo alg coalg init =
  alg $ go <$> coalg init
  where go = hylo alg coalg


productOpA :: Algebra (ListF Int) Int
productOpA (ListF Nothing)            = 1
productOpA (ListF (Just (Tuple a b))) = a * b

rangeOpC :: Coalgebra (ListF Int) Int
rangeOpC n | n <= 0     = ListF Nothing
           | otherwise  = ListF (Just (Tuple n (n-1)))

projectListC :: forall a. Coalgebra (ListF a) (List a)
projectListC Nil         = ListF Nothing
projectListC (Cons a as) = ListF (Just (Tuple a as))


embedListA :: forall a. Algebra (ListF a) (List a)
embedListA (ListF Nothing)             = Nil
embedListA (ListF (Just (Tuple a as))) = a : as


main :: Effect Unit
main = do
  logShow $ cata productOpA projectListC (1 : 5 : 10 : Nil)
  logShow $ ana rangeOpC embedListA 10
  logShow $ factorial' 5
  logShow $ factorial 5
  where
    prodList = cata productOpA projectListC
    rangeList = ana rangeOpC embedListA
    factorial' = prodList <<< rangeList
    factorial = hylo productOpA rangeOpC