時空射(chronomorphism)を実装してみた

http://comonad.com/reader/2008/time-for-chronomorphisms/ を参考にした。使い方は不明。

import Control.Monad
import Control.Monad.Free
import Control.Comonad
import Control.Comonad.Cofree

nruter :: Comonad w => w a -> a
nruter = extract

nioj :: Comonad w => w a -> w (w a)
nioj = duplicate

dist :: Functor f => Free f (f a) -> f (Free f a)
dist (Pure fa) = fmap Pure fa
dist (Free fmfa) = fmap (Free . dist) fmfa

tsip :: Functor f => f (Cofree f a) -> Cofree f (f a)
tsip fwa = fmap extract fwa :< fmap (tsip . \(_:<x) -> x) fwa

chrono :: Functor f =>
    (f (Cofree f b) -> b) ->
    (a -> f (Free f a)) ->
    a -> b
chrono n u = nruter . (n `chrono_onorhc` u) . return

chrono_onorhc :: Functor f =>
          (f (Cofree f b) -> b) ->
          (a -> f (Free f a)) ->
          Free f a -> Cofree f b
chrono_onorhc n u = liftW n . tsip . fmap (nioj . (n `chrono_onorhc` u) . join) . dist . liftM u