module Control.Arrow.Transformer.Static(
StaticArrow, StaticMonadArrow, StaticArrowArrow,
wrapA, unwrapA, wrapM, unwrapM,
) where
import Control.Applicative
import Control.Arrow hiding (pure)
import Control.Arrow.Internals
import Control.Arrow.Operations
import Control.Arrow.Transformer
import Control.Monad
newtype StaticArrow f a b c = SA (f (a b c))
instance (Arrow a, Applicative f) => ArrowTransformer (StaticArrow f) a where
lift f = SA (pure f)
instance (Arrow a, Applicative f) => Arrow (StaticArrow f a) where
arr f = SA (pure (arr f))
SA f >>> SA g = SA ((>>>) <$> f <*> g)
first (SA f) = SA (first <$> f)
instance (ArrowZero a, Applicative f) => ArrowZero (StaticArrow f a) where
zeroArrow = lift zeroArrow
instance (ArrowCircuit a, Applicative f) => ArrowCircuit (StaticArrow f a) where
delay x = lift (delay x)
instance (ArrowError ex a, Applicative f) => ArrowError ex (StaticArrow f a) where
raise = lift raise
handle (SA f) (SA h) = SA (handle <$> f <*> h)
tryInUnless (SA f) (SA s) (SA h) = SA (tryInUnless <$> f <*> s <*> h)
instance (ArrowReader r a, Applicative f) => ArrowReader r (StaticArrow f a) where
readState = lift readState
newReader (SA f) = SA (newReader <$> f)
instance (ArrowState s a, Applicative f) => ArrowState s (StaticArrow f a) where
fetch = lift fetch
store = lift store
instance (ArrowWriter w a, Applicative f) => ArrowWriter w (StaticArrow f a) where
write = lift write
newWriter (SA f) = SA (newWriter <$> f)
instance (ArrowChoice a, Applicative f) => ArrowChoice (StaticArrow f a) where
left (SA f) = SA (left <$> f)
instance (ArrowLoop a, Applicative f) => ArrowLoop (StaticArrow f a) where
loop (SA f) = SA (loop <$> f)
instance (ArrowPlus a, Applicative f) => ArrowPlus (StaticArrow f a) where
SA f <+> SA g = SA ((<+>) <$> f <*> g)
instance (ArrowAddStream a a', Applicative f) =>
ArrowAddStream (StaticArrow f a) (StaticArrow f a') where
liftStream (SA f) = SA (liftStream <$> f)
elimStream (SA f) = SA (elimStream <$> f)
instance (ArrowAddState s a a', Applicative f) =>
ArrowAddState s (StaticArrow f a) (StaticArrow f a') where
liftState (SA f) = SA (liftState <$> f)
elimState (SA f) = SA (elimState <$> f)
instance (ArrowAddReader r a a', Applicative f) =>
ArrowAddReader r (StaticArrow f a) (StaticArrow f a') where
liftReader (SA f) = SA (liftReader <$> f)
elimReader (SA f) = SA (elimReader <$> f)
instance (ArrowAddWriter w a a', Applicative f) =>
ArrowAddWriter w (StaticArrow f a) (StaticArrow f a') where
liftWriter (SA f) = SA (liftWriter <$> f)
elimWriter (SA f) = SA (elimWriter <$> f)
instance (ArrowAddError ex a a', Applicative f) =>
ArrowAddError ex (StaticArrow f a) (StaticArrow f a') where
liftError (SA f) = SA (liftError <$> f)
elimError (SA f) (SA h) = SA (elimError <$> f <*> h)
type StaticArrowArrow a s = StaticArrow (WrappedArrow a s)
wrapA :: (Arrow a, Arrow a') => a s (a' b c) -> StaticArrowArrow a s a' b c
wrapA x = SA (WrapArrow x)
unwrapA :: (Arrow a, Arrow a') => StaticArrowArrow a s a' b c -> a s (a' b c)
unwrapA (SA (WrapArrow x)) = x
type StaticMonadArrow m = StaticArrow (WrappedMonad m)
wrapM :: (Monad m, Arrow a) => m (a b c) -> StaticMonadArrow m a b c
wrapM x = SA (WrapMonad x)
unwrapM :: (Monad m, Arrow a) => StaticMonadArrow m a b c -> m (a b c)
unwrapM (SA (WrapMonad x)) = x