miso-1.13.0.0: src/Miso/Types.hs
-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -Wno-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Miso.Types
-- Copyright : (C) 2016-2026 David M. Johnson
-- License : BSD3-style (see the file LICENSE)
-- Maintainer : David M. Johnson <code@dmj.io>
-- Stability : experimental
-- Portability : non-portable
--
-- = Overview
--
-- "Miso.Types" defines every core type that miso applications are built
-- from. It is re-exported in its entirety by "Miso", so most application
-- code never needs to import it directly.
--
-- = The Component record
--
-- @'Component' context props model action@ is the central record type. It
-- wires together the MVU loop and all supporting runtime configuration:
--
-- @
-- data t'Component' context props model action = Component
-- { model :: model
-- , hydrateModel :: Maybe (IO model)
-- , update :: action -> 'Miso.Effect.Effect' context props model action
-- , view :: context -> props -> model -> 'View' context model action
-- , useContext :: Bool
-- , subs :: ['Miso.Effect.Sub' action]
-- , styles :: ['CSS']
-- , scripts :: ['JS']
-- , mountPoint :: Maybe 'MountPoint'
-- , logLevel :: 'LogLevel'
-- , mailbox :: Value -> Maybe action
-- , eventPropagation :: Bool
-- , mount :: Maybe action
-- , unmount :: Maybe action
-- , onPropsChanged :: Maybe (props -> props -> action)
-- }
-- @
--
-- Use the 'component' smart constructor to build one with sane defaults,
-- then override only the fields you need:
--
-- @
-- myApp :: 'App' Model Action
-- myApp = ('component' initialModel update view)
-- { 'subs' = [ mySub ]
-- , 'styles' = [ 'Href' \"style.css\" (False :: 'CacheBust') ]
-- }
-- @
--
-- = The View type
--
-- @'View' context model action@ is miso's virtual DOM tree. Its five
-- constructors map to the five node kinds the runtime handles:
--
-- * 'VNode' — a regular DOM element (@\<div\>@, @\<svg\>@, …)
-- * 'VText' — a text node
-- * @VComp@ — an embedded child t'Component'
-- * @VCompStatic@ — an embedded child t'Component' behind a 'GHC.StaticPtr.StaticPtr',
-- so it can cross the Lynx dual-thread boundary (see 'vcomp' \/ 'mountStatic')
-- * 'VFrag' — a group of siblings with no wrapper element, optionally keyed
--
-- = Key types at a glance
--
-- ['Component'] full MVU application\/component record
-- ['App'] alias for @'Component' () () model action@
-- ['View'] virtual DOM node
-- ['Attribute'] DOM property, class list, event handler, or style
-- ['Namespace'] @HTML@ \| @SVG@ \| @MATHML@
-- ['Key'] reconciliation hint for list diffing
-- ['CSS'] stylesheet reference (@Href@, @Style@, @Sheet@)
-- ['JS'] script reference (@Src@, @Script@, @Module@, …)
-- ['LogLevel'] debug verbosity (@Off@, @DebugHydrate@, …)
-- ['URI'] parsed URL (path + query string + fragment)
--
-- = Text combinators
--
-- * 'text' — create a text node (HTML-escaped in SSR mode)
-- * 'textRaw' — create a text node without HTML escaping
-- * 'text_' — concatenate a list of strings with a space separator
-- * 'textKey' / 'textKey_' — keyed variants for efficient list diffing
-- * 'htmlEncode' — manually escape @< > & \" \'@
--
-- = Component mounting
--
-- * @\"key\" '+>' comp@ — mount a child component with a key
-- * 'mount_' — mount without a key (unsafe in dynamic lists)
-- * 'mountWithProps' / 'mountWithProps_' — mount with explicit @props@
-- * 'mountUseContext' — mount without a key, subscribed to @context@ updates
-- * 'vcomp' / 'vcomp_' (with 'mountStatic' \/ 'mountStaticWithProps') —
-- static-key mounting; the compile-time
-- 'GHC.StaticPtr.StaticKey' already provides identity, so unlike the
-- non-static combinators there is no keyed variant
--
-- __Under the Lynx dual-thread (@NATIVE@) backend, always use 'vcomp' \/
-- 'vcomp_' — never '+>' \/ 'mount_' \/ 'mountWithProps' \/ 'mountWithProps_' \/
-- 'mountUseContext'.__ The non-static combinators build a component with no
-- 'GHC.StaticPtr.StaticKey'; anything mounted with them /after/ the initial
-- frame (e.g. inside a list or behind a conditional) never registers a
-- main-thread mirror on the MTS, which silently drops every @OnStatic@
-- (main-thread) event handler inside that subtree for the component's whole
-- lifetime. This is invisible outside of a console error — there is no type
-- error and no runtime crash. GHC emits a warning at every use site of the
-- non-static combinators when built with @NATIVE@ as a reminder.
--
-- = Fragment combinators
--
-- * 'fragment' / 'vfrag' — group siblings without a wrapper element
-- * 'fragment_' / 'vfrag_' — keyed fragment
--
-- = Conditional view utilities
--
-- * 'optionalAttrs' — add attributes conditionally
-- * 'optionalVoidAttrs' — same for void (no-children) elements
-- * 'optionalChildren' — add children conditionally
--
-- = See also
--
-- * "Miso.Effect" — 'Miso.Effect.Effect', 'Miso.Effect.Sub', 'Miso.Effect.Sink'
-- * "Miso.Html.Element" — element smart constructors built on 'node'
-- * "Miso.Html.Property" — attribute constructors built on 'Attribute'
-- * "Miso.Html.Render" — SSR serialisation via 'Miso.Html.Render.ToHtml'
-- * "Miso.Router" — 'Miso.Router.URI' parsing and pretty-printing
----------------------------------------------------------------------------
module Miso.Types
( -- ** Types
App
, Component (..)
, ComponentId
, SomeComponent (..)
, SomeStaticComponent (..)
, EventHandler (..)
, View (..)
, Key (..)
, Attribute (..)
, Namespace (..)
, CSS (..)
, JS (..)
, LogLevel (..)
, VTree (..)
, VTreeType (..)
, Hydrate (..)
, Tag
, DirectEvents
, CacheBust
, MountPoint
, DOMRef
, Events
, Phase (..)
, URI (..)
-- ** Classes
, ToKey (..)
-- ** Smart Constructors
, emptyURI
, component
-- ** Event handler smart constructor
, event
-- ** Component mounting
, vcomp
, vcomp_
, (+>)
, mount_
, mountUseContext
, mountWithProps_
, mountWithProps
, mountStatic
, mountStaticWithProps
-- ** Fragment combinators
, fragment
, fragment_
, vfrag
, vfrag_
-- ** Utils
, getMountPoint
, optionalAttrs
, optionalVoidAttrs
, optionalChildren
, prettyURI
, prettyQueryString
-- *** Combinators
, node
, nodeDirectEvents
, vnode
, text
, vtext
, text_
, textRaw
, textKey
, textKey_
, htmlEncode
-- *** MisoString
, MisoString
, toMisoString
, fromMisoString
, ms
) where
-----------------------------------------------------------------------------
import Data.Function
import qualified Data.Map.Strict as M
import Data.Set (Set)
import qualified Data.Set as S
import Data.Maybe (fromMaybe, isJust)
import Data.String (IsString, fromString)
import qualified Data.Text as T
import GHC.Generics
import GHC.StaticPtr
import Prelude
-----------------------------------------------------------------------------
import Miso.DSL
import Miso.Effect (Effect, Sub, Sink, DOMRef, ComponentId)
import Miso.Event.Types
import qualified Miso.Event.Decoder
import Miso.JSON (Value, ToJSON(..), encode)
#ifdef NATIVE
import Miso.JSON (FromJSON(..))
#endif
import qualified Miso.String as MS
import Miso.String (ToMisoString, MisoString, toMisoString, ms, fromMisoString)
import Miso.CSS.Types (StyleSheet)
-----------------------------------------------------------------------------
-- | Application entry point
data Component context props model action
= Component
{ model :: model
-- ^ Initial model
, hydrateModel :: Maybe (IO model)
-- ^ Optional 'IO' to load component @model@ state, such as reading data from page.
-- The resulting @model@ is only used during initial hydration, not on remounts.
--
-- __Note:__ only synchronous 'IO' should be used here (e.g. reading from
-- @localStorage@ via 'Miso.Storage.getLocalStorage').
, update :: action -> Effect context props model action
-- ^ Updates model, optionally providing effects.
, view :: context -> props -> model -> View context model action
-- ^ Draws 'View'. Receives the app-global @context@, the @props@ passed by the
-- parent, and the current @model@.
, useContext :: Bool
-- ^ Whether this t'Miso.Types.Component' should be re-rendered when the
-- app-global @context@ changes (see 'Miso.Effect.modifyContext').
--
-- This controls whether a component __reacts__ to context changes, not
-- whether it may __change__ the context. A component may call
-- 'Miso.Effect.modifyContext' \/ 'Miso.Effect.putContext' with
-- @useContext = False@; it simply won't re-render in response. Enable it on
-- the (usually nested) components whose 'Miso.Lens.view' reads the @context@ and must
-- refresh when it changes.
--
-- Defaults to @False@.
--
-- @since 1.9.0.0
, subs :: [ Sub model action ]
-- ^ Subscriptions to run during application lifetime
, styles :: [CSS]
-- ^ CSS styles expressed as either a URL ('Href') or as 'Style' text.
-- These styles are appended dynamically to the \<head\> section of your HTML page
-- before the initial draw on \<body\> occurs.
--
-- __Note:__ This field should only be used in development mode.
--
-- @since 1.9.0.0
, scripts :: [JS]
-- ^ JavaScript scripts expressed as either a URL ('Src') or raw JS text.
-- These scripts are appended dynamically to the \<head\> section of your HTML page
-- before the initial draw on \<body\> occurs.
--
-- __Note:__ This field should only be used in development mode.
--
-- @since 1.9.0.0
, mountPoint :: Maybe MountPoint
-- ^ ID of the root element for DOM diff.
-- If 'Nothing' is provided, the entire document body is used as a mount point.
, logLevel :: LogLevel
-- ^ Debugging configuration for prerendering and event delegation
, mailbox :: Value -> Maybe action
-- ^ Receives mail from other components
--
-- @since 1.9.0.0
, eventPropagation :: Bool
-- ^ Should events bubble up past the t'Miso.Types.Component' barrier.
--
-- Defaults to @False@
--
-- @since 1.9.0.0
, mount :: Maybe action
-- ^ action to execute during t'Miso.Types.Component' mount phase.
--
-- @since 1.9.0.0
, unmount :: Maybe action
-- ^ action to execute during t'Miso.Types.Component' unmount phase.
--
-- @since 1.9.0.0
, onPropsChanged :: Maybe (props -> props -> action)
-- ^ action to execute when t'Component' @props@ have changed (a.k.a. @props@ phase).
-- Receives previous @props@ and current @props@ as arguments.
--
-- @since 1.11.0.0
}
-----------------------------------------------------------------------------
-- | @mountPoint@ for t'Miso.Types.Component', e.g "body"
type MountPoint = MisoString
-----------------------------------------------------------------------------
-- | Allow users to express 'CSS' and append it to \<head\> before the first draw
--
-- > 'Href' "http://domain.com/style.css" ('True' :: 'CacheBust')
-- > 'Style' "body { background-color: red; }"
--
data CSS
= Href MisoString CacheBust
-- ^ @URL@ linking to hosted 'CSS'
| Style MisoString
-- ^ Raw 'CSS' content in a 'Miso.Html.Element.style_' tag
| Sheet StyleSheet
-- ^ 'CSS' built with "Miso.CSS"
deriving (Show, Eq)
-----------------------------------------------------------------------------
-- | Parameter used to indicate cache busting logic should be used.
-- If 'True' this will append a timestamp to the query. This will force cache
-- invalidation on the browser, causing a fetch of the resources.
--
type CacheBust = Bool
-----------------------------------------------------------------------------
-- | Allow users to express JS and append it to \<head\> before the first draw
--
-- This is meant to be useful in development only.
--
-- @
-- 'Src' \"http:\/\/example.com\/script.js\" (@False@ :: 'CacheBust')
-- 'Script' "alert(\"hi\");"
-- 'ImportMap' [ "key" @=:@ "value" ]
-- 'Module' "console.log(\"hi\");"
-- @
--
-- @since 1.9.0.0
data JS
= Src MisoString CacheBust
-- ^ URL linking to hosted JS
| Script MisoString
-- ^ Raw JS content that you would enter in a \<script\> tag
| Module MisoString
-- ^ Raw JS module content that you would enter in a \<script type="module"\> tag.
-- See [script type](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/script/type)
| ImportMap [(MisoString,MisoString)]
-- ^ Import map content in a \<script type="importmap"\> tag.
-- See [importmap](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/script/type/importmap)
deriving (Show, Eq)
-----------------------------------------------------------------------------
-- | Convenience for extracting mount point
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint = fromMaybe "body"
-----------------------------------------------------------------------------
-- | Smart constructor for t'Miso.Types.Component' with sane defaults.
component
:: model
-- ^ model
-> (action -> Effect context props model action)
-- ^ update
-> (context -> props -> model -> View context model action)
-- ^ view
-> Component context props model action
component m u v = Component
{ model = m
, hydrateModel = Nothing
, update = u
, view = v
, useContext = False
, subs = []
, styles = []
, scripts = []
, mountPoint = Nothing
, logLevel = Off
, mailbox = const Nothing
, eventPropagation = False
, mount = Nothing
, unmount = Nothing
, onPropsChanged = Nothing
}
-----------------------------------------------------------------------------
-- | A miso application is a top-level t'Miso.Types.Component'. Its app-global
-- @context@ defaults to @()@ (see 'Miso.startAppWithContext' to supply a
-- non-trivial context), and its @props@ are fixed to @()@.
--
type App model action = Component () () model action
-----------------------------------------------------------------------------
-- | Logging configuration for debugging Miso internals (useful to see if prerendering is successful)
data LogLevel
= Off
-- ^ No debug logging, the default value used in 'component'
| DebugHydrate
-- ^ Will warn if the structure or properties of the
-- DOM vs. Virtual DOM differ during prerendering.
| DebugEvents
-- ^ Will warn if an event cannot be routed to the Haskell event
-- handler that raised it. Also will warn if an event handler is
-- being used, yet it's not being listened for by the event
-- delegator mount point.
| DebugAll
-- ^ Logs on all of the above
deriving (Show, Eq)
-----------------------------------------------------------------------------
-- | Tag type, (e.g. 'Miso.Html.Element.div_', 'Miso.Html.Element.p_')
--
-- Meant to indicate the type of element being created.
-- Used as the first argument to @document.createElement@ for the web backend.
--
type Tag = MisoString
-----------------------------------------------------------------------------
-- | The set of events an element dispatches /directly/ on itself rather than
-- by bubbling to the delegated mount listener. Empty for HTML\/SVG\/MathML;
-- populated for Lynx native elements (see 'nodeDirectEvents').
--
-- @since 1.13.0.0
type DirectEvents = Set MisoString
-----------------------------------------------------------------------------
-- | Core type for constructing a virtual DOM in Haskell
data View context model action
= VNode Namespace Tag [Attribute model action] [View context model action] DirectEvents
-- ^ The final 'Set' names the events this element dispatches /directly/ on
-- itself rather than by bubbling to the delegated mount listener (Lynx
-- native @input@\/@scroll@\/… events). Empty for all HTML\/SVG\/MathML
-- elements. See 'nodeDirectEvents'.
| VText (Maybe Key) MisoString
| VComp (SomeComponent context)
| forall props . VCompStatic (StaticPtr (SomeStaticComponent props context)) props
-- ^ An embedded child t'Component'. The 'StaticPtr' holds only the closed
-- @props -> component@ constructor ('SomeStaticComponent'); the @props@ value — often
-- derived from the parent's @model@ — rides alongside and crosses the
-- dual-thread (Lynx) boundary as JSON. The no-props case uses @props ~ ()@
-- (see 'mountStatic'). This split is what lets a mount escape @static@\'s
-- closedness restriction. See 'vcomp'. This is necessary for lynx dual-thread
-- in order to transfer context, props, event handlers etc.
| VFrag (Maybe Key) [View context model action]
-----------------------------------------------------------------------------
-- | Existential wrapper allowing nesting of t'Miso.Types.Component' in t'Miso.Types.Component'.
--
-- The @context@ type parameter is shared with the enclosing 'View', so every
-- nested t'Miso.Types.Component' participates in the same app-global context.
data SomeComponent context
#ifdef NATIVE
= forall model action props . (FromJSON model, ToJSON model, FromJSON action, ToJSON action, FromJSON props, ToJSON props, Eq context, Eq model, Eq props)
#else
= forall model action props . (Eq context, Eq model, Eq props)
#endif
=> SomeComponent (Maybe Key) props (Component context props model action)
-----------------------------------------------------------------------------
-- | A closed @props -> component@ constructor, bundled with the serialization
-- dictionaries needed to move @props@ across the dual-thread (Lynx) boundary.
--
-- Unlike t'SomeComponent', the @props@ type parameter is /preserved/ (not
-- existential). This lets @vcompWith@ statically require the runtime @props@
-- value to match the constructor, while the packed 'FromJSON' \/ 'ToJSON'
-- dictionaries are recovered on the MTS after 'unsafeLookupStaticPtr' derefs
-- the 'StaticPtr' — so the MTS can decode the wire @props@ at exactly this
-- type and rebuild the t'SomeComponent'.
--
-- Built with 'mount_' \/ 'mountWithProps' \/ '(+>)'; consumed by 'vcomp'.
--
-- @since 1.13.0.0
data SomeStaticComponent props context
#ifdef NATIVE
= (Eq props, FromJSON props, ToJSON props)
=> SomeStaticComponent (props -> SomeComponent context)
#else
= Eq props
=> SomeStaticComponent (props -> SomeComponent context)
#endif
-----------------------------------------------------------------------------
-- | Create a fragment (keyless).
--
-- A fragment groups multiple sibling 'View' nodes without introducing
-- an extra DOM element.
--
-- Synonym for `fragment'
--
-- @since 1.10.0.0
vfrag :: [View context model action] -> View context model action
vfrag = fragment
-----------------------------------------------------------------------------
-- | Create a fragment (keyless).
--
-- A fragment groups multiple sibling 'View' nodes without introducing
-- an extra DOM element.
--
-- @since 1.10.0.0
fragment :: [View context model action] -> View context model action
fragment = VFrag Nothing
-----------------------------------------------------------------------------
-- | Like 'fragment', but keyed for efficient diffing.
--
-- @since 1.10.0.0
vfrag_ :: MisoString -> [View context model action] -> View context model action
vfrag_ key = VFrag (Just (Key key))
-----------------------------------------------------------------------------
-- | Like 'fragment', but keyed for efficient diffing.
--
-- @since 1.10.0.0
fragment_ :: MisoString -> [View context model action] -> View context model action
fragment_ key = VFrag (Just (Key key))
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator
--
-- Used in the @view@ function to mount a t'Miso.Types.Component' on any 'VNode'.
--
-- @
-- "component-id" +> component model noop $ \\m ->
-- div_ [ id_ "foo" ] [ text (ms m) ]
-- @
--
-- __Warning (Lynx dual-thread \/ @NATIVE@):__ this builds a @VComp@ with no
-- 'GHC.StaticPtr.StaticKey'. A component mounted this way as part of the
-- /initial/ frame is fine (the MTS independently reconstructs it while
-- painting its own first frame). But if it is mounted /later/ — e.g. inside
-- a list or behind a conditional, appearing only after the first frame — the
-- MTS has no other way to learn of it, so it never registers a mirror
-- t'Miso.Types.ComponentState' for it, and any main-thread (@OnStatic@)
-- event handler inside that subtree silently fails to dispatch for the
-- component's whole lifetime, with only a console error as a clue. Use
-- 'vcomp' with 'mountStaticWithProps' instead for anything that may mount
-- after the initial frame under @NATIVE@ — the compile-time
-- 'GHC.StaticPtr.StaticKey' already supplies the identity a manual key would,
-- no explicit key needed.
--
-- @since 1.9.0.0
(+>)
:: forall context childModel childAction model action .
#ifdef NATIVE
(Eq context, Eq childModel, FromJSON childModel, ToJSON childModel, FromJSON childAction, ToJSON childAction)
#else
(Eq context, Eq childModel)
#endif
=> MisoString
-- ^ @VComp@ @key_@
-> Component context () childModel childAction
-- ^ t'Component'
-> View context model action
infixr 0 +>
#ifdef NATIVE
{-# WARNING (+>) "[NATIVE] '+>' has no StaticKey; a component mounted with it after the initial frame silently drops OnStatic handlers inside it. Use 'vcomp' with 'mountStaticWithProps' instead." #-}
#endif
key +> child = VComp (SomeComponent (Just (toKey key)) () child)
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator.
--
-- Note: only use this if you're certain you won't be diffing two t'Miso.Types.Component'
-- against each other. Otherwise, you will need a key to distinguish between
-- the two t'Miso.Types.Component', to ensure unmounting and mounting occurs.
--
-- It takes only the @component@ and yields a closed @props -> component@
-- constructor ('SomeStaticComponent') suitable for @static@ — the @props@ value
-- is /not/ supplied here, but later at the 'vcomp' site, so a parent can pass
-- runtime @props@ (e.g. derived from its own @model@) without an explicit lambda:
--
-- Static mounting automatically provides the @key_@ at compile time (via 'GHC.StaticPtr.staticKey').
-- So the user doesn't need to use the '+>' combinators.
--
-- @
-- vcomp (model ^. field) (static (mountStaticWithProps child))
-- @
--
-- @since 1.13.0.0
mountStaticWithProps
#ifdef NATIVE
:: (Eq context, Eq props, Eq model, FromJSON model, ToJSON model, FromJSON action, ToJSON action, FromJSON props, ToJSON props)
#else
:: (Eq context, Eq props, Eq model)
#endif
=> Component context props model action
-- ^ t'Component' to mount
-> SomeStaticComponent props context
mountStaticWithProps child = SomeStaticComponent (\props -> SomeComponent Nothing props child)
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator, with @props@ supplied directly.
--
-- __Warning (Lynx dual-thread \/ @NATIVE@):__ see the note on '(+>)' — this
-- also builds an unkeyed @VComp@ with no 'GHC.StaticPtr.StaticKey', so the
-- same caveat applies: components mounted with this /after/ the initial
-- frame never get a main-thread mirror registered, silently breaking
-- @OnStatic@ handlers inside them. Use 'vcomp' with 'mountStaticWithProps'
-- instead for anything that may mount dynamically under @NATIVE@.
mountWithProps
:: forall context props childModel childAction model action .
#ifdef NATIVE
(Eq context, Eq props, Eq childModel, FromJSON childModel, ToJSON childModel, FromJSON childAction, ToJSON childAction, FromJSON props, ToJSON props)
#else
(Eq context, Eq props, Eq childModel)
#endif
=> props
-> Component context props childModel childAction
-- ^ t'Component' to mount
-> View context model action
#ifdef NATIVE
{-# WARNING mountWithProps "[NATIVE] 'mountWithProps' has no StaticKey; a component mounted with it after the initial frame silently drops OnStatic handlers inside it. Use 'vcomp' with 'mountStaticWithProps' instead." #-}
#endif
mountWithProps props comp = VComp (SomeComponent Nothing props comp)
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator, keyed, with @props@ supplied directly.
--
-- __Warning (Lynx dual-thread \/ @NATIVE@):__ see the note on '(+>)' — this
-- also builds a @VComp@ with no 'GHC.StaticPtr.StaticKey' (the key here is
-- just the diffing t'Key', unrelated), so the same caveat applies: mounted
-- /after/ the initial frame, it never gets a main-thread mirror registered,
-- silently breaking @OnStatic@ handlers inside it. Use 'vcomp' with
-- 'mountStaticWithProps' instead for anything that may mount dynamically
-- under @NATIVE@ — the compile-time 'GHC.StaticPtr.StaticKey' already
-- supplies the identity a manual key would, no explicit key needed.
mountWithProps_
:: forall context props childModel childAction model action .
#ifdef NATIVE
(Eq context, Eq props, Eq childModel, FromJSON childAction, FromJSON childModel, ToJSON childModel, ToJSON childAction, FromJSON props, ToJSON props)
#else
(Eq context, Eq childModel, Eq props)
#endif
=> MisoString
-> props
-> Component context props childModel childAction
-- ^ t'Component' to mount
-> View context model action
#ifdef NATIVE
{-# WARNING mountWithProps_ "[NATIVE] 'mountWithProps_' has no StaticKey; a component mounted with it after the initial frame silently drops OnStatic handlers inside it. Use 'vcomp' with 'mountStaticWithProps' instead." #-}
#endif
mountWithProps_ key props child = VComp (SomeComponent (Just (Key key)) props child)
-----------------------------------------------------------------------------
-- | Static t'Miso.Types.Component' mounting combinator, for a component
-- that takes no @props@.
--
-- Produces a @'SomeStaticComponent' () context@ to be wrapped in @static@ and
-- turned into a 'View' by 'vcomp_'. Unlike 'mount_', no key is needed: the
-- compile-time 'GHC.StaticPtr.StaticKey' already supplies identity, so this is
-- safe to diff against another t'Miso.Types.Component'.
--
-- To opt the child into app-global @context@ updates, set the field directly:
-- @mountStatic comp { useContext = True }@.
--
-- @
-- div_ [] [ vcomp_ (static (mountStatic myComp)) ]
-- @
--
-- @since 1.13.0.0
mountStatic
#ifdef NATIVE
:: (Eq context, Eq model, FromJSON model, ToJSON model, FromJSON action, ToJSON action)
#else
:: (Eq context, Eq model)
#endif
=> Component context () model action
-- ^ t'Component' to mount
-> SomeStaticComponent () context
mountStatic child = SomeStaticComponent (const (SomeComponent Nothing () child))
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator.
--
-- Note: only use this if you're certain you won't be diffing two t'Miso.Types.Component'
-- against each other. Otherwise, you will need a key to distinguish between
-- the two t'Miso.Types.Component', to ensure unmounting and mounting occurs.
--
-- @
-- mount_ $ component model noop $ \\m ->
-- div_ [ id_ "foo" ] [ text (ms m) ]
-- @
--
-- __Warning (Lynx dual-thread \/ @NATIVE@):__ see the note on '(+>)' — this
-- also builds a @VComp@ with no 'GHC.StaticPtr.StaticKey', so the same
-- caveat applies: mounted /after/ the initial frame, it never gets a
-- main-thread mirror registered, silently breaking @OnStatic@ handlers
-- inside it. Use 'vcomp_' with 'mountStatic' instead for anything that may
-- mount dynamically under @NATIVE@.
--
-- @since 1.9.0.0
mount_
:: forall context childModel childAction model action .
#ifdef NATIVE
(Eq context, Eq childModel, FromJSON childModel, ToJSON childModel, FromJSON childAction, ToJSON childAction)
#else
(Eq context, Eq childModel)
#endif
=> Component context () childModel childAction
-- ^ t'Component' to mount
-> View context model action
#ifdef NATIVE
{-# WARNING mount_ "[NATIVE] 'mount_' has no StaticKey; a component mounted with it after the initial frame silently drops OnStatic handlers inside it. Use 'vcomp_' with 'mountStatic' instead." #-}
#endif
mount_ comp = VComp (SomeComponent Nothing () comp)
-----------------------------------------------------------------------------
-- | Embed a child t'Component' as a 'View'.
--
-- Smart constructor for @VComp@, mirroring 'vnode' \/ 'vtext' \/ 'vfrag'.
--
-- The 'StaticPtr' wraps only the closed @props -> component@ constructor (built
-- with 'mountStatic' or 'mountStaticWithProps'); it must use the @static@ keyword
-- and refer to a closed, top-level binding. The @props@ value is supplied
-- /separately/ — so it may depend on the parent's @model@ — and is serialized
-- across the dual-thread boundary. The no-props case passes @()@.
--
-- No class constraints appear here: the serialization dictionaries are
-- discharged at the @static (mount_ child)@ site and recovered on the MTS from
-- the @Props@.
--
-- @
-- div_ [] [ vcomp_ (static (mountStatic myComp)) ]
-- @
--
-- @since 1.12.0.0
vcomp
:: props
-> StaticPtr (SomeStaticComponent props context)
-> View context model action
vcomp = flip VCompStatic
-----------------------------------------------------------------------------
-- | Like 'vcomp', but for a t'Miso.Types.Component' that takes no @props@.
--
-- @'vcomp_' = 'vcomp' ()@ — pair it with 'mountStatic', which produces a
-- @'SomeStaticComponent' () context@.
--
-- @
-- div_ [] [ vcomp_ (static (mountStatic myComp)) ]
-- @
--
-- @since 1.13.0.0
vcomp_
:: StaticPtr (SomeStaticComponent () context)
-> View context model action
vcomp_ = vcomp ()
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator that opts the child into
-- app-global React-style @context@ updates.
--
-- Equivalent to 'mount_', but sets @useContext = True@ on the mounted
-- t'Miso.Types.Component' so it re-renders whenever the @context@ changes
-- (see 'Miso.Effect.modifyContext'). Like 'mount_', this is unkeyed and so
-- unsafe when diffing two t'Miso.Types.Component' against each other.
--
-- @
-- mountUseContext $ component model noop $ \\ctx m ->
-- div_ [ id_ "foo" ] [ text (ms m) ]
-- @
--
-- __Warning (Lynx dual-thread \/ @NATIVE@):__ see the note on 'mount_' —
-- this also builds a @VComp@ with no 'GHC.StaticPtr.StaticKey', so the same
-- caveat applies: mounted /after/ the initial frame, it never gets a
-- main-thread mirror registered, silently breaking @OnStatic@ handlers
-- inside it. Use @'vcomp_' (static ('mountStatic' comp { useContext = True }))@
-- instead under @NATIVE@.
--
-- @since 1.13.0.0
mountUseContext
:: forall context childModel childAction model action .
#ifdef NATIVE
(Eq context, Eq childModel, FromJSON childModel, ToJSON childModel, FromJSON childAction, ToJSON childAction)
#else
(Eq context, Eq childModel)
#endif
=> Component context () childModel childAction
-- ^ t'Component' to mount
-> View context model action
#ifdef NATIVE
{-# WARNING mountUseContext "[NATIVE] 'mountUseContext' has no StaticKey; a component mounted with it after the initial frame silently drops OnStatic handlers inside it. Use 'vcomp_' with 'mountStatic' on a component with useContext = True instead." #-}
#endif
mountUseContext comp = VComp (SomeComponent Nothing () comp { useContext = True })
-----------------------------------------------------------------------------
-- | DOM element namespace.
data Namespace
= HTML
-- ^ HTML Namespace
| SVG
-- ^ SVG Namespace
| MATHML
-- ^ MATHML Namespace
deriving (Show, Eq)
-----------------------------------------------------------------------------
instance ToJSVal Namespace where
toJSVal = \case
SVG -> toJSVal ("svg" :: MisoString)
HTML -> toJSVal ("html" :: MisoString)
MATHML -> toJSVal ("mathml" :: MisoString)
-----------------------------------------------------------------------------
-- | Unique key for a DOM node.
--
-- This key is only used to speed up diffing the children of a DOM
-- node, the actual content is not important. The keys of the children
-- of a given DOM node must be unique. Failure to satisfy this
-- invariant gives undefined behavior at runtime.
newtype Key = Key MisoString
deriving newtype (Show, Eq, IsString, ToJSON, ToMisoString)
-----------------------------------------------------------------------------
-- | ToJSVal instance for t'Key'
instance ToJSVal Key where
toJSVal (Key x) = toJSVal x
-----------------------------------------------------------------------------
-- | Convert custom key types to t'Key'.
--
-- Instances of this class do not have to guarantee uniqueness of the
-- generated keys, it is up to the user to do so. @toKey@ must be an
-- injective function (different inputs must map to different outputs).
class ToKey key where
-- | Converts any key into t'Key'
toKey :: key -> Key
-----------------------------------------------------------------------------
-- | Identity instance
instance ToKey Key where toKey = id
-----------------------------------------------------------------------------
#if !defined(VANILLA) && !defined(MISO_TEXT)
-- | Convert 'MisoString' to t'Key'
instance ToKey MisoString where toKey = Key
#endif
-----------------------------------------------------------------------------
-- | Convert 'T.Text' to t'Key'
instance ToKey T.Text where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Convert 'String' to t'Key'
instance ToKey String where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Int' to t'Key'
instance ToKey Int where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Double' to t'Key'
instance ToKey Double where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Float' to t'Key'
instance ToKey Float where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Word' to t'Key'
instance ToKey Word where toKey = Key . toMisoString
-----------------------------------------------------------------------------
-- | Wrapper for event handler callbacks, used for cross-thread communication.
--
-- Carries two independent things built from the same @(decoder, convert)@
-- pair:
--
-- * 'eventHandlerInstall' — attaches a real JS listener to a live vnode.
-- Used by the runtime's attribute diffing, on both threads.
-- * 'eventHandlerDecoder' \/ 'eventHandlerConvert' — the decode step exposed
-- directly, with no JS installer round-trip. Used by the MTS's
-- @dispatchMainThreadEvent@ to decode + dispatch a main-thread event
-- synchronously, without reconstructing (and discarding) a JS callback via
-- a throwaway scratch node on every single event.
--
-- @since 1.13.0.0
data EventHandler model action = forall result. EventHandler
{ eventHandlerInstall :: model -> Sink action -> VTree -> LogLevel -> Events -> IO ()
, eventHandlerDecoder :: Miso.Event.Decoder.Decoder result
, eventHandlerConvert :: result -> model -> DOMRef -> action
}
-----------------------------------------------------------------------------
-- | Embed a fully-applied @static@ event handler.
--
-- The handler is baked into the 'StaticPtr', so the main thread can rebuild it
-- from the 'StaticKey' alone (no payload to forward). Use this for handlers that
-- take no injected @model@ data — including decoder handlers whose argument is a
-- function (e.g. @onScroll HandleScroll@).
--
-- @
-- button_ [ event (static (onClick AddOne)) ]
-- div_ [ event (static (onScroll HandleScroll)) ]
-- @
--
-- @since 1.13.0.0
event :: StaticPtr (EventHandler model action) -> Attribute model action
event = OnStatic
-----------------------------------------------------------------------------
-- | Attribute of a vnode in a t'View'.
--
data Attribute model action
= Property MisoString Value
| ClassList [MisoString]
| On (model -> Sink action -> VTree -> LogLevel -> Events -> IO ())
-- ^ A fully-applied @static@ event handler; the main thread rebuilds it from
-- the 'StaticKey' alone. See 'event'.
| OnStatic (StaticPtr (EventHandler model action))
-- ^ A @static@ handler /constructor/ plus a runtime @payload@ (often @model@
-- data) supplied separately and JSON-shipped across the dual-thread boundary,
-- so the handler can reach the main thread with runtime data. The @action@
-- stays outside the existential; only @payload@ is hidden. Handler-identity
-- diffing is by 'StaticKey' (JS-side, @ts\/miso\/dom.ts@). See @eventWith@.
| Styles (M.Map MisoString MisoString)
-----------------------------------------------------------------------------
instance Eq (Attribute model action) where
Property k1 v1 == Property k2 v2 = k1 == k2 && v1 == v2
ClassList x == ClassList y = x == y
Styles x == Styles y = x == y
-- Compare by handler identity ('StaticKey') only. Payload diffing is a JS
-- concern (@ts\/miso\/dom.ts@) over the stashed value.
OnStatic ptr1 == OnStatic ptr2 = on (==) staticKey ptr1 ptr2
_ == _ = False
-----------------------------------------------------------------------------
instance Show (Attribute model action) where
show = \case
Property key value ->
MS.unpack key <> "=" <> MS.unpack (ms (encode value))
ClassList classes ->
MS.unpack (MS.intercalate " " classes)
On _ ->
"<event-handler>"
OnStatic ptr ->
"<event-handler-with: " <> show (staticKey ptr) <> ">"
Styles styles ->
MS.unpack $ MS.concat
[ k <> "=" <> v <> ";"
| (k, v) <- M.toList styles
]
-----------------------------------------------------------------------------
-- | 'IsString' instance
instance IsString (View context model action) where
fromString = VText Nothing . fromString
-----------------------------------------------------------------------------
-- | Virtual DOM implemented as a JavaScript t'Object'.
-- Used for diffing, patching and event delegation.
-- Not meant to be constructed directly, see t'Miso.Types.View' instead.
newtype VTree = VTree
{ getTree :: Object
-- ^ Underlying JavaScript object representing the virtual DOM tree
} deriving newtype (ToObject, ToJSVal)
-----------------------------------------------------------------------------
-- | Create a new 'Miso.Types.VNode'.
--
-- @node ns tag attrs children@ creates a new node with tag @tag@
-- in the namespace @ns@. All @attrs@ are called when
-- the node is created and its children are initialized to @children@.
node
:: Namespace
-- ^ Element namespace (@HTML@, @SVG@, or @MATHML@)
-> MisoString
-- ^ Tag name (e.g. @\"div\"@, @\"circle\"@)
-> [Attribute model action]
-- ^ Attributes, properties, and event handlers
-> [View context model action]
-- ^ Child nodes
-> View context model action
node ns tag attrs kids = VNode ns tag attrs kids mempty
-----------------------------------------------------------------------------
-- | Like 'node', but declares the set of events this element dispatches
-- /directly/ on itself instead of by bubbling to the delegated mount listener.
--
-- Only relevant to the Lynx native runtime, where component-emitted events
-- (@input@, @scroll@, @load@, …) do not bubble and must be bound on the
-- element. The set is a /capability/: a listener is bound only for events the
-- element actually handles. Empty on the browser\/WASM runtime.
--
-- @since 1.13.0.0
nodeDirectEvents
:: Namespace
-- ^ Element namespace (@HTML@, @SVG@, or @MATHML@)
-> MisoString
-- ^ Tag name (e.g. @\"input\"@, @\"scroll-view\"@)
-> [Attribute model action]
-- ^ Attributes, properties, and event handlers
-> [MisoString]
-- ^ Events dispatched directly on this element
-> [View context model action]
-- ^ Child nodes
-> View context model action
nodeDirectEvents ns tag attrs direct kids = VNode ns tag attrs kids (S.fromList direct)
-----------------------------------------------------------------------------
-- | Create a new 'Miso.Types.VNode'.
--
-- Synonym for 'node'
--
vnode
:: Namespace
-- ^ Element namespace (@HTML@, @SVG@, or @MATHML@)
-> MisoString
-- ^ Tag name (e.g. @\"div\"@, @\"circle\"@)
-> [Attribute model action]
-- ^ Attributes, properties, and event handlers
-> [View context model action]
-- ^ Child nodes
-> View context model action
vnode = node
-----------------------------------------------------------------------------
-- | Create a new v'VText' with the given content.
text :: MisoString -> View context model action
#ifdef SSR
text = VText Nothing . htmlEncode
#else
text = VText Nothing
#endif
-----------------------------------------------------------------------------
-- | Synonym for 'text'
vtext :: MisoString -> View context model action
vtext = text
----------------------------------------------------------------------------
-- | Create a new v'VText', not subject to HTML escaping.
--
-- Like 'text', except will not escape HTML when used on the server.
--
textRaw :: MisoString -> View context model action
textRaw = VText Nothing
----------------------------------------------------------------------------
-- |
-- HTML-encodes text.
--
-- Useful for escaping HTML when delivering on the server. Naive usage
-- of 'text' will ensure this as well.
--
-- >>> Data.Text.IO.putStrLn $ text "<a href=\"\">"
-- <a href="">
htmlEncode :: MisoString -> MisoString
htmlEncode = MS.concatMap $ \case
'<' -> "<"
'>' -> ">"
'&' -> "&"
'"' -> """
'\'' -> "'"
x -> MS.singleton x
-----------------------------------------------------------------------------
-- | Create a new v'VText' containing concatenation of the given strings.
--
-- @
-- view :: View context model action
-- view = div_
-- [ className "container" ]
-- [ text_
-- [ "foo"
-- , "bar"
-- ]
-- ]
-- @
--
-- Renders as @<div class="container">foo bar</div>@
--
-- A single additional space is added between elements.
--
text_ :: [MisoString] -> View context model action
text_ = VText Nothing . MS.intercalate " "
-----------------------------------------------------------------------------
-- | Like 'text', but allow the node to be keyed for efficient diffing.
--
-- @
-- view :: model -> View context model action
-- view = \x -> div_ [] [ textKey (1 :: Int) "text here" ]
-- @
--
-- @since 1.9.0.0
textKey :: ToKey key => key -> MisoString -> View context model action
textKey k = VText (Just (toKey k))
-----------------------------------------------------------------------------
-- | Like 'text_', but allow the node to be keyed for efficient diffing.
--
-- @
-- view :: model -> View context model action
-- view = \x -> div_ [] [ textKey_ (1 :: Int) [ "text", "goes", "here" ] ]
-- @
--
-- @since 1.9.0.0
textKey_ :: ToKey key => key -> [MisoString] -> View context model action
textKey_ k xs = VText (Just (toKey k)) (MS.intercalate " " xs)
-----------------------------------------------------------------------------
-- | Utility function to make it easy to specify conditional attributes
--
-- @
-- view :: Bool -> View context model action
-- view danger = optionalAttrs div_ [ id_ "some-div" ] danger [ class_ "danger" ] ["child"]
-- @
--
-- @since 1.9.0.0
optionalAttrs
:: ([Attribute model action] -> [View context model action] -> View context model action)
-> [Attribute model action] -- ^ Attributes to be added unconditionally
-> Bool -- ^ A condition
-> [Attribute model action] -- ^ Additional attributes to add if the condition is True
-> [View context model action] -- ^ Children
-> View context model action
optionalAttrs element attrs condition opts kids =
case element attrs kids of
VNode ns name _ _ de -> do
let newAttrs = concat [ opts | condition ] ++ attrs
VNode ns name newAttrs kids de
x -> x
-----------------------------------------------------------------------------
-- | Utility function to make it easy to specify conditional attributes for void elements.
--
-- @
-- view :: Bool -> View context model action
-- view shouldClear = optionalVoidAttrs textarea_ [ value_ "" ] shouldClear [ id_ "text-area-id" ]
-- @
--
-- @since 1.9.0.0
optionalVoidAttrs
:: ([Attribute model action] -> View context model action)
-> [Attribute model action] -- ^ Attributes to be added unconditionally
-> Bool -- ^ A condition
-> [Attribute model action] -- ^ Additional attributes to add if the condition is True
-> View context model action
optionalVoidAttrs element attrs condition opts =
case element attrs of
VNode ns name _ kids de -> do
let newAttrs = concat [ opts | condition ] ++ attrs
VNode ns name newAttrs kids de
x -> x
----------------------------------------------------------------------------
-- | Conditionally adds children.
--
-- @
-- view :: Bool -> View context model action
-- view withChild = optionalChildren div_ [ id_ "txt" ] [] withChild [ "foo" ]
-- @
--
-- @since 1.9.0.0
optionalChildren
:: ([Attribute model action] -> [View context model action] -> View context model action)
-> [Attribute model action] -- ^ Attributes to be added unconditionally
-> [View context model action] -- ^ Children to be added unconditionally
-> Bool -- ^ A condition
-> [View context model action] -- ^ Additional children to add if the condition is True
-> View context model action
optionalChildren element attrs kids condition opts =
case element attrs kids of
VNode ns name _ _ de -> do
let newKids = kids ++ concat [ opts | condition ]
VNode ns name attrs newKids de
x -> x
----------------------------------------------------------------------------
-- | URI type. See the official [specification](https://www.rfc-editor.org/rfc/rfc3986)
--
data URI
= URI
{ uriPath :: MisoString
-- ^ Path component, e.g. @\"users\/42\"@
, uriFragment :: MisoString
-- ^ Fragment identifier (without the leading @#@), e.g. @\"section-1\"@
, uriQueryString :: M.Map MisoString (Maybe MisoString)
-- ^ Query parameters. @'Just' v@ for @?key=v@ pairs; 'Nothing' for bare flags (@?flag@).
} deriving stock (Show, Eq, Generic)
deriving anyclass (ToJSVal, ToObject)
----------------------------------------------------------------------------
-- | Empty t'URI'.
emptyURI :: URI
emptyURI = URI mempty mempty mempty
----------------------------------------------------------------------------
instance ToMisoString URI where
toMisoString = prettyURI
----------------------------------------------------------------------------
instance ToJSON URI where
toJSON = toJSON . toMisoString
----------------------------------------------------------------------------
-- | Pretty-prints a t'URI'.
prettyURI :: URI -> MisoString
prettyURI uri@URI {..} = "/" <> uriPath <> prettyQueryString uri <> uriFragment
-----------------------------------------------------------------------------
-- | Pretty-prints a t'URI' query string.
prettyQueryString :: URI -> MisoString
prettyQueryString URI {..} = queries <> flags
where
queries =
MS.concat
[ "?" <>
MS.intercalate "&"
[ k <> "=" <> v
| (k, Just v) <- M.toList uriQueryString
]
| any isJust (M.elems uriQueryString)
]
flags = mconcat
[ "?" <> k
| (k, Nothing) <- M.toList uriQueryString
]
-----------------------------------------------------------------------------
-- | VTreeType ADT for matching TypeScript enum
data VTreeType
= VCompType
| VNodeType
| VTextType
| VFragType
deriving (Show, Eq)
-----------------------------------------------------------------------------
instance ToJSVal VTreeType where
toJSVal = \case
VCompType -> toJSVal (0 :: Int)
VNodeType -> toJSVal (1 :: Int)
VTextType -> toJSVal (2 :: Int)
VFragType -> toJSVal (3 :: Int)
-----------------------------------------------------------------------------
-- | Hydrate avoids calling @diff@, and instead calls @hydrate@
-- 'Draw' invokes the virtual-DOM diff
data Hydrate
= Draw
| Hydrate
deriving (Show, Eq)
-----------------------------------------------------------------------------