{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Internal.Sig.Type (
	-- * Type
	Sig(..), ISig(..), isig,
	-- * Function
	-- ** Basic
	emit, emitAll, waitFor, res, ires, hold,
	-- ** Practical
	repeat, find, scanl ) where

import Prelude hiding (repeat, scanl)

import Control.Monad (forever, (<=<))
import Control.Moffy.Internal.React.Type (React, never)
import Data.Type.Flip (Flip(..), (<$%>))
import Data.Bool (bool)

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

-- * TYPE
-- * CLASS INSTANCE
--	+ MONAD
--	+ FLIP FUNCTOR
-- * FUNCTION
--	+ BASIC
--	+ PRACTICAL

---------------------------------------------------------------------------
-- TYPE
---------------------------------------------------------------------------

infixr 5 :|
newtype Sig s es a r = Sig { forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig :: React s es (ISig s es a r) }
data ISig s es a r = End r | a :| Sig s es a r

isig :: (r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig :: forall r b a s (es :: Set (*)).
(r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig r -> b
e a -> Sig s es a r -> b
c = \case End r
x -> r -> b
e r
x; a
h :| Sig s es a r
t -> a -> Sig s es a r -> b
c a
h Sig s es a r
t

---------------------------------------------------------------------------
-- CLASS INSTANCE
---------------------------------------------------------------------------

-- MONAD

instance Functor (Sig s es a) where fmap :: forall a b. (a -> b) -> Sig s es a a -> Sig s es a b
fmap a -> b
f = 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
. ((a -> b
f 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 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

instance Applicative (Sig s es a) where
	pure :: forall a. a -> Sig s es a a
pure = 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 (f :: * -> *) a. Applicative f => a -> f a
pure; Sig React s es (ISig s es a (a -> b))
rf <*> :: forall a b. Sig s es a (a -> b) -> Sig s es a a -> Sig s es a b
<*> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) -> (a -> b) -> Sig s es a b
ax) =
		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 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.
Sig s es a r -> React s es (ISig s es a r)
unSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Sig s es a b
ax) (\a
h -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
h 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
. ((a -> b) -> Sig s es a b
ax forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< React s es (ISig s es a (a -> b))
rf

instance Monad (Sig s es a) where
	Sig React s es (ISig s es a a)
r >>= :: forall a b. Sig s es a a -> (a -> Sig s es a b) -> Sig s es a b
>>= a -> Sig s es a b
f =
		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 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.
Sig s es a r -> React s es (ISig s es a r)
unSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sig s es a b
f) (\a
h -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
h 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
. (a -> Sig s es a b
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< React s es (ISig s es a a)
r

instance Functor (ISig s es a) where
	fmap :: forall a b. (a -> b) -> ISig s es a a -> ISig s es a b
fmap a -> b
f = 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 b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) \a
h -> (a
h 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
. (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance Applicative (ISig s es a) where
	pure :: forall a. a -> ISig s es a a
pure = forall s (es :: Set (*)) a r. r -> ISig s es a r
End; ISig s es a (a -> b)
mf <*> :: forall a b. ISig s es a (a -> b) -> ISig s es a a -> ISig s es a b
<*> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) -> (a -> b) -> ISig s es a b
ax) =
		forall r b a s (es :: Set (*)).
(r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig (a -> b) -> ISig s es a b
ax (\a
h -> (a
h 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. ISig s es a r -> Sig s es a r
emitAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ISig s es a b
ax forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) ISig s es a (a -> b)
mf

instance Monad (ISig s es a) where
	ISig s es a a
m >>= :: forall a b. ISig s es a a -> (a -> ISig s es a b) -> ISig s es a b
>>= a -> ISig s es a b
f = forall r b a s (es :: Set (*)).
(r -> b) -> (a -> Sig s es a r -> b) -> ISig s es a r -> b
isig a -> ISig s es a b
f (\a
h -> (a
h 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. ISig s es a r -> Sig s es a r
emitAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ISig s es a b
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) ISig s es a a
m

-- FLIP FUNCTOR

instance Functor (Flip (Sig s es) r) where
	fmap :: forall a b. (a -> b) -> Flip (Sig s es) r a -> Flip (Sig s es) r b
fmap a -> b
f = 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
. ((a -> b
f forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip

instance Functor (Flip (ISig s es) r) where
	fmap :: forall a b.
(a -> b) -> Flip (ISig s es) r a -> Flip (ISig s es) r b
fmap a -> b
f = forall (t :: * -> * -> *) a b. t b a -> Flip t a b
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (\a
h -> (a -> b
f a
h 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
. (a -> b
f forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> * -> *) a b. Flip t a b -> t b a
unflip

---------------------------------------------------------------------------
-- FUNCTION
---------------------------------------------------------------------------

-- BASIC

emit :: a -> Sig s es a ()
emit :: forall a s (es :: Set (*)). a -> Sig s es a ()
emit = 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 s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:| forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

emitAll :: ISig s es a r -> Sig s es a r
emitAll :: forall s (es :: Set (*)) a r. ISig s es a r -> Sig s es a r
emitAll = 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

waitFor :: React s es r -> Sig s es a r
waitFor :: forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor = 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

res :: Sig s es a r -> React s es r
res :: forall s (es :: Set (*)) a r. Sig s es a r -> React s es r
res = forall s (es :: Set (*)) a r. ISig s es a r -> React s es r
ires forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig

ires :: ISig s es a r -> React s es r
ires :: forall s (es :: Set (*)) a r. ISig s es a r -> React s es r
ires = 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 a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall s (es :: Set (*)) a r. Sig s es a r -> React s es r
res

hold :: Sig s es a r
hold :: forall s (es :: Set (*)) a r. Sig s es a r
hold = forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor forall s (es :: Set (*)) a. React s es a
never

-- PRACTICAL

repeat :: React s es a -> Sig s es a r
repeat :: forall s (es :: Set (*)) a r. React s es a -> Sig s es a r
repeat = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a s (es :: Set (*)). a -> Sig s es a ()
emit forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall s (es :: Set (*)) r a. React s es r -> Sig s es a r
waitFor)

find :: (a -> Bool) -> Sig s es a r -> React s es (Either a r)
find :: forall a s (es :: Set (*)) r.
(a -> Bool) -> Sig s es a r -> React s es (Either a r)
find a -> Bool
p = forall {s} {es :: Set (*)} {r}.
Sig s es a r -> Freer s FTCQueue TaggableFun (Rct es) (Either a r)
go where
	go :: Sig s es a r -> Freer s FTCQueue TaggableFun (Rct es) (Either a r)
go = ISig s es a r -> Freer s FTCQueue TaggableFun (Rct es) (Either a r)
igo forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall s (es :: Set (*)) a r.
Sig s es a r -> React s es (ISig s es a r)
unSig
	igo :: ISig s es a r -> Freer s FTCQueue TaggableFun (Rct es) (Either a r)
igo = 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. b -> Either a b
Right) \a
h -> forall a. a -> a -> Bool -> a
bool Sig s es a r -> Freer s FTCQueue TaggableFun (Rct es) (Either a r)
go (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
h) (a -> Bool
p a
h)

scanl :: (b -> a -> b) -> b -> Sig s es a r -> Sig s es b r
scanl :: forall b a s (es :: Set (*)) r.
(b -> a -> b) -> b -> Sig s es a r -> Sig s es b r
scanl = ((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 c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a s (es :: Set (*)) r.
(b -> a -> b) -> b -> Sig s es a r -> ISig s es b r
iscanl

iscanl :: (b -> a -> b) -> b -> Sig s es a r -> ISig s es b r
iscanl :: forall b a s (es :: Set (*)) r.
(b -> a -> b) -> b -> Sig s es a r -> ISig s es b r
iscanl b -> a -> b
op b
v (Sig React s es (ISig s es a r)
r) = b
v forall s (es :: Set (*)) a r. a -> Sig s es a r -> ISig s es a r
:| (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 a s (es :: Set (*)) r.
(b -> a -> b) -> b -> Sig s es a r -> Sig s es b r
scanl b -> a -> b
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b
v b -> a -> b
`op`)) 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 a r)
r)