{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

module Web.Rep.Page
  ( -- $page
    Page (..),
    PageConfig (..),
    defaultPageConfig,
    Concerns (..),
    suffixes,
    concernNames,
    PageConcerns (..),
    PageStructure (..),
    -- $css
    Css (..),
    renderCss,
    -- $js
    Js (..),
    onLoad,
  )
where

import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as C
import Data.String.Interpolate
import GHC.Generics
import MarkupParse
import Optics.Core

-- | 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 -> Markup
libsCss :: Markup,
    -- | javascript library links
    Page -> Markup
libsJs :: Markup,
    -- | css
    Page -> Css
cssBody :: Css,
    -- | javascript with global scope
    Page -> Js
jsGlobal :: Js,
    -- | javascript included within the onLoad function
    Page -> Js
jsOnLoad :: Js,
    -- | html within the header
    Page -> Markup
htmlHeader :: Markup,
    -- | body html
    Page -> Markup
htmlBody :: Markup
  }
  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 =
    Markup -> Markup -> Css -> Js -> Js -> Markup -> Markup -> 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 = Markup -> Markup -> Css -> Js -> Js -> Markup -> Markup -> 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 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
  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)

-- | Configuration options when rendering a 'Page'.
data PageConfig = PageConfig
  { PageConfig -> PageConcerns
concerns :: PageConcerns,
    PageConfig -> PageStructure
structure :: PageStructure,
    PageConfig -> RenderStyle
renderStyle :: RenderStyle,
    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
-> RenderStyle
-> Concerns FilePath
-> [FilePath]
-> PageConfig
PageConfig
    PageConcerns
Inline
    PageStructure
HeaderBody
    RenderStyle
Compact
    ((FilePath
stem <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concerns FilePath
suffixes)
    []

-- | css as a string.
newtype Css = Css {Css -> ByteString
cssByteString :: ByteString} deriving (Int -> Css -> ShowS
[Css] -> ShowS
Css -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Css] -> ShowS
$cshowList :: [Css] -> ShowS
show :: Css -> FilePath
$cshow :: Css -> FilePath
showsPrec :: Int -> Css -> ShowS
$cshowsPrec :: Int -> Css -> ShowS
Show, Css -> Css -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Css -> Css -> Bool
$c/= :: Css -> Css -> Bool
== :: Css -> Css -> Bool
$c== :: Css -> Css -> Bool
Eq, forall x. Rep Css x -> Css
forall x. Css -> Rep Css x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Css x -> Css
$cfrom :: forall x. Css -> Rep Css x
Generic, NonEmpty Css -> Css
Css -> Css -> Css
forall b. Integral b => b -> Css -> Css
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Css -> Css
$cstimes :: forall b. Integral b => b -> Css -> Css
sconcat :: NonEmpty Css -> Css
$csconcat :: NonEmpty Css -> Css
<> :: Css -> Css -> Css
$c<> :: Css -> Css -> Css
Semigroup, Semigroup Css
Css
[Css] -> Css
Css -> Css -> Css
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Css] -> Css
$cmconcat :: [Css] -> Css
mappend :: Css -> Css -> Css
$cmappend :: Css -> Css -> Css
mempty :: Css
$cmempty :: Css
Monoid)

-- | Render 'Css' as text.
renderCss :: RenderStyle -> Css -> ByteString
renderCss :: RenderStyle -> Css -> ByteString
renderCss RenderStyle
Compact = (Char -> Bool) -> ByteString -> ByteString
C.filter (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> ByteString
cssByteString
renderCss RenderStyle
_ = Css -> ByteString
cssByteString

-- | Javascript as string
newtype Js = Js {Js -> ByteString
jsByteString :: ByteString} deriving (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, 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, 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, NonEmpty Js -> Js
Js -> Js -> Js
forall b. Integral b => b -> Js -> Js
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Js -> Js
$cstimes :: forall b. Integral b => b -> Js -> Js
sconcat :: NonEmpty Js -> Js
$csconcat :: NonEmpty Js -> Js
<> :: Js -> Js -> Js
$c<> :: Js -> Js -> Js
Semigroup, Semigroup Js
Js
[Js] -> Js
Js -> Js -> Js
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Js] -> Js
$cmconcat :: [Js] -> Js
mappend :: Js -> Js -> Js
$cmappend :: Js -> Js -> Js
mempty :: Js
$cmempty :: Js
Monoid)

onLoad :: Js -> Js
onLoad :: Js -> Js
onLoad (Js ByteString
t) = ByteString -> Js
Js [i| window.onload=function(){#{t}};|]