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

-- | Page rendering
module Web.Rep.Render
  ( renderPage,
    renderPageWith,
    renderPageHtmlWith,
    renderPageAsByteString,
    renderPageToFile,
    renderPageHtmlToFile,
  )
where

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) ((ByteString, ByteString, Markup) -> Markup)
-> (ByteString, ByteString, Markup) -> Markup
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) ((ByteString, ByteString, Markup) -> Markup)
-> (ByteString, ByteString, Markup) -> Markup
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 PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns of
    PageConcerns
Inline -> (ByteString
forall a. Monoid a => a
mempty, ByteString
forall a. Monoid a => a
mempty, Markup
h)
    PageConcerns
Separated -> (ByteString
css, ByteString
js, Markup
h)
  where
    h :: Markup
h =
      case PageConfig
pc PageConfig
-> Optic' A_Lens NoIx PageConfig PageStructure -> PageStructure
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageStructure
#structure of
        PageStructure
HeaderBody ->
          Markup
doctypeHtml
            Markup -> Markup -> Markup
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"])
                  Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsCss'
                  Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
cssInline
                  Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#htmlHeader Page
p
              )
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup -> Markup
element
              ByteString
"body"
              []
              ( Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#htmlBody Page
p
                  Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
                  Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline
              )
        PageStructure
Headless ->
          Markup
doctypeHtml
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup
element_ ByteString
"meta" [ByteString -> ByteString -> Attr
Attr ByteString
"charset" ByteString
"utf-8"]
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsCss'
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
cssInline
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#htmlHeader Page
p
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Page
p Page -> Optic' A_Lens NoIx Page Markup -> Markup
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Page Markup
#htmlBody
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline
        PageStructure
Snippet ->
          Markup
cssInline
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsCss'
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#htmlHeader Page
p
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#htmlBody Page
p
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
libsJs'
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> Markup
jsInline

    css :: ByteString
    css :: ByteString
css = RenderStyle -> Css -> ByteString
renderCss (Optic' A_Lens NoIx PageConfig RenderStyle
-> PageConfig -> RenderStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PageConfig RenderStyle
#renderStyle PageConfig
pc) (Page
p Page -> Optic' A_Lens NoIx Page Css -> Css
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Page Css
#cssBody)

    js :: ByteString
    js :: ByteString
js = Js -> ByteString
jsByteString (Page
p Page -> Optic' A_Lens NoIx Page Js -> Js
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Page Js
#jsGlobal Js -> Js -> Js
forall a. Semigroup a => a -> a -> a
<> Js -> Js
onLoad (Page
p Page -> Optic' A_Lens NoIx Page Js -> Js
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Page Js
#jsOnLoad))
    cssInline :: Markup
cssInline
      | PageConfig
pc PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns PageConcerns -> PageConcerns -> Bool
forall a. Eq a => a -> a -> Bool
== PageConcerns
Separated Bool -> Bool -> Bool
|| ByteString
css ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty = Markup
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 PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns PageConcerns -> PageConcerns -> Bool
forall a. Eq a => a -> a -> Bool
== PageConcerns
Separated Bool -> Bool -> Bool
|| ByteString
js ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty = Markup
forall a. Monoid a => a
mempty
      | Bool
otherwise = ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
"script" [] ByteString
js
    libsCss' :: Markup
libsCss' =
      case PageConfig
pc PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns of
        PageConcerns
Inline -> Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#libsCss Page
p
        PageConcerns
Separated ->
          Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#libsCss Page
p
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ByteString -> Markup
libCss (FilePath -> ByteString
strToUtf8 (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ PageConfig
pc PageConfig -> Optic' A_Lens NoIx PageConfig FilePath -> FilePath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  PageConfig
  PageConfig
  (Concerns FilePath)
  (Concerns FilePath)
#filenames Optic
  A_Lens
  NoIx
  PageConfig
  PageConfig
  (Concerns FilePath)
  (Concerns FilePath)
-> Optic
     A_Lens
     NoIx
     (Concerns FilePath)
     (Concerns FilePath)
     FilePath
     FilePath
-> Optic' A_Lens NoIx PageConfig FilePath
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
% Optic
  A_Lens
  NoIx
  (Concerns FilePath)
  (Concerns FilePath)
  FilePath
  FilePath
#cssConcern)
    libsJs' :: Markup
libsJs' =
      case PageConfig
pc PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns of
        PageConcerns
Inline -> Page
p Page -> Optic' A_Lens NoIx Page Markup -> Markup
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Page Markup
#libsJs
        PageConcerns
Separated ->
          Optic' A_Lens NoIx Page Markup -> Page -> Markup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Page Markup
#libsJs Page
p
            Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ByteString -> Markup
libJs (FilePath -> ByteString
strToUtf8 (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ PageConfig
pc PageConfig -> Optic' A_Lens NoIx PageConfig FilePath -> FilePath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  PageConfig
  PageConfig
  (Concerns FilePath)
  (Concerns FilePath)
#filenames Optic
  A_Lens
  NoIx
  PageConfig
  PageConfig
  (Concerns FilePath)
  (Concerns FilePath)
-> Optic
     A_Lens
     NoIx
     (Concerns FilePath)
     (Concerns FilePath)
     FilePath
     FilePath
-> Optic' A_Lens NoIx PageConfig FilePath
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
% Optic
  A_Lens
  NoIx
  (Concerns FilePath)
  (Concerns FilePath)
  FilePath
  FilePath
#jsConcern)

-- | Render Page concerns to files.
renderPageToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageToFile :: FilePath -> PageConfig -> Page -> IO ()
renderPageToFile FilePath
dir PageConfig
pc Page
page =
  Concerns (IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ (Concerns (IO ()) -> IO ()) -> Concerns (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> ByteString -> IO ())
-> Concerns FilePath -> Concerns ByteString -> Concerns (IO ())
forall a b c.
(a -> b -> c) -> Concerns a -> Concerns b -> Concerns c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FilePath -> ByteString -> IO ()
writeFile' (PageConfig
pc PageConfig
-> Optic
     A_Lens
     NoIx
     PageConfig
     PageConfig
     (Concerns FilePath)
     (Concerns FilePath)
-> Concerns FilePath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  PageConfig
  PageConfig
  (Concerns FilePath)
  (Concerns FilePath)
#filenames) (PageConfig -> Page -> Concerns ByteString
renderPageAsByteString PageConfig
pc Page
page)
  where
    writeFile' :: FilePath -> ByteString -> IO ()
writeFile' FilePath
fp ByteString
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty) (FilePath -> ByteString -> IO ()
B.writeFile (FilePath
dir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> 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_ (Optic' A_Lens NoIx PageConfig RenderStyle
-> PageConfig -> RenderStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PageConfig RenderStyle
#renderStyle PageConfig
pc) Standard
Html (Markup -> ByteString) -> Markup -> ByteString
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 PageConfig
-> Optic' A_Lens NoIx PageConfig PageConcerns -> PageConcerns
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PageConfig PageConcerns
#concerns of
    PageConcerns
Inline -> ByteString -> ByteString -> ByteString -> Concerns ByteString
forall a. a -> a -> a -> Concerns a
Concerns ByteString
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty (RenderStyle -> Standard -> Markup -> ByteString
markdown_ (Optic' A_Lens NoIx PageConfig RenderStyle
-> PageConfig -> RenderStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PageConfig RenderStyle
#renderStyle PageConfig
pc) Standard
Html Markup
h)
    PageConcerns
Separated -> ByteString -> ByteString -> ByteString -> Concerns ByteString
forall a. a -> a -> a -> Concerns a
Concerns ByteString
css ByteString
js (RenderStyle -> Standard -> Markup -> ByteString
markdown_ (Optic' A_Lens NoIx PageConfig RenderStyle
-> PageConfig -> RenderStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PageConfig RenderStyle
#renderStyle PageConfig
pc) Standard
Html Markup
h)
  where
    (ByteString
css, ByteString
js, Markup
h) = PageConfig -> Page -> (ByteString, ByteString, Markup)
renderPageWith PageConfig
pc Page
p