-- |
-- Module:     Control.Wire.Core
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}

module Control.Wire.Core
    ( -- * Wires
      Wire(..),
      stepWire,

      -- * Constructing wires
      mkConst,
      mkEmpty,
      mkGen,
      mkGen_,
      mkGenN,
      mkId,
      mkPure,
      mkPure_,
      mkPureN,
      mkSF,
      mkSF_,
      mkSFN,

      -- * Data flow and dependencies
      delay,
      evalWith,
      force,
      forceNF,

      -- * Utilities
      (&&&!),
      (***!),
      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)


-- | A wire is a signal function.  It maps a reactive value to another
-- reactive value.

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 :: 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 _)) <|> :: 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
w1

    WConst (Left ex :: e
ex) <|> w2 :: 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

    w1' :: Wire s e m a a
w1' <|> w2' :: 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
$ \ds :: s
ds mx' :: 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 (\(mx1 :: Either e a
mx1, w1 :: Wire s e m a a
w1) (mx2 :: Either e a
mx2, w2 :: 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 _) _       = Either a b
mx1
        choose _ mx2 :: Either a b
mx2@(Right _)       = Either a b
mx2
        choose (Left ex1 :: a
ex1) (Left ex2 :: 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 :: 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

    wf' :: 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
<*> wx' :: 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
$ \ds :: s
ds mx' :: 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 (\(mf :: Either e (a -> b)
mf, wf :: Wire s e m a (a -> b)
wf) (mx :: Either e a
mx, wx :: 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 :: (b -> c) -> Wire s e m b c
arr f :: 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 :: Wire s e m b c -> Wire s e m (b, d) (c, d)
first w' :: 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
$ \ds :: s
ds mxy' :: 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 (\(mx :: Either e c
mx, w :: 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 :: Wire s e m b c -> Wire s e m (Either b d) (Either c d)
left w' :: 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
$ \ds :: s
ds mmx' :: 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 x :: b
x)  -> b -> Either e b
forall a b. b -> Either a b
Right b
x
              Right (Right _) -> e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
              Left ex :: e
ex         -> e -> Either e b
forall a b. a -> Either a b
Left e
ex

    right :: Wire s e m b c -> Wire s e m (Either d b) (Either d c)
right w' :: 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
$ \ds :: s
ds mmx' :: 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 x :: b
x)  -> b -> Either e b
forall a b. b -> Either a b
Right b
x
              Right (Left _)   -> e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
              Left ex :: e
ex          -> e -> Either e b
forall a b. a -> Either a b
Left e
ex

    wl' :: 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')
+++ wr' :: 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
$ \ds :: s
ds mmx' :: Either e (Either b b')
mmx' ->
            case Either e (Either b b')
mmx' of
              Right (Left x :: 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 (\(mx :: Either e c
mx, wl :: Wire s e m b c
wl) (_, wr :: 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 x :: 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 (\(_, wl :: Wire s e m b c
wl) (mx :: Either e c'
mx, wr :: 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 ex :: 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 (\(_, wl :: Wire s e m b c
wl) (_, wr :: 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))

    wl' :: 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
||| wr' :: 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
$ \ds :: s
ds mmx' :: Either e (Either b c)
mmx' ->
            case Either e (Either b c)
mmx' of
              Right (Left x :: 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 (\(mx :: Either e d
mx, wl :: Wire s e m b d
wl) (_, wr :: 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 x :: 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 (\(_, wl :: Wire s e m b d
wl) (mx :: Either e d
mx, wr :: 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 ex :: 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 (\(_, wl :: Wire s e m b d
wl) (_, wr :: 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 :: Wire s e m (b, d) (c, d) -> Wire s e m b c
loop w' :: 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
$ \ds :: s
ds mx' :: 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
$ \ ~(mx :: Either e (c, d)
mx, _) ->
                let d :: d
d | Right (_, d :: d
d) <- Either e (c, d)
mx = d
d
                      | Bool
otherwise = [Char] -> d
forall a. HasCallStack => [Char] -> a
error "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
    <+> :: 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 :: 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 :: 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

    w2' :: 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
. w1' :: 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
$ \ds :: s
ds mx0 :: Either e a
mx0 -> do
            (mx1 :: Either e b
mx1, w1 :: 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
            (mx2 :: Either e c
mx2, w2 :: 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)
forall a b. a -> b -> b
`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' :: 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' :: 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 :: (a -> b) -> Wire s e m a a -> Wire s e m a b
fmap f :: a -> b
f (WArr g :: 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 f :: a -> b
f (WConst mx :: 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 f :: a -> b
f (WGen g :: 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 (\ds :: 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 f :: a -> b
f 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 f :: a -> b
f (WPure g :: 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 (\ds :: 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 :: (a -> b) -> (c -> d) -> Wire s e m b c -> Wire s e m a d
dimap f :: a -> b
f g :: c -> d
g (WArr h :: 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 _ g :: c -> d
g (WConst mx :: 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 f :: a -> b
f g :: c -> d
g (WGen h :: 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 (\ds :: 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 f :: a -> b
f g :: c -> d
g 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 f :: a -> b
f g :: c -> d
g (WPure h :: 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 (\ds :: 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 :: (a -> b) -> Wire s e m b c -> Wire s e m a c
lmap f :: a -> b
f (WArr g :: 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 _ (WConst mx :: 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 f :: a -> b
f (WGen g :: 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 (\ds :: 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 f :: a -> b
f 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 f :: a -> b
f (WPure g :: 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 (\ds :: 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 :: (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' :: 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' :: 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


-- | Left-strict version of '&&&' for functions.

(&&&!) :: (a -> b) -> (a -> c) -> (a -> (b, c))
&&&! :: (a -> b) -> (a -> c) -> a -> (b, c)
(&&&!) f :: a -> b
f g :: a -> c
g x' :: a
x' =
    let (x :: b
x, y :: c
y) = (a -> b
f a
x', a -> c
g a
x')
    in b
x b -> (b, c) -> (b, c)
forall a b. a -> b -> b
`seq` (b
x, c
y)


-- | Left-strict version of '***' for functions.

(***!) :: (a -> c) -> (b -> d) -> ((a, b) -> (c, d))
***! :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
(***!) f :: a -> c
f g :: b -> d
g (x' :: a
x', y' :: b
y') =
    let (x :: c
x, y :: d
y) = (a -> c
f a
x', b -> d
g b
y')
    in c
x c -> (c, d) -> (c, d)
forall a b. a -> b -> b
`seq` (c
x, d
y)


-- | This wire delays its input signal by the smallest possible
-- (semantically infinitesimal) amount of time.  You can use it when you
-- want to use feedback ('ArrowLoop'):  If the user of the feedback
-- depends on /now/, delay the value before feeding it back.  The
-- argument value is the replacement signal at the beginning.
--
-- * Depends: before now.

delay :: a -> Wire s e m a a
delay :: a -> Wire s e m a a
delay x' :: 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
$ \x :: 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)


-- | Evaluate the input signal using the given 'Strategy' here.  This
-- wire evaluates only produced values.
--
-- * Depends: now.

evalWith :: Strategy a -> Wire s e m a a
evalWith :: Strategy a -> Wire s e m a a
evalWith s :: 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
$ \mx :: Either e a
mx ->
        case Either e a
mx of
          Right x :: 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
forall a b. a -> b -> b
`seq` Either e a
mx
          Left _  -> Either e a
mx


-- | Force the input signal to WHNF here.  This wire forces both
-- produced values and inhibition values.
--
-- * Depends: now.

force :: Wire s e m a a
force :: 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
$ \mx :: Either e a
mx ->
        case Either e a
mx of
          Right x :: a
x -> a
x a -> Either e a -> Either e a
forall a b. a -> b -> b
`seq` Either e a
mx
          Left ex :: e
ex -> e
ex e -> Either e a -> Either e a
forall a b. a -> b -> b
`seq` Either e a
mx


-- | Force the input signal to NF here.  This wire forces only produced
-- values.
--
-- * Depends: now.

forceNF :: (NFData a) => Wire s e m a a
forceNF :: 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
$ \mx :: Either e a
mx ->
        case Either e a
mx of
          Right x :: 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 _  -> Either e a
mx


-- | Left-strict tuple.

lstrict :: (a, b) -> (a, b)
lstrict :: (a, b) -> (a, b)
lstrict (x :: a
x, y :: b
y) = a
x a -> (a, b) -> (a, b)
forall a b. a -> b -> b
`seq` (a
x, b
y)


-- | Apply the given function to the wire's inhibition value.

mapLeft :: (Monad m) => (e -> e) -> Wire s e m a b -> Wire s e m a b
mapLeft :: (e -> e) -> Wire s e m a b -> Wire s e m a b
mapLeft _ w1 :: Wire s e m a b
w1@Wire s e m a b
WId = Wire s e m a b
w1
mapLeft f' :: e -> e
f' w :: 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 ex :: e
ex) = e -> Either e b
forall a b. a -> Either a b
Left (e -> e
f' e
ex)
    f (Right x :: b
x) = b -> Either e b
forall a b. b -> Either a b
Right b
x


-- | Apply the given function to the wire's output.

mapOutput :: (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) -> Wire s e m a b' -> Wire s e m a b
mapOutput f :: Either e b' -> Either e b
f (WArr g :: 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 f :: Either e b' -> Either e b
f (WConst mx :: 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 f :: Either e b' -> Either e b
f (WGen g :: 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 (\ds :: 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 f :: Either e b' -> Either e b
f 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 f :: Either e b' -> Either e b
f (WPure g :: 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 (\ds :: 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)


-- | Apply the given monad morphism to the wire's underlying monad.

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 a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b
mapWire _ (WArr g :: 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 _ (WConst mx :: 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 f :: forall a. m' a -> m a
f (WGen g :: 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 (\ds :: 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 _ WId         = Wire s e m a b
forall s e (m :: * -> *) a. Wire s e m a a
WId
mapWire f :: forall a. m' a -> m a
f (WPure g :: 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 (\ds :: 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)


-- | Construct a stateless wire from the given signal mapping function.

mkConst :: Either e b -> Wire s e m a b
mkConst :: 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


-- | Construct the empty wire, which inhibits forever.

mkEmpty :: (Monoid e) => Wire s e m a b
mkEmpty :: 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)


-- | Construct a stateful wire from the given transition function.

mkGen :: (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)) -> Wire s e m a b
mkGen f :: 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' =
        (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
$ \ds :: s
ds mx :: 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)
forall a b. a -> b -> b
`seq`
            case Either e a
mx of
              Left ex :: 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 x' :: 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')


-- | Construct a stateless wire from the given transition function.

mkGen_ :: (Monad m) => (a -> m (Either e b)) -> Wire s e m a b
mkGen_ :: (a -> m (Either e b)) -> Wire s e m a b
mkGen_ f :: 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
$ \_ mx :: Either e a
mx ->
            case Either e a
mx of
              Left ex :: 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 x :: 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)


-- | Construct a stateful wire from the given transition function.

mkGenN :: (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)) -> Wire s e m a b
mkGenN f :: 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
$ \_ mx :: Either e a
mx ->
            case Either e a
mx of
              Left ex :: 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 x' :: 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')


-- | Construct the identity wire.

mkId :: Wire s e m a a
mkId :: 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


-- | Construct a pure stateful wire from the given transition function.

mkPure :: (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)) -> Wire s e m a b
mkPure f :: 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' =
        (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
$ \ds :: s
ds mx :: 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)
forall a b. a -> b -> b
`seq`
            case Either e a
mx of
              Left ex :: 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 x' :: 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')


-- | Construct a pure stateless wire from the given transition function.

mkPure_ :: (a -> Either e b) -> Wire s e m a b
mkPure_ :: (a -> Either e b) -> Wire s e m a b
mkPure_ f :: 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)


-- | Construct a pure stateful wire from the given transition function.

mkPureN :: (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)) -> Wire s e m a b
mkPureN f :: 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
$ \_ mx :: Either e a
mx ->
            case Either e a
mx of
              Left ex :: e
ex  -> (e -> Either e b
forall a b. a -> Either a b
Left e
ex, Wire s e m a b
loop)
              Right x' :: 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')


-- | Construct a pure stateful wire from the given signal function.

mkSF :: (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)) -> Wire s e m a b
mkSF f :: 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 (\ds :: 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)


-- | Construct a pure stateless wire from the given function.

mkSF_ :: (a -> b) -> Wire s e m a b
mkSF_ :: (a -> b) -> Wire s e m a b
mkSF_ f :: 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)


-- | Construct a pure stateful wire from the given signal function.

mkSFN :: (a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN :: (a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN f :: 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)


-- | Perform one step of the given wire.

stepWire :: (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 -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire w :: Wire s e m a b
w@(WArr f :: Either e a -> Either e b
f)    _  mx' :: 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 mx :: Either e b
mx) _  mx' :: 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 f :: s -> Either e a -> m (Either e b, Wire s e m a b)
f)      ds :: s
ds mx' :: 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         _  mx' :: 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 f :: s -> Either e a -> (Either e b, Wire s e m a b)
f)     ds :: s
ds mx' :: 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')