-----------------------------------------------------------------------------
{-# 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
  , (🍜)
  , startApp
    -- ** Sink
  , withSink
  , Sink
    -- ** Sampling
  , sample
    -- ** Message Passing
  , notify
    -- ** Subscription
  , start
  , start_
  , stop
  , 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
    -- * Mathml
  , module Miso.Mathml
    -- * 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.Mathml
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 -> App model action) -> JSM ()
miso :: forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
miso URI -> App 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@App {..} <- URI -> App model action
f (URI -> App model action) -> JSM URI -> JSM (App 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
-> Map MisoString Capture
-> JSM VTree
forall action.
Prerender
-> View action
-> Sink action
-> LogLevel
-> Map MisoString Capture
-> JSM VTree
runView Prerender
Prerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Map MisoString Capture
events
    let name = Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
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 -> App model action) -> JSM ()
🍜 :: forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
(🍜) = (URI -> App model action) -> JSM ()
forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
miso
----------------------------------------------------------------------------
-- | Runs a miso application
-- Initializes application at 'mountPoint' (defaults to \<body\> when @Nothing@)
startApp :: Eq model => App model action -> JSM ()
startApp :: forall model action. Eq model => App model action -> JSM ()
startApp app :: App model action
app@App {model
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Map MisoString Capture
LogLevel
model -> View action
action -> Effect model action
mountPoint :: forall model action. App model action -> Maybe MisoString
logLevel :: forall model action. App model action -> LogLevel
initialAction :: forall model action. App model action -> Maybe action
styles :: forall model action. App model action -> [CSS]
events :: forall model action. App model action -> Map MisoString Capture
subs :: forall model action. App model action -> [Sub action]
view :: forall model action. App model action -> model -> View action
update :: forall model action.
App model action -> action -> Effect model action
model :: forall model action. App model action -> model
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Map MisoString Capture
styles :: [CSS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
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
$
  App model action
-> (Sink action -> JSM (MisoString, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall model action.
Eq model =>
App model action
-> (Sink action -> JSM (MisoString, JSVal, IORef VTree))
-> JSM (IORef VTree)
initialize App model action
app ((Sink action -> JSM (MisoString, JSVal, IORef VTree))
 -> JSM (IORef VTree))
-> (Sink action -> JSM (MisoString, 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
-> Map MisoString Capture
-> JSM VTree
forall action.
Prerender
-> View action
-> Sink action
-> LogLevel
-> Map MisoString Capture
-> JSM VTree
runView Prerender
DontPrerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Map MisoString Capture
events
    let name = Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
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
  _ <- MisoString -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile "js/miso.js") :: MisoString)
#endif
#endif
  action
-----------------------------------------------------------------------------