コモナドの例

Comonads.hs

{-# LANGUAGE ExistentialQuantification #-}
module Comonads where
import Control.Comonad
import Data.Array.IArray

--
-- CoState (Store) comonad
--

-- Co-St a = ((s -> a), a)
data CoState a = forall s. CoState (s -> a) s

{- GADT syntax
data CoState a where
  CoState :: (s -> a) -> s -> CoState a
-}

instance Functor CoState where
  -- mapCo-St f = \(g, x). (f . g, x)
  fmap f (CoState g s) = CoState (f . g) s

instance Extend CoState where
  duplicate (CoState f s) = CoState (\s' -> (CoState f s')) s
  -- co-ext f = (\(g, s). (\s'. f (g, s')), s)
  extend f (CoState g s)  = CoState (\s' -> f (CoState g s')) s
  
instance Comonad CoState where
  -- co-eval (g, x) = g x
  extract (CoState f s) = f s

--
-- Array
--
data Arr i e = Arr (Array i e) i

instance Ix i => Functor (Arr i) where
  fmap f (Arr a i) = Arr (fmap f a) i

instance Ix i => Extend (Arr i) where
  duplicate (Arr a i) = let (b1, b2) = bounds a
                            app c    = (c, Arr a c)
                            es       = map app (range (b1, b2))
                            a'       = array (b1, b2) es
                        in Arr a' i

instance Ix i => Comonad (Arr i) where
  extract (Arr a i) = a ! i

filter :: Ix i => (a -> Bool) -> a -> Arr i a -> a
filter p x arr
  | p (extract arr) = x
  | otherwise       = extract arr