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 ]