{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
module Miso.Html.Render
(
ToHtml (..)
) where
import Data.Aeson
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
import Unsafe.Coerce (unsafeCoerce)
#ifdef SSR
import Control.Exception (SomeException, catch)
import System.IO.Unsafe (unsafePerformIO)
#endif
import Miso.String hiding (intercalate)
import qualified Miso.String as MS
import Miso.Types
class ToHtml a where
toHtml :: a -> L.ByteString
instance ToHtml (Miso.Types.View m a) where
toHtml :: View m a -> ByteString
toHtml = View m a -> ByteString
forall m a. View m a -> ByteString
renderView
instance ToHtml [Miso.Types.View m a] where
toHtml :: [View m a] -> ByteString
toHtml = (View m a -> ByteString) -> [View m a] -> ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap View m a -> ByteString
forall m a. View m a -> ByteString
renderView
renderView :: View m a -> L.ByteString
renderView :: forall m a. View m a -> ByteString
renderView = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (View m a -> Builder) -> View m a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View m a -> Builder
forall m a. View m a -> Builder
renderBuilder
intercalate :: Builder -> [Builder] -> Builder
intercalate :: Builder -> [Builder] -> Builder
intercalate Builder
_ [] = Builder
""
intercalate Builder
_ [Builder
x] = Builder
x
intercalate Builder
sep (Builder
x:[Builder]
xs) =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
x
, Builder
sep
, Builder -> [Builder] -> Builder
intercalate Builder
sep [Builder]
xs
]
renderBuilder :: Miso.Types.View m a -> Builder
renderBuilder :: forall m a. View m a -> Builder
renderBuilder (VText MisoString
"") = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
" "
renderBuilder (VText MisoString
s) = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
s
renderBuilder (VNode NS
_ MisoString
"doctype" [] []) = Builder
"<!doctype html>"
renderBuilder (VNode NS
ns MisoString
tag [Attribute a]
attrs [View m a]
children) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
"<"
, MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
tag
, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
intercalate Builder
" " (Attribute a -> Builder
forall action. Attribute action -> Builder
renderAttrs (Attribute a -> Builder) -> [Attribute a] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Attribute a]
attrs)
| Bool -> Bool
not ([Attribute a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Attribute a]
attrs)
]
, if MisoString
tag MisoString -> [MisoString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MisoString]
selfClosing then Builder
"/>" else Builder
">"
, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ (View m a -> Builder) -> [View m a] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap View m a -> Builder
forall m a. View m a -> Builder
renderBuilder ([View m a] -> [View m a]
forall m a. [View m a] -> [View m a]
collapseSiblingTextNodes [View m a]
children)
, Builder
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
]
| MisoString
tag MisoString -> [MisoString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [MisoString]
selfClosing
]
] where
selfClosing :: [MisoString]
selfClosing = [MisoString]
htmls [MisoString] -> [MisoString] -> [MisoString]
forall a. Semigroup a => a -> a -> a
<> [MisoString]
svgs [MisoString] -> [MisoString] -> [MisoString]
forall a. Semigroup a => a -> a -> a
<> [MisoString]
mathmls
htmls :: [MisoString]
htmls = [ MisoString
x
| MisoString
x <- [ MisoString
"area", MisoString
"base", MisoString
"col", MisoString
"embed", MisoString
"img", MisoString
"input", MisoString
"br", MisoString
"hr", MisoString
"meta", MisoString
"link", MisoString
"param", MisoString
"source", MisoString
"track", MisoString
"wbr" ]
, NS
ns NS -> NS -> Bool
forall a. Eq a => a -> a -> Bool
== NS
HTML
]
svgs :: [MisoString]
svgs = [ MisoString
x
| MisoString
x <- [ MisoString
"circle", MisoString
"line", MisoString
"rect", MisoString
"path", MisoString
"ellipse", MisoString
"polygon", MisoString
"polyline", MisoString
"use", MisoString
"image"]
, NS
ns NS -> NS -> Bool
forall a. Eq a => a -> a -> Bool
== NS
SVG
]
mathmls :: [MisoString]
mathmls =
[ MisoString
x
| MisoString
x <- [MisoString
"mglyph", MisoString
"mprescripts", MisoString
"none", MisoString
"maligngroup", MisoString
"malignmark" ]
, NS
ns NS -> NS -> Bool
forall a. Eq a => a -> a -> Bool
== NS
MATHML
]
renderBuilder (VComp NS
ns MisoString
tag [Attribute a]
attrs (SomeComponent Component m model action
vcomp)) =
View (ZonkAny 0) a -> Builder
forall m a. View m a -> Builder
renderBuilder (NS
-> MisoString
-> [Attribute a]
-> [View (ZonkAny 0) a]
-> View (ZonkAny 0) a
forall model action.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
VNode NS
ns MisoString
tag [Attribute a]
attrs [View (ZonkAny 0) a]
forall {a}. [a]
vkids)
where
#ifdef SSR
vkids = [ unsafeCoerce $ (view vcomp) $ getInitialComponentModel vcomp ]
#else
vkids :: [a]
vkids = [ View model action -> a
forall a b. a -> b
unsafeCoerce (View model action -> a) -> View model action -> a
forall a b. (a -> b) -> a -> b
$ (Component m model action -> model -> View model action
forall parent model action.
Component parent model action -> model -> View model action
view Component m model action
vcomp) (Component m model action -> model
forall parent model action. Component parent model action -> model
model Component m model action
vcomp) ]
#endif
renderAttrs :: Attribute action -> Builder
renderAttrs :: forall action. Attribute action -> Builder
renderAttrs (ClassList [MisoString]
classes) =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
"class"
, String -> Builder
stringUtf8 String
"=\""
, MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString ([MisoString] -> MisoString
MS.unwords [MisoString]
classes)
, String -> Builder
stringUtf8 String
"\""
]
renderAttrs (Property MisoString
key Value
value) =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
key
, String -> Builder
stringUtf8 String
"=\""
, Value -> Builder
toHtmlFromJSON Value
value
, String -> Builder
stringUtf8 String
"\""
]
renderAttrs (On Sink action -> VTree -> LogLevel -> Events -> JSM ()
_) = Builder
forall a. Monoid a => a
mempty
renderAttrs (Styles Map MisoString MisoString
styles) =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
"style"
, String -> Builder
stringUtf8 String
"=\""
, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
k
, Char -> Builder
charUtf8 Char
':'
, MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
v
, Char -> Builder
charUtf8 Char
';'
]
| (MisoString
k,MisoString
v) <- Map MisoString MisoString -> [(MisoString, MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString MisoString
styles
]
, String -> Builder
stringUtf8 String
"\""
]
collapseSiblingTextNodes :: [View m a] -> [View m a]
collapseSiblingTextNodes :: forall m a. [View m a] -> [View m a]
collapseSiblingTextNodes [] = []
collapseSiblingTextNodes (VText MisoString
x : VText MisoString
y : [View m a]
xs) =
[View m a] -> [View m a]
forall m a. [View m a] -> [View m a]
collapseSiblingTextNodes (MisoString -> View m a
forall model action. MisoString -> View model action
VText (MisoString
x MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
y) View m a -> [View m a] -> [View m a]
forall a. a -> [a] -> [a]
: [View m a]
xs)
collapseSiblingTextNodes (View m a
x:[View m a]
xs) =
View m a
x View m a -> [View m a] -> [View m a]
forall a. a -> [a] -> [a]
: [View m a] -> [View m a]
forall m a. [View m a] -> [View m a]
collapseSiblingTextNodes [View m a]
xs
toHtmlFromJSON :: Value -> Builder
toHtmlFromJSON :: Value -> Builder
toHtmlFromJSON (String Text
t) = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString (Text -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Text
t)
toHtmlFromJSON (Number Scientific
t) = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> Builder) -> MisoString -> Builder
forall a b. (a -> b) -> a -> b
$ String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Scientific -> String
forall a. Show a => a -> String
show Scientific
t)
toHtmlFromJSON (Bool Bool
True) = Builder
"true"
toHtmlFromJSON (Bool Bool
False) = Builder
"false"
toHtmlFromJSON Value
Null = Builder
"null"
toHtmlFromJSON (Object Object
o) = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> Builder) -> MisoString -> Builder
forall a b. (a -> b) -> a -> b
$ String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Object -> String
forall a. Show a => a -> String
show Object
o)
toHtmlFromJSON (Array Array
a) = MisoString -> Builder
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> Builder) -> MisoString -> Builder
forall a b. (a -> b) -> a -> b
$ String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Array -> String
forall a. Show a => a -> String
show Array
a)
#ifdef SSR
getInitialComponentModel :: Component parent model action -> model
getInitialComponentModel Component {..} =
case hydrateModel of
Nothing -> model
Just action -> unsafePerformIO $
action `catch` (\(e :: SomeException) -> do
putStrLn "Encountered exception during model hydration, falling back to default model"
print e
pure model)
#endif