{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
module Control.Wire.Core
(
Wire(..),
stepWire,
mkConst,
mkEmpty,
mkGen,
mkGen_,
mkGenN,
mkId,
mkPure,
mkPure_,
mkPureN,
mkSF,
mkSF_,
mkSFN,
delay,
evalWith,
force,
forceNF,
(&&&!),
(***!),
lstrict,
mapWire
)
where
import Control.Applicative
import Control.Arrow
import Control.Category
import Control.DeepSeq hiding (force)
import Control.Monad
import Control.Monad.Fix
import Control.Parallel.Strategies
import Data.Monoid
import Data.Profunctor
import qualified Data.Semigroup as Sg
import Data.String
import Prelude hiding ((.), id)
data Wire s e m a b where
WArr :: (Either e a -> Either e b) -> Wire s e m a b
WConst :: Either e b -> Wire s e m a b
WGen :: (s -> Either e a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b
WId :: Wire s e m a a
WPure :: (s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
instance (Monad m, Monoid e) => Alternative (Wire s e m a) where
empty :: forall a. Wire s e m a a
empty = Either e a -> Wire s e m a a
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty)
w1 :: Wire s e m a a
w1@(WConst (Right a
_)) <|> :: forall a. Wire s e m a a -> Wire s e m a a -> Wire s e m a a
<|> Wire s e m a a
_ = Wire s e m a a
w1
w1 :: Wire s e m a a
w1@Wire s e m a a
WId <|> Wire s e m a a
_ = Wire s e m a a
w1
WConst (Left e
ex) <|> Wire s e m a a
w2 = (e -> e) -> Wire s e m a a -> Wire s e m a a
forall (m :: * -> *) e s a b.
Monad m =>
(e -> e) -> Wire s e m a b -> Wire s e m a b
mapLeft (e
ex e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) Wire s e m a a
w2
Wire s e m a a
w1' <|> Wire s e m a a
w2' =
(s -> Either e a -> m (Either e a, Wire s e m a a))
-> Wire s e m a a
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e a, Wire s e m a a))
-> Wire s e m a a)
-> (s -> Either e a -> m (Either e a, Wire s e m a a))
-> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' ->
((Either e a, Wire s e m a a)
-> (Either e a, Wire s e m a a) -> (Either e a, Wire s e m a a))
-> m (Either e a, Wire s e m a a)
-> m (Either e a, Wire s e m a a)
-> m (Either e a, Wire s e m a a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e a
mx1, Wire s e m a a
w1) (Either e a
mx2, Wire s e m a a
w2) -> (Either e a, Wire s e m a a) -> (Either e a, Wire s e m a a)
forall a b. (a, b) -> (a, b)
lstrict (Either e a -> Either e a -> Either e a
forall {a} {b}.
Semigroup a =>
Either a b -> Either a b -> Either a b
choose Either e a
mx1 Either e a
mx2, Wire s e m a a
w1 Wire s e m a a -> Wire s e m a a -> Wire s e m a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Wire s e m a a
w2))
(Wire s e m a a -> s -> Either e a -> m (Either e a, Wire s e m a a)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a a
w1' s
ds Either e a
mx')
(Wire s e m a a -> s -> Either e a -> m (Either e a, Wire s e m a a)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a a
w2' s
ds Either e a
mx')
where
choose :: Either a b -> Either a b -> Either a b
choose mx1 :: Either a b
mx1@(Right b
_) Either a b
_ = Either a b
mx1
choose Either a b
_ mx2 :: Either a b
mx2@(Right b
_) = Either a b
mx2
choose (Left a
ex1) (Left a
ex2) = a -> Either a b
forall a b. a -> Either a b
Left (a
ex1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ex2)
instance (Monad m) => Applicative (Wire s e m a) where
pure :: forall a. a -> Wire s e m a a
pure = Either e a -> Wire s e m a a
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst (Either e a -> Wire s e m a a)
-> (a -> Either e a) -> a -> Wire s e m a a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either e a
forall a b. b -> Either a b
Right
Wire s e m a (a -> b)
wf' <*> :: forall a b.
Wire s e m a (a -> b) -> Wire s e m a a -> Wire s e m a b
<*> Wire s e m a a
wx' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' ->
((Either e (a -> b), Wire s e m a (a -> b))
-> (Either e a, Wire s e m a a) -> (Either e b, Wire s e m a b))
-> m (Either e (a -> b), Wire s e m a (a -> b))
-> m (Either e a, Wire s e m a a)
-> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e (a -> b)
mf, Wire s e m a (a -> b)
wf) (Either e a
mx, Wire s e m a a
wx) -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict (Either e (a -> b)
mf Either e (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e a
mx, Wire s e m a (a -> b)
wf Wire s e m a (a -> b) -> Wire s e m a a -> Wire s e m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Wire s e m a a
wx))
(Wire s e m a (a -> b)
-> s -> Either e a -> m (Either e (a -> b), Wire s e m a (a -> b))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a (a -> b)
wf' s
ds Either e a
mx')
(Wire s e m a a -> s -> Either e a -> m (Either e a, Wire s e m a a)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a a
wx' s
ds Either e a
mx')
instance (Monad m) => Arrow (Wire s e m) where
arr :: forall b c. (b -> c) -> Wire s e m b c
arr b -> c
f = (Either e b -> Either e c) -> Wire s e m b c
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((b -> c) -> Either e b -> Either e c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f)
first :: forall b c d. Wire s e m b c -> Wire s e m (b, d) (c, d)
first Wire s e m b c
w' =
(s
-> Either e (b, d)
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> Wire s e m (b, d) (c, d)
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (b, d)
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> Wire s e m (b, d) (c, d))
-> (s
-> Either e (b, d)
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> Wire s e m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (b, d)
mxy' ->
((Either e c, Wire s e m b c)
-> (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e c, Wire s e m b c)
-> m (Either e (c, d), Wire s e m (b, d) (c, d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(Either e c
mx, Wire s e m b c
w) -> (Either e (c, d), Wire s e m (b, d) (c, d))
-> (Either e (c, d), Wire s e m (b, d) (c, d))
forall a b. (a, b) -> (a, b)
lstrict ((c -> d -> (c, d)) -> Either e c -> Either e d -> Either e (c, d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Either e c
mx (((b, d) -> d) -> Either e (b, d) -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, d) -> d
forall a b. (a, b) -> b
snd Either e (b, d)
mxy'), Wire s e m b c -> Wire s e m (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Wire s e m b c
w))
(Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
w' s
ds (((b, d) -> b) -> Either e (b, d) -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, d) -> b
forall a b. (a, b) -> a
fst Either e (b, d)
mxy'))
instance (Monad m, Monoid e) => ArrowChoice (Wire s e m) where
left :: forall b c d.
Wire s e m b c -> Wire s e m (Either b d) (Either c d)
left Wire s e m b c
w' =
(s
-> Either e (Either b d)
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> Wire s e m (Either b d) (Either c d)
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (Either b d)
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> Wire s e m (Either b d) (Either c d))
-> (s
-> Either e (Either b d)
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> Wire s e m (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (Either b d)
mmx' ->
((Either e c, Wire s e m b c)
-> (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> m (Either e c, Wire s e m b c)
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((c -> Either c d) -> Either e c -> Either e (Either c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either c d
forall a b. a -> Either a b
Left (Either e c -> Either e (Either c d))
-> (Wire s e m b c -> Wire s e m (Either b d) (Either c d))
-> (Either e c, Wire s e m b c)
-> (Either e (Either c d), Wire s e m (Either b d) (Either c d))
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! Wire s e m b c -> Wire s e m (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left) (m (Either e c, Wire s e m b c)
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> (Either e b -> m (Either e c, Wire s e m b c))
-> Either e b
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d))
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
w' s
ds (Either e b
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d)))
-> Either e b
-> m (Either e (Either c d), Wire s e m (Either b d) (Either c d))
forall a b. (a -> b) -> a -> b
$
case Either e (Either b d)
mmx' of
Right (Left b
x) -> b -> Either e b
forall a b. b -> Either a b
Right b
x
Right (Right d
_) -> e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
Left e
ex -> e -> Either e b
forall a b. a -> Either a b
Left e
ex
right :: forall b c d.
Wire s e m b c -> Wire s e m (Either d b) (Either d c)
right Wire s e m b c
w' =
(s
-> Either e (Either d b)
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> Wire s e m (Either d b) (Either d c)
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (Either d b)
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> Wire s e m (Either d b) (Either d c))
-> (s
-> Either e (Either d b)
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> Wire s e m (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (Either d b)
mmx' ->
((Either e c, Wire s e m b c)
-> (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> m (Either e c, Wire s e m b c)
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((c -> Either d c) -> Either e c -> Either e (Either d c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either d c
forall a b. b -> Either a b
Right (Either e c -> Either e (Either d c))
-> (Wire s e m b c -> Wire s e m (Either d b) (Either d c))
-> (Either e c, Wire s e m b c)
-> (Either e (Either d c), Wire s e m (Either d b) (Either d c))
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! Wire s e m b c -> Wire s e m (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right) (m (Either e c, Wire s e m b c)
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> (Either e b -> m (Either e c, Wire s e m b c))
-> Either e b
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c))
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
w' s
ds (Either e b
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c)))
-> Either e b
-> m (Either e (Either d c), Wire s e m (Either d b) (Either d c))
forall a b. (a -> b) -> a -> b
$
case Either e (Either d b)
mmx' of
Right (Right b
x) -> b -> Either e b
forall a b. b -> Either a b
Right b
x
Right (Left d
_) -> e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
Left e
ex -> e -> Either e b
forall a b. a -> Either a b
Left e
ex
Wire s e m b c
wl' +++ :: forall b c b' c'.
Wire s e m b c
-> Wire s e m b' c' -> Wire s e m (Either b b') (Either c c')
+++ Wire s e m b' c'
wr' =
(s
-> Either e (Either b b')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> Wire s e m (Either b b') (Either c c')
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (Either b b')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> Wire s e m (Either b b') (Either c c'))
-> (s
-> Either e (Either b b')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> Wire s e m (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (Either b b')
mmx' ->
case Either e (Either b b')
mmx' of
Right (Left b
x) -> do
((Either e c, Wire s e m b c)
-> (Either e c', Wire s e m b' c')
-> (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> m (Either e c, Wire s e m b c)
-> m (Either e c', Wire s e m b' c')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c'))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e c
mx, Wire s e m b c
wl) (Either e c'
_, Wire s e m b' c'
wr) -> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
-> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
forall a b. (a, b) -> (a, b)
lstrict ((c -> Either c c') -> Either e c -> Either e (Either c c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either c c'
forall a b. a -> Either a b
Left Either e c
mx, Wire s e m b c
wl Wire s e m b c
-> Wire s e m b' c' -> Wire s e m (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Wire s e m b' c'
wr))
(Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
wl' s
ds (b -> Either e b
forall a b. b -> Either a b
Right b
x))
(Wire s e m b' c'
-> s -> Either e b' -> m (Either e c', Wire s e m b' c')
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b' c'
wr' s
ds (e -> Either e b'
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty))
Right (Right b'
x) -> do
((Either e c, Wire s e m b c)
-> (Either e c', Wire s e m b' c')
-> (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> m (Either e c, Wire s e m b c)
-> m (Either e c', Wire s e m b' c')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c'))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e c
_, Wire s e m b c
wl) (Either e c'
mx, Wire s e m b' c'
wr) -> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
-> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
forall a b. (a, b) -> (a, b)
lstrict ((c' -> Either c c') -> Either e c' -> Either e (Either c c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c' -> Either c c'
forall a b. b -> Either a b
Right Either e c'
mx, Wire s e m b c
wl Wire s e m b c
-> Wire s e m b' c' -> Wire s e m (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Wire s e m b' c'
wr))
(Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
wl' s
ds (e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty))
(Wire s e m b' c'
-> s -> Either e b' -> m (Either e c', Wire s e m b' c')
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b' c'
wr' s
ds (b' -> Either e b'
forall a b. b -> Either a b
Right b'
x))
Left e
ex ->
((Either e c, Wire s e m b c)
-> (Either e c', Wire s e m b' c')
-> (Either e (Either c c'),
Wire s e m (Either b b') (Either c c')))
-> m (Either e c, Wire s e m b c)
-> m (Either e c', Wire s e m b' c')
-> m (Either e (Either c c'),
Wire s e m (Either b b') (Either c c'))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e c
_, Wire s e m b c
wl) (Either e c'
_, Wire s e m b' c'
wr) -> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
-> (Either e (Either c c'), Wire s e m (Either b b') (Either c c'))
forall a b. (a, b) -> (a, b)
lstrict (e -> Either e (Either c c')
forall a b. a -> Either a b
Left e
ex, Wire s e m b c
wl Wire s e m b c
-> Wire s e m b' c' -> Wire s e m (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Wire s e m b' c'
wr))
(Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
wl' s
ds (e -> Either e b
forall a b. a -> Either a b
Left e
ex))
(Wire s e m b' c'
-> s -> Either e b' -> m (Either e c', Wire s e m b' c')
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b' c'
wr' s
ds (e -> Either e b'
forall a b. a -> Either a b
Left e
ex))
Wire s e m b d
wl' ||| :: forall b d c.
Wire s e m b d -> Wire s e m c d -> Wire s e m (Either b c) d
||| Wire s e m c d
wr' =
(s
-> Either e (Either b c)
-> m (Either e d, Wire s e m (Either b c) d))
-> Wire s e m (Either b c) d
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (Either b c)
-> m (Either e d, Wire s e m (Either b c) d))
-> Wire s e m (Either b c) d)
-> (s
-> Either e (Either b c)
-> m (Either e d, Wire s e m (Either b c) d))
-> Wire s e m (Either b c) d
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (Either b c)
mmx' ->
case Either e (Either b c)
mmx' of
Right (Left b
x) -> do
((Either e d, Wire s e m b d)
-> (Either e d, Wire s e m c d)
-> (Either e d, Wire s e m (Either b c) d))
-> m (Either e d, Wire s e m b d)
-> m (Either e d, Wire s e m c d)
-> m (Either e d, Wire s e m (Either b c) d)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e d
mx, Wire s e m b d
wl) (Either e d
_, Wire s e m c d
wr) -> (Either e d, Wire s e m (Either b c) d)
-> (Either e d, Wire s e m (Either b c) d)
forall a b. (a, b) -> (a, b)
lstrict (Either e d
mx, Wire s e m b d
wl Wire s e m b d -> Wire s e m c d -> Wire s e m (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Wire s e m c d
wr))
(Wire s e m b d -> s -> Either e b -> m (Either e d, Wire s e m b d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b d
wl' s
ds (b -> Either e b
forall a b. b -> Either a b
Right b
x))
(Wire s e m c d -> s -> Either e c -> m (Either e d, Wire s e m c d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m c d
wr' s
ds (e -> Either e c
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty))
Right (Right c
x) -> do
((Either e d, Wire s e m b d)
-> (Either e d, Wire s e m c d)
-> (Either e d, Wire s e m (Either b c) d))
-> m (Either e d, Wire s e m b d)
-> m (Either e d, Wire s e m c d)
-> m (Either e d, Wire s e m (Either b c) d)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e d
_, Wire s e m b d
wl) (Either e d
mx, Wire s e m c d
wr) -> (Either e d, Wire s e m (Either b c) d)
-> (Either e d, Wire s e m (Either b c) d)
forall a b. (a, b) -> (a, b)
lstrict (Either e d
mx, Wire s e m b d
wl Wire s e m b d -> Wire s e m c d -> Wire s e m (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Wire s e m c d
wr))
(Wire s e m b d -> s -> Either e b -> m (Either e d, Wire s e m b d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b d
wl' s
ds (e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty))
(Wire s e m c d -> s -> Either e c -> m (Either e d, Wire s e m c d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m c d
wr' s
ds (c -> Either e c
forall a b. b -> Either a b
Right c
x))
Left e
ex ->
((Either e d, Wire s e m b d)
-> (Either e d, Wire s e m c d)
-> (Either e d, Wire s e m (Either b c) d))
-> m (Either e d, Wire s e m b d)
-> m (Either e d, Wire s e m c d)
-> m (Either e d, Wire s e m (Either b c) d)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(Either e d
_, Wire s e m b d
wl) (Either e d
_, Wire s e m c d
wr) -> (Either e d, Wire s e m (Either b c) d)
-> (Either e d, Wire s e m (Either b c) d)
forall a b. (a, b) -> (a, b)
lstrict (e -> Either e d
forall a b. a -> Either a b
Left e
ex, Wire s e m b d
wl Wire s e m b d -> Wire s e m c d -> Wire s e m (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Wire s e m c d
wr))
(Wire s e m b d -> s -> Either e b -> m (Either e d, Wire s e m b d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b d
wl' s
ds (e -> Either e b
forall a b. a -> Either a b
Left e
ex))
(Wire s e m c d -> s -> Either e c -> m (Either e d, Wire s e m c d)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m c d
wr' s
ds (e -> Either e c
forall a b. a -> Either a b
Left e
ex))
instance (MonadFix m) => ArrowLoop (Wire s e m) where
loop :: forall b d c. Wire s e m (b, d) (c, d) -> Wire s e m b c
loop Wire s e m (b, d) (c, d)
w' =
(s -> Either e b -> m (Either e c, Wire s e m b c))
-> Wire s e m b c
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e b -> m (Either e c, Wire s e m b c))
-> Wire s e m b c)
-> (s -> Either e b -> m (Either e c, Wire s e m b c))
-> Wire s e m b c
forall a b. (a -> b) -> a -> b
$ \s
ds Either e b
mx' ->
((Either e (c, d), Wire s e m (b, d) (c, d))
-> (Either e c, Wire s e m b c))
-> m (Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e c, Wire s e m b c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((c, d) -> c) -> Either e (c, d) -> Either e c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, d) -> c
forall a b. (a, b) -> a
fst (Either e (c, d) -> Either e c)
-> (Wire s e m (b, d) (c, d) -> Wire s e m b c)
-> (Either e (c, d), Wire s e m (b, d) (c, d))
-> (Either e c, Wire s e m b c)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! Wire s e m (b, d) (c, d) -> Wire s e m b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop) (m (Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e c, Wire s e m b c))
-> (((Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> ((Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e c, Wire s e m b c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
((Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e (c, d), Wire s e m (b, d) (c, d))
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (((Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e c, Wire s e m b c))
-> ((Either e (c, d), Wire s e m (b, d) (c, d))
-> m (Either e (c, d), Wire s e m (b, d) (c, d)))
-> m (Either e c, Wire s e m b c)
forall a b. (a -> b) -> a -> b
$ \ ~(Either e (c, d)
mx, Wire s e m (b, d) (c, d)
_) ->
let d :: d
d | Right (c
_, d
d) <- Either e (c, d)
mx = d
d
| Bool
otherwise = [Char] -> d
forall a. HasCallStack => [Char] -> a
error [Char]
"Feedback broken by inhibition"
in Wire s e m (b, d) (c, d)
-> s
-> Either e (b, d)
-> m (Either e (c, d), Wire s e m (b, d) (c, d))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m (b, d) (c, d)
w' s
ds ((b -> (b, d)) -> Either e b -> Either e (b, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, d
d) Either e b
mx')
instance (Monad m, Monoid e) => ArrowPlus (Wire s e m) where
<+> :: forall b c. Wire s e m b c -> Wire s e m b c -> Wire s e m b c
(<+>) = Wire s e m b c -> Wire s e m b c -> Wire s e m b c
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance (Monad m, Monoid e) => ArrowZero (Wire s e m) where
zeroArrow :: forall b c. Wire s e m b c
zeroArrow = Wire s e m b c
forall (f :: * -> *) a. Alternative f => f a
empty
instance (Monad m) => Category (Wire s e m) where
id :: forall a. Wire s e m a a
id = Wire s e m a a
forall s e (m :: * -> *) a. Wire s e m a a
WId
Wire s e m b c
w2' . :: forall b c a. Wire s e m b c -> Wire s e m a b -> Wire s e m a c
. Wire s e m a b
w1' =
(s -> Either e a -> m (Either e c, Wire s e m a c))
-> Wire s e m a c
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e c, Wire s e m a c))
-> Wire s e m a c)
-> (s -> Either e a -> m (Either e c, Wire s e m a c))
-> Wire s e m a c
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx0 -> do
(Either e b
mx1, Wire s e m a b
w1) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1' s
ds Either e a
mx0
(Either e c
mx2, Wire s e m b c
w2) <- Wire s e m b c -> s -> Either e b -> m (Either e c, Wire s e m b c)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m b c
w2' s
ds Either e b
mx1
Either e c
mx2 Either e c
-> m (Either e c, Wire s e m a c) -> m (Either e c, Wire s e m a c)
`seq` (Either e c, Wire s e m a c) -> m (Either e c, Wire s e m a c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e c
mx2, Wire s e m b c
w2 Wire s e m b c -> Wire s e m a b -> Wire s e m a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Wire s e m a b
w1)
instance (Monad m, Monoid e) => Choice (Wire s e m) where
left' :: forall a b c.
Wire s e m a b -> Wire s e m (Either a c) (Either b c)
left' = Wire s e m a b -> Wire s e m (Either a c) (Either b c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left
right' :: forall a b c.
Wire s e m a b -> Wire s e m (Either c a) (Either c b)
right' = Wire s e m a b -> Wire s e m (Either c a) (Either c b)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right
instance (Monad m, Floating b) => Floating (Wire s e m a b) where
** :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
(**) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
acos :: Wire s e m a b -> Wire s e m a b
acos = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
acos
acosh :: Wire s e m a b -> Wire s e m a b
acosh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
acosh
asin :: Wire s e m a b -> Wire s e m a b
asin = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
asin
asinh :: Wire s e m a b -> Wire s e m a b
asinh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
asinh
atan :: Wire s e m a b -> Wire s e m a b
atan = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
atan
atanh :: Wire s e m a b -> Wire s e m a b
atanh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
atanh
cos :: Wire s e m a b -> Wire s e m a b
cos = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
cos
cosh :: Wire s e m a b -> Wire s e m a b
cosh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
cosh
exp :: Wire s e m a b -> Wire s e m a b
exp = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
exp
log :: Wire s e m a b -> Wire s e m a b
log = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
log
logBase :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
logBase = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
logBase
pi :: Wire s e m a b
pi = b -> Wire s e m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Floating a => a
pi
sin :: Wire s e m a b -> Wire s e m a b
sin = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
sin
sinh :: Wire s e m a b -> Wire s e m a b
sinh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
sinh
sqrt :: Wire s e m a b -> Wire s e m a b
sqrt = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
sqrt
tan :: Wire s e m a b -> Wire s e m a b
tan = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
tan
tanh :: Wire s e m a b -> Wire s e m a b
tanh = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Floating a => a -> a
tanh
instance (Monad m, Fractional b) => Fractional (Wire s e m a b) where
/ :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
(/) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Fractional a => a -> a -> a
(/)
recip :: Wire s e m a b -> Wire s e m a b
recip = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Fractional a => a -> a
recip
fromRational :: Rational -> Wire s e m a b
fromRational = b -> Wire s e m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Wire s e m a b)
-> (Rational -> b) -> Rational -> Wire s e m a b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> b
forall a. Fractional a => Rational -> a
fromRational
instance (Monad m) => Functor (Wire s e m a) where
fmap :: forall a b. (a -> b) -> Wire s e m a a -> Wire s e m a b
fmap a -> b
f (WArr Either e a -> Either e a
g) = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either e a -> Either e b)
-> (Either e a -> Either e a) -> Either e a -> Either e b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either e a -> Either e a
g)
fmap a -> b
f (WConst Either e a
mx) = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either e a
mx)
fmap a -> b
f (WGen s -> Either e a -> m (Either e a, Wire s e m a a)
g) = (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen (\s
ds -> ((Either e a, Wire s e m a a) -> (Either e b, Wire s e m a b))
-> m (Either e a, Wire s e m a a) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either e a -> Either e b)
-> (Wire s e m a a -> Wire s e m a b)
-> (Either e a, Wire s e m a a)
-> (Either e b, Wire s e m a b)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! (a -> b) -> Wire s e m a a -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Either e a, Wire s e m a a) -> m (Either e b, Wire s e m a b))
-> (Either e a -> m (Either e a, Wire s e m a a))
-> Either e a
-> m (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> m (Either e a, Wire s e m a a)
g s
ds)
fmap a -> b
f Wire s e m a a
WId = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
fmap a -> b
f (WPure s -> Either e a -> (Either e a, Wire s e m a a)
g) = (s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure (\s
ds -> ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either e a -> Either e b)
-> (Wire s e m a a -> Wire s e m a b)
-> (Either e a, Wire s e m a a)
-> (Either e b, Wire s e m a b)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! (a -> b) -> Wire s e m a a -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((Either e a, Wire s e m a a) -> (Either e b, Wire s e m a b))
-> (Either e a -> (Either e a, Wire s e m a a))
-> Either e a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> (Either e a, Wire s e m a a)
g s
ds)
instance (Monad m, IsString b) => IsString (Wire s e m a b) where
fromString :: [Char] -> Wire s e m a b
fromString = b -> Wire s e m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Wire s e m a b) -> ([Char] -> b) -> [Char] -> Wire s e m a b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> b
forall a. IsString a => [Char] -> a
fromString
instance (Monad m, Monoid b) => Monoid (Wire s e m a b) where
mempty :: Wire s e m a b
mempty = b -> Wire s e m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
mappend :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
mappend = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend
instance (Monad m, Num b) => Num (Wire s e m a b) where
+ :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
(+) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(+)
(-) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
* :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
(*) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(*)
abs :: Wire s e m a b -> Wire s e m a b
abs = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
abs
negate :: Wire s e m a b -> Wire s e m a b
negate = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
negate
signum :: Wire s e m a b -> Wire s e m a b
signum = (b -> b) -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
signum
fromInteger :: Integer -> Wire s e m a b
fromInteger = b -> Wire s e m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Wire s e m a b)
-> (Integer -> b) -> Integer -> Wire s e m a b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> b
forall a. Num a => Integer -> a
fromInteger
instance (Monad m) => Profunctor (Wire s e m) where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Wire s e m b c -> Wire s e m a d
dimap a -> b
f c -> d
g (WArr Either e b -> Either e c
h) = (Either e a -> Either e d) -> Wire s e m a d
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((c -> d) -> Either e c -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Either e c -> Either e d)
-> (Either e a -> Either e c) -> Either e a -> Either e d
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either e b -> Either e c
h (Either e b -> Either e c)
-> (Either e a -> Either e b) -> Either e a -> Either e c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
dimap a -> b
_ c -> d
g (WConst Either e c
mx) = Either e d -> Wire s e m a d
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst ((c -> d) -> Either e c -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g Either e c
mx)
dimap a -> b
f c -> d
g (WGen s -> Either e b -> m (Either e c, Wire s e m b c)
h) = (s -> Either e a -> m (Either e d, Wire s e m a d))
-> Wire s e m a d
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen (\s
ds -> ((Either e c, Wire s e m b c) -> (Either e d, Wire s e m a d))
-> m (Either e c, Wire s e m b c) -> m (Either e d, Wire s e m a d)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((c -> d) -> Either e c -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Either e c -> Either e d)
-> (Wire s e m b c -> Wire s e m a d)
-> (Either e c, Wire s e m b c)
-> (Either e d, Wire s e m a d)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! (a -> b) -> (c -> d) -> Wire s e m b c -> Wire s e m a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g) (m (Either e c, Wire s e m b c) -> m (Either e d, Wire s e m a d))
-> (Either e a -> m (Either e c, Wire s e m b c))
-> Either e a
-> m (Either e d, Wire s e m a d)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e b -> m (Either e c, Wire s e m b c)
h s
ds (Either e b -> m (Either e c, Wire s e m b c))
-> (Either e a -> Either e b)
-> Either e a
-> m (Either e c, Wire s e m b c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
dimap a -> b
f c -> d
g Wire s e m b c
WId = (Either e a -> Either e d) -> Wire s e m a d
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((a -> d) -> Either e a -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> d
c -> d
g (b -> d) -> (a -> b) -> a -> d
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f))
dimap a -> b
f c -> d
g (WPure s -> Either e b -> (Either e c, Wire s e m b c)
h) = (s -> Either e a -> (Either e d, Wire s e m a d)) -> Wire s e m a d
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure (\s
ds -> ((c -> d) -> Either e c -> Either e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Either e c -> Either e d)
-> (Wire s e m b c -> Wire s e m a d)
-> (Either e c, Wire s e m b c)
-> (Either e d, Wire s e m a d)
forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
***! (a -> b) -> (c -> d) -> Wire s e m b c -> Wire s e m a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g) ((Either e c, Wire s e m b c) -> (Either e d, Wire s e m a d))
-> (Either e a -> (Either e c, Wire s e m b c))
-> Either e a
-> (Either e d, Wire s e m a d)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e b -> (Either e c, Wire s e m b c)
h s
ds (Either e b -> (Either e c, Wire s e m b c))
-> (Either e a -> Either e b)
-> Either e a
-> (Either e c, Wire s e m b c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
lmap :: forall a b c. (a -> b) -> Wire s e m b c -> Wire s e m a c
lmap a -> b
f (WArr Either e b -> Either e c
g) = (Either e a -> Either e c) -> Wire s e m a c
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr (Either e b -> Either e c
g (Either e b -> Either e c)
-> (Either e a -> Either e b) -> Either e a -> Either e c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
lmap a -> b
_ (WConst Either e c
mx) = Either e c -> Wire s e m a c
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst Either e c
mx
lmap a -> b
f (WGen s -> Either e b -> m (Either e c, Wire s e m b c)
g) = (s -> Either e a -> m (Either e c, Wire s e m a c))
-> Wire s e m a c
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen (\s
ds -> ((Either e c, Wire s e m b c) -> (Either e c, Wire s e m a c))
-> m (Either e c, Wire s e m b c) -> m (Either e c, Wire s e m a c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m b c -> Wire s e m a c)
-> (Either e c, Wire s e m b c) -> (Either e c, Wire s e m a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Wire s e m b c -> Wire s e m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f)) (m (Either e c, Wire s e m b c) -> m (Either e c, Wire s e m a c))
-> (Either e a -> m (Either e c, Wire s e m b c))
-> Either e a
-> m (Either e c, Wire s e m a c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e b -> m (Either e c, Wire s e m b c)
g s
ds (Either e b -> m (Either e c, Wire s e m b c))
-> (Either e a -> Either e b)
-> Either e a
-> m (Either e c, Wire s e m b c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
lmap a -> b
f Wire s e m b c
WId = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
lmap a -> b
f (WPure s -> Either e b -> (Either e c, Wire s e m b c)
g) = (s -> Either e a -> (Either e c, Wire s e m a c)) -> Wire s e m a c
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure (\s
ds -> (Wire s e m b c -> Wire s e m a c)
-> (Either e c, Wire s e m b c) -> (Either e c, Wire s e m a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Wire s e m b c -> Wire s e m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f) ((Either e c, Wire s e m b c) -> (Either e c, Wire s e m a c))
-> (Either e a -> (Either e c, Wire s e m b c))
-> Either e a
-> (Either e c, Wire s e m a c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e b -> (Either e c, Wire s e m b c)
g s
ds (Either e b -> (Either e c, Wire s e m b c))
-> (Either e a -> Either e b)
-> Either e a
-> (Either e c, Wire s e m b c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
rmap :: forall b c a. (b -> c) -> Wire s e m a b -> Wire s e m a c
rmap = (b -> c) -> Wire s e m a b -> Wire s e m a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance (Monad m, Sg.Semigroup b) => Sg.Semigroup (Wire s e m a b) where
<> :: Wire s e m a b -> Wire s e m a b -> Wire s e m a b
(<>) = (b -> b -> b) -> Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(Sg.<>)
instance (Monad m, Monoid e) => Strong (Wire s e m) where
first' :: forall a b c. Wire s e m a b -> Wire s e m (a, c) (b, c)
first' = Wire s e m a b -> Wire s e m (a, c) (b, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
second' :: forall a b c. Wire s e m a b -> Wire s e m (c, a) (c, b)
second' = Wire s e m a b -> Wire s e m (c, a) (c, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
(&&&!) :: (a -> b) -> (a -> c) -> (a -> (b, c))
&&&! :: forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
(&&&!) a -> b
f a -> c
g a
x' =
let (b
x, c
y) = (a -> b
f a
x', a -> c
g a
x')
in b
x b -> (b, c) -> (b, c)
`seq` (b
x, c
y)
(***!) :: (a -> c) -> (b -> d) -> ((a, b) -> (c, d))
***! :: forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
(***!) a -> c
f b -> d
g (a
x', b
y') =
let (c
x, d
y) = (a -> c
f a
x', b -> d
g b
y')
in c
x c -> (c, d) -> (c, d)
`seq` (c
x, d
y)
delay :: a -> Wire s e m a a
delay :: forall a s e (m :: * -> *). a -> Wire s e m a a
delay a
x' = (a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (a, Wire s e m a a)) -> Wire s e m a a)
-> (a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a
x', a -> Wire s e m a a
forall a s e (m :: * -> *). a -> Wire s e m a a
delay a
x)
evalWith :: Strategy a -> Wire s e m a a
evalWith :: forall a s e (m :: * -> *). Strategy a -> Wire s e m a a
evalWith Strategy a
s =
(Either e a -> Either e a) -> Wire s e m a a
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((Either e a -> Either e a) -> Wire s e m a a)
-> (Either e a -> Either e a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \Either e a
mx ->
case Either e a
mx of
Right a
x -> (a
x a -> Strategy a -> a
forall a. a -> Strategy a -> a
`using` Strategy a
s) a -> Either e a -> Either e a
`seq` Either e a
mx
Left e
_ -> Either e a
mx
force :: Wire s e m a a
force :: forall s e (m :: * -> *) a. Wire s e m a a
force =
(Either e a -> Either e a) -> Wire s e m a a
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((Either e a -> Either e a) -> Wire s e m a a)
-> (Either e a -> Either e a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \Either e a
mx ->
case Either e a
mx of
Right a
x -> a
x a -> Either e a -> Either e a
`seq` Either e a
mx
Left e
ex -> e
ex e -> Either e a -> Either e a
`seq` Either e a
mx
forceNF :: (NFData a) => Wire s e m a a
forceNF :: forall a s e (m :: * -> *). NFData a => Wire s e m a a
forceNF =
(Either e a -> Either e a) -> Wire s e m a a
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((Either e a -> Either e a) -> Wire s e m a a)
-> (Either e a -> Either e a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \Either e a
mx ->
case Either e a
mx of
Right a
x -> a
x a -> Either e a -> Either e a
forall a b. NFData a => a -> b -> b
`deepseq` Either e a
mx
Left e
_ -> Either e a
mx
lstrict :: (a, b) -> (a, b)
lstrict :: forall a b. (a, b) -> (a, b)
lstrict (a
x, b
y) = a
x a -> (a, b) -> (a, b)
`seq` (a
x, b
y)
mapLeft :: (Monad m) => (e -> e) -> Wire s e m a b -> Wire s e m a b
mapLeft :: forall (m :: * -> *) e s a b.
Monad m =>
(e -> e) -> Wire s e m a b -> Wire s e m a b
mapLeft e -> e
_ w1 :: Wire s e m a b
w1@Wire s e m a b
WId = Wire s e m a b
w1
mapLeft e -> e
f' Wire s e m a b
w = (Either e b -> Either e b) -> Wire s e m a b -> Wire s e m a b
forall (m :: * -> *) e b' b s a.
Monad m =>
(Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
mapOutput Either e b -> Either e b
f Wire s e m a b
w
where
f :: Either e b -> Either e b
f (Left e
ex) = e -> Either e b
forall a b. a -> Either a b
Left (e -> e
f' e
ex)
f (Right b
x) = b -> Either e b
forall a b. b -> Either a b
Right b
x
mapOutput :: (Monad m) => (Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
mapOutput :: forall (m :: * -> *) e b' b s a.
Monad m =>
(Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
mapOutput Either e b' -> Either e b
f (WArr Either e a -> Either e b'
g) = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr (Either e b' -> Either e b
f (Either e b' -> Either e b)
-> (Either e a -> Either e b') -> Either e a -> Either e b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either e a -> Either e b'
g)
mapOutput Either e b' -> Either e b
f (WConst Either e b'
mx) = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst (Either e b' -> Either e b
f Either e b'
mx)
mapOutput Either e b' -> Either e b
f (WGen s -> Either e a -> m (Either e b', Wire s e m a b')
g) = (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen (\s
ds -> ((Either e b', Wire s e m a b') -> (Either e b, Wire s e m a b))
-> m (Either e b', Wire s e m a b')
-> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either e b' -> Either e b
f (Either e b' -> Either e b)
-> (Wire s e m a b' -> Wire s e m a b)
-> (Either e b', Wire s e m a b')
-> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
forall (m :: * -> *) e b' b s a.
Monad m =>
(Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
mapOutput Either e b' -> Either e b
f) (m (Either e b', Wire s e m a b')
-> m (Either e b, Wire s e m a b))
-> (Either e a -> m (Either e b', Wire s e m a b'))
-> Either e a
-> m (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> m (Either e b', Wire s e m a b')
g s
ds)
mapOutput Either e b' -> Either e b
f Wire s e m a b'
WId = (Either e b' -> Either e b) -> Wire s e m b' b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr Either e b' -> Either e b
f
mapOutput Either e b' -> Either e b
f (WPure s -> Either e a -> (Either e b', Wire s e m a b')
g) = (s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure (\s
ds -> (Either e b' -> Either e b
f (Either e b' -> Either e b)
-> (Wire s e m a b' -> Wire s e m a b)
-> (Either e b', Wire s e m a b')
-> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
forall (m :: * -> *) e b' b s a.
Monad m =>
(Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b
mapOutput Either e b' -> Either e b
f) ((Either e b', Wire s e m a b') -> (Either e b, Wire s e m a b))
-> (Either e a -> (Either e b', Wire s e m a b'))
-> Either e a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> (Either e b', Wire s e m a b')
g s
ds)
mapWire ::
(Monad m', Monad m)
=> (forall a. m' a -> m a)
-> Wire s e m' a b
-> Wire s e m a b
mapWire :: forall (m' :: * -> *) (m :: * -> *) s e a b.
(Monad m', Monad m) =>
(forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
mapWire forall a. m' a -> m a
_ (WArr Either e a -> Either e b
g) = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr Either e a -> Either e b
g
mapWire forall a. m' a -> m a
_ (WConst Either e b
mx) = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst Either e b
mx
mapWire forall a. m' a -> m a
f (WGen s -> Either e a -> m' (Either e b, Wire s e m' a b)
g) = (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen (\s
ds -> ((Either e b, Wire s e m' a b) -> (Either e b, Wire s e m a b))
-> m (Either e b, Wire s e m' a b)
-> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> ((Either e b, Wire s e m' a b) -> (Either e b, Wire s e m a b))
-> (Either e b, Wire s e m' a b)
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Wire s e m' a b -> Wire s e m a b)
-> (Either e b, Wire s e m' a b) -> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
forall (m' :: * -> *) (m :: * -> *) s e a b.
(Monad m', Monad m) =>
(forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
mapWire forall a. m' a -> m a
f)) (m (Either e b, Wire s e m' a b) -> m (Either e b, Wire s e m a b))
-> (Either e a -> m (Either e b, Wire s e m' a b))
-> Either e a
-> m (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m' (Either e b, Wire s e m' a b) -> m (Either e b, Wire s e m' a b)
forall a. m' a -> m a
f (m' (Either e b, Wire s e m' a b)
-> m (Either e b, Wire s e m' a b))
-> (Either e a -> m' (Either e b, Wire s e m' a b))
-> Either e a
-> m (Either e b, Wire s e m' a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> m' (Either e b, Wire s e m' a b)
g s
ds)
mapWire forall a. m' a -> m a
_ Wire s e m' a b
WId = Wire s e m a b
forall s e (m :: * -> *) a. Wire s e m a a
WId
mapWire forall a. m' a -> m a
f (WPure s -> Either e a -> (Either e b, Wire s e m' a b)
g) = (s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure (\s
ds -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (Either e a -> (Either e b, Wire s e m a b))
-> Either e a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Wire s e m' a b -> Wire s e m a b)
-> (Either e b, Wire s e m' a b) -> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
forall (m' :: * -> *) (m :: * -> *) s e a b.
(Monad m', Monad m) =>
(forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
mapWire forall a. m' a -> m a
f) ((Either e b, Wire s e m' a b) -> (Either e b, Wire s e m a b))
-> (Either e a -> (Either e b, Wire s e m' a b))
-> Either e a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Either e a -> (Either e b, Wire s e m' a b)
g s
ds)
mkConst :: Either e b -> Wire s e m a b
mkConst :: forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
mkConst = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
WConst
mkEmpty :: (Monoid e) => Wire s e m a b
mkEmpty :: forall e s (m :: * -> *) a b. Monoid e => Wire s e m a b
mkEmpty = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
mkConst (e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty)
mkGen :: (Monad m, Monoid s) => (s -> a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b
mkGen :: forall (m :: * -> *) s a e b.
(Monad m, Monoid s) =>
(s -> a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b
mkGen s -> a -> m (Either e b, Wire s e m a b)
f = s -> Wire s e m a b
loop s
forall a. Monoid a => a
mempty
where
loop :: s -> Wire s e m a b
loop s
s' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx ->
let s :: s
s = s
s' s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
ds in
s
s s
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
`seq`
case Either e a
mx of
Left e
ex -> (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
ex, s -> Wire s e m a b
loop s
s)
Right a
x' -> ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict (s -> a -> m (Either e b, Wire s e m a b)
f s
s a
x')
mkGen_ :: (Monad m) => (a -> m (Either e b)) -> Wire s e m a b
mkGen_ :: forall (m :: * -> *) a e b s.
Monad m =>
(a -> m (Either e b)) -> Wire s e m a b
mkGen_ a -> m (Either e b)
f = Wire s e m a b
loop
where
loop :: Wire s e m a b
loop =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
_ Either e a
mx ->
case Either e a
mx of
Left e
ex -> (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
ex, Wire s e m a b
loop)
Right a
x -> (Either e b -> (Either e b, Wire s e m a b))
-> m (Either e b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (Either e b -> (Either e b, Wire s e m a b))
-> Either e b
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (, Wire s e m a b
loop)) (a -> m (Either e b)
f a
x)
mkGenN :: (Monad m) => (a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b
mkGenN :: forall (m :: * -> *) a e b s.
Monad m =>
(a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b
mkGenN a -> m (Either e b, Wire s e m a b)
f = Wire s e m a b
loop
where
loop :: Wire s e m a b
loop =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
_ Either e a
mx ->
case Either e a
mx of
Left e
ex -> (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
ex, Wire s e m a b
loop)
Right a
x' -> ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict (a -> m (Either e b, Wire s e m a b)
f a
x')
mkId :: Wire s e m a a
mkId :: forall s e (m :: * -> *) a. Wire s e m a a
mkId = Wire s e m a a
forall s e (m :: * -> *) a. Wire s e m a a
WId
mkPure :: (Monoid s) => (s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure :: forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure s -> a -> (Either e b, Wire s e m a b)
f = s -> Wire s e m a b
loop s
forall a. Monoid a => a
mempty
where
loop :: s -> Wire s e m a b
loop s
s' =
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure ((s -> Either e a -> (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx ->
let s :: s
s = s
s' s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
ds in
s
s s -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
`seq`
case Either e a
mx of
Left e
ex -> (e -> Either e b
forall a b. a -> Either a b
Left e
ex, s -> Wire s e m a b
loop s
s)
Right a
x' -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict (s -> a -> (Either e b, Wire s e m a b)
f s
s a
x')
mkPure_ :: (a -> Either e b) -> Wire s e m a b
mkPure_ :: forall a e b s (m :: * -> *). (a -> Either e b) -> Wire s e m a b
mkPure_ a -> Either e b
f = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((Either e a -> Either e b) -> Wire s e m a b)
-> (Either e a -> Either e b) -> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ (Either e a -> (a -> Either e b) -> Either e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either e b
f)
mkPureN :: (a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN :: forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN a -> (Either e b, Wire s e m a b)
f = Wire s e m a b
loop
where
loop :: Wire s e m a b
loop =
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s e a b (m :: * -> *).
(s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
WPure ((s -> Either e a -> (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
_ Either e a
mx ->
case Either e a
mx of
Left e
ex -> (e -> Either e b
forall a b. a -> Either a b
Left e
ex, Wire s e m a b
loop)
Right a
x' -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict (a -> (Either e b, Wire s e m a b)
f a
x')
mkSF :: (Monoid s) => (s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF :: forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF s -> a -> (b, Wire s e m a b)
f = (s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure (\s
ds -> (Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (a -> (Either e b, Wire s e m a b))
-> a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> Either e b)
-> (b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b -> Either e b
forall a b. b -> Either a b
Right) ((b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (a -> (b, Wire s e m a b)) -> a -> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> a -> (b, Wire s e m a b)
f s
ds)
mkSF_ :: (a -> b) -> Wire s e m a b
mkSF_ :: forall a b s e (m :: * -> *). (a -> b) -> Wire s e m a b
mkSF_ a -> b
f = (Either e a -> Either e b) -> Wire s e m a b
forall e a b s (m :: * -> *).
(Either e a -> Either e b) -> Wire s e m a b
WArr ((a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
mkSFN :: (a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN :: forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN a -> (b, Wire s e m a b)
f = (a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall a b. (a, b) -> (a, b)
lstrict ((Either e b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (a -> (Either e b, Wire s e m a b))
-> a
-> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> Either e b)
-> (b, Wire s e m a b) -> (Either e b, Wire s e m a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b -> Either e b
forall a b. b -> Either a b
Right) ((b, Wire s e m a b) -> (Either e b, Wire s e m a b))
-> (a -> (b, Wire s e m a b)) -> a -> (Either e b, Wire s e m a b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> (b, Wire s e m a b)
f)
stepWire :: (Monad m) => Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire w :: Wire s e m a b
w@(WArr Either e a -> Either e b
f) s
_ Either e a
mx' = (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> Either e b
f Either e a
mx', Wire s e m a b
w)
stepWire w :: Wire s e m a b
w@(WConst Either e b
mx) s
_ Either e a
mx' = (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a
mx' Either e a -> Either e b -> Either e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either e b
mx, Wire s e m a b
w)
stepWire (WGen s -> Either e a -> m (Either e b, Wire s e m a b)
f) s
ds Either e a
mx' = s -> Either e a -> m (Either e b, Wire s e m a b)
f s
ds Either e a
mx'
stepWire w :: Wire s e m a b
w@Wire s e m a b
WId s
_ Either e a
mx' = (Either e a, Wire s e m a b) -> m (Either e a, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a
mx', Wire s e m a b
w)
stepWire (WPure s -> Either e a -> (Either e b, Wire s e m a b)
f) s
ds Either e a
mx' = (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Either e a -> (Either e b, Wire s e m a b)
f s
ds Either e a
mx')