{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module Miso.Types
(
Component (..)
, SomeComponent (..)
, Dynamic
, View (..)
, Key (..)
, Attribute (..)
, NS (..)
, CSS (..)
, LogLevel (..)
, VTree (..)
, MountPoint
, ToView (..)
, ToKey (..)
, defaultComponent
, 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 Data.Proxy (Proxy(Proxy))
import Language.Javascript.JSaddle (ToJSVal(toJSVal), Object, JSM)
import Prelude hiding (null)
import GHC.TypeLits (KnownSymbol, symbolVal, Symbol)
import Servant.API (HasLink(MkLink, toLink))
import Miso.Effect (Effect, Sub, Sink)
import Miso.Event.Types
import Miso.String (MisoString, toMisoString, ms)
import Miso.Style.Types (StyleSheet)
data Component (name :: Symbol) model action = Component
{ forall (name :: Symbol) model action.
Component name model action -> model
model :: model
, forall (name :: Symbol) model action.
Component name model action -> action -> Effect model action
update :: action -> Effect model action
, forall (name :: Symbol) model action.
Component name model action -> model -> View action
view :: model -> View action
, forall (name :: Symbol) model action.
Component name model action -> [Sub action]
subs :: [ Sub action ]
, forall (name :: Symbol) model action.
Component name model action -> Events
events :: Events
, forall (name :: Symbol) model action.
Component name model action -> [CSS]
styles :: [CSS]
, forall (name :: Symbol) model action.
Component name model action -> Maybe action
initialAction :: Maybe action
, forall (name :: Symbol) model action.
Component name model action -> Maybe MisoString
mountPoint :: Maybe MountPoint
, forall (name :: Symbol) model action.
Component name model action -> LogLevel
logLevel :: LogLevel
}
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)
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint = MisoString -> Maybe MisoString -> MisoString
forall a. a -> Maybe a -> a
fromMaybe MisoString
"body"
defaultComponent
:: model
-> (action -> Effect model action)
-> (model -> View action)
-> Component name model action
defaultComponent :: forall model action (name :: Symbol).
model
-> (action -> Effect model action)
-> (model -> View action)
-> Component name model action
defaultComponent 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 = []
, 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
}
data LogLevel
= Off
| DebugHydrate
| DebugEvents
| DebugNotify
| 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 MisoString [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 name model action . Eq model
=> SomeComponent (Component name model action)
component_
:: forall name model action a . (Eq model, KnownSymbol name)
=> Component name model action
-> [Attribute a]
-> View a
component_ :: forall (name :: Symbol) model action a.
(Eq model, KnownSymbol name) =>
Component name model action -> [Attribute a] -> View a
component_ Component name model action
app [Attribute a]
attrs = MisoString -> [Attribute a] -> SomeComponent -> View a
forall action.
MisoString -> [Attribute action] -> SomeComponent -> View action
VComp (String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
name) [Attribute a]
attrs (Component name model action -> SomeComponent
forall (name :: Symbol) model action.
Eq model =>
Component name model action -> SomeComponent
SomeComponent Component name model action
app)
where
name :: String
name = Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
type Dynamic = ""
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 name model action) where
type ToViewAction (Component name model action) = action
toView :: Component name model action
-> View (ToViewAction (Component name model action))
toView Component {model
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Events
LogLevel
model -> View action
action -> Effect model action
model :: forall (name :: Symbol) model action.
Component name model action -> model
update :: forall (name :: Symbol) model action.
Component name model action -> action -> Effect model action
view :: forall (name :: Symbol) model action.
Component name model action -> model -> View action
subs :: forall (name :: Symbol) model action.
Component name model action -> [Sub action]
events :: forall (name :: Symbol) model action.
Component name model action -> Events
styles :: forall (name :: Symbol) model action.
Component name model action -> [CSS]
initialAction :: forall (name :: Symbol) model action.
Component name model action -> Maybe action
mountPoint :: forall (name :: Symbol) model action.
Component name model action -> Maybe MisoString
logLevel :: forall (name :: Symbol) model action.
Component name model action -> LogLevel
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Events
styles :: [CSS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
logLevel :: LogLevel
..} = 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] -> Value
[Key] -> Encoding
Key -> Bool
Key -> Value
Key -> Encoding
(Key -> Value)
-> (Key -> Encoding)
-> ([Key] -> Value)
-> ([Key] -> Encoding)
-> (Key -> Bool)
-> ToJSON Key
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Key -> Value
toJSON :: Key -> Value
$ctoEncoding :: Key -> Encoding
toEncoding :: Key -> Encoding
$ctoJSONList :: [Key] -> Value
toJSONList :: [Key] -> Value
$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 -> Object -> 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 }
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