-----------------------------------------------------------------------------
{-# 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
    -- ** Miso
    miso
  , (🍜)
    -- ** App
  , App
  , startApp
  , renderApp
    -- ** Component
  , Component
  , startComponent
  , component
  , (+>)
    -- ** Sink
  , withSink
  , Sink
    -- ** Mail
  , mail
  , checkMail
  , parent
  , mailParent
  , broadcast
    -- ** Subscriptions
  , startSub
  , stopSub
  , Sub
    -- ** Effect
  , issue
  , batch
  , io
  , io_
  , sync
  , sync_
  , for
    -- * Reactivity
    -- | Primitives for synchronizing parent and child models.
  , module Miso.Binding
    -- * Types
    -- | Core types for Miso applications.
  , module Miso.Types
    -- * Effect
    -- | 'Effect', 'Sub', and 'Sink' types for defining update functions and subscriptions.
  , module Miso.Effect
    -- * Event
    -- | Functions for specifying component lifecycle events and event handlers.
  , module Miso.Event
    -- * Property
    -- | Construct custom properties on DOM elements.
  , module Miso.Property
    -- * PubSub
    -- | Publish / Subscribe primitives for communication between components.
  , module Miso.PubSub
    -- * Run
    -- | Support for running and live-reloading of miso applications.
  , module Miso.Run
    -- * Subscriptions
    -- | Subscriptions for external events (mouse, keyboard, window, history, etc.).
  , module Miso.Subscription
    -- * Storage
    -- | Web Storage API (Local and Session storage) interface.
  , module Miso.Storage
    -- * Fetch
    -- | Interface to the Fetch API for making HTTP requests.
  , module Miso.Fetch
    -- * Util
    -- | Utility functions for views, parsing, and general purpose combinators.
  , module Miso.Util
    -- * FFI
    -- | Foreign Function Interface (FFI) utilities for interacting with JavaScript.
  , module Miso.FFI
    -- * State management
    -- | State management for Miso applications.
  , module Miso.State
  ) where
-----------------------------------------------------------------------------
import           Control.Monad (void)
#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.Binding
import           Miso.Diff
import           Miso.Effect
import           Miso.Event
import           Miso.Fetch
import           Miso.FFI
import qualified Miso.FFI.Internal as FFI
import           Miso.Runtime
import           Miso.Property
import           Miso.PubSub
import           Miso.Router
import           Miso.Run
import           Miso.State
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.
-- Always mounts to \<body\>. Copies page into the virtual DOM.
--
-- To get an IO action that starts the application, use 'run' on the result of this function.
--
-- @
-- main :: IO ()
-- main = run (miso (\\uri -> ..))
-- @
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 (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
  vcomp <- 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
  body <- FFI.getBody
  initialize Hydrate isRoot vcomp (pure body)
-----------------------------------------------------------------------------
-- | Synonym for 'startComponent'.
--
-- To get an IO action that starts the application, use 'run' on the result of this function.
--
-- @
-- main :: IO ()
-- main = run (startApp app)
-- @
startApp :: Eq model => App model action -> JSM ()
startApp :: forall model action. Eq model => App model action -> JSM ()
startApp = Component ROOT model action -> JSM ()
forall model action. Eq model => App model action -> JSM ()
startComponent
-----------------------------------------------------------------------------
-- | Alias for 'Miso.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
startComponent :: Eq model => Component ROOT model action -> JSM ()
startComponent :: forall model action. Eq model => App model action -> JSM ()
startComponent Component ROOT model action
vcomp = JSM (ComponentState model action) -> JSM ()
forall a. JSM a -> JSM ()
withJS (Component ROOT model action -> JSM (ComponentState model action)
forall parent model action.
(Eq parent, Eq model) =>
Component parent model action -> JSM (ComponentState model action)
initComponent Component ROOT model action
vcomp)
----------------------------------------------------------------------------
-- | 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.
--
-- To get an IO action that starts the application, use 'run' on the result of this function.
--
-- @
-- main :: IO ()
-- main = run (renderApp "my-context" app)
-- @
renderApp
  :: Eq model
  => MisoString
  -- ^ Name of the JS object that contains the drawing context
  -> App model action
  -- ^ Component application
  -> JSM ()
renderApp :: forall model action.
Eq model =>
MisoString -> App model action -> JSM ()
renderApp MisoString
renderer App model action
vcomp =
  JSM (ComponentState model action) -> JSM ()
forall a. JSM a -> JSM ()
withJS (MisoString -> JSM ()
FFI.setDrawingContext MisoString
renderer JSM ()
-> JSM (ComponentState model action)
-> JSM (ComponentState model action)
forall a b. JSM a -> JSM b -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> App model action -> JSM (ComponentState model action)
forall parent model action.
(Eq parent, Eq model) =>
Component parent model action -> JSM (ComponentState model action)
initComponent App model action
vcomp)
----------------------------------------------------------------------------
-- | Top-level t'Miso.Types.Component' initialization helper for 'renderApp' and 'startComponent'.
initComponent
  :: (Eq parent, Eq model)
  => Component parent model action
  -> JSM (ComponentState model action)
initComponent :: forall parent model action.
(Eq parent, Eq model) =>
Component parent model action -> JSM (ComponentState model action)
initComponent vcomp :: Component parent model action
vcomp@Component {model
Bool
[Binding parent model]
[JS]
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Maybe (JSM model)
Events
LogLevel
model -> View model action
action -> Effect parent model action
Mail -> Maybe action
model :: model
hydrateModel :: Maybe (JSM model)
update :: action -> Effect parent model action
view :: model -> View model action
subs :: [Sub action]
events :: Events
styles :: [CSS]
scripts :: [JS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Mail -> Maybe action
bindings :: [Binding parent model]
eventPropagation :: Bool
eventPropagation :: forall parent model action. Component parent model action -> Bool
bindings :: forall parent model action.
Component parent model action -> [Binding parent model]
mailbox :: forall parent model action.
Component parent model action -> Mail -> Maybe action
logLevel :: forall parent model action.
Component parent model action -> LogLevel
mountPoint :: forall parent model action.
Component parent model action -> Maybe MisoString
initialAction :: forall parent model action.
Component parent model action -> Maybe action
scripts :: forall parent model action. Component parent model action -> [JS]
styles :: forall parent model action. Component parent model action -> [CSS]
events :: forall parent model action. Component parent model action -> Events
subs :: forall parent model action.
Component parent model action -> [Sub action]
view :: forall parent model action.
Component parent model action -> model -> View model action
update :: forall parent model action.
Component parent model action
-> action -> Effect parent model action
hydrateModel :: forall parent model action.
Component parent model action -> Maybe (JSM model)
model :: forall parent model action. Component parent model action -> model
..} = do
  mount <- MisoString -> JSM JSVal
mountElement (Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
mountPoint)
  initialize Draw isRoot vcomp (pure mount)
----------------------------------------------------------------------------
isRoot :: Bool
isRoot :: Bool
isRoot = Bool
True
----------------------------------------------------------------------------
#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
  _ <- MisoString -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile MISO_JS_PATH) :: MisoString)
#endif
#endif
  action
-----------------------------------------------------------------------------