{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-orphans #-}
module Control.Moffy.Internal.Sig (
adjustSig,
app_, iapp_,
at_, break_, until_, indexBy_,
spawn, parList_ ) where
import Prelude hiding (repeat)
import Control.Arrow (first, (>>>), (***))
import Control.Monad.Freer.Par (pattern Pure, pattern (:=<<))
import Control.Moffy.Internal.Sig.Type (
Sig(..), ISig(..), isig,
emit, emitAll, waitFor, repeat, res, ires, hold )
import Control.Moffy.Internal.React (
Firstable, Adjustable, Updatable, adjust, par )
import Control.Moffy.Internal.React.Type (
React, Rct(..), ThreadId, forkThreadId )
import Data.Type.Set ((:+:))
import Data.Type.Flip (Flip(..), (<$%>))
import Data.OneOrMore (Mergeable)
instance ((es :+: es) ~ es, Mergeable es es es, Monoid r) =>
Applicative (Flip (Sig s es) r) where
pure :: forall a. a -> Flip (Sig s es) r a
pure = forall (t :: * -> * -> *) a b. t b a -> Flip t a b
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Flip (Sig s es) r (a -> b)
mf <*> :: forall a b.
Flip (Sig s es) r (a -> b)
-> Flip (Sig s es) r a -> Flip (Sig s es) r b
<*> Flip (Sig s es) r a
mx = forall (t :: * -> * -> *) a b. t b a -> Flip t a b
Flip forall a b. (a -> b) -> a -> b
$ forall (es :: Set (*)) r s a b.
((es :+: es) ~ es, Mergeable es es es, Monoid r) =>
React s es (ThreadId, ThreadId)
-> Sig s es (a -> b) r -> Sig s es a r -> Sig s es b r
app_ forall s (es :: Set (*)). React s es (ThreadId, ThreadId)
forkThreadId (forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip Flip (Sig s es) r (a -> b)
mf) (forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip Flip (Sig s es) r a
mx)
instance ((es :+: es) ~ es, Mergeable es es es, Semigroup r) =>
Applicative (Flip (ISig s es) r) where
pure :: forall a. a -> Flip (ISig s es) r a
pure = forall (t :: * -> * -> *) a b. t b a -> Flip t a b
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:| forall s (es :: Set (*)) a r. Sig s es a r
hold)
Flip (ISig s es) r (a -> b)
mf <*> :: forall a b.
Flip (ISig s es) r (a -> b)
-> Flip (ISig s es) r a -> Flip (ISig s es) r b
<*> Flip (ISig s es) r a
mx = forall (t :: * -> * -> *) a b. t b a -> Flip t a b
Flip forall a b. (a -> b) -> a -> b
$ forall (es :: Set (*)) r s a b.
((es :+: es) ~ es, Mergeable es es es, Semigroup r) =>
React s es (ThreadId, ThreadId)
-> ISig s es (a -> b) r -> ISig s es a r -> ISig s es b r
iapp_ forall s (es :: Set (*)). React s es (ThreadId, ThreadId)
forkThreadId (forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip Flip (ISig s es) r (a -> b)
mf) (forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip Flip (ISig s es) r a
mx)
app_ :: ((es :+: es) ~ es, Mergeable es es es, Monoid r) =>
React s es (ThreadId, ThreadId) ->
Sig s es (a -> b) r -> Sig s es a r -> Sig s es b r
app_ :: forall (es :: Set (*)) r s a b.
((es :+: es) ~ es, Mergeable es es es, Monoid r) =>
React s es (ThreadId, ThreadId)
-> Sig s es (a -> b) r -> Sig s es a r -> Sig s es b r
app_ React s es (ThreadId, ThreadId)
ft Sig s es (a -> b) r
mf Sig s es a r
mx = forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall (es :: Set (*)) r s a b.
((es :+: es) ~ es, Mergeable es es es, Semigroup r) =>
React s es (ThreadId, ThreadId)
-> ISig s es (a -> b) r -> ISig s es a r -> ISig s es b r
iapp_ React s es (ThreadId, ThreadId)
ft) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor (forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'),
Updatable (ISig s es b r') (ISig s es a r), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es b r'
-> React s es (Maybe (ISig s es a r, ISig s es b r'))
exposeBoth React s es (ThreadId, ThreadId)
ft Sig s es (a -> b) r
mf Sig s es a r
mx)
exposeBoth :: (
Updatable (ISig s es a r) (ISig s es b r'),
Updatable (ISig s es b r') (ISig s es a r), (es :+: es) ~ es, Mergeable es es es ) =>
React s es (ThreadId, ThreadId) -> Sig s es a r -> Sig s es b r' ->
React s es (Maybe (ISig s es a r, ISig s es b r'))
exposeBoth :: forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'),
Updatable (ISig s es b r') (ISig s es a r), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es b r'
-> React s es (Maybe (ISig s es a r, ISig s es b r'))
exposeBoth React s es (ThreadId, ThreadId)
ft Sig s es a r
l (Sig React s es (ISig s es b r')
r) = do
(Sig React s es (ISig s es a r)
l', React s es (ISig s es b r')
r') <- forall s (es :: Set (*)) a r. Sig s es a r -> React s es r
res forall a b. (a -> b) -> a -> b
$ forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s es (ThreadId, ThreadId)
ft Sig s es a r
l React s es (ISig s es b r')
r
(Sig React s es (ISig s es b r')
r'', React s es (ISig s es a r)
l'') <- forall s (es :: Set (*)) a r. Sig s es a r -> React s es r
res forall a b. (a -> b) -> a -> b
$ forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s es (ThreadId, ThreadId)
ft (forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig React s es (ISig s es b r')
r') React s es (ISig s es a r)
l'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s} {sq :: (* -> * -> *) -> * -> * -> *}
{f :: (* -> *) -> * -> * -> *} {t :: * -> *} {a}.
Freer s sq f t a -> Maybe a
ex React s es (ISig s es a r)
l'' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {s} {sq :: (* -> * -> *) -> * -> * -> *}
{f :: (* -> *) -> * -> * -> *} {t :: * -> *} {a}.
Freer s sq f t a -> Maybe a
ex React s es (ISig s es b r')
r''
where ex :: Freer s sq f t a -> Maybe a
ex = \case Pure a
x -> forall a. a -> Maybe a
Just a
x; Freer s sq f t a
_ -> forall a. Maybe a
Nothing
iapp_ :: ((es :+: es) ~ es, Mergeable es es es, Semigroup r) =>
React s es (ThreadId, ThreadId) ->
ISig s es (a -> b) r -> ISig s es a r -> ISig s es b r
iapp_ :: forall (es :: Set (*)) r s a b.
((es :+: es) ~ es, Mergeable es es es, Semigroup r) =>
React s es (ThreadId, ThreadId)
-> ISig s es (a -> b) r -> ISig s es a r -> ISig s es b r
iapp_ React s es (ThreadId, ThreadId)
ft ISig s es (a -> b) r
mf ISig s es a r
mx = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
($) forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%> forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), Mergeable es es es,
(es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> ISig s es b r'
-> ISig s es (a, b) (ISig s es a r, ISig s es b r')
ipairs React s es (ThreadId, ThreadId)
ft ISig s es (a -> b) r
mf ISig s es a r
mx)) \case
(End r
x, End r
y) -> r
x forall a. Semigroup a => a -> a -> a
<> r
y; (End r
x, a
_ :| Sig s es a r
_) -> r
x; (a -> b
_ :| Sig s es (a -> b) r
_, End r
y) -> r
y
(a -> b
_ :| Sig s es (a -> b) r
_, a
_ :| Sig s es a r
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
at_ :: Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId) ->
Sig s es a r -> React s es' r' ->
React s (es :+: es') (Either r (Maybe a, r'))
at_ :: forall (es :: Set (*)) (es' :: Set (*)) s a r r'.
Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId)
-> Sig s es a r
-> React s es' r'
-> React s (es :+: es') (Either r (Maybe a, r'))
at_ React s (es :+: es') (ThreadId, ThreadId)
ft (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig -> Sig React s (es :+: es') (ISig s (es :+: es') a r)
l) (forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust -> React s (es :+: es') r'
r) = forall a b (es :: Set (*)) s.
(Updatable a b, Mergeable es es es, (es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> React s es a
-> React s es b
-> React s es (React s es a, React s es b)
par React s (es :+: es') (ThreadId, ThreadId)
ft React s (es :+: es') (ISig s (es :+: es') a r)
l React s (es :+: es') r'
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Pure ISig s (es :+: es') a r
l', React s (es :+: es') r'
r') -> (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r -> React s es r' -> React s es (Either r (a, r'))
iat_ React s (es :+: es') (ThreadId, ThreadId)
ft ISig s (es :+: es') a r
l' React s (es :+: es') r'
r'
(React s (es :+: es') (ISig s (es :+: es') a r)
_, Pure r'
y) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, r'
y)
(Fun
s
FTCQueue
TaggableFun
(Rct (es :+: es'))
x
(ISig s (es :+: es') a r)
_ :=<< Rct (es :+: es') x
_, Fun s FTCQueue TaggableFun (Rct (es :+: es')) x r'
_ :=<< Rct (es :+: es') x
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
iat_ :: (Updatable (ISig s es a r) r', (es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
ISig s es a r -> React s es r' -> React s es (Either r (a, r'))
iat_ :: forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r -> React s es r' -> React s es (Either r (a, r'))
iat_ React s es (ThreadId, ThreadId)
ft ISig s es a r
l React s es r'
r = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r. ISig s es a r -> React s es r
ires (forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> React s es r'
-> ISig s es a (ISig s es a r, React s es r')
ipause React s es (ThreadId, ThreadId)
ft ISig s es a r
l React s es r'
r)) \case
(End r
x, React s es r'
_) -> forall a b. a -> Either a b
Left r
x; (a
h :| Sig s es a r
_, Pure r'
y) -> forall a b. b -> Either a b
Right (a
h, r'
y)
(a
_ :| Sig s es a r
_, Fun s FTCQueue TaggableFun (Rct es) x r'
_ :=<< Rct es x
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
break_ :: Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId) ->
Sig s es a r -> React s es' r' ->
Sig s (es :+: es') a (Either r (Maybe a, r'))
break_ :: forall (es :: Set (*)) (es' :: Set (*)) s a r r'.
Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId)
-> Sig s es a r
-> React s es' r'
-> Sig s (es :+: es') a (Either r (Maybe a, r'))
break_ React s (es :+: es') (ThreadId, ThreadId)
ft (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig -> Sig s (es :+: es') a r
l) (forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust -> React s (es :+: es') r'
r) = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s (es :+: es') (ThreadId, ThreadId)
ft Sig s (es :+: es') a r
l React s (es :+: es') r'
r)
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
(Pure (End r
x), React s (es :+: es') r'
_) -> forall a b. a -> Either a b
Left r
x
(Fun
s
FTCQueue
TaggableFun
(Rct (es :+: es'))
x
(ISig s (es :+: es') a r)
_ :=<< Await EvReqs (es :+: es')
_, Pure r'
r') -> forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, r'
r')
(Pure (a
h :| Sig s (es :+: es') a r
_), Pure r'
r') -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just a
h, r'
r')
(Freer
s
FTCQueue
TaggableFun
(Rct (es :+: es'))
(ISig s (es :+: es') a r),
React s (es :+: es') r')
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
until_ :: Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId) ->
Sig s es a r -> React s es' r' ->
Sig s (es :+: es') a (Either r (a, r'))
until_ :: forall (es :: Set (*)) (es' :: Set (*)) s a r r'.
Firstable es es' (ISig s (es :+: es') a r) r' =>
React s (es :+: es') (ThreadId, ThreadId)
-> Sig s es a r
-> React s es' r'
-> Sig s (es :+: es') a (Either r (a, r'))
until_ React s (es :+: es') (ThreadId, ThreadId)
ft (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig -> Sig s (es :+: es') a r
l) (forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust -> React s (es :+: es') r'
r) = forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s (es :+: es') (ThreadId, ThreadId)
ft Sig s (es :+: es') a r
l React s (es :+: es') r'
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Sig React s (es :+: es') (ISig s (es :+: es') a r)
l', React s (es :+: es') r'
r') ->
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor React s (es :+: es') (ISig s (es :+: es') a r)
l') \case
End r
x -> forall a b. a -> Either a b
Left r
x
a
h :| Sig s (es :+: es') a r
_ -> case React s (es :+: es') r'
r' of
Pure r'
y -> forall a b. b -> Either a b
Right (a
h, r'
y); React s (es :+: es') r'
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
indexBy_ ::
Firstable es es' (ISig s (es :+: es') a r) (ISig s (es :+: es') b r') =>
React s (es :+: es') (ThreadId, ThreadId) ->
Sig s es a r -> Sig s es' b r' ->
Sig s (es :+: es') (a, b) (Either r (Maybe a, r'))
indexBy_ :: forall (es :: Set (*)) (es' :: Set (*)) s a r b r'.
Firstable
es es' (ISig s (es :+: es') a r) (ISig s (es :+: es') b r') =>
React s (es :+: es') (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es' b r'
-> Sig s (es :+: es') (a, b) (Either r (Maybe a, r'))
indexBy_ React s (es :+: es') (ThreadId, ThreadId)
ft (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig -> Sig s (es :+: es') a r
l) (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig -> Sig s (es :+: es') b r'
r) = forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (Maybe a, r'))
indexByGen React s (es :+: es') (ThreadId, ThreadId)
ft Sig s (es :+: es') a r
l Sig s (es :+: es') b r'
r
indexByGen ::
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
Sig s es a r -> Sig s es b r' -> Sig s es (a, b) (Either r (Maybe a, r'))
indexByGen :: forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (Maybe a, r'))
indexByGen React s es (ThreadId, ThreadId)
ft Sig s es a r
l (Sig React s es (ISig s es b r')
r) = forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor (forall s (es :: Set (*)) a r. Sig s es a r -> React s es r
res forall a b. (a -> b) -> a -> b
$ forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s es (ThreadId, ThreadId)
ft Sig s es a r
l React s es (ISig s es b r')
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Sig (Pure ISig s es a r
l'), React s es (ISig s es b r')
r') -> (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (a, r'))
iindexBy React s es (ThreadId, ThreadId)
ft ISig s es a r
l' (forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig React s es (ISig s es b r')
r')
(Sig s es a r
l', Pure (b
_ :| Sig s es b r'
r')) -> forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (Maybe a, r'))
indexByGen React s es (ThreadId, ThreadId)
ft Sig s es a r
l' Sig s es b r'
r'
(Sig s es a r
_, Pure (End r'
y)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing, r'
y)
(Sig s es a r, React s es (ISig s es b r'))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
iindexBy :: (Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
ISig s es a r -> Sig s es b r' -> Sig s es (a, b) (Either r (a, r'))
iindexBy :: forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (a, r'))
iindexBy React s es (ThreadId, ThreadId)
ft ISig s es a r
l (Sig React s es (ISig s es b r')
r) = forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor (forall s (es :: Set (*)) a r. ISig s es a r -> React s es r
ires forall a b. (a -> b) -> a -> b
$ forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> React s es r'
-> ISig s es a (ISig s es a r, React s es r')
ipause React s es (ThreadId, ThreadId)
ft ISig s es a r
l React s es (ISig s es b r')
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(End r
x, React s es (ISig s es b r')
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left r
x
(l' :: ISig s es a r
l'@(a
hl :| Sig s es a r
_), Pure (b
x :| Sig s es b r'
r')) -> forall a s (es :: Set (*)). a -> Sig s es a ()
emit (a
hl, b
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> Sig s es b r'
-> Sig s es (a, b) (Either r (a, r'))
iindexBy React s es (ThreadId, ThreadId)
ft ISig s es a r
l' Sig s es b r'
r'
(a
hl :| Sig s es a r
_, Pure (End r'
y)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (a
hl, r'
y)
(ISig s es a r, React s es (ISig s es b r'))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
spawn :: Sig s es a r -> Sig s es (ISig s es a r) r'
spawn :: forall s (es :: Set (*)) a r r'.
Sig s es a r -> Sig s es (ISig s es a r) r'
spawn = forall s (es :: Set (*)) a r. React s es a -> Sig s es a r
repeat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig
parList_, parListGen :: ((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
parList_ :: forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
parList_ React s es (ThreadId, ThreadId)
ft Sig s es (ISig s es a r) r'
s = forall a. [a] -> [a]
reverse forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%> forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
parListGen React s es (ThreadId, ThreadId)
ft Sig s es (ISig s es a r) r'
s
parListGen :: forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
parListGen React s es (ThreadId, ThreadId)
ft (Sig React s es (ISig s es (ISig s es a r) r')
r) = forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
iparList React s es (ThreadId, ThreadId)
ft forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor React s es (ISig s es (ISig s es a r) r')
r
iparList :: ((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
ISig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
iparList :: forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
iparList React s es (ThreadId, ThreadId)
ft = forall r b a s (es :: Set (*)).
(r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([] ,)) forall a b. (a -> b) -> a -> b
$ ISig s es [a] [r]
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. a -> [a] -> [a]
: []) forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%>) where
go :: ISig s es [a] [r]
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
go ISig s es [a] [r]
s (Sig React s es (ISig s es (ISig s es a r) r')
r) = forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll (forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> React s es r'
-> ISig s es a (ISig s es a r, React s es r')
ipause React s es (ThreadId, ThreadId)
ft ISig s es [a] [r]
s React s es (ISig s es (ISig s es a r) r')
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(ISig s es [a] [r]
s', Pure (ISig s es a r
h :| Sig s es (ISig s es a r) r'
t)) -> ISig s es [a] [r]
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
go (forall (es :: Set (*)) s a r.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r -> ISig s es [a] [r] -> ISig s es [a] [r]
cons React s es (ThreadId, ThreadId)
ft ISig s es a r
h ISig s es [a] [r]
s') Sig s es (ISig s es a r) r'
t
(ISig s es [a] [r]
s', Pure (End r'
y)) -> (, r'
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll ISig s es [a] [r]
s'
(End [r]
x, React s es (ISig s es (ISig s es a r) r')
r') -> forall a s (es :: Set (*)). a -> Sig s es a ()
emit [] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([r]
x forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (es :: Set (*)) s a r r'.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es (ISig s es a r) r' -> Sig s es [a] ([r], r')
parListGen React s es (ThreadId, ThreadId)
ft (forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig React s es (ISig s es (ISig s es a r) r')
r')
([a]
_ :| Sig s es [a] [r]
_, Fun
s FTCQueue TaggableFun (Rct es) x (ISig s es (ISig s es a r) r')
_ :=<< Rct es x
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
cons :: ((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) ->
ISig s es a r -> ISig s es [a] [r] -> ISig s es [a] [r]
cons :: forall (es :: Set (*)) s a r.
((es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r -> ISig s es [a] [r] -> ISig s es [a] [r]
cons React s es (ThreadId, ThreadId)
ft ISig s es a r
h ISig s es [a] [r]
t = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%> forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), Mergeable es es es,
(es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> ISig s es b r'
-> ISig s es (a, b) (ISig s es a r, ISig s es b r')
ipairs React s es (ThreadId, ThreadId)
ft ISig s es a r
h ISig s es [a] [r]
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ISig s es a r
h', ISig s es [a] [r]
t') ->
(:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall a. a -> [a] -> [a]
: []) forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%> ISig s es a r
h') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ISig s es [a] [r]
t'
adjustSig :: Adjustable es es' => Sig s es a r -> Sig s es' a r
adjustSig :: forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig = forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
ISig s es a r -> ISig s es' a r
adjustISig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig
adjustISig :: Adjustable es es' => ISig s es a r -> ISig s es' a r
adjustISig :: forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
ISig s es a r -> ISig s es' a r
adjustISig = forall r b a s (es :: Set (*)).
(r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig forall s (es :: Set (*)) a r. r -> ISig s es a r
End forall a b. (a -> b) -> a -> b
$ (forall (es :: Set (*)) (es' :: Set (*)) s a r.
Adjustable es es' =>
Sig s es a r -> Sig s es' a r
adjustSig forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
(:|)
ipairs :: (Updatable (ISig s es a r) (ISig s es b r'), Mergeable es es es, (es :+: es) ~ es) =>
React s es (ThreadId, ThreadId) -> ISig s es a r -> ISig s es b r' ->
ISig s es (a, b) (ISig s es a r, ISig s es b r')
ipairs :: forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), Mergeable es es es,
(es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> ISig s es b r'
-> ISig s es (a, b) (ISig s es a r, ISig s es b r')
ipairs React s es (ThreadId, ThreadId)
_ l :: ISig s es a r
l@(End r
_) ISig s es b r'
r = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ISig s es a r
l, ISig s es b r'
r)
ipairs React s es (ThreadId, ThreadId)
_ ISig s es a r
l r :: ISig s es b r'
r@(End r'
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ISig s es a r
l, ISig s es b r'
r)
ipairs React s es (ThreadId, ThreadId)
ft (a
hl :| Sig React s es (ISig s es a r)
tl) (b
hr :| Sig React s es (ISig s es b r')
tr) = ((a
hl, b
hr) forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall s (es :: Set (*)) a r b r'.
(Updatable (ISig s es a r) (ISig s es b r'), Mergeable es es es,
(es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> ISig s es b r'
-> ISig s es (a, b) (ISig s es a r, ISig s es b r')
ipairs React s es (ThreadId, ThreadId)
ft) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
hl forall {a} {s} {es :: Set (*)} {r}.
a
-> Freer s FTCQueue TaggableFun (Rct es) (ISig s es a r)
-> ISig s es a r
?:|) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (b
hr forall {a} {s} {es :: Set (*)} {r}.
a
-> Freer s FTCQueue TaggableFun (Rct es) (ISig s es a r)
-> ISig s es a r
?:|)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b (es :: Set (*)) s.
(Updatable a b, Mergeable es es es, (es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> React s es a
-> React s es b
-> React s es (React s es a, React s es b)
par React s es (ThreadId, ThreadId)
ft React s es (ISig s es a r)
tl React s es (ISig s es b r')
tr
where ?:| :: a
-> Freer s FTCQueue TaggableFun (Rct es) (ISig s es a r)
-> ISig s es a r
(?:|) a
h = \case Pure ISig s es a r
i -> ISig s es a r
i; Freer s FTCQueue TaggableFun (Rct es) (ISig s es a r)
t -> a
h forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:| forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig Freer s FTCQueue TaggableFun (Rct es) (ISig s es a r)
t
pause :: (Updatable (ISig s es a r) r', (es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) -> Sig s es a r -> React s es r' ->
Sig s es a (Sig s es a r, React s es r')
pause :: forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s es (ThreadId, ThreadId)
ft (Sig React s es (ISig s es a r)
l) React s es r'
r = forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor (forall a b (es :: Set (*)) s.
(Updatable a b, Mergeable es es es, (es :+: es) ~ es) =>
React s es (ThreadId, ThreadId)
-> React s es a
-> React s es b
-> React s es (React s es a, React s es b)
par React s es (ThreadId, ThreadId)
ft React s es (ISig s es a r)
l React s es r'
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Pure ISig s es a r
l', React s es r'
r') -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll (forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> React s es r'
-> ISig s es a (ISig s es a r, React s es r')
ipause React s es (ThreadId, ThreadId)
ft ISig s es a r
l' React s es r'
r')
(React s es (ISig s es a r)
l', r' :: React s es r'
r'@(Pure r'
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s (es :: Set (*)) a r.
React s es (ISig s es a r) -> Sig s es a r
Sig React s es (ISig s es a r)
l', React s es r'
r')
(React s es (ISig s es a r), React s es r')
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"
ipause :: (Updatable (ISig s es a r) r', (es :+: es) ~ es, Mergeable es es es) =>
React s es (ThreadId, ThreadId) -> ISig s es a r -> React s es r' ->
ISig s es a (ISig s es a r, React s es r')
ipause :: forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> ISig s es a r
-> React s es r'
-> ISig s es a (ISig s es a r, React s es r')
ipause React s es (ThreadId, ThreadId)
_ l :: ISig s es a r
l@(End r
_) React s es r'
r = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ISig s es a r
l, React s es r'
r)
ipause React s es (ThreadId, ThreadId)
ft (a
h :| Sig s es a r
t) React s es r'
r = (a
h forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:|) forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (es :: Set (*)) a r r'.
(Updatable (ISig s es a r) r', (es :+: es) ~ es,
Mergeable es es es) =>
React s es (ThreadId, ThreadId)
-> Sig s es a r
-> React s es r'
-> Sig s es a (Sig s es a r, React s es r')
pause React s es (ThreadId, ThreadId)
ft Sig s es a r
t React s es r'
r) \case
(Sig (Pure ISig s es a r
t'), React s es r'
r') -> (ISig s es a r
t', React s es r'
r')
(Sig s es a r
t', r' :: React s es r'
r'@(Pure r'
_)) -> (a
h forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:| Sig s es a r
t', React s es r'
r')
(Sig s es a r, React s es r')
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"never occur"