module Control.Arrow.Transformer.CoState(
CoStateArrow,
) where
import Control.Arrow.Operations
import Control.Applicative
import Control.Arrow hiding (pure)
import Data.Monoid
newtype CoStateArrow s a b c = CST (a (s -> b) (s -> c))
instance Arrow a => Arrow (CoStateArrow s a) where
arr f = CST (arr (f .))
CST f >>> CST g = CST (f >>> g)
first (CST f) = CST (arr unzipMap >>> first f >>> arr zipMap)
zipMap :: (s -> a, s -> b) -> (s -> (a,b))
zipMap h s = (fst h s, snd h s)
unzipMap :: (s -> (a,b)) -> (s -> a, s -> b)
unzipMap h = (fst . h, snd . h)
instance ArrowLoop a => ArrowLoop (CoStateArrow s a) where
loop (CST f) = CST (loop (arr zipMap >>> f >>> arr unzipMap))
instance ArrowZero a => ArrowZero (CoStateArrow s a) where
zeroArrow = CST zeroArrow
instance ArrowPlus a => ArrowPlus (CoStateArrow s a) where
CST f <+> CST g = CST (f <+> g)
instance Arrow a => Functor (CoStateArrow s a b) where
fmap f g = g >>> arr f
instance Arrow a => Applicative (CoStateArrow s a b) where
pure x = arr (const x)
f <*> g = f &&& g >>> arr (uncurry id)
instance ArrowPlus a => Alternative (CoStateArrow s a b) where
empty = zeroArrow
f <|> g = f <+> g
instance ArrowPlus a => Monoid (CoStateArrow s a b c) where
mempty = zeroArrow
mappend f g = f <+> g