{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_HADDOCK hide, not-home #-}

module Web.Rep.Page
  ( -- $page
    Page (..),
    PageConfig (..),
    defaultPageConfig,
    Concerns (..),
    suffixes,
    concernNames,
    PageConcerns (..),
    PageStructure (..),
    PageRender (..),
    -- $css
    Css,
    RepCss (..),
    renderCss,
    renderRepCss,
    -- $js
    JS (..),
    RepJs (..),
    onLoad,
    renderRepJs,
    parseJs,
    renderJs,
  )
where

import Clay (Css)
import qualified Clay
import Data.Text (Text, unpack)
import Data.Text.Lazy (toStrict)
import GHC.Generics
import Language.JavaScript.Parser
import Language.JavaScript.Parser.AST
import Language.JavaScript.Process.Minify
import Lucid
import Optics.Core
import Text.InterpolatedString.Perl6

-- | Components of a web page.
--
-- A web page can take many forms but still have the same underlying representation. For example, CSS can be linked to in a separate file, or can be inline within html, but still be the same css and have the same expected external effect. A Page represents the practical components of what makes up a static snapshot of a web page.
data Page = Page
  { -- | css library links
    Page -> [Html ()]
libsCss :: [Html ()],
    -- | javascript library links
    Page -> [Html ()]
libsJs :: [Html ()],
    -- | css
    Page -> RepCss
cssBody :: RepCss,
    -- | javascript with global scope
    Page -> RepJs
jsGlobal :: RepJs,
    -- | javascript included within the onLoad function
    Page -> RepJs
jsOnLoad :: RepJs,
    -- | html within the header
    Page -> Html ()
htmlHeader :: Html (),
    -- | body html
    Page -> Html ()
htmlBody :: Html ()
  }
  deriving (Int -> Page -> ShowS
[Page] -> ShowS
Page -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Page] -> ShowS
$cshowList :: [Page] -> ShowS
show :: Page -> FilePath
$cshow :: Page -> FilePath
showsPrec :: Int -> Page -> ShowS
$cshowsPrec :: Int -> Page -> ShowS
Show, forall x. Rep Page x -> Page
forall x. Page -> Rep Page x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Page x -> Page
$cfrom :: forall x. Page -> Rep Page x
Generic)

instance Semigroup Page where
  <> :: Page -> Page -> Page
(<>) Page
p0 Page
p1 =
    [Html ()]
-> [Html ()]
-> RepCss
-> RepJs
-> RepJs
-> Html ()
-> Html ()
-> Page
Page
      (Page
p0 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "libsCss" a => a
#libsCss forall a. Semigroup a => a -> a -> a
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "libsCss" a => a
#libsCss)
      (Page
p0 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "libsJs" a => a
#libsJs forall a. Semigroup a => a -> a -> a
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "libsJs" a => a
#libsJs)
      (Page
p0 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "cssBody" a => a
#cssBody forall a. Semigroup a => a -> a -> a
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "cssBody" a => a
#cssBody)
      (Page
p0 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
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "jsGlobal" a => a
#jsGlobal)
      (Page
p0 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "jsOnLoad" a => a
#jsOnLoad forall a. Semigroup a => a -> a -> a
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "jsOnLoad" a => a
#jsOnLoad)
      (Page
p0 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "htmlHeader" a => a
#htmlHeader forall a. Semigroup a => a -> a -> a
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "htmlHeader" a => a
#htmlHeader)
      (Page
p0 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
<> Page
p1 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "htmlBody" a => a
#htmlBody)

instance Monoid Page where
  mempty :: Page
mempty = [Html ()]
-> [Html ()]
-> RepCss
-> RepJs
-> RepJs
-> Html ()
-> Html ()
-> Page
Page [] [] forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

  mappend :: Page -> Page -> Page
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | A web page typically is composed of some css, javascript and html.
--
-- 'Concerns' abstracts this structural feature of a web page.
data Concerns a = Concerns
  { forall a. Concerns a -> a
cssConcern :: a,
    forall a. Concerns a -> a
jsConcern :: a,
    forall a. Concerns a -> a
htmlConcern :: a
  }
  deriving (Concerns a -> Concerns a -> Bool
forall a. Eq a => Concerns a -> Concerns a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Concerns a -> Concerns a -> Bool
$c/= :: forall a. Eq a => Concerns a -> Concerns a -> Bool
== :: Concerns a -> Concerns a -> Bool
$c== :: forall a. Eq a => Concerns a -> Concerns a -> Bool
Eq, Int -> Concerns a -> ShowS
forall a. Show a => Int -> Concerns a -> ShowS
forall a. Show a => [Concerns a] -> ShowS
forall a. Show a => Concerns a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Concerns a] -> ShowS
$cshowList :: forall a. Show a => [Concerns a] -> ShowS
show :: Concerns a -> FilePath
$cshow :: forall a. Show a => Concerns a -> FilePath
showsPrec :: Int -> Concerns a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Concerns a -> ShowS
Show, forall a. Eq a => a -> Concerns a -> Bool
forall a. Num a => Concerns a -> a
forall a. Ord a => Concerns a -> a
forall m. Monoid m => Concerns m -> m
forall a. Concerns a -> Bool
forall a. Concerns a -> Int
forall a. Concerns a -> [a]
forall a. (a -> a -> a) -> Concerns a -> a
forall m a. Monoid m => (a -> m) -> Concerns a -> m
forall b a. (b -> a -> b) -> b -> Concerns a -> b
forall a b. (a -> b -> b) -> b -> Concerns a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Concerns a -> a
$cproduct :: forall a. Num a => Concerns a -> a
sum :: forall a. Num a => Concerns a -> a
$csum :: forall a. Num a => Concerns a -> a
minimum :: forall a. Ord a => Concerns a -> a
$cminimum :: forall a. Ord a => Concerns a -> a
maximum :: forall a. Ord a => Concerns a -> a
$cmaximum :: forall a. Ord a => Concerns a -> a
elem :: forall a. Eq a => a -> Concerns a -> Bool
$celem :: forall a. Eq a => a -> Concerns a -> Bool
length :: forall a. Concerns a -> Int
$clength :: forall a. Concerns a -> Int
null :: forall a. Concerns a -> Bool
$cnull :: forall a. Concerns a -> Bool
toList :: forall a. Concerns a -> [a]
$ctoList :: forall a. Concerns a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Concerns a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Concerns a -> a
foldr1 :: forall a. (a -> a -> a) -> Concerns a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Concerns a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Concerns a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Concerns a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Concerns a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Concerns a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Concerns a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Concerns a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Concerns a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Concerns a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Concerns a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Concerns a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Concerns a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Concerns a -> m
fold :: forall m. Monoid m => Concerns m -> m
$cfold :: forall m. Monoid m => Concerns m -> m
Foldable, Functor Concerns
Foldable Concerns
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Concerns (m a) -> m (Concerns a)
forall (f :: * -> *) a.
Applicative f =>
Concerns (f a) -> f (Concerns a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Concerns a -> m (Concerns b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Concerns a -> f (Concerns b)
sequence :: forall (m :: * -> *) a. Monad m => Concerns (m a) -> m (Concerns a)
$csequence :: forall (m :: * -> *) a. Monad m => Concerns (m a) -> m (Concerns a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Concerns a -> m (Concerns b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Concerns a -> m (Concerns b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Concerns (f a) -> f (Concerns a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Concerns (f a) -> f (Concerns a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Concerns a -> f (Concerns b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Concerns a -> f (Concerns b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Concerns a) x -> Concerns a
forall a x. Concerns a -> Rep (Concerns a) x
$cto :: forall a x. Rep (Concerns a) x -> Concerns a
$cfrom :: forall a x. Concerns a -> Rep (Concerns a) x
Generic)

instance Functor Concerns where
  fmap :: forall a b. (a -> b) -> Concerns a -> Concerns b
fmap a -> b
f (Concerns a
c a
j a
h) = forall a. a -> a -> a -> Concerns a
Concerns (a -> b
f a
c) (a -> b
f a
j) (a -> b
f a
h)

instance Applicative Concerns where
  pure :: forall a. a -> Concerns a
pure a
a = forall a. a -> a -> a -> Concerns a
Concerns a
a a
a a
a

  Concerns a -> b
f a -> b
g a -> b
h <*> :: forall a b. Concerns (a -> b) -> Concerns a -> Concerns b
<*> Concerns a
a a
b a
c = forall a. a -> a -> a -> Concerns a
Concerns (a -> b
f a
a) (a -> b
g a
b) (a -> b
h a
c)

-- | The common file suffixes of the three concerns.
suffixes :: Concerns FilePath
suffixes :: Concerns FilePath
suffixes = forall a. a -> a -> a -> Concerns a
Concerns FilePath
".css" FilePath
".js" FilePath
".html"

-- | Create filenames for each Concern element.
concernNames :: FilePath -> FilePath -> Concerns FilePath
concernNames :: FilePath -> FilePath -> Concerns FilePath
concernNames FilePath
dir FilePath
stem =
  (\FilePath
x -> FilePath
dir forall a. Semigroup a => a -> a -> a
<> FilePath
stem forall a. Semigroup a => a -> a -> a
<> FilePath
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concerns FilePath
suffixes

-- | Is the rendering to include all 'Concerns' (typically in a html file) or be separated (tyypically into separate files and linked in the html file)?
data PageConcerns
  = Inline
  | Separated
  deriving (Int -> PageConcerns -> ShowS
[PageConcerns] -> ShowS
PageConcerns -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PageConcerns] -> ShowS
$cshowList :: [PageConcerns] -> ShowS
show :: PageConcerns -> FilePath
$cshow :: PageConcerns -> FilePath
showsPrec :: Int -> PageConcerns -> ShowS
$cshowsPrec :: Int -> PageConcerns -> ShowS
Show, PageConcerns -> PageConcerns -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageConcerns -> PageConcerns -> Bool
$c/= :: PageConcerns -> PageConcerns -> Bool
== :: PageConcerns -> PageConcerns -> Bool
$c== :: PageConcerns -> PageConcerns -> Bool
Eq, forall x. Rep PageConcerns x -> PageConcerns
forall x. PageConcerns -> Rep PageConcerns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageConcerns x -> PageConcerns
$cfrom :: forall x. PageConcerns -> Rep PageConcerns x
Generic)

-- | Various ways that a Html file can be structured.
data PageStructure
  = HeaderBody
  | Headless
  | Snippet
  | Svg
  deriving (Int -> PageStructure -> ShowS
[PageStructure] -> ShowS
PageStructure -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PageStructure] -> ShowS
$cshowList :: [PageStructure] -> ShowS
show :: PageStructure -> FilePath
$cshow :: PageStructure -> FilePath
showsPrec :: Int -> PageStructure -> ShowS
$cshowsPrec :: Int -> PageStructure -> ShowS
Show, PageStructure -> PageStructure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageStructure -> PageStructure -> Bool
$c/= :: PageStructure -> PageStructure -> Bool
== :: PageStructure -> PageStructure -> Bool
$c== :: PageStructure -> PageStructure -> Bool
Eq, forall x. Rep PageStructure x -> PageStructure
forall x. PageStructure -> Rep PageStructure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageStructure x -> PageStructure
$cfrom :: forall x. PageStructure -> Rep PageStructure x
Generic)

-- | Post-processing of page concerns
data PageRender
  = Pretty
  | Minified
  | NoPost
  deriving (Int -> PageRender -> ShowS
[PageRender] -> ShowS
PageRender -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PageRender] -> ShowS
$cshowList :: [PageRender] -> ShowS
show :: PageRender -> FilePath
$cshow :: PageRender -> FilePath
showsPrec :: Int -> PageRender -> ShowS
$cshowsPrec :: Int -> PageRender -> ShowS
Show, PageRender -> PageRender -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageRender -> PageRender -> Bool
$c/= :: PageRender -> PageRender -> Bool
== :: PageRender -> PageRender -> Bool
$c== :: PageRender -> PageRender -> Bool
Eq, forall x. Rep PageRender x -> PageRender
forall x. PageRender -> Rep PageRender x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageRender x -> PageRender
$cfrom :: forall x. PageRender -> Rep PageRender x
Generic)

-- | Configuration options when rendering a 'Page'.
data PageConfig = PageConfig
  { PageConfig -> PageConcerns
concerns :: PageConcerns,
    PageConfig -> PageStructure
structure :: PageStructure,
    PageConfig -> PageRender
pageRender :: PageRender,
    PageConfig -> Concerns FilePath
filenames :: Concerns FilePath,
    PageConfig -> [FilePath]
localdirs :: [FilePath]
  }
  deriving (Int -> PageConfig -> ShowS
[PageConfig] -> ShowS
PageConfig -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PageConfig] -> ShowS
$cshowList :: [PageConfig] -> ShowS
show :: PageConfig -> FilePath
$cshow :: PageConfig -> FilePath
showsPrec :: Int -> PageConfig -> ShowS
$cshowsPrec :: Int -> PageConfig -> ShowS
Show, PageConfig -> PageConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageConfig -> PageConfig -> Bool
$c/= :: PageConfig -> PageConfig -> Bool
== :: PageConfig -> PageConfig -> Bool
$c== :: PageConfig -> PageConfig -> Bool
Eq, forall x. Rep PageConfig x -> PageConfig
forall x. PageConfig -> Rep PageConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageConfig x -> PageConfig
$cfrom :: forall x. PageConfig -> Rep PageConfig x
Generic)

-- | Default configuration is inline ecma and css, separate html header and body, minified code, with the suggested filename prefix.
defaultPageConfig :: FilePath -> PageConfig
defaultPageConfig :: FilePath -> PageConfig
defaultPageConfig FilePath
stem =
  PageConcerns
-> PageStructure
-> PageRender
-> Concerns FilePath
-> [FilePath]
-> PageConfig
PageConfig
    PageConcerns
Inline
    PageStructure
HeaderBody
    PageRender
Minified
    ((FilePath
stem forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concerns FilePath
suffixes)
    []

-- | Unifies css as either a 'Clay.Css' or as Text.
data RepCss = RepCss Clay.Css | RepCssText Text deriving (forall x. Rep RepCss x -> RepCss
forall x. RepCss -> Rep RepCss x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepCss x -> RepCss
$cfrom :: forall x. RepCss -> Rep RepCss x
Generic)

instance Show RepCss where
  show :: RepCss -> FilePath
show (RepCss Css
css) = Text -> FilePath
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss forall a b. (a -> b) -> a -> b
$ Css
css
  show (RepCssText Text
txt) = Text -> FilePath
unpack Text
txt

instance Semigroup RepCss where
  <> :: RepCss -> RepCss -> RepCss
(<>) (RepCss Css
css) (RepCss Css
css') = Css -> RepCss
RepCss (Css
css forall a. Semigroup a => a -> a -> a
<> Css
css')
  (<>) (RepCssText Text
css) (RepCssText Text
css') = Text -> RepCss
RepCssText (Text
css forall a. Semigroup a => a -> a -> a
<> Text
css')
  (<>) (RepCss Css
css) (RepCssText Text
css') =
    Text -> RepCss
RepCssText (Css -> Text
renderCss Css
css forall a. Semigroup a => a -> a -> a
<> Text
css')
  (<>) (RepCssText Text
css) (RepCss Css
css') =
    Text -> RepCss
RepCssText (Text
css forall a. Semigroup a => a -> a -> a
<> Css -> Text
renderCss Css
css')

instance Monoid RepCss where
  mempty :: RepCss
mempty = Text -> RepCss
RepCssText forall a. Monoid a => a
mempty

  mappend :: RepCss -> RepCss -> RepCss
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Render 'RepCss' as text.
renderRepCss :: PageRender -> RepCss -> Text
renderRepCss :: PageRender -> RepCss -> Text
renderRepCss PageRender
Minified (RepCss Css
css) = Text -> Text
toStrict forall a b. (a -> b) -> a -> b
$ Config -> [App] -> Css -> Text
Clay.renderWith Config
Clay.compact [] Css
css
renderRepCss PageRender
_ (RepCss Css
css) = Text -> Text
toStrict forall a b. (a -> b) -> a -> b
$ Css -> Text
Clay.render Css
css
renderRepCss PageRender
_ (RepCssText Text
css) = Text
css

-- | Render 'Css' as text.
renderCss :: Css -> Text
renderCss :: Css -> Text
renderCss = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
Clay.render

-- | wrapper for `JSAST`
newtype JS = JS {JS -> JSAST
unJS :: JSAST} deriving (Int -> JS -> ShowS
[JS] -> ShowS
JS -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JS] -> ShowS
$cshowList :: [JS] -> ShowS
show :: JS -> FilePath
$cshow :: JS -> FilePath
showsPrec :: Int -> JS -> ShowS
$cshowsPrec :: Int -> JS -> ShowS
Show, JS -> JS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JS -> JS -> Bool
$c/= :: JS -> JS -> Bool
== :: JS -> JS -> Bool
$c== :: JS -> JS -> Bool
Eq, forall x. Rep JS x -> JS
forall x. JS -> Rep JS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JS x -> JS
$cfrom :: forall x. JS -> Rep JS x
Generic)

instance Semigroup JS where
  <> :: JS -> JS -> JS
(<>) (JS (JSAstProgram [JSStatement]
ss JSAnnot
ann)) (JS (JSAstProgram [JSStatement]
ss' JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram ([JSStatement]
ss forall a. Semigroup a => a -> a -> a
<> [JSStatement]
ss') JSAnnot
ann
  (<>) (JS (JSAstProgram [JSStatement]
ss JSAnnot
ann)) (JS (JSAstStatement JSStatement
s JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram ([JSStatement]
ss forall a. Semigroup a => a -> a -> a
<> [JSStatement
s]) JSAnnot
ann
  (<>) (JS (JSAstProgram [JSStatement]
ss JSAnnot
ann)) (JS (JSAstExpression JSExpression
e JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram ([JSStatement]
ss forall a. Semigroup a => a -> a -> a
<> [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')]) JSAnnot
ann
  (<>) (JS (JSAstProgram [JSStatement]
ss JSAnnot
ann)) (JS (JSAstLiteral JSExpression
e JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram ([JSStatement]
ss forall a. Semigroup a => a -> a -> a
<> [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')]) JSAnnot
ann
  (<>) (JS (JSAstStatement JSStatement
s JSAnnot
ann)) (JS (JSAstProgram [JSStatement]
ss JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram (JSStatement
s forall a. a -> [a] -> [a]
: [JSStatement]
ss) JSAnnot
ann
  (<>) (JS (JSAstStatement JSStatement
s JSAnnot
ann)) (JS (JSAstStatement JSStatement
s' JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSStatement
s, JSStatement
s'] JSAnnot
ann
  (<>) (JS (JSAstStatement JSStatement
s JSAnnot
ann)) (JS (JSAstExpression JSExpression
e JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSStatement
s, JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann
  (<>) (JS (JSAstStatement JSStatement
s JSAnnot
ann)) (JS (JSAstLiteral JSExpression
e JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSStatement
s, JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann
  (<>) (JS (JSAstExpression JSExpression
e JSAnnot
ann)) (JS (JSAstProgram [JSStatement]
ss JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram (JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann) forall a. a -> [a] -> [a]
: [JSStatement]
ss) JSAnnot
ann
  (<>) (JS (JSAstExpression JSExpression
e JSAnnot
ann)) (JS (JSAstStatement JSStatement
s' JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSStatement
s'] JSAnnot
ann
  (<>) (JS (JSAstExpression JSExpression
e JSAnnot
ann)) (JS (JSAstExpression JSExpression
e' JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e' (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann
  (<>) (JS (JSAstExpression JSExpression
e JSAnnot
ann)) (JS (JSAstLiteral JSExpression
e' JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e' (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann
  (<>) (JS (JSAstLiteral JSExpression
e JSAnnot
ann)) (JS (JSAstProgram [JSStatement]
ss JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram (JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann) forall a. a -> [a] -> [a]
: [JSStatement]
ss) JSAnnot
ann
  (<>) (JS (JSAstLiteral JSExpression
e JSAnnot
ann)) (JS (JSAstStatement JSStatement
s' JSAnnot
_)) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSStatement
s'] JSAnnot
ann
  (<>) (JS (JSAstLiteral JSExpression
e JSAnnot
ann)) (JS (JSAstExpression JSExpression
e' JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e' (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann
  (<>) (JS (JSAstLiteral JSExpression
e JSAnnot
ann)) (JS (JSAstLiteral JSExpression
e' JSAnnot
ann')) =
    JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann), JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e' (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')] JSAnnot
ann

instance Monoid JS where
  mempty :: JS
mempty = JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [] (TokenPosn -> [CommentAnnotation] -> JSAnnot
JSAnnot (Int -> Int -> Int -> TokenPosn
TokenPn Int
0 Int
0 Int
0) [])

  mappend :: JS -> JS -> JS
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Unifies javascript as 'JSStatement' and script as 'Text'.
data RepJs = RepJs JS | RepJsText Text deriving (RepJs -> RepJs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepJs -> RepJs -> Bool
$c/= :: RepJs -> RepJs -> Bool
== :: RepJs -> RepJs -> Bool
$c== :: RepJs -> RepJs -> Bool
Eq, Int -> RepJs -> ShowS
[RepJs] -> ShowS
RepJs -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RepJs] -> ShowS
$cshowList :: [RepJs] -> ShowS
show :: RepJs -> FilePath
$cshow :: RepJs -> FilePath
showsPrec :: Int -> RepJs -> ShowS
$cshowsPrec :: Int -> RepJs -> ShowS
Show, forall x. Rep RepJs x -> RepJs
forall x. RepJs -> Rep RepJs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepJs x -> RepJs
$cfrom :: forall x. RepJs -> Rep RepJs x
Generic)

instance Semigroup RepJs where
  <> :: RepJs -> RepJs -> RepJs
(<>) (RepJs JS
js) (RepJs JS
js') = JS -> RepJs
RepJs (JS
js forall a. Semigroup a => a -> a -> a
<> JS
js')
  (<>) (RepJsText Text
js) (RepJsText Text
js') = Text -> RepJs
RepJsText (Text
js forall a. Semigroup a => a -> a -> a
<> Text
js')
  (<>) (RepJs JS
js) (RepJsText Text
js') =
    Text -> RepJs
RepJsText (Text -> Text
toStrict (JSAST -> Text
renderToText forall a b. (a -> b) -> a -> b
$ JS -> JSAST
unJS JS
js) forall a. Semigroup a => a -> a -> a
<> Text
js')
  (<>) (RepJsText Text
js) (RepJs JS
js') =
    Text -> RepJs
RepJsText (Text
js forall a. Semigroup a => a -> a -> a
<> Text -> Text
toStrict (JSAST -> Text
renderToText forall a b. (a -> b) -> a -> b
$ JS -> JSAST
unJS JS
js'))

instance Monoid RepJs where
  mempty :: RepJs
mempty = JS -> RepJs
RepJs forall a. Monoid a => a
mempty

  mappend :: RepJs -> RepJs -> RepJs
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Wrap js in standard DOM window loader.
onLoad :: RepJs -> RepJs
onLoad :: RepJs -> RepJs
onLoad (RepJs JS
js) = JS -> RepJs
RepJs forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JS
onLoadStatements [JS -> JSStatement
toStatement JS
js]
onLoad (RepJsText Text
js) = Text -> RepJs
RepJsText forall a b. (a -> b) -> a -> b
$ Text -> Text
onLoadText Text
js

toStatement :: JS -> JSStatement
toStatement :: JS -> JSStatement
toStatement (JS (JSAstProgram [JSStatement]
ss JSAnnot
ann)) = JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
JSNoAnnot [JSStatement]
ss JSAnnot
JSNoAnnot (JSAnnot -> JSSemi
JSSemi JSAnnot
ann)
toStatement (JS (JSAstStatement JSStatement
s JSAnnot
_)) = JSStatement
s
toStatement (JS (JSAstExpression JSExpression
e JSAnnot
ann')) = JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')
toStatement (JS (JSAstLiteral JSExpression
e JSAnnot
ann')) = JSExpression -> JSSemi -> JSStatement
JSExpressionStatement JSExpression
e (JSAnnot -> JSSemi
JSSemi JSAnnot
ann')

onLoadStatements :: [JSStatement] -> JS
onLoadStatements :: [JSStatement] -> JS
onLoadStatements [JSStatement]
js = JSAST -> JS
JS forall a b. (a -> b) -> a -> b
$ [JSStatement] -> JSAnnot -> JSAST
JSAstProgram [JSExpression -> JSAssignOp -> JSExpression -> JSSemi -> JSStatement
JSAssignStatement (JSExpression -> JSAnnot -> JSExpression -> JSExpression
JSMemberDot (JSAnnot -> FilePath -> JSExpression
JSIdentifier JSAnnot
JSNoAnnot FilePath
"window") JSAnnot
JSNoAnnot (JSAnnot -> FilePath -> JSExpression
JSIdentifier JSAnnot
JSNoAnnot FilePath
"onload")) (JSAnnot -> JSAssignOp
JSAssign JSAnnot
JSNoAnnot) (JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSExpression
JSFunctionExpression JSAnnot
JSNoAnnot JSIdent
JSIdentNone JSAnnot
JSNoAnnot forall a. JSCommaList a
JSLNil JSAnnot
JSNoAnnot (JSAnnot -> [JSStatement] -> JSAnnot -> JSBlock
JSBlock JSAnnot
JSNoAnnot [JSStatement]
js JSAnnot
JSNoAnnot)) JSSemi
JSSemiAuto] JSAnnot
JSNoAnnot

onLoadText :: Text -> Text
onLoadText :: Text -> Text
onLoadText Text
t = [qc| window.onload=function()\{{t}};|]

-- | Convert 'Text' to 'JS', throwing an error on incorrectness.
parseJs :: Text -> JS
parseJs :: Text -> JS
parseJs = JSAST -> JS
JS forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> JSAST
readJs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack

-- | Render 'JS' as 'Text'.
renderJs :: JS -> Text
renderJs :: JS -> Text
renderJs = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> Text
renderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. JS -> JSAST
unJS

-- | Render 'RepJs' as 'Text'.
renderRepJs :: PageRender -> RepJs -> Text
renderRepJs :: PageRender -> RepJs -> Text
renderRepJs PageRender
_ (RepJsText Text
js) = Text
js
renderRepJs PageRender
Minified (RepJs JS
js) = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> Text
renderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> JSAST
minifyJS forall b c a. (b -> c) -> (a -> b) -> a -> c
. JS -> JSAST
unJS forall a b. (a -> b) -> a -> b
$ JS
js
renderRepJs PageRender
Pretty (RepJs JS
js) = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> Text
renderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. JS -> JSAST
unJS forall a b. (a -> b) -> a -> b
$ JS
js