{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
module Control.Arrow.Transformer.Reader(
ReaderArrow(ReaderArrow),
runReader,
ArrowAddReader(..),
) where
import Control.Arrow.Internals
import Control.Arrow.Operations
import Control.Arrow.Transformer
import Control.Applicative
import Control.Arrow
import Control.Category
import Data.Monoid
#if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Prelude hiding (id,(.))
newtype ReaderArrow r a b c = ReaderArrow (a (b, r) c)
runReader :: Arrow a => ReaderArrow r a e b -> a (e,r) b
runReader :: forall (a :: * -> * -> *) r e b.
Arrow a =>
ReaderArrow r a e b -> a (e, r) b
runReader (ReaderArrow a (e, r) b
f) = a (e, r) b
f
instance Arrow a => ArrowTransformer (ReaderArrow r) a where
lift :: forall b c. a b c -> ReaderArrow r a b c
lift a b c
f = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a b c
f)
instance Arrow a => Category (ReaderArrow r a) where
id :: forall a. ReaderArrow r a a a
id = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst)
ReaderArrow a (b, r) c
f . :: forall b c a.
ReaderArrow r a b c -> ReaderArrow r a a b -> ReaderArrow r a a c
. ReaderArrow a (a, r) b
g = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (b, r) c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (a, r) b
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {a} {b}. (a, b) -> ((a, b), b)
dupenv)
where
dupenv :: (a, b) -> ((a, b), b)
dupenv (a
a, b
r) = ((a
a, b
r), b
r)
instance Arrow a => Arrow (ReaderArrow r a) where
arr :: forall b c. (b -> c) -> ReaderArrow r a b c
arr b -> c
f = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b -> c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst))
first :: forall b c d. ReaderArrow r a b c -> ReaderArrow r a (b, d) (c, d)
first (ReaderArrow a (b, r) c
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (b, r) c
f)
swapsnd :: ((a, r), b) -> ((a, b), r)
swapsnd :: forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd ~(~(a
a, r
r), b
b) = ((a
a, b
b), r
r)
instance ArrowChoice a => ArrowChoice (ReaderArrow r a) where
left :: forall b c d.
ReaderArrow r a b c -> ReaderArrow r a (Either b d) (Either c d)
left (ReaderArrow a (b, r) c
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall b c r. (Either b c, r) -> Either (b, r) c
dist' forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left a (b, r) c
f)
where
dist' :: (Either b c, r) -> Either (b, r) c
dist' :: forall b c r. (Either b c, r) -> Either (b, r) c
dist' (Left b
b, r
r) = forall a b. a -> Either a b
Left (b
b, r
r)
dist' (Right c
c, r
_) = forall a b. b -> Either a b
Right c
c
instance ArrowApply a => ArrowApply (ReaderArrow r a) where
app :: forall b c. ReaderArrow r a (ReaderArrow r a b c, b) c
app = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow
(forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((ReaderArrow a (b, r) c
f, b
a), r
r) -> (a (b, r) c
f, (b
a, r
r))) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app)
instance ArrowZero a => ArrowZero (ReaderArrow r a) where
zeroArrow :: forall b c. ReaderArrow r a b c
zeroArrow = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
instance ArrowPlus a => ArrowPlus (ReaderArrow r a) where
ReaderArrow a (b, r) c
f <+> :: forall b c.
ReaderArrow r a b c -> ReaderArrow r a b c -> ReaderArrow r a b c
<+> ReaderArrow a (b, r) c
g = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (b, r) c
f forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> a (b, r) c
g)
instance ArrowLoop a => ArrowLoop (ReaderArrow r a) where
loop :: forall b d c. ReaderArrow r a (b, d) (c, d) -> ReaderArrow r a b c
loop (ReaderArrow a ((b, d), r) (c, d)
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((b, d), r) (c, d)
f))
instance Arrow a => ArrowReader r (ReaderArrow r a) where
readState :: forall b. ReaderArrow r a b r
readState = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> b
snd)
newReader :: forall e b. ReaderArrow r a e b -> ReaderArrow r a (e, r) b
newReader (ReaderArrow a (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (e, r) b
f)
instance Arrow a => ArrowAddReader r (ReaderArrow r a) a where
liftReader :: forall e b. a e b -> ReaderArrow r a e b
liftReader = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift
elimReader :: forall e b. ReaderArrow r a e b -> a (e, r) b
elimReader = forall (a :: * -> * -> *) r e b.
Arrow a =>
ReaderArrow r a e b -> a (e, r) b
runReader
instance ArrowCircuit a => ArrowCircuit (ReaderArrow r a) where
delay :: forall b. b -> ReaderArrow r a b b
delay b
x = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift (forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay b
x)
instance ArrowError ex a => ArrowError ex (ReaderArrow r a) where
raise :: forall b. ReaderArrow r a ex b
raise = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall ex (a :: * -> * -> *) b. ArrowError ex a => a ex b
raise
handle :: forall e b.
ReaderArrow r a e b
-> ReaderArrow r a (e, ex) b -> ReaderArrow r a e b
handle (ReaderArrow a (e, r) b
f) (ReaderArrow a ((e, ex), r) b
h) =
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a (e, ex) b -> a e b
handle a (e, r) b
f (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, ex), r) b
h))
tryInUnless :: forall e b c.
ReaderArrow r a e b
-> ReaderArrow r a (e, b) c
-> ReaderArrow r a (e, ex) c
-> ReaderArrow r a e c
tryInUnless (ReaderArrow a (e, r) b
f) (ReaderArrow a ((e, b), r) c
s) (ReaderArrow a ((e, ex), r) c
h) =
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall ex (a :: * -> * -> *) e b c.
ArrowError ex a =>
a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnless a (e, r) b
f (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, b), r) c
s) (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, ex), r) c
h))
newError :: forall e b. ReaderArrow r a e b -> ReaderArrow r a e (Either ex b)
newError (ReaderArrow a (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError a (e, r) b
f)
instance ArrowState s a => ArrowState s (ReaderArrow r a) where
fetch :: forall e. ReaderArrow r a e s
fetch = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall s (a :: * -> * -> *) e. ArrowState s a => a e s
fetch
store :: ReaderArrow r a s ()
store = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall s (a :: * -> * -> *). ArrowState s a => a s ()
store
instance ArrowWriter s a => ArrowWriter s (ReaderArrow r a) where
write :: ReaderArrow r a s ()
write = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall w (a :: * -> * -> *). ArrowWriter w a => a w ()
write
newWriter :: forall e b. ReaderArrow r a e b -> ReaderArrow r a e (b, s)
newWriter (ReaderArrow a (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter a (e, r) b
f)
instance ArrowAddError ex a a' =>
ArrowAddError ex (ReaderArrow r a) (ReaderArrow r a') where
liftError :: forall e b. ReaderArrow r a' e b -> ReaderArrow r a e b
liftError (ReaderArrow a' (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a' e b -> a e b
liftError a' (e, r) b
f)
elimError :: forall e b.
ReaderArrow r a e b
-> ReaderArrow r a' (e, ex) b -> ReaderArrow r a' e b
elimError (ReaderArrow a (e, r) b
f) (ReaderArrow a' ((e, ex), r) b
h) =
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a e b -> a' (e, ex) b -> a' e b
elimError a (e, r) b
f (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a' ((e, ex), r) b
h))
instance ArrowAddState s a a' =>
ArrowAddState s (ReaderArrow r a) (ReaderArrow r a') where
liftState :: forall e b. ReaderArrow r a' e b -> ReaderArrow r a e b
liftState (ReaderArrow a' (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a' e b -> a e b
liftState a' (e, r) b
f)
elimState :: forall e b. ReaderArrow r a e b -> ReaderArrow r a' (e, s) (b, s)
elimState (ReaderArrow a (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a e b -> a' (e, s) (b, s)
elimState a (e, r) b
f)
instance ArrowAddWriter s a a' =>
ArrowAddWriter s (ReaderArrow r a) (ReaderArrow r a') where
liftWriter :: forall e b. ReaderArrow r a' e b -> ReaderArrow r a e b
liftWriter (ReaderArrow a' (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter a' (e, r) b
f)
elimWriter :: forall e b. ReaderArrow r a e b -> ReaderArrow r a' e (b, s)
elimWriter (ReaderArrow a (e, r) b
f) = forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a e b -> a' e (b, w)
elimWriter a (e, r) b
f)
instance Arrow a => Functor (ReaderArrow r a b) where
fmap :: forall a b. (a -> b) -> ReaderArrow r a b a -> ReaderArrow r a b b
fmap a -> b
f ReaderArrow r a b a
g = ReaderArrow r a b a
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f
instance Arrow a => Applicative (ReaderArrow r a b) where
pure :: forall a. a -> ReaderArrow r a b a
pure a
x = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const a
x)
ReaderArrow r a b (a -> b)
f <*> :: forall a b.
ReaderArrow r a b (a -> b)
-> ReaderArrow r a b a -> ReaderArrow r a b b
<*> ReaderArrow r a b a
g = ReaderArrow r a b (a -> b)
f forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ReaderArrow r a b a
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
instance ArrowPlus a => Alternative (ReaderArrow r a b) where
empty :: forall a. ReaderArrow r a b a
empty = forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
ReaderArrow r a b a
f <|> :: forall a.
ReaderArrow r a b a -> ReaderArrow r a b a -> ReaderArrow r a b a
<|> ReaderArrow r a b a
g = ReaderArrow r a b a
f forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> ReaderArrow r a b a
g
#if MIN_VERSION_base(4,9,0)
instance ArrowPlus a => Semigroup (ReaderArrow r a b c) where
<> :: ReaderArrow r a b c -> ReaderArrow r a b c -> ReaderArrow r a b c
(<>) = forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>)
#endif
instance ArrowPlus a => Monoid (ReaderArrow r a b c) where
mempty :: ReaderArrow r a b c
mempty = forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
#if !(MIN_VERSION_base(4,11,0))
mappend = (<+>)
#endif