{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module Miso.Types
(
Component (..)
, ComponentId
, SomeComponent (..)
, View (..)
, Key (..)
, Attribute (..)
, NS (..)
, CSS (..)
, JS (..)
, LogLevel (..)
, VTree (..)
, MountPoint
, DOMRef
, ToView (..)
, ToKey (..)
, component
, component_
, getMountPoint
, node
, text
, textRaw
, rawHtml
) where
import Data.Aeson (Value, ToJSON)
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 hiding (null)
import Servant.API (HasLink(MkLink, toLink))
import Miso.Concurrent (Mail)
import Miso.Effect (Effect, Sub, Sink, DOMRef)
import Miso.Event.Types
import Miso.String (MisoString, toMisoString)
import Miso.Style.Types (StyleSheet)
data Component model action
= Component
{ forall model action. Component model action -> model
model :: model
, forall model action.
Component model action -> action -> Effect model action
update :: action -> Effect model action
, forall model action. Component model action -> model -> View action
view :: model -> View action
, forall model action. Component model action -> [Sub action]
subs :: [ Sub action ]
, forall model action. Component model action -> Events
events :: Events
, forall model action. Component model action -> [CSS]
styles :: [CSS]
, forall model action. Component model action -> [JS]
scripts :: [JS]
, forall model action. Component model action -> Maybe action
initialAction :: Maybe action
, forall model action. Component model action -> Maybe MisoString
mountPoint :: Maybe MountPoint
, forall model action. Component model action -> LogLevel
logLevel :: LogLevel
, forall model action. Component model action -> Mail -> Maybe action
mailbox :: Mail -> Maybe action
}
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
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 model action)
-> (model -> View action)
-> Component model action
component :: forall model action.
model
-> (action -> Effect model action)
-> (model -> View action)
-> Component model action
component model
m action -> Effect model action
u model -> View action
v = Component
{ model :: model
model = model
m
, update :: action -> Effect model action
update = action -> Effect model action
u
, view :: model -> View action
view = model -> View 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
}
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 action
= VNode NS MisoString [Attribute action] [View action]
| VText MisoString
| MisoString
| VComp [Attribute action] SomeComponent
deriving (forall a b. (a -> b) -> View a -> View b)
-> (forall a b. a -> View b -> View a) -> Functor View
forall a b. a -> View b -> View a
forall a b. (a -> b) -> View a -> View 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) -> View a -> View b
fmap :: forall a b. (a -> b) -> View a -> View b
$c<$ :: forall a b. a -> View b -> View a
<$ :: forall a b. a -> View b -> View a
Functor
data SomeComponent
= forall model action . Eq model
=> SomeComponent (Component model action)
component_
:: forall model action a . Eq model
=> [Attribute a]
-> Component model action
-> View a
component_ :: forall model action a.
Eq model =>
[Attribute a] -> Component model action -> View a
component_ [Attribute a]
attrs Component model action
app = [Attribute a] -> SomeComponent -> View a
forall action. [Attribute action] -> SomeComponent -> View action
VComp [Attribute a]
attrs (Component model action -> SomeComponent
forall model action.
Eq model =>
Component model action -> SomeComponent
SomeComponent Component model action
app)
instance HasLink (View a) where
type MkLink (View a) b = b
toLink :: forall a.
(Link -> a) -> Proxy (View a) -> Link -> MkLink (View a) a
toLink Link -> a
x Proxy (View a)
_ = Link -> a
Link -> MkLink (View a) a
x
class ToView a where
type ToViewAction a :: Type
toView :: a -> View (ToViewAction a)
instance ToView (View action) where
type ToViewAction (View action) = action
toView :: View action -> View (ToViewAction (View action))
toView = View action -> View action
View action -> View (ToViewAction (View action))
forall a. a -> a
id
instance ToView (Component model action) where
type ToViewAction (Component model action) = action
toView :: Component model action
-> View (ToViewAction (Component model action))
toView Component {model
[JS]
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Events
LogLevel
model -> View action
action -> Effect model action
Mail -> Maybe action
model :: forall model action. Component model action -> model
update :: forall model action.
Component model action -> action -> Effect model action
view :: forall model action. Component model action -> model -> View action
subs :: forall model action. Component model action -> [Sub action]
events :: forall model action. Component model action -> Events
styles :: forall model action. Component model action -> [CSS]
scripts :: forall model action. Component model action -> [JS]
initialAction :: forall model action. Component model action -> Maybe action
mountPoint :: forall model action. Component model action -> Maybe MisoString
logLevel :: forall model action. Component model action -> LogLevel
mailbox :: forall model action. Component model action -> Mail -> Maybe action
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Events
styles :: [CSS]
scripts :: [JS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Mail -> Maybe action
..} = View action -> View (ToViewAction (View action))
forall a. ToView a => a -> View (ToViewAction a)
toView (model -> View 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 a) where
fromString :: String -> View a
fromString = MisoString -> View a
forall action. MisoString -> View action
VText (MisoString -> View a)
-> (String -> MisoString) -> String -> View a
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 action
rawHtml :: forall action. MisoString -> View action
rawHtml = MisoString -> View action
forall action. MisoString -> View action
VTextRaw
node :: NS
-> MisoString
-> [Attribute action]
-> [View action]
-> View action
node :: forall action.
NS
-> MisoString -> [Attribute action] -> [View action] -> View action
node = NS
-> MisoString -> [Attribute action] -> [View action] -> View action
forall action.
NS
-> MisoString -> [Attribute action] -> [View action] -> View action
VNode
text :: MisoString -> View action
text :: forall action. MisoString -> View action
text = MisoString -> View action
forall action. MisoString -> View action
VText
textRaw :: MisoString -> View action
= MisoString -> View action
forall action. MisoString -> View action
VTextRaw