{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Miso.Effect
(
Effect
, Sub
, Sink
, (<#)
, (#>)
, batch
, batch_
, io
, io_
, for
, issue
, withSink
, mapSub
, runEffect
, scheduleIO
, scheduleIO_
, scheduleIOFor_
, scheduleSub
, effectSub
, batchEff
, noEff
) where
import Data.Foldable (for_)
import Control.Monad.RWS ( RWS, put, tell, execRWS )
#if __GLASGOW_HASKELL__ <= 881
import qualified Control.Monad.Fail as Fail
import Data.Functor.Identity (Identity(..))
#endif
import Miso.FFI.Internal (JSM)
import Miso.String (MisoString)
type Sub action = Sink action -> JSM ()
type Sink action = action -> JSM ()
infixl 0 <#
(<#) :: model -> JSM action -> Effect model action
<# :: forall model action. model -> JSM action -> Effect model action
(<#) model
m JSM action
action = model
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
m RWST ComponentName [Sink action -> JSM ()] model Identity ()
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall a b.
RWST ComponentName [Sink action -> JSM ()] model Identity a
-> RWST ComponentName [Sink action -> JSM ()] model Identity b
-> RWST ComponentName [Sink action -> JSM ()] model Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Sink action -> JSM ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ \Sink action
f -> Sink action
f Sink action -> JSM action -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM action
action ]
infixr 0 #>
(#>) :: JSM action -> model -> Effect model action
#> :: forall action model. JSM action -> model -> Effect model action
(#>) = (model -> JSM action -> Effect model action)
-> JSM action -> model -> Effect model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip model -> JSM action -> Effect model action
forall model action. model -> JSM action -> Effect model action
(<#)
batch :: [JSM action] -> Effect model action
batch :: forall action model. [JSM action] -> Effect model action
batch [JSM action]
actions = [RWST ComponentName [Sink action -> JSM ()] model Identity ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Sink action -> JSM ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ \Sink action
f -> Sink action
f Sink action -> JSM action -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM action
action ]
| JSM action
action <- [JSM action]
actions
]
batch_ :: [JSM ()] -> Effect model action
batch_ :: forall model action. [JSM ()] -> Effect model action
batch_ [JSM ()]
actions = [RWST ComponentName [Sink action -> JSM ()] model Identity ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Sink action -> JSM ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ JSM () -> Sink action -> JSM ()
forall a b. a -> b -> a
const JSM ()
action ]
| JSM ()
action <- [JSM ()]
actions
]
type Effect model action = RWS ComponentName [Sink action -> JSM ()] model ()
#if __GLASGOW_HASKELL__ <= 881
instance Fail.MonadFail Identity where
fail = error
#endif
type ComponentName = MisoString
runEffect
:: Effect model action
-> MisoString
-> model
-> (model, [Sink action -> JSM ()])
runEffect :: forall model action.
Effect model action
-> ComponentName -> model -> (model, [Sink action -> JSM ()])
runEffect = RWS ComponentName [Sink action -> JSM ()] model ()
-> ComponentName -> model -> (model, [Sink action -> JSM ()])
forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS
mapSub :: (a -> b) -> Sub a -> Sub b
mapSub :: forall a b. (a -> b) -> Sub a -> Sub b
mapSub a -> b
f Sub a
sub = \Sink b
g -> Sub a
sub (Sink b
g Sink b -> (a -> b) -> a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
io :: JSM action -> Effect model action
io :: forall action model. JSM action -> Effect model action
io JSM action
action = (Sink action -> JSM ()) -> Effect model action
forall action model. (Sink action -> JSM ()) -> Effect model action
withSink (JSM action
action JSM action -> Sink action -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
io_ :: JSM () -> Effect model action
io_ :: forall model action. JSM () -> Effect model action
io_ JSM ()
action = (Sink action -> JSM ()) -> Effect model action
forall action model. (Sink action -> JSM ()) -> Effect model action
withSink (\Sink action
_ -> JSM ()
action)
for :: Foldable f => JSM (f action) -> Effect model action
for :: forall (f :: * -> *) action model.
Foldable f =>
JSM (f action) -> Effect model action
for JSM (f action)
actions = (Sink action -> JSM ()) -> Effect model action
forall action model. (Sink action -> JSM ()) -> Effect model action
withSink ((Sink action -> JSM ()) -> Effect model action)
-> (Sink action -> JSM ()) -> Effect model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> JSM (f action)
actions JSM (f action) -> (f action -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (f action -> Sink action -> JSM ())
-> Sink action -> f action -> JSM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip f action -> Sink action -> JSM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Sink action
sink
withSink :: (Sink action -> JSM ()) -> Effect model action
withSink :: forall action model. (Sink action -> JSM ()) -> Effect model action
withSink Sink action -> JSM ()
f = [Sink action -> JSM ()]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sink action -> JSM ()
f ]
issue :: action -> Effect model action
issue :: forall action model. action -> Effect model action
issue action
action = [(action -> JSM ()) -> JSM ()]
-> RWST
ComponentName [(action -> JSM ()) -> JSM ()] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ \action -> JSM ()
f -> action -> JSM ()
f action
action ]
{-# DEPRECATED scheduleIO "Please use 'io' instead" #-}
scheduleIO :: JSM action -> Effect model action
scheduleIO :: forall action model. JSM action -> Effect model action
scheduleIO = JSM action -> Effect model action
forall action model. JSM action -> Effect model action
io
{-# DEPRECATED scheduleIO_ "Please use 'io_' instead" #-}
scheduleIO_ :: JSM () -> Effect model action
scheduleIO_ :: forall model action. JSM () -> Effect model action
scheduleIO_ = JSM () -> Effect model action
forall model action. JSM () -> Effect model action
io_
{-# DEPRECATED scheduleIOFor_ "Please use 'for' instead" #-}
scheduleIOFor_ :: Foldable f => JSM (f action) -> Effect model action
scheduleIOFor_ :: forall (f :: * -> *) action model.
Foldable f =>
JSM (f action) -> Effect model action
scheduleIOFor_ = JSM (f action) -> Effect model action
forall (f :: * -> *) action model.
Foldable f =>
JSM (f action) -> Effect model action
for
{-# DEPRECATED scheduleSub "Please use 'withSink' instead" #-}
scheduleSub :: (Sink action -> JSM ()) -> Effect model action
scheduleSub :: forall action model. (Sink action -> JSM ()) -> Effect model action
scheduleSub = (Sink action -> JSM ()) -> Effect model action
forall action model. (Sink action -> JSM ()) -> Effect model action
withSink
{-# DEPRECATED effectSub "Please use 'put' and 'withSink' instead " #-}
effectSub :: model -> (Sink action -> JSM ()) -> Effect model action
effectSub :: forall model action.
model -> (Sink action -> JSM ()) -> Effect model action
effectSub model
m Sink action -> JSM ()
s = model
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
m RWST ComponentName [Sink action -> JSM ()] model Identity ()
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall a b.
RWST ComponentName [Sink action -> JSM ()] model Identity a
-> RWST ComponentName [Sink action -> JSM ()] model Identity b
-> RWST ComponentName [Sink action -> JSM ()] model Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Sink action -> JSM ())
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall action model. (Sink action -> JSM ()) -> Effect model action
withSink Sink action -> JSM ()
s
{-# DEPRECATED noEff "Please use 'put' instead " #-}
noEff :: model -> Effect model action
noEff :: forall model action. model -> Effect model action
noEff = model
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# DEPRECATED batchEff "Please use 'put' and 'batch' instead " #-}
batchEff :: model -> [JSM action] -> Effect model action
batchEff :: forall model action. model -> [JSM action] -> Effect model action
batchEff model
model [JSM action]
actions = do
model
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
model
[JSM action]
-> RWST ComponentName [Sink action -> JSM ()] model Identity ()
forall action model. [JSM action] -> Effect model action
batch [JSM action]
actions