{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Miso.Effect
(
Effect
, Sub
, Sink
, DOMRef
, ComponentInfo (..)
, ComponentId
, mkComponentInfo
, Schedule (..)
, Synchronicity (..)
, (<#)
, (#>)
, batch
, batch_
, io
, io_
, sync
, sync_
, for
, issue
, withSink
, mapSub
, noop
, beforeAll
, afterAll
, modifyAllIO
, componentDOMRef
, componentParentId
, componentId
, runEffect
, scheduleIO
, scheduleIO_
, scheduleIOFor_
, scheduleSub
, effectSub
, batchEff
, noEff
) where
import Control.Monad (void)
import Data.Foldable (for_)
import Control.Monad.RWS ( RWS, put, tell, execRWS, censor)
import Miso.Lens
import Miso.DSL.FFI
mkComponentInfo
:: ComponentId
-> ComponentId
-> DOMRef
-> ComponentInfo parent
mkComponentInfo :: forall parent.
ComponentId -> ComponentId -> DOMRef -> ComponentInfo parent
mkComponentInfo = ComponentId -> ComponentId -> DOMRef -> ComponentInfo parent
forall parent.
ComponentId -> ComponentId -> DOMRef -> ComponentInfo parent
ComponentInfo
data ComponentInfo parent
= ComponentInfo
{ forall parent. ComponentInfo parent -> ComponentId
_componentId :: ComponentId
, forall parent. ComponentInfo parent -> ComponentId
_componentParentId :: ComponentId
, forall parent. ComponentInfo parent -> DOMRef
_componentDOMRef :: DOMRef
}
componentId :: Lens (ComponentInfo parent) ComponentId
componentId :: forall parent. Lens (ComponentInfo parent) ComponentId
componentId = (ComponentInfo parent -> ComponentId)
-> (ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo parent -> ComponentId
forall parent. ComponentInfo parent -> ComponentId
_componentId ((ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId)
-> (ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId
forall a b. (a -> b) -> a -> b
$ \ComponentInfo parent
r ComponentId
x -> ComponentInfo parent
r { _componentId = x }
componentParentId :: Lens (ComponentInfo parent) ComponentId
componentParentId :: forall parent. Lens (ComponentInfo parent) ComponentId
componentParentId = (ComponentInfo parent -> ComponentId)
-> (ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo parent -> ComponentId
forall parent. ComponentInfo parent -> ComponentId
_componentParentId ((ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId)
-> (ComponentInfo parent -> ComponentId -> ComponentInfo parent)
-> Lens (ComponentInfo parent) ComponentId
forall a b. (a -> b) -> a -> b
$ \ComponentInfo parent
r ComponentId
x -> ComponentInfo parent
r { _componentParentId = x }
componentDOMRef :: Lens (ComponentInfo parent) DOMRef
componentDOMRef :: forall parent. Lens (ComponentInfo parent) DOMRef
componentDOMRef = (ComponentInfo parent -> DOMRef)
-> (ComponentInfo parent -> DOMRef -> ComponentInfo parent)
-> Lens (ComponentInfo parent) DOMRef
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo parent -> DOMRef
forall parent. ComponentInfo parent -> DOMRef
_componentDOMRef ((ComponentInfo parent -> DOMRef -> ComponentInfo parent)
-> Lens (ComponentInfo parent) DOMRef)
-> (ComponentInfo parent -> DOMRef -> ComponentInfo parent)
-> Lens (ComponentInfo parent) DOMRef
forall a b. (a -> b) -> a -> b
$ \ComponentInfo parent
r DOMRef
x -> ComponentInfo parent
r { _componentDOMRef = x }
type ComponentId = Int
type Sub action = Sink action -> IO ()
type Sink action = action -> IO ()
infixl 0 <#
(<#) :: model -> IO action -> Effect parent model action
<# :: forall model action parent.
model -> IO action -> Effect parent model action
(<#) model
m IO action
action = model
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
m RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall a b.
RWST (ComponentInfo parent) [Schedule action] model Identity a
-> RWST (ComponentInfo parent) [Schedule action] model Identity b
-> RWST (ComponentInfo parent) [Schedule action] model Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule action
forall action. (Sink action -> IO ()) -> Schedule action
async ((Sink action -> IO ()) -> Schedule action)
-> (Sink action -> IO ()) -> Schedule action
forall a b. (a -> b) -> a -> b
$ \Sink action
f -> Sink action
f Sink action -> IO action -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO action
action ]
async :: (Sink action -> IO ()) -> Schedule action
async :: forall action. (Sink action -> IO ()) -> Schedule action
async = Synchronicity -> (Sink action -> IO ()) -> Schedule action
forall action.
Synchronicity -> (Sink action -> IO ()) -> Schedule action
Schedule Synchronicity
Async
infixr 0 #>
(#>) :: IO action -> model -> Effect parent model action
#> :: forall action model parent.
IO action -> model -> Effect parent model action
(#>) = (model -> IO action -> Effect parent model action)
-> IO action -> model -> Effect parent model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip model -> IO action -> Effect parent model action
forall model action parent.
model -> IO action -> Effect parent model action
(<#)
batch :: [IO action] -> Effect parent model action
batch :: forall action parent model.
[IO action] -> Effect parent model action
batch [IO action]
actions = [RWST (ComponentInfo parent) [Schedule action] model Identity ()]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule action
forall action. (Sink action -> IO ()) -> Schedule action
async ((Sink action -> IO ()) -> Schedule action)
-> (Sink action -> IO ()) -> Schedule action
forall a b. (a -> b) -> a -> b
$ \Sink action
f -> Sink action
f Sink action -> IO action -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO action
action ]
| IO action
action <- [IO action]
actions
]
batch_ :: [IO ()] -> Effect parent model action
batch_ :: forall parent model action. [IO ()] -> Effect parent model action
batch_ [IO ()]
actions = [RWST (ComponentInfo parent) [Schedule action] model Identity ()]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule action
forall action. (Sink action -> IO ()) -> Schedule action
async (IO () -> Sink action -> IO ()
forall a b. a -> b -> a
const IO ()
action) ]
| IO ()
action <- [IO ()]
actions
]
type Effect parent model action = RWS (ComponentInfo parent) [Schedule action] model ()
data Schedule action = Schedule Synchronicity (Sink action -> IO ())
type DOMRef = JSVal
runEffect
:: Effect parent model action
-> ComponentInfo parent
-> model
-> (model, [Schedule action])
runEffect :: forall parent model action.
Effect parent model action
-> ComponentInfo parent -> model -> (model, [Schedule action])
runEffect = RWS (ComponentInfo parent) [Schedule action] model ()
-> ComponentInfo parent -> model -> (model, [Schedule action])
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 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
sync :: IO action -> Effect parent model action
sync :: forall action parent model. IO action -> Effect parent model action
sync IO action
action = [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Synchronicity -> (Sink action -> IO ()) -> Schedule action
forall action.
Synchronicity -> (Sink action -> IO ()) -> Schedule action
Schedule Synchronicity
Sync ((Sink action -> IO ()) -> Schedule action)
-> (Sink action -> IO ()) -> Schedule action
forall a b. (a -> b) -> a -> b
$ \Sink action
f -> Sink action
f Sink action -> IO action -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO action
action ]
sync_ :: IO () -> Effect parent model action
sync_ :: forall parent model action. IO () -> Effect parent model action
sync_ IO ()
action = [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Synchronicity -> (Sink action -> IO ()) -> Schedule action
forall action.
Synchronicity -> (Sink action -> IO ()) -> Schedule action
Schedule Synchronicity
Sync ((Sink action -> IO ()) -> Schedule action)
-> (Sink action -> IO ()) -> Schedule action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ -> IO ()
action ]
io :: IO action -> Effect parent model action
io :: forall action parent model. IO action -> Effect parent model action
io IO action
action = (Sink action -> IO ()) -> Effect parent model action
forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink (IO action
action IO action -> Sink action -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
io_ :: IO a -> Effect parent model action
io_ :: forall a parent model action. IO a -> Effect parent model action
io_ IO a
action = (Sink action -> IO ()) -> Effect parent model action
forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink (\Sink action
_ -> IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
action)
for :: Foldable f => IO (f action) -> Effect parent model action
for :: forall (f :: * -> *) action parent model.
Foldable f =>
IO (f action) -> Effect parent model action
for IO (f action)
actions = (Sink action -> IO ()) -> Effect parent model action
forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink ((Sink action -> IO ()) -> Effect parent model action)
-> (Sink action -> IO ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> IO (f action)
actions IO (f action) -> (f action -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (f action -> Sink action -> IO ())
-> Sink action -> f action -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip f action -> Sink action -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Sink action
sink
beforeAll :: IO () -> Effect parent model action -> Effect parent model action
beforeAll :: forall parent model action.
IO () -> Effect parent model action -> Effect parent model action
beforeAll = (IO () -> IO ())
-> Effect parent model action -> Effect parent model action
forall parent model action.
(IO () -> IO ())
-> Effect parent model action -> Effect parent model action
modifyAllIO ((IO () -> IO ())
-> Effect parent model action -> Effect parent model action)
-> (IO () -> IO () -> IO ())
-> IO ()
-> Effect parent model action
-> Effect parent model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
afterAll :: IO () -> Effect parent model action -> Effect parent model action
afterAll :: forall parent model action.
IO () -> Effect parent model action -> Effect parent model action
afterAll = (IO () -> IO ())
-> Effect parent model action -> Effect parent model action
forall parent model action.
(IO () -> IO ())
-> Effect parent model action -> Effect parent model action
modifyAllIO ((IO () -> IO ())
-> Effect parent model action -> Effect parent model action)
-> (IO () -> IO () -> IO ())
-> IO ()
-> Effect parent model action
-> Effect parent model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
modifyAllIO
:: (IO () -> IO ())
-> Effect parent model action
-> Effect parent model action
modifyAllIO :: forall parent model action.
(IO () -> IO ())
-> Effect parent model action -> Effect parent model action
modifyAllIO IO () -> IO ()
f = ([Schedule action] -> [Schedule action])
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor (([Schedule action] -> [Schedule action])
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ())
-> ([Schedule action] -> [Schedule action])
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall a b. (a -> b) -> a -> b
$ \[Schedule action]
actions ->
[ Synchronicity -> (Sink action -> IO ()) -> Schedule action
forall action.
Synchronicity -> (Sink action -> IO ()) -> Schedule action
Schedule Synchronicity
x (IO () -> IO ()
f (IO () -> IO ()) -> (Sink action -> IO ()) -> Sink action -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sink action -> IO ()
action)
| Schedule Synchronicity
x Sink action -> IO ()
action <- [Schedule action]
actions
]
withSink :: (Sink action -> IO ()) -> Effect parent model action
withSink :: forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink Sink action -> IO ()
f = [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule action
forall action. (Sink action -> IO ()) -> Schedule action
async Sink action -> IO ()
f ]
issue :: action -> Effect parent model action
issue :: forall action parent model. action -> Effect parent model action
issue action
action = [Schedule action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule action
forall action. (Sink action -> IO ()) -> Schedule action
async ((Sink action -> IO ()) -> Schedule action)
-> (Sink action -> IO ()) -> Schedule action
forall a b. (a -> b) -> a -> b
$ \Sink action
f -> Sink action
f action
action ]
{-# DEPRECATED scheduleIO "Please use 'io' instead" #-}
scheduleIO :: IO action -> Effect parent model action
scheduleIO :: forall action parent model. IO action -> Effect parent model action
scheduleIO = IO action -> Effect parent model action
forall action parent model. IO action -> Effect parent model action
io
{-# DEPRECATED scheduleIO_ "Please use 'io_' instead" #-}
scheduleIO_ :: IO () -> Effect parent model action
scheduleIO_ :: forall parent model action. IO () -> Effect parent model action
scheduleIO_ = IO () -> Effect parent model action
forall a parent model action. IO a -> Effect parent model action
io_
{-# DEPRECATED scheduleIOFor_ "Please use 'for' instead" #-}
scheduleIOFor_ :: Foldable f => IO (f action) -> Effect parent model action
scheduleIOFor_ :: forall (f :: * -> *) action parent model.
Foldable f =>
IO (f action) -> Effect parent model action
scheduleIOFor_ = IO (f action) -> Effect parent model action
forall (f :: * -> *) action parent model.
Foldable f =>
IO (f action) -> Effect parent model action
for
{-# DEPRECATED scheduleSub "Please use 'withSink' instead" #-}
scheduleSub :: (Sink action -> IO ()) -> Effect parent model action
scheduleSub :: forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
scheduleSub = (Sink action -> IO ()) -> Effect parent model action
forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink
{-# DEPRECATED effectSub "Please use 'put' and 'withSink' instead " #-}
effectSub :: model -> (Sink action -> IO ()) -> Effect parent model action
effectSub :: forall model action parent.
model -> (Sink action -> IO ()) -> Effect parent model action
effectSub model
m Sink action -> IO ()
s = model
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
m RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall a b.
RWST (ComponentInfo parent) [Schedule action] model Identity a
-> RWST (ComponentInfo parent) [Schedule action] model Identity b
-> RWST (ComponentInfo parent) [Schedule action] model Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Sink action -> IO ())
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall action parent model.
(Sink action -> IO ()) -> Effect parent model action
withSink Sink action -> IO ()
s
{-# DEPRECATED noEff "Please use 'put' instead " #-}
noEff :: model -> Effect parent model action
noEff :: forall model parent action. model -> Effect parent model action
noEff = model
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# DEPRECATED batchEff "Please use 'put' and 'batch' instead " #-}
batchEff :: model -> [IO action] -> Effect parent model action
batchEff :: forall model action parent.
model -> [IO action] -> Effect parent model action
batchEff model
model [IO action]
actions = do
model
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
model
[IO action]
-> RWST (ComponentInfo parent) [Schedule action] model Identity ()
forall action parent model.
[IO action] -> Effect parent model action
batch [IO action]
actions
noop :: action -> Effect parent model action
noop :: forall action parent model. action -> Effect parent model action
noop = Effect parent model action -> action -> Effect parent model action
forall a b. a -> b -> a
const (() -> Effect parent model action
forall a.
a -> RWST (ComponentInfo parent) [Schedule action] model Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
data Synchronicity
= Async
| Sync
deriving (ComponentId -> Synchronicity -> ShowS
[Synchronicity] -> ShowS
Synchronicity -> String
(ComponentId -> Synchronicity -> ShowS)
-> (Synchronicity -> String)
-> ([Synchronicity] -> ShowS)
-> Show Synchronicity
forall a.
(ComponentId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ComponentId -> Synchronicity -> ShowS
showsPrec :: ComponentId -> Synchronicity -> ShowS
$cshow :: Synchronicity -> String
show :: Synchronicity -> String
$cshowList :: [Synchronicity] -> ShowS
showList :: [Synchronicity] -> ShowS
Show, Synchronicity -> Synchronicity -> Bool
(Synchronicity -> Synchronicity -> Bool)
-> (Synchronicity -> Synchronicity -> Bool) -> Eq Synchronicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Synchronicity -> Synchronicity -> Bool
== :: Synchronicity -> Synchronicity -> Bool
$c/= :: Synchronicity -> Synchronicity -> Bool
/= :: Synchronicity -> Synchronicity -> Bool
Eq)