yoneda.hs

{-# LANGUAGE RankNTypes #-}

data Proc a = Action1 a | Action2 a | Action3 a

newtype Yoneda f a = Yoneda { runYoneda :: forall b. ((a -> b) -> f b) }

instance Functor (Yoneda f) where
    fmap f m = Yoneda (\k -> runYoneda m (k . f))

data Free f a = Pure a | Free (f (Free f a))

instance Functor f => Monad (Free f) where
    return = Pure
    (Pure x) >>= f = f x
    (Free x) >>= f = Free (fmap (>>= f) x)

act1 = Free $ Yoneda $ \f -> Action1 (f (Pure ()))
act2 = Free $ Yoneda $ \f -> Action2 (f (Pure ()))
act3 = Free $ Yoneda $ \f -> Action3 (f (Pure ()))

runProc :: Free (Yoneda Proc) () -> IO ()
runProc (Pure ()) = putStrLn "end"
runProc (Free (Yoneda f)) = case f id of
    Action1 a -> putStrLn "act1" >> runProc a
    Action2 a -> putStrLn "act2" >> runProc a
    Action3 a -> putStrLn "act3" >> runProc a

proc :: Free (Yoneda Proc) ()
proc = do
    act1
    act2
    act3
    act1

main = runProc proc

act1, act2, act3 を定義するときに暗黙にProcのファンクタとしての性質を使ってる.
CoYonedaを使うべき

{-# LANGUAGE RankNTypes, GADTs #-}

data CoYoneda f a where
    CoYoneda :: (b -> a) -> (f b) -> CoYoneda f a

instance Functor (CoYoneda f) where
    fmap f (CoYoneda mp fb) = CoYoneda (f . mp) fb

data Free f a = Pure a | Free (f (Free f a))

instance Functor f => Monad (Free f) where
    return = Pure
    (Pure x) >>= f = f x
    (Free x) >>= f = Free (fmap (>>= f) x)


data Proc a = Action1 a | Action2 a | Action3 a

act1 = Free $ CoYoneda id (Action1 (Pure ()))
act2 = Free $ CoYoneda id (Action2 (Pure ()))
act3 = Free $ CoYoneda id (Action3 (Pure ()))

runProc :: Free (CoYoneda Proc) () -> IO ()
runProc (Pure ()) = putStrLn "end"
runProc (Free (CoYoneda f act)) = case act of
    Action1 a -> putStrLn "act1" >> runProc (f a)
    Action2 a -> putStrLn "act2" >> runProc (f a)
    Action3 a -> putStrLn "act3" >> runProc (f a)

proc :: Free (CoYoneda Proc) ()
proc = do
    act1
    act2
    act3
    act1

main = runProc proc