{-# 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 (
	-- * Adjust
	adjustSig,
	-- * Applicative
	app_, iapp_,
	-- * Parallel
	at_, break_, until_, indexBy_,
	-- * Copies
	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)

---------------------------------------------------------------------------

-- * FLIP APPLIICATIVE
--	+ INSTANCE APPLICATIVE
--	+ APP AND IAPP
-- * PARALLEL
--	+ AT
--	+ BREAK AND UNTIL
--	+ INDEX BY
-- * COPIES
--	+ SPAWN
--	+ PAR LIST
-- * BASIC COMBINATOR
--	+ ADJUST
--	+ PAIRS
--	+ PAUSE

---------------------------------------------------------------------------
-- FLIP APPLICATIVE
---------------------------------------------------------------------------

-- INSTANCE APPLICATIVE

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 AND IAPP

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"

---------------------------------------------------------------------------
-- PARALLEL
---------------------------------------------------------------------------

-- AT

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 AND UNTIL

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"

-- INDEX BY

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"

---------------------------------------------------------------------------
-- COPIES
---------------------------------------------------------------------------

-- SPAWN

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

-- PAR 	LIST

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'

---------------------------------------------------------------------------
-- BASIC COMBINATOR
---------------------------------------------------------------------------

-- ADJUST

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
(:|)

-- PAIRS

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

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"