{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Page rendering
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

-- | Render a Page with the default configuration into Html.
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

-- | Render a Page into Html.
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

-- | Render a Page into css text, js text and html.
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)

-- | Render Page concerns to files.
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)

-- | Render a page to just a Html file.
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)

-- | Render a Page as Text.
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