{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module Miso.Types
(
App
, Component (..)
, Binding (..)
, ComponentId
, SomeComponent (..)
, View (..)
, Key (..)
, Attribute (..)
, NS (..)
, CSS (..)
, JS (..)
, LogLevel (..)
, VTree (..)
, MountPoint
, DOMRef
, ROOT
, Transition
, ToView (..)
, ToKey (..)
, component
, (-->)
, (<--)
, (<-->)
, getDirection
, Direction (..)
, mount
, (+>)
, getMountPoint
, node
, text
, text_
, textRaw
, rawHtml
, MisoString
, toMisoString
, fromMisoString
, ms
) where
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Aeson (Value, ToJSON)
import Data.JSString (JSString)
import Data.Kind (Type)
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import Language.Javascript.JSaddle (ToJSVal(toJSVal), Object(..), JSM)
import Prelude hiding (null)
import Servant.API (HasLink(MkLink, toLink))
import Miso.Concurrent (Mail)
import Miso.Effect (Effect, Sub, Sink, DOMRef)
import Miso.Lens (Lens)
import Miso.String (MisoString, toMisoString, ms, fromMisoString)
import Miso.Event.Types
import Miso.Style.Types (StyleSheet)
import qualified Miso.String as MS
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
type ComponentId = Int
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 parent model action a . Eq model
=> ([View parent a] -> View parent a)
-> Component parent model action
-> View parent a
mount :: forall parent model action a.
Eq model =>
([View parent a] -> View parent a)
-> Component parent model action -> View parent a
mount [View parent a] -> View parent a
mkNode Component parent model action
vcomp =
case [View parent a] -> View parent a
mkNode [] of
VNode NS
ns MisoString
tag [Attribute a]
attrs [View parent a]
_ ->
NS
-> MisoString
-> [Attribute a]
-> SomeComponent parent
-> View parent a
forall model action.
NS
-> MisoString
-> [Attribute action]
-> SomeComponent model
-> View model action
VComp NS
ns MisoString
tag [Attribute a]
attrs
(Component parent model action -> SomeComponent parent
forall parent model action.
Eq model =>
Component parent model action -> SomeComponent parent
SomeComponent Component parent model action
vcomp)
VComp NS
ns MisoString
tag [Attribute a]
attrs SomeComponent parent
vcomp_ ->
NS
-> MisoString
-> [Attribute a]
-> SomeComponent parent
-> View parent a
forall model action.
NS
-> MisoString
-> [Attribute action]
-> SomeComponent model
-> View model action
VComp NS
ns MisoString
tag [Attribute a]
attrs SomeComponent parent
vcomp_
View parent a
_ ->
String -> View parent a
forall a. HasCallStack => String -> a
error String
"Impossible: cannot mount on a Text node"
(+>)
:: forall parent model action a . Eq model
=> ([View parent a] -> View parent a)
-> Component parent model action
-> View parent a
infixr 0 +>
+> :: forall parent model action a.
Eq model =>
([View parent a] -> View parent a)
-> Component parent model action -> View parent a
(+>) = ([View parent a] -> View parent a)
-> Component parent model action -> View parent a
forall parent model action a.
Eq model =>
([View parent a] -> View parent a)
-> Component parent model action -> View parent a
mount
instance HasLink (View m a) where
type MkLink (View m a) b = b
toLink :: forall a.
(Link -> a) -> Proxy (View m a) -> Link -> MkLink (View m a) a
toLink Link -> a
x Proxy (View m a)
_ = Link -> a
Link -> MkLink (View m a) a
x
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 = JSString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (JSString
"svg" :: JSString)
toJSVal NS
HTML = JSString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (JSString
"html" :: JSString)
toJSVal NS
MATHML = JSString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (JSString
"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)
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 :: JSString -> Key
toKey = MisoString -> Key
Key (MisoString -> Key) -> (JSString -> MisoString) -> JSString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
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
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 parent action
rawHtml :: forall model action. MisoString -> View model action
rawHtml = MisoString -> View parent action
forall model action. MisoString -> View model action
VTextRaw
node :: NS
-> MisoString
-> [Attribute action]
-> [View parent action]
-> View parent action
node :: forall action parent.
NS
-> MisoString
-> [Attribute action]
-> [View parent action]
-> View parent action
node = NS
-> MisoString
-> [Attribute action]
-> [View parent action]
-> View parent action
forall model action.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
VNode
text :: MisoString -> View parent action
text :: forall model action. MisoString -> View model action
text = MisoString -> View parent action
forall model action. MisoString -> View model action
VText
text_ :: [MisoString] -> View parent action
text_ :: forall parent action. [MisoString] -> View parent action
text_ = MisoString -> View parent action
forall model action. MisoString -> View model action
VText (MisoString -> View parent action)
-> ([MisoString] -> MisoString)
-> [MisoString]
-> View parent action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MisoString] -> MisoString
MS.concat
textRaw :: MisoString -> View parent action
= MisoString -> View parent action
forall model action. MisoString -> View model action
VTextRaw
data Binding parent model = forall a . Binding Direction (Lens parent a) (Lens model a)
bind
:: Direction
-> Lens parent a
-> Lens model a
-> Binding parent model
bind :: forall parent a model.
Direction -> Lens parent a -> Lens model a -> Binding parent model
bind = Direction -> Lens parent a -> Lens model a -> Binding parent model
forall parent model a.
Direction -> Lens parent a -> Lens model a -> Binding parent model
Binding
data Direction
= ParentToChild
| ChildToParent
| Bidirectional
deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq)
getDirection :: Binding parent model -> Direction
getDirection :: forall parent model. Binding parent model -> Direction
getDirection (Binding Direction
dir Lens parent a
_ Lens model a
_) = Direction
dir
(-->) :: Lens parent a -> Lens model a -> Binding parent model
--> :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
(-->) = Direction -> Lens parent a -> Lens model a -> Binding parent model
forall parent a model.
Direction -> Lens parent a -> Lens model a -> Binding parent model
bind Direction
ParentToChild
(<--) :: Lens parent a -> Lens model a -> Binding parent model
<-- :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
(<--) = Direction -> Lens parent a -> Lens model a -> Binding parent model
forall parent a model.
Direction -> Lens parent a -> Lens model a -> Binding parent model
bind Direction
ChildToParent
(<-->) :: Lens parent a -> Lens model a -> Binding parent model
<--> :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
(<-->) = Direction -> Lens parent a -> Lens model a -> Binding parent model
forall parent a model.
Direction -> Lens parent a -> Lens model a -> Binding parent model
bind Direction
Bidirectional