-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE RankNTypes                 #-}
{-# 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 '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 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 ]
--   }
-- @
--
-- = The View type
--
-- @'View' context action@ is miso's virtual DOM tree. Its four constructors
-- map to the four node kinds the runtime handles:
--
-- * 'VNode' — a regular DOM element (@\<div\>@, @\<svg\>@, …)
-- * 'VText' — a text node
-- * 'VComp' — an embedded child 'Component'
-- * 'VFrag' — a keyless group of siblings (no wrapper element)
--
-- = 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@
--
-- = Fragment and keyed combinators
--
-- * 'fragment' / 'vfrag' — group siblings without a wrapper element
-- * 'fragment_' / 'vfrag_' — keyed fragment
-- * 'keyed' — attach a reconciliation key to any 'View'
--
-- = 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 (..)
  , View          (..)
  , Key           (..)
  , Attribute     (..)
  , Namespace     (..)
  , CSS           (..)
  , JS            (..)
  , LogLevel      (..)
  , VTree         (..)
  , VTreeType     (..)
  , Tag
  , CacheBust
  , MountPoint
  , DOMRef
  , Events
  , Phase         (..)
  , URI           (..)
  -- ** Classes
  , ToKey         (..)
  -- ** Smart Constructors
  , emptyURI
  , component
  , vcomp
  -- ** Component mounting
  , (+>)
  , mount_
  , mountUseContext
  , mountWithProps_
  , mountWithProps
  -- ** Key combinators
  , keyed
  -- ** Fragment combinators
  , fragment
  , fragment_
  , vfrag
  , vfrag_
  -- ** Utils
  , getMountPoint
  , optionalAttrs
  , optionalVoidAttrs
  , optionalChildren
  , prettyURI
  , prettyQueryString
  -- *** Combinators
  , node
  , vnode
  , text
  , vtext
  , text_
  , textRaw
  , textKey
  , textKey_
  , htmlEncode
  -- *** MisoString
  , MisoString
  , toMisoString
  , fromMisoString
  , ms
  ) where
-----------------------------------------------------------------------------
import qualified Data.Map.Strict as M
import           Data.Maybe (fromMaybe, isJust)
import           Data.String (IsString, fromString)
import qualified Data.Text as T
import           GHC.Generics
import           Prelude
-----------------------------------------------------------------------------
import           Miso.DSL
import           Miso.Effect (Effect, Sub, Sink, DOMRef, ComponentId)
import           Miso.Event.Types
import           Miso.JSON (Value, ToJSON(..), encode)
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
  { forall context props model action.
Component context props model action -> model
model :: model
  -- ^ Initial model
  , forall context props model action.
Component context props model action -> Maybe (IO 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 'getLocalStorage').
  , forall context props model action.
Component context props model action
-> action -> Effect context props model action
update :: action -> Effect context props model action
  -- ^ Updates model, optionally providing effects.
  , forall context props model action.
Component context props model action
-> context -> props -> model -> View context action
view :: context -> props -> model -> View context action
  -- ^ Draws 'View'. Receives the app-global @context@, the @props@ passed by the
  --   parent, and the current @model@.
  , forall context props model action.
Component context props model action -> Bool
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 'view' reads the @context@ and must
  --   refresh when it changes.
  --
  --   Defaults to 'False'.
  --
  -- @since 1.9.0.0
  , forall context props model action.
Component context props model action -> [Sub action]
subs :: [ Sub action ]
  -- ^ Subscriptions to run during application lifetime
  , forall context props model action.
Component context props model action -> [CSS]
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
  , forall context props model action.
Component context props model action -> [JS]
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
  , forall context props model action.
Component context props model action -> Maybe MisoString
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.
  , forall context props model action.
Component context props model action -> LogLevel
logLevel :: LogLevel
  -- ^ Debugging configuration for prerendering and event delegation
  , forall context props model action.
Component context props model action -> Value -> Maybe action
mailbox :: Value -> Maybe action
  -- ^ Receives mail from other components
  --
  -- @since 1.9.0.0
  , forall context props model action.
Component context props model action -> Bool
eventPropagation :: Bool
  -- ^ Should events bubble up past the t'Miso.Types.Component' barrier.
  --
  -- Defaults to t'False'
  --
  -- @since 1.9.0.0
  , forall context props model action.
Component context props model action -> Maybe action
mount :: Maybe action
  -- ^ action to execute during t'Miso.Types.Component' mount phase.
  --
  -- @since 1.9.0.0
  , forall context props model action.
Component context props model action -> Maybe action
unmount :: Maybe action
  -- ^ action to execute during t'Miso.Types.Component' unmount phase.
  --
  -- @since 1.9.0.0
  , forall context props model action.
Component context props model action
-> Maybe (props -> props -> action)
onPropsChanged :: Maybe (props -> props -> action)
  -- ^ action to execute when '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 (Int -> CSS -> ShowS
[CSS] -> ShowS
CSS -> String
(Int -> CSS -> ShowS)
-> (CSS -> String) -> ([CSS] -> ShowS) -> Show CSS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSS -> ShowS
showsPrec :: Int -> CSS -> ShowS
$cshow :: CSS -> String
show :: CSS -> String
$cshowList :: [CSS] -> ShowS
showList :: [CSS] -> ShowS
Show, CSS -> CSS -> Bool
(CSS -> CSS -> Bool) -> (CSS -> CSS -> Bool) -> Eq CSS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSS -> CSS -> Bool
== :: CSS -> CSS -> Bool
$c/= :: CSS -> CSS -> Bool
/= :: CSS -> CSS -> Bool
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 (Int -> JS -> ShowS
[JS] -> ShowS
JS -> String
(Int -> JS -> ShowS)
-> (JS -> String) -> ([JS] -> ShowS) -> Show JS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JS -> ShowS
showsPrec :: Int -> JS -> ShowS
$cshow :: JS -> String
show :: JS -> String
$cshowList :: [JS] -> ShowS
showList :: [JS] -> ShowS
Show, JS -> JS -> Bool
(JS -> JS -> Bool) -> (JS -> JS -> Bool) -> Eq JS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JS -> JS -> Bool
== :: JS -> JS -> Bool
$c/= :: JS -> JS -> Bool
/= :: JS -> JS -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Convenience for extracting mount point
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint = MisoString -> Maybe MisoString -> MisoString
forall a. a -> Maybe a -> a
fromMaybe MisoString
"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 action)
  -- ^ view
  -> Component context props model action
component :: forall model action context props.
model
-> (action -> Effect context props model action)
-> (context -> props -> model -> View context action)
-> Component context props model action
component model
m action -> Effect context props model action
u context -> props -> model -> View context action
v = Component
  { model :: model
model = model
m
  , hydrateModel :: Maybe (IO model)
hydrateModel = Maybe (IO model)
forall a. Maybe a
Nothing
  , update :: action -> Effect context props model action
update = action -> Effect context props model action
u
  , view :: context -> props -> model -> View context action
view = context -> props -> model -> View context action
v
  , useContext :: Bool
useContext = Bool
False
  , subs :: [Sub action]
subs = []
  , styles :: [CSS]
styles = []
  , scripts :: [JS]
scripts = []
  , mountPoint :: Maybe MisoString
mountPoint = Maybe MisoString
forall a. Maybe a
Nothing
  , logLevel :: LogLevel
logLevel = LogLevel
Off
  , mailbox :: Value -> Maybe action
mailbox = Maybe action -> Value -> Maybe action
forall a b. a -> b -> a
const Maybe action
forall a. Maybe a
Nothing
  , eventPropagation :: Bool
eventPropagation = Bool
False
  , mount :: Maybe action
mount = Maybe action
forall a. Maybe a
Nothing
  , unmount :: Maybe action
unmount = Maybe action
forall a. Maybe a
Nothing
  , onPropsChanged :: Maybe (props -> props -> action)
onPropsChanged = Maybe (props -> props -> action)
forall a. Maybe a
Nothing
  }
-----------------------------------------------------------------------------
-- | Synonym for 'component'
vcomp
  :: model
  -- ^ model
  -> (action -> Effect context props model action)
  -- ^ update
  -> (context -> props -> model -> View context action)
  -- ^ view
  -> Component context props model action
vcomp :: forall model action context props.
model
-> (action -> Effect context props model action)
-> (context -> props -> model -> View context action)
-> Component context props model action
vcomp = model
-> (action -> Effect context props model action)
-> (context -> props -> model -> View context action)
-> Component context props model action
forall model action context props.
model
-> (action -> Effect context props model action)
-> (context -> props -> model -> View context action)
-> Component context props model action
component
-----------------------------------------------------------------------------
-- | 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 (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Tag type, (e.g. 'div_', '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
-----------------------------------------------------------------------------
-- | Core type for constructing a virtual DOM in Haskell
data View context action
  = VNode Namespace Tag [Attribute action] [View context action]
  | VText (Maybe Key) MisoString
  | VComp (Maybe Key) (SomeComponent context)
  | VFrag (Maybe Key) [View context action]
  deriving (forall a b. (a -> b) -> View context a -> View context b)
-> (forall a b. a -> View context b -> View context a)
-> Functor (View context)
forall a b. a -> View context b -> View context a
forall a b. (a -> b) -> View context a -> View context b
forall context a b. a -> View context b -> View context a
forall context a b. (a -> b) -> View context a -> View context b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall context a b. (a -> b) -> View context a -> View context b
fmap :: forall a b. (a -> b) -> View context a -> View context b
$c<$ :: forall context a b. a -> View context b -> View context a
<$ :: forall a b. a -> View context b -> View context a
Functor
-----------------------------------------------------------------------------
-- | 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
   = forall model action props . (Eq context, Eq model, Eq props)
  => SomeComponent props (Component context props model action)
-----------------------------------------------------------------------------
-- | Like '+>' but operates on any 'View', not just 'Component'.
--
-- This appends a 'Key' to any 'View'.
--
-- @
-- keyed "key" ("some text" :: View context action)
-- keyed "key" $ div_ [ id_ "container" ] [ "content" ]
-- keyed "key" (mount_ calendarComponent)
-- @
--
-- @since 1.10.0.0
keyed
  :: MisoString
  -> View context action
  -> View context action
keyed :: forall context action.
MisoString -> View context action -> View context action
keyed MisoString
key = \case
    VText Maybe Key
_ MisoString
txt ->
      Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
key)) MisoString
txt
    VComp Maybe Key
_ SomeComponent context
comp ->
      Maybe Key -> SomeComponent context -> View context action
forall context action.
Maybe Key -> SomeComponent context -> View context action
VComp (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
key)) SomeComponent context
comp
    VFrag Maybe Key
_ [View context action]
kids ->
      Maybe Key -> [View context action] -> View context action
forall context action.
Maybe Key -> [View context action] -> View context action
VFrag (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
key)) [View context action]
kids
    VNode Namespace
ns MisoString
tag [Attribute action]
attrs [View context action]
kids ->
      Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall context action.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
VNode Namespace
ns MisoString
tag (MisoString -> Value -> Attribute action
forall action. MisoString -> Value -> Attribute action
Property MisoString
"key" (MisoString -> Value
forall a. ToJSON a => a -> Value
toJSON MisoString
key) Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs) [View context action]
kids
-----------------------------------------------------------------------------
-- | 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 action] -> View context action
vfrag :: forall context action. [View context action] -> View context action
vfrag = [View context action] -> View context action
forall context action. [View context action] -> View context action
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 action] -> View context action
fragment :: forall context action. [View context action] -> View context action
fragment = Maybe Key -> [View context action] -> View context action
forall context action.
Maybe Key -> [View context action] -> View context action
VFrag Maybe Key
forall a. Maybe a
Nothing
-----------------------------------------------------------------------------
-- | Like 'fragment', but keyed for efficient diffing.
--
-- @since 1.10.0.0
vfrag_ :: MisoString -> [View context action] -> View context action
vfrag_ :: forall context action.
MisoString -> [View context action] -> View context action
vfrag_ MisoString
key = Maybe Key -> [View context action] -> View context action
forall context action.
Maybe Key -> [View context action] -> View context action
VFrag (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
key))
-----------------------------------------------------------------------------
-- | Like 'fragment', but keyed for efficient diffing.
--
-- @since 1.10.0.0
fragment_ :: MisoString -> [View context action] -> View context action
fragment_ :: forall context action.
MisoString -> [View context action] -> View context action
fragment_ MisoString
key = Maybe Key -> [View context action] -> View context action
forall context action.
Maybe Key -> [View context action] -> View context action
VFrag (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
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) ]
-- @
--
-- @since 1.9.0.0
(+>)
  :: forall context model action a . (Eq context, Eq model)
  => MisoString
  -- ^ 'VComp' 'key_'
  -> Component context () model action
  -- ^ 'Component'
  -> View context a
infixr 0 +>
MisoString
key +> :: forall context model action a.
(Eq context, Eq model) =>
MisoString -> Component context () model action -> View context a
+> Component context () model action
comp = Maybe Key -> SomeComponent context -> View context a
forall context action.
Maybe Key -> SomeComponent context -> View context action
VComp (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
forall key. ToKey key => key -> Key
toKey MisoString
key)) (() -> Component context () model action -> SomeComponent context
forall context model action props.
(Eq context, Eq model, Eq props) =>
props
-> Component context props model action -> SomeComponent context
SomeComponent () Component context () model action
comp)
-----------------------------------------------------------------------------
-- | 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.
--
-- @
-- mountWithProps someProps $ component model noop $ \\m ->
--  div_ [ id_ "foo" ] [ text (ms m) ]
-- @
--
-- @since 1.11.0.0
mountWithProps
  :: (Eq context, Eq model, Eq props)
  => props
  -- ^ 'props' to use
  -> Component context props model action
  -- ^ 'Component' to mount
  -> View context a
mountWithProps :: forall context model props action a.
(Eq context, Eq model, Eq props) =>
props -> Component context props model action -> View context a
mountWithProps props
props Component context props model action
comp  = Maybe Key -> SomeComponent context -> View context a
forall context action.
Maybe Key -> SomeComponent context -> View context action
VComp Maybe Key
forall a. Maybe a
Nothing (props
-> Component context props model action -> SomeComponent context
forall context model action props.
(Eq context, Eq model, Eq props) =>
props
-> Component context props model action -> SomeComponent context
SomeComponent props
props Component context props model action
comp)
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' mounting combinator.
--
-- @
-- mountWithProps_ "key" someProps $ component model noop $ \\m ->
--  div_ [ id_ "foo" ] [ text (ms m) ]
-- @
--
-- @since 1.11.0.0
mountWithProps_
  :: (Eq context, Eq model, Eq props)
  => MisoString
  -- ^ 'key' to use
  -> props
  -- ^ 'props' to use
  -> Component context props model action
  -- ^ 'Component' to mount
  -> View context a
mountWithProps_ :: forall context model props action a.
(Eq context, Eq model, Eq props) =>
MisoString
-> props -> Component context props model action -> View context a
mountWithProps_ MisoString
key props
props Component context props model action
comp  = Maybe Key -> SomeComponent context -> View context a
forall context action.
Maybe Key -> SomeComponent context -> View context action
VComp (Key -> Maybe Key
forall a. a -> Maybe a
Just (MisoString -> Key
Key MisoString
key)) (props
-> Component context props model action -> SomeComponent context
forall context model action props.
(Eq context, Eq model, Eq props) =>
props
-> Component context props model action -> SomeComponent context
SomeComponent props
props Component context props model action
comp)
-----------------------------------------------------------------------------
-- | 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) ]
-- @
--
-- @since 1.9.0.0
mount_
  :: (Eq context, Eq model)
  => Component context () model action
  -- ^ 'Component' to mount
  -> View context a
mount_ :: forall context model action a.
(Eq context, Eq model) =>
Component context () model action -> View context a
mount_ Component context () model action
comp = Maybe Key -> SomeComponent context -> View context a
forall context action.
Maybe Key -> SomeComponent context -> View context action
VComp Maybe Key
forall a. Maybe a
Nothing (() -> Component context () model action -> SomeComponent context
forall context model action props.
(Eq context, Eq model, Eq props) =>
props
-> Component context props model action -> SomeComponent context
SomeComponent () Component context () model action
comp)
-----------------------------------------------------------------------------
-- | 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) ]
-- @
--
-- @since 1.9.0.0
mountUseContext
  :: (Eq context, Eq model)
  => Component context () model action
  -- ^ 'Component' to mount
  -> View context a
mountUseContext :: forall context model action a.
(Eq context, Eq model) =>
Component context () model action -> View context a
mountUseContext Component context () model action
comp = Component context () model action -> View context a
forall context model action a.
(Eq context, Eq model) =>
Component context () model action -> View context a
mount_ Component context () model action
comp { useContext = True }
-----------------------------------------------------------------------------
-- | DOM element namespace.
data Namespace
  = HTML
  -- ^ HTML Namespace
  | SVG
  -- ^ SVG Namespace
  | MATHML
  -- ^ MATHML Namespace
  deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq)
-----------------------------------------------------------------------------
instance ToJSVal Namespace where
  toJSVal :: Namespace -> IO JSVal
toJSVal = \case
    Namespace
SVG -> MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"svg" :: MisoString)
    Namespace
HTML -> MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"html" :: MisoString)
    Namespace
MATHML -> MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString
"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 (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, String -> Key
(String -> Key) -> IsString Key
forall a. (String -> a) -> IsString a
$cfromString :: String -> Key
fromString :: String -> Key
IsString, [Key] -> Value
Key -> Value
(Key -> Value) -> ([Key] -> Value) -> ToJSON Key
forall a. (a -> Value) -> ([a] -> Value) -> ToJSON a
$ctoJSON :: Key -> Value
toJSON :: Key -> Value
$ctoJSONList :: [Key] -> Value
toJSONList :: [Key] -> Value
ToJSON, Key -> MisoString
(Key -> MisoString) -> ToMisoString Key
forall str. (str -> MisoString) -> ToMisoString str
$ctoMisoString :: Key -> MisoString
toMisoString :: Key -> MisoString
ToMisoString)
-----------------------------------------------------------------------------
-- | ToJSVal instance for t'Key'
instance ToJSVal Key where
  toJSVal :: Key -> IO JSVal
toJSVal (Key MisoString
x) = MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
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 :: Key -> Key
toKey = Key -> Key
forall a. a -> a
id
-----------------------------------------------------------------------------
#ifndef VANILLA
-- | Convert 'MisoString' to t'Key'
instance ToKey MisoString where toKey = Key
#endif
-----------------------------------------------------------------------------
-- | Convert 'T.Text' to t'Key'
instance ToKey T.Text where toKey :: MisoString -> Key
toKey = MisoString -> Key
Key (MisoString -> Key)
-> (MisoString -> MisoString) -> MisoString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Convert 'String' to t'Key'
instance ToKey String where toKey :: String -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (String -> MisoString) -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Int' to t'Key'
instance ToKey Int where toKey :: Int -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (Int -> MisoString) -> Int -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Double' to t'Key'
instance ToKey Double where toKey :: Double -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (Double -> MisoString) -> Double -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Float' to t'Key'
instance ToKey Float where toKey :: Float -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (Float -> MisoString) -> Float -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Convert 'Word' to t'Key'
instance ToKey Word where toKey :: Word -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (Word -> MisoString) -> Word -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
-----------------------------------------------------------------------------
-- | Attribute of a vnode in a t'View'.
--
data Attribute action
  = Property MisoString Value
  | ClassList [MisoString]
  | On (Sink action -> VTree -> LogLevel -> Events -> IO ())
  -- ^ The @Sink@ callback can be used to dispatch actions which are fed back to
  -- the @update@ function. This is especially useful for event handlers
  -- like the @onclick@ attribute. The second argument represents the
  -- vnode the attribute is attached to.
  | Styles (M.Map MisoString MisoString)
  deriving (forall a b. (a -> b) -> Attribute a -> Attribute b)
-> (forall a b. a -> Attribute b -> Attribute a)
-> Functor Attribute
forall a b. a -> Attribute b -> Attribute a
forall a b. (a -> b) -> Attribute a -> Attribute b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Attribute a -> Attribute b
fmap :: forall a b. (a -> b) -> Attribute a -> Attribute b
$c<$ :: forall a b. a -> Attribute b -> Attribute a
<$ :: forall a b. a -> Attribute b -> Attribute a
Functor
-----------------------------------------------------------------------------
instance Eq (Attribute action) where
  Property MisoString
k1 Value
v1 == :: Attribute action -> Attribute action -> Bool
== Property MisoString
k2 Value
v2 = MisoString
k1 MisoString -> MisoString -> Bool
forall a. Eq a => a -> a -> Bool
== MisoString
k2 Bool -> Bool -> Bool
&& Value
v1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
v2
  ClassList [MisoString]
x == ClassList [MisoString]
y = [MisoString]
x [MisoString] -> [MisoString] -> Bool
forall a. Eq a => a -> a -> Bool
== [MisoString]
y
  Styles Map MisoString MisoString
x == Styles Map MisoString MisoString
y = Map MisoString MisoString
x Map MisoString MisoString -> Map MisoString MisoString -> Bool
forall a. Eq a => a -> a -> Bool
== Map MisoString MisoString
y
  Attribute action
_ == Attribute action
_ = Bool
False
-----------------------------------------------------------------------------
instance Show (Attribute action) where
  show :: Attribute action -> String
show = \case
    Property MisoString
key Value
value ->
      MisoString -> String
MS.unpack MisoString
key String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MisoString -> String
MS.unpack (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Value -> MisoString
forall a. ToJSON a => a -> MisoString
encode Value
value))
    ClassList [MisoString]
classes ->
      MisoString -> String
MS.unpack (MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
" " [MisoString]
classes)
    On Sink action -> VTree -> LogLevel -> Events -> IO ()
_ ->
      String
"<event-handler>"
    Styles Map MisoString MisoString
styles ->
      MisoString -> String
MS.unpack (MisoString -> String) -> MisoString -> String
forall a b. (a -> b) -> a -> b
$ [MisoString] -> MisoString
MS.concat
        [ MisoString
k MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
v MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
";"
        | (MisoString
k, MisoString
v) <- Map MisoString MisoString -> [(MisoString, MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString MisoString
styles
        ]
-----------------------------------------------------------------------------
-- | 'IsString' instance
instance IsString (View context action) where
  fromString :: String -> View context action
fromString = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText Maybe Key
forall a. Maybe a
Nothing (MisoString -> View context action)
-> (String -> MisoString) -> String -> View context action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
forall a. IsString a => String -> a
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
  { VTree -> Object
getTree :: Object
  -- ^ Underlying JavaScript object representing the virtual DOM tree
  } deriving newtype (VTree -> IO Object
(VTree -> IO Object) -> ToObject VTree
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: VTree -> IO Object
toObject :: VTree -> IO Object
ToObject, VTree -> IO JSVal
(VTree -> IO JSVal) -> ToJSVal VTree
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: VTree -> IO JSVal
toJSVal :: VTree -> IO JSVal
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 action]
  -- ^ Attributes, properties, and event handlers
  -> [View context action]
  -- ^ Child nodes
  -> View context action
node :: forall action context.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
node = Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall context action.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
VNode
-----------------------------------------------------------------------------
-- | 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 action]
  -- ^ Attributes, properties, and event handlers
  -> [View context action]
  -- ^ Child nodes
  -> View context action
vnode :: forall action context.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
vnode = Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall action context.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
node
-----------------------------------------------------------------------------
-- | Create a new v'VText' with the given content.
text :: MisoString -> View context action
#ifdef SSR
text = VText Nothing . htmlEncode
#else
text :: forall context action. MisoString -> View context action
text = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText Maybe Key
forall a. Maybe a
Nothing
#endif
-----------------------------------------------------------------------------
-- | Synonym for 'text'
vtext :: MisoString -> View context action
vtext :: forall context action. MisoString -> View context action
vtext = MisoString -> View context action
forall context action. MisoString -> View context action
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 action
textRaw :: forall context action. MisoString -> View context action
textRaw = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText Maybe Key
forall a. Maybe a
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=\"\">"
-- &lt;a href=&quot;&quot;&gt;
htmlEncode :: MisoString -> MisoString
htmlEncode :: MisoString -> MisoString
htmlEncode = (Char -> MisoString) -> MisoString -> MisoString
MS.concatMap ((Char -> MisoString) -> MisoString -> MisoString)
-> (Char -> MisoString) -> MisoString -> MisoString
forall a b. (a -> b) -> a -> b
$ \case
  Char
'<' -> MisoString
"&lt;"
  Char
'>' -> MisoString
"&gt;"
  Char
'&' -> MisoString
"&amp;"
  Char
'"' -> MisoString
"&quot;"
  Char
'\'' -> MisoString
"&#39;"
  Char
x -> Char -> MisoString
MS.singleton Char
x
-----------------------------------------------------------------------------
-- | Create a new v'VText' containing concatenation of the given strings.
--
-- @
--   view :: View context 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 action
text_ :: forall context action. [MisoString] -> View context action
text_ = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText Maybe Key
forall a. Maybe a
Nothing (MisoString -> View context action)
-> ([MisoString] -> MisoString)
-> [MisoString]
-> View context action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
" "
-----------------------------------------------------------------------------
-- | Like 'text', but allow the node to be keyed for efficient diffing.
--
-- @
-- view :: model -> View context action
-- view = \x -> div_ [] [ textKey (1 :: Int) "text here" ]
-- @
--
-- @since 1.9.0.0
textKey :: ToKey key => key -> MisoString -> View context action
textKey :: forall key context action.
ToKey key =>
key -> MisoString -> View context action
textKey key
k = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText (Key -> Maybe Key
forall a. a -> Maybe a
Just (key -> Key
forall key. ToKey key => key -> Key
toKey key
k))
-----------------------------------------------------------------------------
-- | Like 'text_', but allow the node to be keyed for efficient diffing.
--
-- @
-- view :: model -> View context action
-- view = \x -> div_ [] [ textKey_ (1 :: Int) [ "text", "goes", "here" ] ]
-- @
--
-- @since 1.9.0.0
textKey_ :: ToKey key => key -> [MisoString] -> View context action
textKey_ :: forall key context action.
ToKey key =>
key -> [MisoString] -> View context action
textKey_ key
k [MisoString]
xs = Maybe Key -> MisoString -> View context action
forall context action.
Maybe Key -> MisoString -> View context action
VText (Key -> Maybe Key
forall a. a -> Maybe a
Just (key -> Key
forall key. ToKey key => key -> Key
toKey key
k)) (MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
" " [MisoString]
xs)
-----------------------------------------------------------------------------
-- | Utility function to make it easy to specify conditional attributes
--
-- @
-- view :: Bool -> View context action
-- view danger = optionalAttrs div_ [ id_ "some-div" ] danger [ class_ "danger" ] ["child"]
-- @
--
-- @since 1.9.0.0
optionalAttrs
  :: ([Attribute action] -> [View context action] -> View context action)
  -> [Attribute action] -- ^ Attributes to be added unconditionally
  -> Bool -- ^ A condition
  -> [Attribute action] -- ^ Additional attributes to add if the condition is True
  -> [View context action] -- ^ Children
  -> View context action
optionalAttrs :: forall action context.
([Attribute action]
 -> [View context action] -> View context action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View context action]
-> View context action
optionalAttrs [Attribute action] -> [View context action] -> View context action
element [Attribute action]
attrs Bool
condition [Attribute action]
opts [View context action]
kids =
  case [Attribute action] -> [View context action] -> View context action
element [Attribute action]
attrs [View context action]
kids of
    VNode Namespace
ns MisoString
name [Attribute action]
_ [View context action]
_ -> do
      let newAttrs :: [Attribute action]
newAttrs = [[Attribute action]] -> [Attribute action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Attribute action]
opts | Bool
condition ] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. [a] -> [a] -> [a]
++ [Attribute action]
attrs
      Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall context action.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
VNode Namespace
ns MisoString
name [Attribute action]
newAttrs [View context action]
kids
    View context action
x -> View context action
x
-----------------------------------------------------------------------------
-- | Utility function to make it easy to specify conditional attributes for void elements.
--
-- @
-- view :: Bool -> View context action
-- view shouldClear = optionalVoidAttrs textarea_ [ value_ "" ] shouldClear [ id_ "text-area-id" ]
-- @
--
-- @since 1.9.0.0
optionalVoidAttrs
  :: ([Attribute action] -> View context action)
  -> [Attribute action] -- ^ Attributes to be added unconditionally
  -> Bool -- ^ A condition
  -> [Attribute action] -- ^ Additional attributes to add if the condition is True
  -> View context action
optionalVoidAttrs :: forall action context.
([Attribute action] -> View context action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> View context action
optionalVoidAttrs [Attribute action] -> View context action
element [Attribute action]
attrs Bool
condition [Attribute action]
opts =
  case [Attribute action] -> View context action
element [Attribute action]
attrs of
    VNode Namespace
ns MisoString
name [Attribute action]
_ [View context action]
kids -> do
      let newAttrs :: [Attribute action]
newAttrs = [[Attribute action]] -> [Attribute action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Attribute action]
opts | Bool
condition ] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. [a] -> [a] -> [a]
++ [Attribute action]
attrs
      Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall context action.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
VNode Namespace
ns MisoString
name [Attribute action]
newAttrs [View context action]
kids
    View context action
x -> View context action
x
----------------------------------------------------------------------------
-- | Conditionally adds children.
--
-- @
-- view :: Bool -> View context action
-- view withChild = optionalChildren div_ [ id_ "txt" ] [] withChild [ "foo" ]
-- @
--
-- @since 1.9.0.0
optionalChildren
  :: ([Attribute action] -> [View context action] -> View context action)
  -> [Attribute action] -- ^ Attributes to be added unconditionally
  -> [View context action] -- ^ Children to be added unconditionally
  -> Bool -- ^ A condition
  -> [View context action] -- ^ Additional children to add if the condition is True
  -> View context action
optionalChildren :: forall action context.
([Attribute action]
 -> [View context action] -> View context action)
-> [Attribute action]
-> [View context action]
-> Bool
-> [View context action]
-> View context action
optionalChildren [Attribute action] -> [View context action] -> View context action
element [Attribute action]
attrs [View context action]
kids Bool
condition [View context action]
opts =
  case [Attribute action] -> [View context action] -> View context action
element [Attribute action]
attrs [View context action]
kids of
    VNode Namespace
ns MisoString
name [Attribute action]
_ [View context action]
_ -> do
      let newKids :: [View context action]
newKids = [View context action]
kids [View context action]
-> [View context action] -> [View context action]
forall a. [a] -> [a] -> [a]
++ [[View context action]] -> [View context action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [View context action]
opts | Bool
condition ]
      Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
forall context action.
Namespace
-> MisoString
-> [Attribute action]
-> [View context action]
-> View context action
VNode Namespace
ns MisoString
name [Attribute action]
attrs [View context action]
newKids
    View context action
x -> View context action
x
----------------------------------------------------------------------------
-- | URI type. See the official [specification](https://www.rfc-editor.org/rfc/rfc3986)
--
data URI
  = URI
  { URI -> MisoString
uriPath :: MisoString
  -- ^ Path component, e.g. @\"users\/42\"@
  , URI -> MisoString
uriFragment :: MisoString
  -- ^ Fragment identifier (without the leading @#@), e.g. @\"section-1\"@
  , URI -> Map MisoString (Maybe MisoString)
uriQueryString :: M.Map MisoString (Maybe MisoString)
  -- ^ Query parameters. @'Just' v@ for @?key=v@ pairs; 'Nothing' for bare flags (@?flag@).
  } deriving stock (Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
(Int -> URI -> ShowS)
-> (URI -> String) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URI -> ShowS
showsPrec :: Int -> URI -> ShowS
$cshow :: URI -> String
show :: URI -> String
$cshowList :: [URI] -> ShowS
showList :: [URI] -> ShowS
Show, URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
/= :: URI -> URI -> Bool
Eq, (forall x. URI -> Rep URI x)
-> (forall x. Rep URI x -> URI) -> Generic URI
forall x. Rep URI x -> URI
forall x. URI -> Rep URI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. URI -> Rep URI x
from :: forall x. URI -> Rep URI x
$cto :: forall x. Rep URI x -> URI
to :: forall x. Rep URI x -> URI
Generic)
    deriving anyclass (URI -> IO JSVal
(URI -> IO JSVal) -> ToJSVal URI
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: URI -> IO JSVal
toJSVal :: URI -> IO JSVal
ToJSVal, URI -> IO Object
(URI -> IO Object) -> ToObject URI
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: URI -> IO Object
toObject :: URI -> IO Object
ToObject)
----------------------------------------------------------------------------
-- | Empty t'URI'.
emptyURI :: URI
emptyURI :: URI
emptyURI = MisoString
-> MisoString -> Map MisoString (Maybe MisoString) -> URI
URI MisoString
forall a. Monoid a => a
mempty MisoString
forall a. Monoid a => a
mempty Map MisoString (Maybe MisoString)
forall a. Monoid a => a
mempty
----------------------------------------------------------------------------
instance ToMisoString URI where
  toMisoString :: URI -> MisoString
toMisoString = URI -> MisoString
prettyURI
----------------------------------------------------------------------------
instance ToJSON URI where
  toJSON :: URI -> Value
toJSON = MisoString -> Value
forall a. ToJSON a => a -> Value
toJSON (MisoString -> Value) -> (URI -> MisoString) -> URI -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
----------------------------------------------------------------------------
-- | Pretty-prints a t'URI'.
prettyURI :: URI -> MisoString
prettyURI :: URI -> MisoString
prettyURI uri :: URI
uri@URI {Map MisoString (Maybe MisoString)
MisoString
uriPath :: URI -> MisoString
uriFragment :: URI -> MisoString
uriQueryString :: URI -> Map MisoString (Maybe MisoString)
uriPath :: MisoString
uriFragment :: MisoString
uriQueryString :: Map MisoString (Maybe MisoString)
..} = MisoString
"/" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
uriPath MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> URI -> MisoString
prettyQueryString URI
uri MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
uriFragment
-----------------------------------------------------------------------------
-- | Pretty-prints a t'URI' query string.
prettyQueryString :: URI -> MisoString
prettyQueryString :: URI -> MisoString
prettyQueryString URI {Map MisoString (Maybe MisoString)
MisoString
uriPath :: URI -> MisoString
uriFragment :: URI -> MisoString
uriQueryString :: URI -> Map MisoString (Maybe MisoString)
uriPath :: MisoString
uriFragment :: MisoString
uriQueryString :: Map MisoString (Maybe MisoString)
..} = MisoString
queries MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
flags
  where
    queries :: MisoString
queries =
      [MisoString] -> MisoString
MS.concat
      [ MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<>
        MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"&"
        [ MisoString
k MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
v
        | (MisoString
k, Just MisoString
v) <- Map MisoString (Maybe MisoString)
-> [(MisoString, Maybe MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString (Maybe MisoString)
uriQueryString
        ]
      | (Maybe MisoString -> Bool) -> [Maybe MisoString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe MisoString -> Bool
forall a. Maybe a -> Bool
isJust (Map MisoString (Maybe MisoString) -> [Maybe MisoString]
forall k a. Map k a -> [a]
M.elems Map MisoString (Maybe MisoString)
uriQueryString)
      ]
    flags :: MisoString
flags = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
        [ MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
k
        | (MisoString
k, Maybe MisoString
Nothing) <- Map MisoString (Maybe MisoString)
-> [(MisoString, Maybe MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString (Maybe MisoString)
uriQueryString
        ]
-----------------------------------------------------------------------------
-- | VTreeType ADT for matching TypeScript enum
data VTreeType
  = VCompType
  | VNodeType
  | VTextType
  | VFragType
  deriving (Int -> VTreeType -> ShowS
[VTreeType] -> ShowS
VTreeType -> String
(Int -> VTreeType -> ShowS)
-> (VTreeType -> String)
-> ([VTreeType] -> ShowS)
-> Show VTreeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VTreeType -> ShowS
showsPrec :: Int -> VTreeType -> ShowS
$cshow :: VTreeType -> String
show :: VTreeType -> String
$cshowList :: [VTreeType] -> ShowS
showList :: [VTreeType] -> ShowS
Show, VTreeType -> VTreeType -> Bool
(VTreeType -> VTreeType -> Bool)
-> (VTreeType -> VTreeType -> Bool) -> Eq VTreeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VTreeType -> VTreeType -> Bool
== :: VTreeType -> VTreeType -> Bool
$c/= :: VTreeType -> VTreeType -> Bool
/= :: VTreeType -> VTreeType -> Bool
Eq)
-----------------------------------------------------------------------------
instance ToJSVal VTreeType where
  toJSVal :: VTreeType -> IO JSVal
toJSVal = \case
    VTreeType
VCompType -> Int -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Int
0 :: Int)
    VTreeType
VNodeType -> Int -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Int
1 :: Int)
    VTreeType
VTextType -> Int -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Int
2 :: Int)
    VTreeType
VFragType -> Int -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Int
3 :: Int)
-----------------------------------------------------------------------------