{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
module Miso.Types
(
App
, Component (..)
, ComponentId
, SomeComponent (..)
, View (..)
, Key (..)
, Attribute (..)
, NS (..)
, CSS (..)
, JS (..)
, LogLevel (..)
, VTree (..)
, MountPoint
, DOMRef
, ROOT
, Transition
, JSM
, ToView (..)
, ToKey (..)
, Binding (..)
, component
, (-->)
, (<--)
, (<-->)
, (<--->)
, (--->)
, (<---)
, mount
, (+>)
, getMountPoint
, optionalAttrs
, optionalChildren
, node
, text
, text_
, textRaw
, rawHtml
, MisoString
, toMisoString
, fromMisoString
, ms
) where
import Data.Aeson (Value, ToJSON)
import Data.Coerce (coerce)
import Data.JSString (JSString)
import Data.Kind (Type)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import qualified Data.Text as T
import Language.Javascript.JSaddle (ToJSVal(toJSVal), Object(..), JSM)
import Prelude
import Miso.Binding ((<--), (-->), (<-->), (<---), (--->), (<--->), Binding(..))
import Miso.Concurrent (Mail)
import Miso.Effect (Effect, Sub, Sink, DOMRef, ComponentId)
import Miso.Event.Types
import qualified Miso.String as MS
import Miso.String (ToMisoString, MisoString, toMisoString, ms, fromMisoString)
import Miso.CSS.Types (StyleSheet)
data Component parent model action
= Component
{ forall parent model action. Component parent model action -> model
model :: model
, forall parent model action.
Component parent model action
-> action -> Effect parent model action
update :: action -> Effect parent model action
, forall parent model action.
Component parent model action -> model -> View model action
view :: model -> View model action
, forall parent model action.
Component parent model action -> [Sub action]
subs :: [ Sub action ]
, forall parent model action. Component parent model action -> Events
events :: Events
, forall parent model action. Component parent model action -> [CSS]
styles :: [CSS]
, forall parent model action. Component parent model action -> [JS]
scripts :: [JS]
, forall parent model action.
Component parent model action -> Maybe action
initialAction :: Maybe action
, forall parent model action.
Component parent model action -> Maybe MisoString
mountPoint :: Maybe MountPoint
, forall parent model action.
Component parent model action -> LogLevel
logLevel :: LogLevel
, forall parent model action.
Component parent model action -> Mail -> Maybe action
mailbox :: Mail -> Maybe action
, forall parent model action.
Component parent model action -> [Binding parent model]
bindings :: [ Binding parent model ]
}
type MountPoint = MisoString
data CSS
= Href MisoString
| Style MisoString
| Sheet StyleSheet
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)
data JS
= Src MisoString
| Script MisoString
| ImportMap [(MisoString,MisoString)]
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)
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint = MisoString -> Maybe MisoString -> MisoString
forall a. a -> Maybe a -> a
fromMaybe MisoString
"body"
component
:: model
-> (action -> Effect parent model action)
-> (model -> View model action)
-> Component parent model action
component :: forall model action parent.
model
-> (action -> Effect parent model action)
-> (model -> View model action)
-> Component parent model action
component model
m action -> Effect parent model action
u model -> View model action
v = Component
{ model :: model
model = model
m
, update :: action -> Effect parent model action
update = action -> Effect parent model action
u
, view :: model -> View model action
view = model -> View model action
v
, subs :: [Sub action]
subs = []
, events :: Events
events = Events
defaultEvents
, styles :: [CSS]
styles = []
, scripts :: [JS]
scripts = []
, mountPoint :: Maybe MisoString
mountPoint = Maybe MisoString
forall a. Maybe a
Nothing
, logLevel :: LogLevel
logLevel = LogLevel
Off
, initialAction :: Maybe action
initialAction = Maybe action
forall a. Maybe a
Nothing
, mailbox :: Mail -> Maybe action
mailbox = Maybe action -> Mail -> Maybe action
forall a b. a -> b -> a
const Maybe action
forall a. Maybe a
Nothing
, bindings :: [Binding parent model]
bindings = []
}
data ROOT
type App model action = Component ROOT model action
type Transition model action = Effect ROOT model action
data LogLevel
= Off
| DebugHydrate
| DebugEvents
| DebugAll
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)
data View model action
= VNode NS MisoString [Attribute action] [View model action]
| VText MisoString
| MisoString
| VComp NS MisoString [Attribute action] (SomeComponent model)
deriving (forall a b. (a -> b) -> View model a -> View model b)
-> (forall a b. a -> View model b -> View model a)
-> Functor (View model)
forall a b. a -> View model b -> View model a
forall a b. (a -> b) -> View model a -> View model b
forall model a b. a -> View model b -> View model a
forall model a b. (a -> b) -> View model a -> View model b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall model a b. (a -> b) -> View model a -> View model b
fmap :: forall a b. (a -> b) -> View model a -> View model b
$c<$ :: forall model a b. a -> View model b -> View model a
<$ :: forall a b. a -> View model b -> View model a
Functor
data SomeComponent parent
= forall model action . Eq model
=> SomeComponent (Component parent model action)
mount
:: forall child model action a . Eq child
=> ([View model a] -> View model a)
-> Component model child action
-> View model a
mount :: forall child model action a.
Eq child =>
([View model a] -> View model a)
-> Component model child action -> View model a
mount [View model a] -> View model a
mkNode Component model child action
vcomp =
case [View model a] -> View model a
mkNode [] of
VNode NS
ns MisoString
tag [Attribute a]
attrs [View model a]
_ ->
NS
-> MisoString
-> [Attribute a]
-> SomeComponent model
-> View model a
forall model action.
NS
-> MisoString
-> [Attribute action]
-> SomeComponent model
-> View model action
VComp NS
ns MisoString
tag [Attribute a]
attrs
(Component model child action -> SomeComponent model
forall parent model action.
Eq model =>
Component parent model action -> SomeComponent parent
SomeComponent Component model child action
vcomp)
VComp NS
ns MisoString
tag [Attribute a]
attrs SomeComponent model
vcomp_ ->
NS
-> MisoString
-> [Attribute a]
-> SomeComponent model
-> View model a
forall model action.
NS
-> MisoString
-> [Attribute action]
-> SomeComponent model
-> View model action
VComp NS
ns MisoString
tag [Attribute a]
attrs SomeComponent model
vcomp_
View model a
_ ->
String -> View model a
forall a. HasCallStack => String -> a
error String
"Impossible: cannot mount on a Text node"
(+>)
:: forall child model action a . Eq child
=> ([View model a] -> View model a)
-> Component model child action
-> View model a
infixr 0 +>
+> :: forall child model action a.
Eq child =>
([View model a] -> View model a)
-> Component model child action -> View model a
(+>) = ([View model a] -> View model a)
-> Component model child action -> View model a
forall child model action a.
Eq child =>
([View model a] -> View model a)
-> Component model child action -> View model a
mount
class ToView m a where
type ToViewAction m a :: Type
toView :: a -> View m (ToViewAction m a)
instance ToView model (View model action) where
type ToViewAction model (View model action) = action
toView :: View model action
-> View model (ToViewAction model (View model action))
toView = View model action -> View model action
View model action
-> View model (ToViewAction model (View model action))
forall a b. Coercible a b => a -> b
coerce
instance ToView model (Component parent model action) where
type ToViewAction model (Component parent model action) = action
toView :: Component parent model action
-> View model (ToViewAction model (Component parent model action))
toView Component {model
[Binding parent model]
[JS]
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Events
LogLevel
model -> View model action
action -> Effect parent model action
Mail -> Maybe action
model :: forall parent model action. Component parent model action -> model
update :: forall parent model action.
Component parent model action
-> action -> Effect parent model action
view :: forall parent model action.
Component parent model action -> model -> View model action
subs :: forall parent model action.
Component parent model action -> [Sub action]
events :: forall parent model action. Component parent model action -> Events
styles :: forall parent model action. Component parent model action -> [CSS]
scripts :: forall parent model action. Component parent model action -> [JS]
initialAction :: forall parent model action.
Component parent model action -> Maybe action
mountPoint :: forall parent model action.
Component parent model action -> Maybe MisoString
logLevel :: forall parent model action.
Component parent model action -> LogLevel
mailbox :: forall parent model action.
Component parent model action -> Mail -> Maybe action
bindings :: forall parent model action.
Component parent model action -> [Binding parent model]
model :: model
update :: action -> Effect parent model action
view :: model -> View model action
subs :: [Sub action]
events :: Events
styles :: [CSS]
scripts :: [JS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Mail -> Maybe action
bindings :: [Binding parent model]
..} = View model action
-> View model (ToViewAction model (View model action))
forall m a. ToView m a => a -> View m (ToViewAction m a)
toView (model -> View model action
view model
model)
data NS
= HTML
| SVG
| MATHML
deriving (Int -> NS -> ShowS
[NS] -> ShowS
NS -> String
(Int -> NS -> ShowS)
-> (NS -> String) -> ([NS] -> ShowS) -> Show NS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NS -> ShowS
showsPrec :: Int -> NS -> ShowS
$cshow :: NS -> String
show :: NS -> String
$cshowList :: [NS] -> ShowS
showList :: [NS] -> ShowS
Show, NS -> NS -> Bool
(NS -> NS -> Bool) -> (NS -> NS -> Bool) -> Eq NS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NS -> NS -> Bool
== :: NS -> NS -> Bool
$c/= :: NS -> NS -> Bool
/= :: NS -> NS -> Bool
Eq)
instance ToJSVal NS where
toJSVal :: NS -> JSM JSVal
toJSVal NS
SVG = MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (MisoString
"svg" :: JSString)
toJSVal NS
HTML = MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (MisoString
"html" :: JSString)
toJSVal NS
MATHML = MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (MisoString
"mathml" :: JSString)
newtype Key = Key MisoString
deriving (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] -> Mail
[Key] -> Encoding
Key -> Bool
Key -> Mail
Key -> Encoding
(Key -> Mail)
-> (Key -> Encoding)
-> ([Key] -> Mail)
-> ([Key] -> Encoding)
-> (Key -> Bool)
-> ToJSON Key
forall a.
(a -> Mail)
-> (a -> Encoding)
-> ([a] -> Mail)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Key -> Mail
toJSON :: Key -> Mail
$ctoEncoding :: Key -> Encoding
toEncoding :: Key -> Encoding
$ctoJSONList :: [Key] -> Mail
toJSONList :: [Key] -> Mail
$ctoEncodingList :: [Key] -> Encoding
toEncodingList :: [Key] -> Encoding
$comitField :: Key -> Bool
omitField :: Key -> Bool
ToJSON, Key -> MisoString
(Key -> MisoString) -> ToMisoString Key
forall str. (str -> MisoString) -> ToMisoString str
$ctoMisoString :: Key -> MisoString
toMisoString :: Key -> MisoString
ToMisoString)
instance ToJSVal Key where
toJSVal :: Key -> JSM JSVal
toJSVal (Key MisoString
x) = MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal MisoString
x
class ToKey key where
toKey :: key -> Key
instance ToKey Key where toKey :: Key -> Key
toKey = Key -> Key
forall a. a -> a
id
instance ToKey JSString 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
instance ToKey T.Text where toKey :: Text -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (Text -> MisoString) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
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
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
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
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
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
data Attribute action
= Property MisoString Value
| Event (Sink action -> VTree -> LogLevel -> Events -> JSM ())
| 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 IsString (View model action) where
fromString :: String -> View model action
fromString = MisoString -> View model action
forall model action. MisoString -> View model action
VText (MisoString -> View model action)
-> (String -> MisoString) -> String -> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
forall a. IsString a => String -> a
fromString
newtype VTree = VTree { VTree -> Object
getTree :: Object }
instance ToJSVal VTree where
toJSVal :: VTree -> JSM JSVal
toJSVal (VTree (Object JSVal
vtree)) = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
vtree
rawHtml
:: MisoString
-> View model action
rawHtml :: forall model action. MisoString -> View model action
rawHtml = MisoString -> View model action
forall model action. MisoString -> View model action
VTextRaw
node :: NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
node :: forall action model.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
node = NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall model action.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
VNode
text :: MisoString -> View model action
text :: forall model action. MisoString -> View model action
text = MisoString -> View model action
forall model action. MisoString -> View model action
VText
text_ :: [MisoString] -> View model action
text_ :: forall model action. [MisoString] -> View model action
text_ = MisoString -> View model action
forall model action. MisoString -> View model action
VText (MisoString -> View model action)
-> ([MisoString] -> MisoString)
-> [MisoString]
-> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MisoString] -> MisoString
MS.concat
textRaw :: MisoString -> View model action
= MisoString -> View model action
forall model action. MisoString -> View model action
VTextRaw
optionalAttrs
:: ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs :: forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> Bool
-> [Attribute action]
-> [View model action]
-> View model action
optionalAttrs [Attribute action] -> [View model action] -> View model action
element [Attribute action]
attrs Bool
condition [Attribute action]
opts [View model action]
kids =
case [Attribute action] -> [View model action] -> View model action
element [Attribute action]
attrs [View model action]
kids of
VNode NS
ns MisoString
name [Attribute action]
_ [View model 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
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall model action.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
VNode NS
ns MisoString
name [Attribute action]
newAttrs [View model action]
kids
View model action
x -> View model action
x
optionalChildren
:: ([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> [View model action]
-> Bool
-> [View model action]
-> View model action
optionalChildren :: forall action model.
([Attribute action] -> [View model action] -> View model action)
-> [Attribute action]
-> [View model action]
-> Bool
-> [View model action]
-> View model action
optionalChildren [Attribute action] -> [View model action] -> View model action
element [Attribute action]
attrs [View model action]
kids Bool
condition [View model action]
opts =
case [Attribute action] -> [View model action] -> View model action
element [Attribute action]
attrs [View model action]
kids of
VNode NS
ns MisoString
name [Attribute action]
_ [View model action]
_ -> do
let newKids :: [View model action]
newKids = [View model action]
kids [View model action] -> [View model action] -> [View model action]
forall a. [a] -> [a] -> [a]
++ [[View model action]] -> [View model action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [View model action]
opts | Bool
condition ]
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall model action.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
VNode NS
ns MisoString
name [Attribute action]
attrs [View model action]
newKids
View model action
x -> View model action
x