{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
module Web.Rep.Render
( renderPage,
renderPageWith,
renderPageHtmlWith,
renderPageAsByteString,
renderPageToFile,
renderPageHtmlToFile,
)
where
import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Foldable
import MarkupParse
import Optics.Core hiding (element)
import Web.Rep.Html
import Web.Rep.Page
renderPage :: Page -> Markup
renderPage :: Page -> Markup
renderPage Page
p =
(\(ByteString
_, ByteString
_, Markup
x) -> Markup
x) forall a b. (a -> b) -> a -> b
$ PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith (FilePath -> PageConfig
defaultPageConfig FilePath
"default") Page
p
renderPageHtmlWith :: PageConfig -> Page -> Markup
renderPageHtmlWith :: PageConfig -> Page -> Markup
renderPageHtmlWith PageConfig
pc Page
p =
(\(ByteString
_, ByteString
_, Markup
x) -> Markup
x) forall a b. (a -> b) -> a -> b
$ PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith PageConfig
pc Page
p
renderPageWith :: PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith :: PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith PageConfig
pc Page
p =
case PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns of
PageConcerns
Inline -> (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, Markup
h)
PageConcerns
Separated -> (ByteString
css, ByteString
js, Markup
h)
where
h :: Markup
h =
case PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "structure" a => a
#structure of
PageStructure
HeaderBody ->
Markup
doctypeHtml
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup -> Markup
element
ByteString
"html"
[ByteString -> ByteString -> Attr
Attr ByteString
"lang" ByteString
"en"]
( ByteString -> [Attr] -> Markup -> Markup
element
ByteString
"head"
[]
(ByteString -> [Attr] -> Markup
element_ ByteString
"meta" [ByteString -> ByteString -> Attr
Attr ByteString
"charset" ByteString
"utf-8"])
forall a. Semigroup a => a -> a -> a
<> Markup
cssInline
forall a. Semigroup a => a -> a -> a
<> Markup
libsCss'
forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "htmlHeader" a => a
#htmlHeader Page
p
)
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup -> Markup
element
ByteString
"body"
[]
( forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "htmlBody" a => a
#htmlBody Page
p
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline
)
PageStructure
Headless ->
Markup
doctypeHtml
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup
element_ ByteString
"meta" [ByteString -> ByteString -> Attr
Attr ByteString
"charset" ByteString
"utf-8"]
forall a. Semigroup a => a -> a -> a
<> Markup
libsCss'
forall a. Semigroup a => a -> a -> a
<> Markup
cssInline
forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "htmlHeader" a => a
#htmlHeader Page
p
forall a. Semigroup a => a -> a -> a
<> Page
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "htmlBody" a => a
#htmlBody
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline
PageStructure
Snippet ->
Markup
libsCss'
forall a. Semigroup a => a -> a -> a
<> Markup
cssInline
forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "htmlHeader" a => a
#htmlHeader Page
p
forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "htmlBody" a => a
#htmlBody Page
p
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline
css :: ByteString
css :: ByteString
css = RenderStyle -> Css -> ByteString
renderCss (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "renderStyle" a => a
#renderStyle PageConfig
pc) (Page
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "cssBody" a => a
#cssBody)
js :: ByteString
js :: ByteString
js = Js -> ByteString
jsByteString (Page
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "jsGlobal" a => a
#jsGlobal forall a. Semigroup a => a -> a -> a
<> Js -> Js
onLoad (Page
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "jsOnLoad" a => a
#jsOnLoad))
cssInline :: Markup
cssInline
| PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns forall a. Eq a => a -> a -> Bool
== PageConcerns
Separated Bool -> Bool -> Bool
|| ByteString
css forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. Monoid a => a
mempty
| Bool
otherwise = ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
"style" [ByteString -> ByteString -> Attr
Attr ByteString
"type" ByteString
"text/css"] ByteString
css
jsInline :: Markup
jsInline
| PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns forall a. Eq a => a -> a -> Bool
== PageConcerns
Separated Bool -> Bool -> Bool
|| ByteString
js forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. Monoid a => a
mempty
| Bool
otherwise = ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
"script" [] ByteString
js
libsCss' :: Markup
libsCss' =
case PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns of
PageConcerns
Inline -> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "libsCss" a => a
#libsCss Page
p
PageConcerns
Separated ->
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "libsCss" a => a
#libsCss Page
p
forall a. Semigroup a => a -> a -> a
<> ByteString -> Markup
libCss (FilePath -> ByteString
strToUtf8 forall a b. (a -> b) -> a -> b
$ PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "filenames" a => a
#filenames forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cssConcern" a => a
#cssConcern)
libsJs' :: Markup
libsJs' =
case PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns of
PageConcerns
Inline -> Page
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "libsJs" a => a
#libsJs
PageConcerns
Separated ->
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "libsJs" a => a
#libsJs Page
p
forall a. Semigroup a => a -> a -> a
<> ByteString -> Markup
libJs (FilePath -> ByteString
strToUtf8 forall a b. (a -> b) -> a -> b
$ PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "filenames" a => a
#filenames forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "jsConcern" a => a
#jsConcern)
renderPageToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageToFile FilePath
dir PageConfig
pc Page
page =
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FilePath -> ByteString -> IO ()
writeFile' (PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "filenames" a => a
#filenames) (PageConfig -> Page -> Concerns ByteString
renderPageAsByteString PageConfig
pc Page
page)
where
writeFile' :: FilePath -> ByteString -> IO ()
writeFile' FilePath
fp ByteString
s = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
s forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) (FilePath -> ByteString -> IO ()
B.writeFile (FilePath
dir forall a. Semigroup a => a -> a -> a
<> FilePath
"/" forall a. Semigroup a => a -> a -> a
<> FilePath
fp) ByteString
s)
renderPageHtmlToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageHtmlToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageHtmlToFile FilePath
file PageConfig
pc Page
page =
FilePath -> ByteString -> IO ()
B.writeFile FilePath
file (RenderStyle -> Standard -> Markup -> ByteString
markdown_ (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "renderStyle" a => a
#renderStyle PageConfig
pc) Standard
Html forall a b. (a -> b) -> a -> b
$ PageConfig -> Page -> Markup
renderPageHtmlWith PageConfig
pc Page
page)
renderPageAsByteString :: PageConfig -> Page -> Concerns ByteString
renderPageAsByteString :: PageConfig -> Page -> Concerns ByteString
renderPageAsByteString PageConfig
pc Page
p =
case PageConfig
pc forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "concerns" a => a
#concerns of
PageConcerns
Inline -> forall a. a -> a -> a -> Concerns a
Concerns forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (RenderStyle -> Standard -> Markup -> ByteString
markdown_ (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "renderStyle" a => a
#renderStyle PageConfig
pc) Standard
Html Markup
h)
PageConcerns
Separated -> forall a. a -> a -> a -> Concerns a
Concerns ByteString
css ByteString
js (RenderStyle -> Standard -> Markup -> ByteString
markdown_ (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "renderStyle" a => a
#renderStyle PageConfig
pc) Standard
Html Markup
h)
where
(ByteString
css, ByteString
js, Markup
h) = PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith PageConfig
pc Page
p