-----------------------------------------------------------------------------
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# 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
  , (🍜)
  , App
  , startApp
  , startComponent
  , renderComponent
    -- ** Sink
  , withSink
  , Sink
    -- ** Publishers / Subscribers
  , subscribe
  , unsubscribe
  , publish
  , Topic
  , topic
  -- ** Component
  , mail
  , getComponentId
  , getParentComponentId
  -- ** Subscriptions
  , startSub
  , stopSub
  , Sub
  -- ** 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
    -- * Property
  , module Miso.Property
    -- * Router
  , module Miso.Router
    -- * Run
  , module Miso.Run
    -- * Subscriptions
  , module Miso.Subscription
    -- * Storage
  , module Miso.Storage
    -- * Fetch
  , module Miso.Fetch
    -- * Util
  , module Miso.Util
    -- * FFI
  , module Miso.FFI
    -- * State management
  , module Miso.State
  ) where
-----------------------------------------------------------------------------
import           Control.Monad (void)
import           Control.Monad.IO.Class (liftIO)
import           Data.IORef (newIORef)
import           Language.Javascript.JSaddle (Object(Object), JSM, JSVal)
#ifndef GHCJS_BOTH
#ifdef WASM
import qualified Language.Javascript.JSaddle.Wasm.TH as JSaddle.Wasm.TH
#else
import           Data.FileEmbed (embedStringFile)
import           Language.Javascript.JSaddle (eval)
#endif
#endif
-----------------------------------------------------------------------------
import           Miso.Diff
import           Miso.Effect
import           Miso.Event
import           Miso.Fetch
import           Miso.FFI hiding (getComponentId, getParentComponentId)
import qualified Miso.FFI.Internal as FFI
import           Miso.Html
import           Miso.Runtime
import           Miso.Property
import           Miso.Render
import           Miso.Router
import           Miso.Run
import           Miso.State
import           Miso.Storage
import           Miso.String (MisoString)
import           Miso.Subscription
import           Miso.Types
import           Miso.Util
----------------------------------------------------------------------------
-- | Runs an isomorphic @miso@ application.
-- Assumes the pre-rendered DOM is already present.
-- Always mounts to \<body\>. Copies page into the virtual DOM.
miso :: Eq model => (URI -> Component model action) -> JSM ()
miso :: forall model action.
Eq model =>
(URI -> Component model action) -> JSM ()
miso URI -> Component model action
f = JSM (ComponentState model action) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (ComponentState model action) -> JSM ())
-> JSM (ComponentState model action) -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
  app@Component {..} <- URI -> Component model action
f (URI -> Component model action)
-> JSM URI -> JSM (Component model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM URI
getURI
  initialize app $ \Sink action
snk -> do
    refs <- [DOMRef] -> [DOMRef] -> [DOMRef]
forall a. [a] -> [a] -> [a]
(++) ([DOMRef] -> [DOMRef] -> [DOMRef])
-> JSM [DOMRef] -> JSM ([DOMRef] -> [DOMRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JS] -> JSM [DOMRef]
renderScripts [JS]
scripts JSM ([DOMRef] -> [DOMRef]) -> JSM [DOMRef] -> JSM [DOMRef]
forall a b. JSM (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CSS] -> JSM [DOMRef]
renderStyles [CSS]
styles
    VTree (Object vtree) <- runView Hydrate (view model) snk logLevel events
    mount_ <- FFI.getBody
    FFI.hydrate (logLevel `elem` [DebugHydrate, DebugAll]) mount_ vtree
    viewRef <- liftIO $ newIORef $ VTree (Object vtree)
    pure (refs, mount_, viewRef)
-----------------------------------------------------------------------------
-- | Type synonym 'App' to 'Component', for legacy `miso` compat.
type App model action = Component model action
-----------------------------------------------------------------------------
-- | Synonym 'startApp' to 'startComponent'.
startApp :: Eq model => App model action -> JSM ()
startApp :: forall model action. Eq model => App model action -> JSM ()
startApp = Component model action -> JSM ()
forall model action. Eq model => App model action -> JSM ()
startComponent
-----------------------------------------------------------------------------
-- | Alias for 'miso'.
(🍜) :: Eq model => (URI -> App model action) -> JSM ()
🍜 :: forall model action.
Eq model =>
(URI -> Component model action) -> JSM ()
(🍜) = (URI -> Component model action) -> JSM ()
forall model action.
Eq model =>
(URI -> Component model action) -> JSM ()
miso
----------------------------------------------------------------------------
-- | Runs a miso application
-- Initializes application at 'mountPoint' (defaults to \<body\> when @Nothing@)
startComponent
  :: Eq model
  => Component model action
  -- ^ Component application
  -> JSM ()
startComponent :: forall model action. Eq model => App model action -> JSM ()
startComponent vcomp :: Component model action
vcomp@Component { [CSS]
styles :: forall model action. Component model action -> [CSS]
styles :: [CSS]
styles, [JS]
scripts :: forall model action. Component model action -> [JS]
scripts :: [JS]
scripts } =
  JSM (ComponentState model action) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (ComponentState model action) -> JSM ())
-> JSM (ComponentState model action) -> JSM ()
forall a b. (a -> b) -> a -> b
$ Component model action
-> JSM [DOMRef] -> JSM (ComponentState model action)
forall model action.
Eq model =>
Component model action
-> JSM [DOMRef] -> JSM (ComponentState model action)
initComponent Component model action
vcomp (JSM [DOMRef] -> JSM (ComponentState model action))
-> JSM [DOMRef] -> JSM (ComponentState model action)
forall a b. (a -> b) -> a -> b
$ do
     [DOMRef] -> [DOMRef] -> [DOMRef]
forall a. [a] -> [a] -> [a]
(++) ([DOMRef] -> [DOMRef] -> [DOMRef])
-> JSM [DOMRef] -> JSM ([DOMRef] -> [DOMRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JS] -> JSM [DOMRef]
renderScripts [JS]
scripts
          JSM ([DOMRef] -> [DOMRef]) -> JSM [DOMRef] -> JSM [DOMRef]
forall a b. JSM (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CSS] -> JSM [DOMRef]
renderStyles [CSS]
styles
----------------------------------------------------------------------------
-- | Runs a miso application, but with a custom rendering engine.
-- The @MisoString@ specified here is the variable name of a globally-scoped
-- JS object that implements the context interface per 'ts/miso/context/dom.ts'
-- This is necessary for native support.
renderComponent
  :: Eq model
  => Maybe MisoString
  -- ^ Name of the JS object that contains the drawing context
  -> Component model action
  -- ^ Component application
  -> JSM [JSVal]
  -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
  -> JSM ()
renderComponent :: forall model action.
Eq model =>
Maybe MountPoint
-> Component model action -> JSM [DOMRef] -> JSM ()
renderComponent Maybe MountPoint
Nothing Component model action
vcomp JSM [DOMRef]
_ = Component model action -> JSM ()
forall model action. Eq model => App model action -> JSM ()
startComponent Component model action
vcomp
renderComponent (Just MountPoint
renderer) Component model action
vcomp JSM [DOMRef]
hooks = JSM (ComponentState model action) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (ComponentState model action) -> JSM ())
-> JSM (ComponentState model action) -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
  MountPoint -> JSM ()
FFI.setDrawingContext MountPoint
renderer
  Component model action
-> JSM [DOMRef] -> JSM (ComponentState model action)
forall model action.
Eq model =>
Component model action
-> JSM [DOMRef] -> JSM (ComponentState model action)
initComponent Component model action
vcomp JSM [DOMRef]
hooks
----------------------------------------------------------------------------
-- | Internal helper function to support both 'render' and 'startComponent'
initComponent
  :: Eq model
  => Component model action
  -- ^ Component application
  -> JSM [JSVal]
  -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
  -> JSM (ComponentState model action)
initComponent :: forall model action.
Eq model =>
Component model action
-> JSM [DOMRef] -> JSM (ComponentState model action)
initComponent vcomp :: Component model action
vcomp@Component{model
[JS]
[CSS]
[Sub action]
Maybe action
Maybe MountPoint
Events
LogLevel
model -> View action
action -> Effect model action
Mail -> Maybe action
mailbox :: forall model action. Component model action -> Mail -> Maybe action
logLevel :: forall model action. Component model action -> LogLevel
mountPoint :: forall model action. Component model action -> Maybe MountPoint
initialAction :: forall model action. Component model action -> Maybe action
scripts :: forall model action. Component model action -> [JS]
styles :: forall model action. Component model action -> [CSS]
events :: forall model action. Component model action -> Events
subs :: forall model action. Component model action -> [Sub action]
view :: forall model action. Component model action -> model -> View action
update :: forall model action.
Component model action -> action -> Effect model action
model :: forall model action. Component model action -> model
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Events
styles :: [CSS]
scripts :: [JS]
initialAction :: Maybe action
mountPoint :: Maybe MountPoint
logLevel :: LogLevel
mailbox :: Mail -> Maybe action
..} JSM [DOMRef]
hooks = do
  Component model action
-> (Sink action -> JSM ([DOMRef], DOMRef, IORef VTree))
-> JSM (ComponentState model action)
forall model action.
Eq model =>
Component model action
-> (Sink action -> JSM ([DOMRef], DOMRef, IORef VTree))
-> JSM (ComponentState model action)
initialize Component model action
vcomp ((Sink action -> JSM ([DOMRef], DOMRef, IORef VTree))
 -> JSM (ComponentState model action))
-> (Sink action -> JSM ([DOMRef], DOMRef, IORef VTree))
-> JSM (ComponentState model action)
forall a b. (a -> b) -> a -> b
$ \Sink action
snk -> do
    refs <- JSM [DOMRef]
hooks
    vtree <- runView Draw (view model) snk logLevel events
    mount_ <- mountElement (getMountPoint mountPoint)
    diff Nothing (Just vtree) mount_
    viewRef <- liftIO (newIORef vtree)
    pure (refs, mount_, viewRef)
-----------------------------------------------------------------------------
#ifdef PRODUCTION
#define MISO_JS_PATH "js/miso.prod.js"
#else
#define MISO_JS_PATH "js/miso.js"
#endif
-- | 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 WASM
  $(JSaddle.Wasm.TH.evalFile MISO_JS_PATH)
#else
  _ <- MountPoint -> JSM DOMRef
forall script. ToJSString script => script -> JSM DOMRef
eval ($(embedStringFile MISO_JS_PATH) :: MisoString)
#endif
#endif
  action
-----------------------------------------------------------------------------