Dyad
Maarten Fokkinga の Dyads。使い道は謎。
{-# LANGUAGE Arrows, MultiParamTypeClasses, FunctionalDependencies, TypeOperators #-} module Main where import Prelude import Control.Arrow import qualified Control.Category as Cat import Control.Monad import Control.Monad.Identity import Control.Comonad import Data.Maybe -------------------------- Maarten Fokkinga's Dyads --------------------------------------------- -------------------------- from category-extras-0.53.5 --------------------------------------------- class (Cat.Category r, Cat.Category s) => CFunctor f r s | f r -> s, f s -> r where cmap :: r a b -> s (f a) (f b) class (CFunctor f (~>) (~>), CFunctor g (~>) (~>)) => CDistributes f g (~>) where cdist :: f (g a) ~> g (f a) class CFunctor m (~>) (~>) => CBind m (~>) where cjoin :: m (m a) ~> m a cbind :: (a ~> m b) -> (m a ~> m b) cjoin = cbind Cat.id cbind f = (Cat..) cjoin (cmap f) class CFunctor w (~>) (~>) => CExtend w (~>) where cduplicate :: w a ~> w (w a) cextend :: (w a ~> b) -> (w a ~> w b) cduplicate = cextend Cat.id cextend f = (Cat..) (cmap f) cduplicate class (CDistributes w m (~>), CDistributes m w (~>), CExtend w (~>), CBind m (~>)) => CDyad w m (~>) where cdyid :: w a ~> m a newtype DiKleisli w m (~>) a b = DiKleisli { runDiKleisli :: w a ~> m b } instance CDyad w m k => Cat.Category (DiKleisli w m k) where DiKleisli g . DiKleisli f = DiKleisli ((Cat..) (cbind g) ((Cat..) cdist (cextend f))) id = DiKleisli cdyid ----------------------------------------------------------------------------------------------------- -------------------------------------------some instances-------------------------------------------- instance CFunctor ([]) (->) (->) where cmap = fmap instance CFunctor Maybe (->) (->) where cmap = fmap instance CFunctor Identity (->) (->) where cmap = fmap instance CDistributes ([]) ([]) (->) where cdist = id instance CDistributes Maybe ([]) (->) where cdist Nothing = [] cdist (Just as) = fmap return as instance CDistributes ([]) Maybe (->) where cdist as = mapM (return . fromJust) as instance CDistributes Identity ([]) (->) where cdist (Identity a) = fmap return a instance CDistributes ([]) Identity (->) where cdist as = mapM (return . runIdentity) as instance CBind ([]) (->) where cjoin = join instance CExtend ([]) (->) where cduplicate = duplicate instance CExtend Maybe (->) where cduplicate = duplicate instance CExtend Identity (->) where cduplicate = duplicate instance CDyad Maybe ([]) (->) where cdyid Nothing = [] cdyid (Just a) = [a] instance CDyad ([]) ([]) (->) where cdyid = id instance CDyad Identity ([]) (->) where cdyid (Identity a) = [a] -- てすと、 -- F a -> G b と F b -> G c の composition -- F は Identity の場合 G は Monad、I a -> M b と I b -> M c の composition は monad comosition main = (print $ runDiKleisli ( DiKleisli foo >>> DiKleisli bar ) (Just 2)) >> (print $ runDiKleisli ( DiKleisli foo' >>> DiKleisli bar' ) [3, 4, 5]) >> (print $ runDiKleisli ( DiKleisli foo'' >>> DiKleisli bar'' ) (Identity 6)) where foo :: Maybe Int -> [String] foo Nothing = [] foo (Just a) = [ show (a+1), show (a*2) ] bar :: Maybe String -> [Int] bar Nothing = [] bar (Just a) = [ read a ] foo' :: [Int] -> [String] foo' = fmap (\x -> show (x+1)) bar' :: [String] -> [Int] bar' = fmap (read) foo'' :: Identity Int -> [String] foo'' (Identity a) = [ show (a+1), show (a*2) ] bar'' :: Identity String -> [Int] bar'' (Identity a) = [ read a ]