module Miso.Effect (
module Miso.Effect.Storage
, module Miso.Effect.DOM
, Effect (..), Sub, Sink
, mapSub
, noEff
, (<#)
, (#>)
, batchEff
, effectSub
) where
import Data.Bifunctor
import Control.Monad.IO.Class
import Miso.FFI (JSM)
import Miso.Effect.Storage
import Miso.Effect.DOM
data Effect action model = Effect model [Sub action]
type Sub action = Sink action -> JSM ()
type Sink action = action -> IO ()
mapSub :: (actionA -> actionB) -> Sub actionA -> Sub actionB
mapSub :: (actionA -> actionB) -> Sub actionA -> Sub actionB
mapSub actionA -> actionB
f Sub actionA
sub = \Sink actionB
sinkB -> let sinkA :: actionA -> IO ()
sinkA = Sink actionB
sinkB Sink actionB -> (actionA -> actionB) -> actionA -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. actionA -> actionB
f
in Sub actionA
sub actionA -> IO ()
sinkA
instance Functor (Effect action) where
fmap :: (a -> b) -> Effect action a -> Effect action b
fmap a -> b
f (Effect a
m [Sub action]
acts) = b -> [Sub action] -> Effect action b
forall action model. model -> [Sub action] -> Effect action model
Effect (a -> b
f a
m) [Sub action]
acts
instance Applicative (Effect action) where
pure :: a -> Effect action a
pure a
m = a -> [Sub action] -> Effect action a
forall action model. model -> [Sub action] -> Effect action model
Effect a
m []
Effect a -> b
fModel [Sub action]
fActs <*> :: Effect action (a -> b) -> Effect action a -> Effect action b
<*> Effect a
xModel [Sub action]
xActs = b -> [Sub action] -> Effect action b
forall action model. model -> [Sub action] -> Effect action model
Effect (a -> b
fModel a
xModel) ([Sub action]
fActs [Sub action] -> [Sub action] -> [Sub action]
forall a. [a] -> [a] -> [a]
++ [Sub action]
xActs)
instance Monad (Effect action) where
return :: a -> Effect action a
return = a -> Effect action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Effect a
m [Sub action]
acts >>= :: Effect action a -> (a -> Effect action b) -> Effect action b
>>= a -> Effect action b
f =
case a -> Effect action b
f a
m of
Effect b
m' [Sub action]
acts' -> b -> [Sub action] -> Effect action b
forall action model. model -> [Sub action] -> Effect action model
Effect b
m' ([Sub action]
acts [Sub action] -> [Sub action] -> [Sub action]
forall a. [a] -> [a] -> [a]
++ [Sub action]
acts')
instance Bifunctor Effect where
bimap :: (a -> b) -> (c -> d) -> Effect a c -> Effect b d
bimap a -> b
f c -> d
g (Effect c
m [Sub a]
acts) = d -> [Sub b] -> Effect b d
forall action model. model -> [Sub action] -> Effect action model
Effect (c -> d
g c
m) ((Sub a -> Sub b) -> [Sub a] -> [Sub b]
forall a b. (a -> b) -> [a] -> [b]
map (\Sub a
act -> \b -> IO ()
sink -> Sub a
act (b -> IO ()
sink (b -> IO ()) -> (a -> b) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)) [Sub a]
acts)
noEff :: model -> Effect action model
noEff :: model -> Effect action model
noEff model
m = model -> [Sub action] -> Effect action model
forall action model. model -> [Sub action] -> Effect action model
Effect model
m []
(<#) :: model -> JSM action -> Effect action model
<# :: model -> JSM action -> Effect action model
(<#) model
m JSM action
a = model -> Sub action -> Effect action model
forall model action. model -> Sub action -> Effect action model
effectSub model
m (Sub action -> Effect action model)
-> Sub action -> Effect action model
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> JSM action
a JSM action -> (action -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> Sink action -> action -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sink action
sink
(#>) :: JSM action -> model -> Effect action model
#> :: JSM action -> model -> Effect action model
(#>) = (model -> JSM action -> Effect action model)
-> JSM action -> model -> Effect action model
forall a b c. (a -> b -> c) -> b -> a -> c
flip model -> JSM action -> Effect action model
forall model action. model -> JSM action -> Effect action model
(<#)
batchEff :: model -> [JSM action] -> Effect action model
batchEff :: model -> [JSM action] -> Effect action model
batchEff model
model [JSM action]
actions = model -> [Sub action] -> Effect action model
forall action model. model -> [Sub action] -> Effect action model
Effect model
model ([Sub action] -> Effect action model)
-> [Sub action] -> Effect action model
forall a b. (a -> b) -> a -> b
$
(JSM action -> Sub action) -> [JSM action] -> [Sub action]
forall a b. (a -> b) -> [a] -> [b]
map (\JSM action
a action -> IO ()
sink -> IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (action -> IO ()) -> action -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. action -> IO ()
sink (action -> JSM ()) -> JSM action -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM action
a) [JSM action]
actions
effectSub :: model -> Sub action -> Effect action model
effectSub :: model -> Sub action -> Effect action model
effectSub model
model Sub action
sub = model -> [Sub action] -> Effect action model
forall action model. model -> [Sub action] -> Effect action model
Effect model
model [Sub action
sub]