-----------------------------------------------------------------------------
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso
-- Copyright   :  (C) 2016-2025 David M. Johnson (@dmjio)
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso
  ( -- * API
    -- ** Entry
    miso
  , (🍜)
  , startComponent
    -- ** Sink
  , withSink
  , Sink
    -- ** Sampling
  , sample
  , sample'
    -- ** Message Passing
  , notify
  , notify'
    -- ** Subscription
  , startSub
  , stopSub
  , Sub
  , SubName
  -- ** Effect
  , issue
  , batch
  , io
  , io_
  , for
  , module Miso.Types
    -- * Effect
  , module Miso.Effect
    -- * Event
  , module Miso.Event
    -- * Property
  , module Miso.Property
    -- * Html
  , module Miso.Html
  , module Miso.Render
    -- * Router
  , module Miso.Router
    -- * Run
  , module Miso.Run
    -- * Exception
  , module Miso.Exception
    -- * Subscriptions
  , module Miso.Subscription
    -- * Storage
  , module Miso.Storage
    -- * Fetch
  , module Miso.Fetch
    -- * Util
  , module Miso.Util
    -- * FFI
  , module Miso.FFI
    -- * State management
  , ask
  , modify
  , modify'
  , get
  , gets
  , put
  , tell
  ) where
-----------------------------------------------------------------------------
import           Control.Monad (void)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.RWS (get, gets, modify, modify', tell, put, ask)
import           Data.IORef (newIORef)
import           Language.Javascript.JSaddle (Object(Object), JSM)
#ifndef GHCJS_BOTH
import           Data.FileEmbed (embedStringFile)
import           Language.Javascript.JSaddle (eval)
import           Miso.String (MisoString)
#endif
-----------------------------------------------------------------------------
import           Miso.Diff
import           Miso.Effect
import           Miso.Event
import           Miso.Exception
import           Miso.Fetch
import           Miso.FFI
import qualified Miso.FFI.Internal as FFI
import           Miso.Html
import           Miso.Internal
import           Miso.Property
import           Miso.Render
import           Miso.Router
import           Miso.Run
import           Miso.Storage
import           Miso.Subscription
import           Miso.Types
import           Miso.Util
----------------------------------------------------------------------------
-- | Runs an isomorphic @miso@ application.
-- Assumes the pre-rendered DOM is already present.
-- Note: Uses 'mountPoint' as the 'Component' name.
-- Always mounts to \<body\>. Copies page into the virtual DOM.
miso :: Eq model => (URI -> Component name model action) -> JSM ()
miso :: forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
miso URI -> Component name model action
f = JSM (IORef VTree) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (IORef VTree) -> JSM ()) -> JSM (IORef VTree) -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
  app@Component {..} <- URI -> Component name model action
f (URI -> Component name model action)
-> JSM URI -> JSM (Component name model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM URI
getURI
  initialize app $ \Sink action
snk -> do
    [CSS] -> JSM ()
renderStyles [CSS]
styles
    VTree (Object vtree) <- Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
forall action.
Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
runView Prerender
Prerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Events
events
    let name = Maybe MountPoint -> MountPoint
getMountPoint Maybe MountPoint
mountPoint
    FFI.setBodyComponent name
    mount <- FFI.getBody
    FFI.hydrate (logLevel `elem` [DebugPrerender, DebugAll]) mount vtree
    viewRef <- liftIO $ newIORef $ VTree (Object vtree)
    pure (name, mount, viewRef)
-----------------------------------------------------------------------------
-- | Alias for 'miso'.
(🍜) :: Eq model => (URI -> Component name model action) -> JSM ()
🍜 :: forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
(🍜) = (URI -> Component name model action) -> JSM ()
forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
miso
----------------------------------------------------------------------------
-- | Runs a miso application
-- Initializes application at 'mountPoint' (defaults to \<body\> when @Nothing@)
startComponent :: Eq model => Component name model action -> JSM ()
startComponent :: forall model (name :: Symbol) action.
Eq model =>
Component name model action -> JSM ()
startComponent app :: Component name model action
app@Component {model
[CSS]
[Sub action]
Maybe action
Maybe MountPoint
Events
LogLevel
model -> View action
action -> Effect model action
mountPoint :: forall (name :: Symbol) model action.
Component name model action -> Maybe MountPoint
logLevel :: forall (name :: Symbol) model action.
Component name model action -> LogLevel
initialAction :: forall (name :: Symbol) model action.
Component name model action -> Maybe action
styles :: forall (name :: Symbol) model action.
Component name model action -> [CSS]
events :: forall (name :: Symbol) model action.
Component name model action -> Events
subs :: forall (name :: Symbol) model action.
Component name model action -> [Sub action]
view :: forall (name :: Symbol) model action.
Component name model action -> model -> View action
update :: forall (name :: Symbol) model action.
Component name model action -> action -> Effect model action
model :: forall (name :: Symbol) model action.
Component name model action -> model
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Events
styles :: [CSS]
initialAction :: Maybe action
mountPoint :: Maybe MountPoint
logLevel :: LogLevel
..} = JSM (IORef VTree) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (IORef VTree) -> JSM ()) -> JSM (IORef VTree) -> JSM ()
forall a b. (a -> b) -> a -> b
$
  Component name model action
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall model (name :: Symbol) action.
Eq model =>
Component name model action
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
initialize Component name model action
app ((Sink action -> JSM (MountPoint, JSVal, IORef VTree))
 -> JSM (IORef VTree))
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall a b. (a -> b) -> a -> b
$ \Sink action
snk -> do
    [CSS] -> JSM ()
renderStyles [CSS]
styles
    vtree <- Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
forall action.
Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
runView Prerender
DontPrerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Events
events
    let name = Maybe MountPoint -> MountPoint
getMountPoint Maybe MountPoint
mountPoint
    FFI.setBodyComponent name
    mount <- mountElement name
    diff Nothing (Just vtree) mount
    viewRef <- liftIO (newIORef vtree)
    pure (name, mount, viewRef)
-----------------------------------------------------------------------------
-- | Used when compiling with jsaddle to make miso's JavaScript present in
-- the execution context.
withJS :: JSM a -> JSM ()
withJS :: forall a. JSM a -> JSM ()
withJS JSM a
action = JSM a -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM a -> JSM ()) -> JSM a -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
#ifndef GHCJS_BOTH
#ifdef PRODUCTION
  _ <- eval ($(embedStringFile "js/miso.prod.js") :: MisoString)
#else
  _ <- MountPoint -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile "js/miso.js") :: MisoString)
#endif
#endif
  action
-----------------------------------------------------------------------------