{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module Miso.Types
(
App (..)
, View (..)
, Key (..)
, Attribute (..)
, NS (..)
, CSS (..)
, LogLevel (..)
, Component (..)
, SomeComponent (..)
, ToView (..)
, ToKey (..)
, defaultApp
, component
, component_
, embed
, embedKeyed
, getMountPoint
) where
import Data.Aeson (Value)
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.Effect (Effect, Sub, Sink)
import Miso.Event.Types
import Miso.String (MisoString, toMisoString)
data App model action = App
{ forall model action. App model action -> model
model :: model
, forall model action.
App model action -> action -> Effect model action
update :: action -> Effect model action
, forall model action. App model action -> model -> View action
view :: model -> View action
, forall model action. App model action -> [Sub action]
subs :: [ Sub action ]
, forall model action. App model action -> Map MisoString Capture
events :: M.Map MisoString Capture
, forall model action. App model action -> [CSS]
styles :: [CSS]
, forall model action. App model action -> Maybe action
initialAction :: Maybe action
, forall model action. App model action -> Maybe MisoString
mountPoint :: Maybe MisoString
, forall model action. App model action -> LogLevel
logLevel :: LogLevel
}
data CSS
= Href MisoString
| Style MisoString
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 -> Capture
(CSS -> CSS -> Capture) -> (CSS -> CSS -> Capture) -> Eq CSS
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: CSS -> CSS -> Capture
== :: CSS -> CSS -> Capture
$c/= :: CSS -> CSS -> Capture
/= :: CSS -> CSS -> Capture
Eq)
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint :: Maybe MisoString -> MisoString
getMountPoint = MisoString -> Maybe MisoString -> MisoString
forall a. a -> Maybe a -> a
fromMaybe MisoString
"body"
defaultApp
:: model
-> (action -> Effect model action)
-> (model -> View action)
-> App model action
defaultApp :: forall model action.
model
-> (action -> Effect model action)
-> (model -> View action)
-> App model action
defaultApp model
m action -> Effect model action
u model -> View action
v = App
{ 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 :: Map MisoString Capture
events = Map MisoString Capture
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
| DebugPrerender
| 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 -> Capture
(LogLevel -> LogLevel -> Capture)
-> (LogLevel -> LogLevel -> Capture) -> Eq LogLevel
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: LogLevel -> LogLevel -> Capture
== :: LogLevel -> LogLevel -> Capture
$c/= :: LogLevel -> LogLevel -> Capture
/= :: LogLevel -> LogLevel -> Capture
Eq)
data View action
= Node NS MisoString (Maybe Key) [Attribute action] [View action]
| Text MisoString
| MisoString
| Embed [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)
data Component model action
= Component
{ forall model action. Component model action -> Maybe Key
componentKey :: Maybe Key
, forall model action. Component model action -> MisoString
componentName :: MisoString
, forall model action. Component model action -> App model action
componentApp :: App model action
}
component
:: MisoString
-> App model action
-> Component model action
component :: forall model action.
MisoString -> App model action -> Component model action
component = Maybe Key
-> MisoString -> App model action -> Component model action
forall model action.
Maybe Key
-> MisoString -> App model action -> Component model action
Component Maybe Key
forall a. Maybe a
Nothing
component_
:: App model action
-> Component model action
component_ :: forall model action. App model action -> Component model action
component_ = Maybe Key
-> MisoString -> App model action -> Component model action
forall model action.
Maybe Key
-> MisoString -> App model action -> Component model action
Component Maybe Key
forall a. Maybe a
Nothing MisoString
""
embed
:: Eq model
=> Component model action
-> [Attribute b]
-> View b
embed :: forall model action b.
Eq model =>
Component model action -> [Attribute b] -> View b
embed Component model action
comp [Attribute b]
attrs = [Attribute b] -> SomeComponent -> View b
forall action. [Attribute action] -> SomeComponent -> View action
Embed [Attribute b]
attrs (Component model action -> SomeComponent
forall model action.
Eq model =>
Component model action -> SomeComponent
SomeComponent Component model action
comp)
embedKeyed
:: Eq model
=> Component model action
-> [Attribute b]
-> Key
-> View b
embedKeyed :: forall model action b.
Eq model =>
Component model action -> [Attribute b] -> Key -> View b
embedKeyed Component model action
comp [Attribute b]
attrs Key
key
= [Attribute b] -> SomeComponent -> View b
forall action. [Attribute action] -> SomeComponent -> View action
Embed [Attribute b]
attrs
(SomeComponent -> View b) -> SomeComponent -> View b
forall a b. (a -> b) -> a -> b
$ Component model action -> SomeComponent
forall model action.
Eq model =>
Component model action -> SomeComponent
SomeComponent Component model action
comp { componentKey = Just key }
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 Maybe Key
_ MisoString
_ App model action
app) = App model action -> View (ToViewAction (App model action))
forall a. ToView a => a -> View (ToViewAction a)
toView App model action
app
instance ToView (App model action) where
type ToViewAction (App model action) = action
toView :: App model action -> View (ToViewAction (App model action))
toView App {model
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Map MisoString Capture
LogLevel
model -> View action
action -> Effect model action
model :: forall model action. App model action -> model
update :: forall model action.
App model action -> action -> Effect model action
view :: forall model action. App model action -> model -> View action
subs :: forall model action. App model action -> [Sub action]
events :: forall model action. App model action -> Map MisoString Capture
styles :: forall model action. App model action -> [CSS]
initialAction :: forall model action. App model action -> Maybe action
mountPoint :: forall model action. App model action -> Maybe MisoString
logLevel :: forall model action. App model action -> LogLevel
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Map MisoString Capture
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 -> Capture
(NS -> NS -> Capture) -> (NS -> NS -> Capture) -> Eq NS
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: NS -> NS -> Capture
== :: NS -> NS -> Capture
$c/= :: NS -> NS -> Capture
/= :: NS -> NS -> Capture
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 -> Capture
(Key -> Key -> Capture) -> (Key -> Key -> Capture) -> Eq Key
forall a. (a -> a -> Capture) -> (a -> a -> Capture) -> Eq a
$c== :: Key -> Key -> Capture
== :: Key -> Key -> Capture
$c/= :: Key -> Key -> Capture
/= :: Key -> Key -> Capture
Eq, String -> Key
(String -> Key) -> IsString Key
forall a. (String -> a) -> IsString a
$cfromString :: String -> Key
fromString :: String -> Key
IsString)
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
Text (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