-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Types
-- 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
----------------------------------------------------------------------------
module Miso.Types
  ( App (..)
  , LogLevel (..)
  , Effect
  , Sub

    -- * The Transition Monad
  , Transition
  , mapAction
  , fromTransition
  , toTransition
  , scheduleIO
  , scheduleIO_
  , scheduleIOFor_
  , scheduleSub
  ) where

import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class (lift)
import           Control.Monad.Trans.State.Strict (StateT(StateT), execStateT, mapStateT)
import           Control.Monad.Trans.Writer.Strict (WriterT(WriterT), Writer, runWriter, tell, mapWriter)
import           Data.Bifunctor (second)
import           Data.Foldable (Foldable, for_)
import qualified Data.Map as M
import           Miso.Effect
import           Miso.FFI (JSM)
import           Miso.Html.Types (View)
import           Miso.String

-- | Application entry point
data App model action = App
  { App model action -> model
model :: model
  -- ^ initial model
  , App model action -> action -> model -> Effect action model
update :: action -> model -> Effect action model
  -- ^ Function to update model, optionally providing effects.
  --   See the 'Transition' monad for succinctly expressing model transitions.
  , App model action -> model -> View action
view :: model -> View action
  -- ^ Function to draw `View`
  , App model action -> [Sub action]
subs :: [ Sub action ]
  -- ^ List of subscriptions to run during application lifetime
  , App model action -> Map MisoString Bool
events :: M.Map MisoString Bool
  -- ^ List of delegated events that the body element will listen for.
  --   You can start with 'Miso.Event.Types.defaultEvents' and modify as needed.
  , App model action -> action
initialAction :: action
  -- ^ Initial action that is run after the application has loaded
  , App model action -> Maybe MisoString
mountPoint :: Maybe MisoString
  -- ^ Id of the root element for DOM diff. If 'Nothing' is provided, the entire document body is used as a mount point.
  , App model action -> LogLevel
logLevel :: LogLevel
  -- ^ Display warning messages when prerendering if the DOM and VDOM are not in sync.
  }

-- | Optional Logging for debugging miso internals (useful to see if prerendering is successful)
data LogLevel
  = Off
  | DebugPrerender
  deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq)

-- | A monad for succinctly expressing model transitions in the 'update' function.
--
-- @Transition@ is a state monad so it abstracts over manually passing the model
-- around. It's also a writer monad where the accumulator is a list of scheduled
-- IO actions. Multiple actions can be scheduled using
-- @Control.Monad.Writer.Class.tell@ from the @mtl@ library and a single action
-- can be scheduled using 'scheduleIO'.
--
-- Tip: use the @Transition@ monad in combination with the stateful
-- <http://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Operators.html lens>
-- operators (all operators ending in "@=@"). The following example assumes
-- the lenses @field1@, @counter@ and @field2@ are in scope and that the
-- @LambdaCase@ language extension is enabled:
--
-- @
-- myApp = App
--   { update = 'fromTransition' . \\case
--       MyAction1 -> do
--         field1 .= value1
--         counter += 1
--       MyAction2 -> do
--         field2 %= f
--         scheduleIO $ do
--           putStrLn \"Hello\"
--           putStrLn \"World!\"
--   , ...
--   }
-- @
type Transition action model = StateT model (Writer [Sub action])

-- | Turn a transition that schedules subscriptions that consume
-- actions of type @a@ into a transition that schedules subscriptions
-- that consume actions of type @b@ using the supplied function of
-- type @a -> b@.
mapAction :: (actionA -> actionB) -> Transition actionA model r -> Transition actionB model r
mapAction :: (actionA -> actionB)
-> Transition actionA model r -> Transition actionB model r
mapAction = (WriterT [Sub actionA] Identity (r, model)
 -> WriterT [Sub actionB] Identity (r, model))
-> Transition actionA model r -> Transition actionB model r
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((WriterT [Sub actionA] Identity (r, model)
  -> WriterT [Sub actionB] Identity (r, model))
 -> Transition actionA model r -> Transition actionB model r)
-> ((actionA -> actionB)
    -> WriterT [Sub actionA] Identity (r, model)
    -> WriterT [Sub actionB] Identity (r, model))
-> (actionA -> actionB)
-> Transition actionA model r
-> Transition actionB model r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((r, model), [Sub actionA]) -> ((r, model), [Sub actionB]))
-> WriterT [Sub actionA] Identity (r, model)
-> WriterT [Sub actionB] Identity (r, model)
forall a w b w'. ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter ((((r, model), [Sub actionA]) -> ((r, model), [Sub actionB]))
 -> WriterT [Sub actionA] Identity (r, model)
 -> WriterT [Sub actionB] Identity (r, model))
-> ((actionA -> actionB)
    -> ((r, model), [Sub actionA]) -> ((r, model), [Sub actionB]))
-> (actionA -> actionB)
-> WriterT [Sub actionA] Identity (r, model)
-> WriterT [Sub actionB] Identity (r, model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sub actionA] -> [Sub actionB])
-> ((r, model), [Sub actionA]) -> ((r, model), [Sub actionB])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Sub actionA] -> [Sub actionB])
 -> ((r, model), [Sub actionA]) -> ((r, model), [Sub actionB]))
-> ((actionA -> actionB) -> [Sub actionA] -> [Sub actionB])
-> (actionA -> actionB)
-> ((r, model), [Sub actionA])
-> ((r, model), [Sub actionB])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sub actionA -> Sub actionB) -> [Sub actionA] -> [Sub actionB]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sub actionA -> Sub actionB) -> [Sub actionA] -> [Sub actionB])
-> ((actionA -> actionB) -> Sub actionA -> Sub actionB)
-> (actionA -> actionB)
-> [Sub actionA]
-> [Sub actionB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (actionA -> actionB) -> Sub actionA -> Sub actionB
forall actionA actionB.
(actionA -> actionB) -> Sub actionA -> Sub actionB
mapSub

-- | Convert a @Transition@ computation to a function that can be given to 'update'.
fromTransition
    :: Transition action model ()
    -> (model -> Effect action model) -- ^ model 'update' function.
fromTransition :: Transition action model () -> model -> Effect action model
fromTransition Transition action model ()
act = (model -> [Sub action] -> Effect action model)
-> (model, [Sub action]) -> Effect action model
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry model -> [Sub action] -> Effect action model
forall action model. model -> [Sub action] -> Effect action model
Effect ((model, [Sub action]) -> Effect action model)
-> (model -> (model, [Sub action])) -> model -> Effect action model
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Sub action] model -> (model, [Sub action])
forall w a. Writer w a -> (a, w)
runWriter (Writer [Sub action] model -> (model, [Sub action]))
-> (model -> Writer [Sub action] model)
-> model
-> (model, [Sub action])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition action model () -> model -> Writer [Sub action] model
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Transition action model ()
act

-- | Convert an 'update' function to a @Transition@ computation.
toTransition
    :: (model -> Effect action model) -- ^ model 'update' function
    -> Transition action model ()
toTransition :: (model -> Effect action model) -> Transition action model ()
toTransition model -> Effect action model
f = (model -> WriterT [Sub action] Identity ((), model))
-> Transition action model ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((model -> WriterT [Sub action] Identity ((), model))
 -> Transition action model ())
-> (model -> WriterT [Sub action] Identity ((), model))
-> Transition action model ()
forall a b. (a -> b) -> a -> b
$ \model
s ->
                   let Effect model
s' [Sub action]
ios = model -> Effect action model
f model
s
                   in Identity (((), model), [Sub action])
-> WriterT [Sub action] Identity ((), model)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (Identity (((), model), [Sub action])
 -> WriterT [Sub action] Identity ((), model))
-> Identity (((), model), [Sub action])
-> WriterT [Sub action] Identity ((), model)
forall a b. (a -> b) -> a -> b
$ (((), model), [Sub action]) -> Identity (((), model), [Sub action])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((), model
s'), [Sub action]
ios)

-- | Schedule a single IO action for later execution.
--
-- Note that multiple IO action can be scheduled using
-- @Control.Monad.Writer.Class.tell@ from the @mtl@ library.
scheduleIO :: JSM action -> Transition action model ()
scheduleIO :: JSM action -> Transition action model ()
scheduleIO JSM action
ioAction = Sub action -> Transition action model ()
forall action model. Sub action -> Transition action model ()
scheduleSub (Sub action -> Transition action model ())
-> Sub action -> Transition action model ()
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> JSM action
ioAction 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

-- | Like 'scheduleIO' but doesn't cause an action to be dispatched to
-- the 'update' function.
--
-- This is handy for scheduling IO computations where you don't care
-- about their results or when they complete.
scheduleIO_ :: JSM () -> Transition action model ()
scheduleIO_ :: JSM () -> Transition action model ()
scheduleIO_ JSM ()
ioAction = Sub action -> Transition action model ()
forall action model. Sub action -> Transition action model ()
scheduleSub (Sub action -> Transition action model ())
-> Sub action -> Transition action model ()
forall a b. (a -> b) -> a -> b
$ \Sink action
_sink -> JSM ()
ioAction

-- | Like `scheduleIO_` but generalized to any instance of `Foldable`
--
-- This is handy for scheduling IO computations that return a `Maybe` value
scheduleIOFor_ :: Foldable f => JSM (f action) -> Transition action model ()
scheduleIOFor_ :: JSM (f action) -> Transition action model ()
scheduleIOFor_ JSM (f action)
io = Sub action -> Transition action model ()
forall action model. Sub action -> Transition action model ()
scheduleSub (Sub action -> Transition action model ())
-> Sub action -> Transition action model ()
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> JSM (f action)
io JSM (f action) -> (f action -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \f action
m -> IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (f action -> Sink action -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f action
m Sink action
sink)

-- | Like 'scheduleIO' but schedules a subscription which is an IO
-- computation that has access to a 'Sink' which can be used to
-- asynchronously dispatch actions to the '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.
scheduleSub :: Sub action -> Transition action model ()
scheduleSub :: Sub action -> Transition action model ()
scheduleSub Sub action
sub = WriterT [Sub action] Identity () -> Transition action model ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [Sub action] Identity () -> Transition action model ())
-> WriterT [Sub action] Identity () -> Transition action model ()
forall a b. (a -> b) -> a -> b
$ [Sub action] -> WriterT [Sub action] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [ Sub action
sub ]