{-# 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 (..),
PageConfig (..),
defaultPageConfig,
Concerns (..),
suffixes,
concernNames,
PageConcerns (..),
PageStructure (..),
PageRender (..),
Css,
RepCss (..),
renderCss,
renderRepCss,
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
data Page = Page
{
Page -> [Html ()]
libsCss :: [Html ()],
Page -> [Html ()]
libsJs :: [Html ()],
Page -> RepCss
cssBody :: RepCss,
Page -> RepJs
jsGlobal :: RepJs,
Page -> RepJs
jsOnLoad :: RepJs,
:: 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
(<>)
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)
suffixes :: Concerns FilePath
suffixes :: Concerns FilePath
suffixes = forall a. a -> a -> a -> Concerns a
Concerns FilePath
".css" FilePath
".js" FilePath
".html"
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
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)
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)
data
= 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)
data PageConfig = PageConfig
{ PageConfig -> PageConcerns
concerns :: PageConcerns,
PageConfig -> PageStructure
structure :: PageStructure,
:: 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)
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)
[]
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
(<>)
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
renderCss :: Css -> Text
renderCss :: Css -> Text
renderCss = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
Clay.render
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
(<>)
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
(<>)
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}};|]
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
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
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