{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Run (
	-- * Type
	Sig, React, Handle, HandleSt, St,
	-- * Run
	interpret, interpretSt, interpretReact, interpretReactSt ) where

import Control.Monad.Freer.Par (pattern Pure, pattern (:=<<), app)
import Control.Moffy.Internal.Sig.Type (Sig(..), isig)
import Control.Moffy.Internal.React (Adjustable, adjust)
import Control.Moffy.Internal.React.Type (
	React, Rct(..), Handle, HandleSt, liftHandle, St,
	ThreadId, rootThreadId )

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

-- * SIG
-- * REACT

---------------------------------------------------------------------------
-- SIG
---------------------------------------------------------------------------

interpret :: (Monad m, Adjustable es es') =>
	Handle m es' -> (a -> m ()) -> Sig s es a r -> m r
interpret :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) a s r.
(Monad m, Adjustable es es') =>
Handle m es' -> (a -> m ()) -> Sig s es a r -> m r
interpret Handle m es'
hdl a -> m ()
vw Sig s es a r
rqs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st a s r.
(Monad m, Adjustable es es') =>
HandleSt st m es' -> (a -> m ()) -> Sig s es a r -> St st m r
interpretSt (forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle m es -> HandleSt st m es
liftHandle Handle m es'
hdl) a -> m ()
vw Sig s es a r
rqs ()

interpretSt :: (Monad m, Adjustable es es') =>
	HandleSt st m es' -> (a -> m ()) -> Sig s es a r -> St st m r
interpretSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st a s r.
(Monad m, Adjustable es es') =>
HandleSt st m es' -> (a -> m ()) -> Sig s es a r -> St st m r
interpretSt HandleSt st m es'
hdl a -> m ()
vw = Sig s es a r -> st -> m (r, st)
go where
	Sig React s es (ISig s es a r)
r go :: Sig s es a r -> st -> m (r, st)
`go` st
st = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st s r.
(Monad m, Adjustable es es') =>
HandleSt st m es' -> React s es r -> St st m r
interpretReactSt HandleSt st m es'
hdl React s es (ISig s es a r)
r st
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ISig s es a r
i, st
st') ->
		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
. (, st
st')) ((forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig s es a r -> st -> m (r, st)
`go` st
st')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
vw) ISig s es a r
i

---------------------------------------------------------------------------
-- REACT
---------------------------------------------------------------------------

interpretReact :: (Monad m, Adjustable es es') =>
	Handle m es' -> React s es r -> m r
interpretReact :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) s r.
(Monad m, Adjustable es es') =>
Handle m es' -> React s es r -> m r
interpretReact Handle m es'
hdl React s es r
rqs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st s r.
(Monad m, Adjustable es es') =>
HandleSt st m es' -> React s es r -> St st m r
interpretReactSt (forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle m es -> HandleSt st m es
liftHandle Handle m es'
hdl) React s es r
rqs ()

interpretReactSt :: (Monad m, Adjustable es es') =>
	HandleSt st m es' -> React s es r -> St st m r
interpretReactSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st s r.
(Monad m, Adjustable es es') =>
HandleSt st m es' -> React s es r -> St st m r
interpretReactSt HandleSt st m es'
hdl (forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust -> React s es' r
r) = forall (m :: * -> *) st (es :: Set (*)) s r.
Monad m =>
HandleSt st m es -> React s es r -> ThreadId -> St st m r
runSt HandleSt st m es'
hdl React s es' r
r ThreadId
rootThreadId

runSt :: Monad m => HandleSt st m es -> React s es r -> ThreadId -> St st m r
runSt :: forall (m :: * -> *) st (es :: Set (*)) s r.
Monad m =>
HandleSt st m es -> React s es r -> ThreadId -> St st m r
runSt HandleSt st m es
_ (Pure r
x) ThreadId
_ st
st = forall (f :: * -> *) a. Applicative f => a -> f a
pure (r
x, st
st)
runSt HandleSt st m es
_ (Fun s FTCQueue TaggableFun (Rct es) x r
_ :=<< Rct es x
Never) ThreadId
_ st
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"never end"
runSt HandleSt st m es
hdl (Fun s FTCQueue TaggableFun (Rct es) x r
c :=<< Rct es x
GetThreadId) ThreadId
t st
st = forall (m :: * -> *) st (es :: Set (*)) s r.
Monad m =>
HandleSt st m es -> React s es r -> ThreadId -> St st m r
runSt HandleSt st m es
hdl (Fun s FTCQueue TaggableFun (Rct es) x r
c forall (sq :: (* -> * -> *) -> * -> * -> *)
       (f :: (* -> *) -> * -> * -> *) s (t :: * -> *) a b.
(Sequence sq, Funable f) =>
Fun s sq f t a b -> a -> Freer s sq f t b
`app` ThreadId
t) ThreadId
t st
st
runSt HandleSt st m es
hdl (Fun s FTCQueue TaggableFun (Rct es) x r
c :=<< Await EvReqs es
rqs) ThreadId
t st
st =
	HandleSt st m es
hdl EvReqs es
rqs st
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(x
o, st
st') -> forall (m :: * -> *) st (es :: Set (*)) s r.
Monad m =>
HandleSt st m es -> React s es r -> ThreadId -> St st m r
runSt HandleSt st m es
hdl (Fun s FTCQueue TaggableFun (Rct es) x r
c forall (sq :: (* -> * -> *) -> * -> * -> *)
       (f :: (* -> *) -> * -> * -> *) s (t :: * -> *) a b.
(Sequence sq, Funable f) =>
Fun s sq f t a b -> a -> Freer s sq f t b
`app` x
o) ThreadId
t st
st'