-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Effect
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- This module defines `Effect` and `Sub` types, which are used to define
-- `Miso.Types.update` function and `Miso.Types.subs` field of the `Miso.Types.App`.
----------------------------------------------------------------------------
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

-- | An effect represents the results of an update action.
--
-- It consists of the updated model and a list of subscriptions. Each 'Sub' is
-- run in a new thread so there is no risk of accidentally blocking the
-- application.
data Effect action model = Effect model [Sub action]

-- | Type synonym for constructing event subscriptions.
--
-- The 'Sink' callback is used to dispatch actions which are then fed
-- back to the 'Miso.Types.update' function.
type Sub action = Sink action -> JSM ()

-- | Function to asynchronously dispatch actions to the 'Miso.Types.update' function.
type Sink action = action -> IO ()

-- | Turn a subscription that consumes actions of type @a@ into a subscription
-- that consumes actions of type @b@ using the supplied function of type @a -> b@.
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)

-- | Smart constructor for an 'Effect' with no actions.
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 []

-- | Smart constructor for an 'Effect' with exactly one action.
(<#) :: 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

-- | `Effect` smart constructor, flipped
(#>) :: 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
(<#)

-- | Smart constructor for an 'Effect' with multiple actions.
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

-- | Like '<#' but schedules a subscription which is an IO computation which has
-- access to a 'Sink' which can be used to asynchronously dispatch actions to
-- the 'Miso.Types.update' function.
--
-- A use-case is scheduling an IO computation which creates a 3rd-party JS
-- widget which has an associated callback. The callback can then call the sink
-- to turn events into actions. To do this without accessing a sink requires
-- going via a @'Sub'scription@ which introduces a leaky-abstraction.
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]