{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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
, modifyContext
, modifyContext_
, putContext
, mapSub
, noop
, beforeAll
, afterAll
, modifyAllIO
, componentInfoDOMRef
, componentInfoParentId
, componentInfoId
, runEffect
, componentInfoProps
, props
, getProps
, componentInfoContext
, context
, getContext
) where
import Control.Monad (void)
import Data.Foldable (traverse_)
import Control.Monad.RWS (RWS, put, tell, execRWS, censor, MonadReader)
import Control.Monad.State (State, execState)
import Miso.DSL.FFI
import Miso.Lens
mkComponentInfo
:: ComponentId
-> ComponentId
-> DOMRef
-> props
-> context
-> ComponentInfo context props
mkComponentInfo :: forall props context.
ComponentId
-> ComponentId
-> DOMRef
-> props
-> context
-> ComponentInfo context props
mkComponentInfo = ComponentId
-> ComponentId
-> DOMRef
-> props
-> context
-> ComponentInfo context props
forall context props.
ComponentId
-> ComponentId
-> DOMRef
-> props
-> context
-> ComponentInfo context props
ComponentInfo
data ComponentInfo context props
= ComponentInfo
{ forall context props. ComponentInfo context props -> ComponentId
_componentInfoId :: ComponentId
, forall context props. ComponentInfo context props -> ComponentId
_componentInfoParentId :: ComponentId
, forall context props. ComponentInfo context props -> DOMRef
_componentInfoDOMRef :: DOMRef
, forall context props. ComponentInfo context props -> props
_componentInfoProps :: props
, forall context props. ComponentInfo context props -> context
_componentInfoContext :: context
}
componentInfoId :: Lens (ComponentInfo context props) ComponentId
componentInfoId :: forall context props.
Lens (ComponentInfo context props) ComponentId
componentInfoId = (ComponentInfo context props -> ComponentId)
-> (ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo context props -> ComponentId
forall context props. ComponentInfo context props -> ComponentId
_componentInfoId ((ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId)
-> (ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId
forall a b. (a -> b) -> a -> b
$ \ComponentInfo context props
r ComponentId
x -> ComponentInfo context props
r { _componentInfoId = x }
componentInfoParentId :: Lens (ComponentInfo context props) ComponentId
componentInfoParentId :: forall context props.
Lens (ComponentInfo context props) ComponentId
componentInfoParentId = (ComponentInfo context props -> ComponentId)
-> (ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo context props -> ComponentId
forall context props. ComponentInfo context props -> ComponentId
_componentInfoParentId ((ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId)
-> (ComponentInfo context props
-> ComponentId -> ComponentInfo context props)
-> Lens (ComponentInfo context props) ComponentId
forall a b. (a -> b) -> a -> b
$ \ComponentInfo context props
r ComponentId
x -> ComponentInfo context props
r { _componentInfoParentId = x }
componentInfoDOMRef :: Lens (ComponentInfo context props) DOMRef
componentInfoDOMRef :: forall context props. Lens (ComponentInfo context props) DOMRef
componentInfoDOMRef = (ComponentInfo context props -> DOMRef)
-> (ComponentInfo context props
-> DOMRef -> ComponentInfo context props)
-> Lens (ComponentInfo context props) DOMRef
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo context props -> DOMRef
forall context props. ComponentInfo context props -> DOMRef
_componentInfoDOMRef ((ComponentInfo context props
-> DOMRef -> ComponentInfo context props)
-> Lens (ComponentInfo context props) DOMRef)
-> (ComponentInfo context props
-> DOMRef -> ComponentInfo context props)
-> Lens (ComponentInfo context props) DOMRef
forall a b. (a -> b) -> a -> b
$ \ComponentInfo context props
r DOMRef
x -> ComponentInfo context props
r { _componentInfoDOMRef = x }
componentInfoProps :: Lens (ComponentInfo context props) props
componentInfoProps :: forall context props. Lens (ComponentInfo context props) props
componentInfoProps = (ComponentInfo context props -> props)
-> (ComponentInfo context props
-> props -> ComponentInfo context props)
-> Lens (ComponentInfo context props) props
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo context props -> props
forall context props. ComponentInfo context props -> props
_componentInfoProps ((ComponentInfo context props
-> props -> ComponentInfo context props)
-> Lens (ComponentInfo context props) props)
-> (ComponentInfo context props
-> props -> ComponentInfo context props)
-> Lens (ComponentInfo context props) props
forall a b. (a -> b) -> a -> b
$ \ComponentInfo context props
r props
x -> ComponentInfo context props
r { _componentInfoProps = x }
componentInfoContext :: Lens (ComponentInfo context props) context
componentInfoContext :: forall context props. Lens (ComponentInfo context props) context
componentInfoContext = (ComponentInfo context props -> context)
-> (ComponentInfo context props
-> context -> ComponentInfo context props)
-> Lens (ComponentInfo context props) context
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentInfo context props -> context
forall context props. ComponentInfo context props -> context
_componentInfoContext ((ComponentInfo context props
-> context -> ComponentInfo context props)
-> Lens (ComponentInfo context props) context)
-> (ComponentInfo context props
-> context -> ComponentInfo context props)
-> Lens (ComponentInfo context props) context
forall a b. (a -> b) -> a -> b
$ \ComponentInfo context props
r context
x -> ComponentInfo context props
r { _componentInfoContext = x }
context :: Lens (ComponentInfo context props) context
context :: forall context props. Lens (ComponentInfo context props) context
context = Lens (ComponentInfo context props) context
forall context props. Lens (ComponentInfo context props) context
componentInfoContext
props :: Lens (ComponentInfo context props) props
props :: forall context props. Lens (ComponentInfo context props) props
props = Lens (ComponentInfo context props) props
forall context props. Lens (ComponentInfo context props) props
componentInfoProps
getProps :: MonadReader (ComponentInfo context props) m => m props
getProps :: forall context props (m :: * -> *).
MonadReader (ComponentInfo context props) m =>
m props
getProps = Lens (ComponentInfo context props) props -> m props
forall record (m :: * -> *) field.
MonadReader record m =>
Lens record field -> m field
Miso.Lens.view Lens (ComponentInfo context props) props
forall context props. Lens (ComponentInfo context props) props
props
getContext :: MonadReader (ComponentInfo context props) m => m context
getContext :: forall context props (m :: * -> *).
MonadReader (ComponentInfo context props) m =>
m context
getContext = Lens (ComponentInfo context props) context -> m context
forall record (m :: * -> *) field.
MonadReader record m =>
Lens record field -> m field
Miso.Lens.view Lens (ComponentInfo context props) context
forall context props. Lens (ComponentInfo context props) context
context
type ComponentId = Int
type Sub action = Sink action -> IO ()
type Sink action = action -> IO ()
infixl 0 <#
(<#) :: model -> IO action -> Effect context props model action
<# :: forall model action context props.
model -> IO action -> Effect context props model action
(<#) model
m IO action
action = model
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall s (m :: * -> *). MonadState s m => s -> m ()
put model
m RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall a b.
RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
a
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
b
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule context action
forall action context.
(Sink action -> IO ()) -> Schedule context action
async ((Sink action -> IO ()) -> Schedule context action)
-> (Sink action -> IO ()) -> Schedule context 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 context action
async :: forall action context.
(Sink action -> IO ()) -> Schedule context action
async = Synchronicity -> (Sink action -> IO ()) -> Schedule context action
forall context action.
Synchronicity -> (Sink action -> IO ()) -> Schedule context action
Schedule Synchronicity
Async
infixr 0 #>
(#>) :: IO action -> model -> Effect context props model action
#> :: forall action model context props.
IO action -> model -> Effect context props model action
(#>) = (model -> IO action -> Effect context props model action)
-> IO action -> model -> Effect context props model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip model -> IO action -> Effect context props model action
forall model action context props.
model -> IO action -> Effect context props model action
(<#)
batch
:: [IO action]
-> Effect context props model action
batch :: forall action context props model.
[IO action] -> Effect context props model action
batch [IO action]
actions = [RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule context action
forall action context.
(Sink action -> IO ()) -> Schedule context action
async ((Sink action -> IO ()) -> Schedule context action)
-> (Sink action -> IO ()) -> Schedule context 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 context props model action
batch_ :: forall context props model action.
[IO ()] -> Effect context props model action
batch_ [IO ()]
actions = [RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule context action
forall action context.
(Sink action -> IO ()) -> Schedule context action
async (IO () -> Sink action -> IO ()
forall a b. a -> b -> a
const IO ()
action) ]
| IO ()
action <- [IO ()]
actions
]
type Effect context props model action = RWS (ComponentInfo context props) [Schedule context action] model ()
data Schedule context action
= Schedule Synchronicity (Sink action -> IO ())
| ContextModify (context -> context)
type DOMRef = JSVal
runEffect
:: Effect context props model action
-> ComponentInfo context props
-> model
-> (model, [Schedule context action])
runEffect :: forall context props model action.
Effect context props model action
-> ComponentInfo context props
-> model
-> (model, [Schedule context action])
runEffect = RWS
(ComponentInfo context props) [Schedule context action] model ()
-> ComponentInfo context props
-> model
-> (model, [Schedule context 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 context props model action
sync :: forall action context props model.
IO action -> Effect context props model action
sync IO action
action = [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Synchronicity -> (Sink action -> IO ()) -> Schedule context action
forall context action.
Synchronicity -> (Sink action -> IO ()) -> Schedule context action
Schedule Synchronicity
Sync ((Sink action -> IO ()) -> Schedule context action)
-> (Sink action -> IO ()) -> Schedule context 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 context props model action
sync_ :: forall context props model action.
IO () -> Effect context props model action
sync_ IO ()
action = [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Synchronicity -> (Sink action -> IO ()) -> Schedule context action
forall context action.
Synchronicity -> (Sink action -> IO ()) -> Schedule context action
Schedule Synchronicity
Sync ((Sink action -> IO ()) -> Schedule context action)
-> (Sink action -> IO ()) -> Schedule context action
forall a b. (a -> b) -> a -> b
$ \Sink action
_ -> IO ()
action ]
io
:: IO action
-> Effect context props model action
io :: forall action context props model.
IO action -> Effect context props model action
io IO action
action = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props 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 ()
-> Effect context props model action
io_ :: forall context props model action.
IO () -> Effect context props model action
io_ IO ()
action = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink (\Sink action
_ -> IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO ()
action)
for
:: Foldable f
=> IO (f action)
-> Effect context props model action
for :: forall (f :: * -> *) action context props model.
Foldable f =>
IO (f action) -> Effect context props model action
for IO (f action)
actions = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props 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
>>= Sink action -> f action -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Sink action
sink
beforeAll
:: IO ()
-> Effect context props model action
-> Effect context props model action
beforeAll :: forall context props model action.
IO ()
-> Effect context props model action
-> Effect context props model action
beforeAll = (IO () -> IO ())
-> Effect context props model action
-> Effect context props model action
forall context props model action.
(IO () -> IO ())
-> Effect context props model action
-> Effect context props model action
modifyAllIO ((IO () -> IO ())
-> Effect context props model action
-> Effect context props model action)
-> (IO () -> IO () -> IO ())
-> IO ()
-> Effect context props model action
-> Effect context props 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 context props model action
-> Effect context props model action
afterAll :: forall context props model action.
IO ()
-> Effect context props model action
-> Effect context props model action
afterAll = (IO () -> IO ())
-> Effect context props model action
-> Effect context props model action
forall context props model action.
(IO () -> IO ())
-> Effect context props model action
-> Effect context props model action
modifyAllIO ((IO () -> IO ())
-> Effect context props model action
-> Effect context props model action)
-> (IO () -> IO () -> IO ())
-> IO ()
-> Effect context props model action
-> Effect context props 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 context props model action
-> Effect context props model action
modifyAllIO :: forall context props model action.
(IO () -> IO ())
-> Effect context props model action
-> Effect context props model action
modifyAllIO IO () -> IO ()
f = ([Schedule context action] -> [Schedule context action])
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor (([Schedule context action] -> [Schedule context action])
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
())
-> ([Schedule context action] -> [Schedule context action])
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall a b. (a -> b) -> a -> b
$ \[Schedule context action]
actions ->
[ Synchronicity -> (Sink action -> IO ()) -> Schedule context action
forall context action.
Synchronicity -> (Sink action -> IO ()) -> Schedule context 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 context action]
actions
]
withSink
:: (Sink action -> IO ())
-> Effect context props model action
withSink :: forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink Sink action -> IO ()
f = [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule context action
forall action context.
(Sink action -> IO ()) -> Schedule context action
async Sink action -> IO ()
f ]
modifyContext
:: (context -> context)
-> Effect context props model action
modifyContext :: forall context props model action.
(context -> context) -> Effect context props model action
modifyContext context -> context
f = [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (context -> context) -> Schedule context action
forall context action.
(context -> context) -> Schedule context action
ContextModify context -> context
f ]
putContext
:: context
-> Effect context props model action
putContext :: forall context props model action.
context -> Effect context props model action
putContext = (context -> context) -> Effect context props model action
forall context props model action.
(context -> context) -> Effect context props model action
modifyContext ((context -> context) -> Effect context props model action)
-> (context -> context -> context)
-> context
-> Effect context props model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. context -> context -> context
forall a b. a -> b -> a
const
modifyContext_
:: State context ()
-> Effect context props model action
modifyContext_ :: forall context props model action.
State context () -> Effect context props model action
modifyContext_ = (context -> context) -> Effect context props model action
forall context props model action.
(context -> context) -> Effect context props model action
modifyContext ((context -> context) -> Effect context props model action)
-> (State context () -> context -> context)
-> State context ()
-> Effect context props model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State context () -> context -> context
forall s a. State s a -> s -> s
execState
issue
:: action
-> Effect context props model action
issue :: forall action context props model.
action -> Effect context props model action
issue action
action = [Schedule context action]
-> RWST
(ComponentInfo context props)
[Schedule context action]
model
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ (Sink action -> IO ()) -> Schedule context action
forall action context.
(Sink action -> IO ()) -> Schedule context action
async ((Sink action -> IO ()) -> Schedule context action)
-> (Sink action -> IO ()) -> Schedule context action
forall a b. (a -> b) -> a -> b
$ \Sink action
f -> Sink action
f action
action ]
noop :: action -> Effect context props model action
noop :: forall action context props model.
action -> Effect context props model action
noop = Effect context props model action
-> action -> Effect context props model action
forall a b. a -> b -> a
const (() -> Effect context props model action
forall a.
a
-> RWST
(ComponentInfo context props)
[Schedule context 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)