{-| Functions used to generate HTML from a dhall package.
    You can see this module as logic-less HTML building blocks for the whole
    generator tool.

    There are functions that uses `FilePath` instead of `Path a b`. That is because
    the `Path` module doesn't allows to use ".." on its paths and that is needed
    here to properly link css and images.
-}

{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}

module Dhall.Docs.Html
    ( dhallFileToHtml
    , indexToHtml
    , DocParams(..)
    ) where

import Data.Text               (Text)
import Data.Void               (Void)
import Dhall.Core              (Expr, Import)
import Dhall.Docs.CodeRenderer
import Dhall.Pretty            (CharacterSet)
import Dhall.Src               (Src)
import Lucid
import Path                    (Dir, File, Path, Rel)

import qualified Control.Monad
import qualified Data.Foldable
import qualified Data.Text
import qualified Path
import qualified System.FilePath as FilePath

-- $setup
-- >>> :set -XQuasiQuotes
-- >>> import Path (reldir, relfile)

-- | Params for commonly supplied values on the generated documentation
data DocParams = DocParams
    { DocParams -> FilePath
relativeResourcesPath :: FilePath -- ^ Relative resource path to the
                                        --   front-end files
    , DocParams -> Text
packageName :: Text               -- ^ Name of the package
    , DocParams -> CharacterSet
characterSet :: CharacterSet      -- ^ Render code as `ASCII` or `Unicode`
    }

-- | Generates an @`Html` ()@ with all the information about a dhall file
dhallFileToHtml
    :: Path Rel File            -- ^ Source file name, used to extract the title
    -> Text                     -- ^ Contents of the file
    -> Expr Src Import          -- ^ AST of the file
    -> [Expr Void Import]       -- ^ Examples extracted from the assertions of the file
    -> Html ()                  -- ^ Header document as HTML
    -> DocParams                -- ^ Parameters for the documentation
    -> Html ()
dhallFileToHtml :: Path Rel File
-> Text
-> Expr Src Import
-> [Expr Void Import]
-> Html ()
-> DocParams
-> Html ()
dhallFileToHtml Path Rel File
filePath Text
contents Expr Src Import
expr [Expr Void Import]
examples Html ()
header params :: DocParams
params@DocParams{FilePath
Text
CharacterSet
characterSet :: CharacterSet
packageName :: Text
relativeResourcesPath :: FilePath
characterSet :: DocParams -> CharacterSet
packageName :: DocParams -> Text
relativeResourcesPath :: DocParams -> FilePath
..} =
    Html () -> Html ()
forall (m :: * -> *) a. Applicative m => HtmlT m a -> HtmlT m a
doctypehtml_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> DocParams -> Html ()
headContents Text
htmlTitle DocParams
params
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
body_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
            DocParams -> Html ()
navBar DocParams
params
            Html () -> Html ()
mainContainer (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                DocParams -> HtmlFileType -> Breadcrumb -> Html ()
setPageTitle DocParams
params HtmlFileType
NotIndex Breadcrumb
breadcrumb
                Text -> Html ()
copyToClipboardButton Text
htmlTitle
                [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
br_ []
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"doc-contents"] Html ()
header
                Bool -> Html () -> Html ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless ([Expr Void Import] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr Void Import]
examples) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                    Html () -> Html ()
forall arg result. Term arg result => arg -> result
h3_ Html ()
"Examples"
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source-code code-examples"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                        (Expr Void Import -> Html ()) -> [Expr Void Import] -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CharacterSet -> ExprType -> Expr Void Import -> Html ()
renderCodeSnippet CharacterSet
characterSet ExprType
AssertionExample) [Expr Void Import]
examples
                Html () -> Html ()
forall arg result. Term arg result => arg -> result
h3_ Html ()
"Source"
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source-code"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr Src Import -> Html ()
renderCodeWithHyperLinks Text
contents Expr Src Import
expr
  where
    breadcrumb :: Breadcrumb
breadcrumb = Path Rel File -> Breadcrumb
forall a. Path Rel a -> Breadcrumb
relPathToBreadcrumb Path Rel File
filePath
    htmlTitle :: Text
htmlTitle = Breadcrumb -> Text
breadCrumbsToText Breadcrumb
breadcrumb

-- | Generates an index @`Html` ()@ that list all the dhall files in that folder
indexToHtml
    :: Path Rel Dir                                -- ^ Index directory
    -> [(Path Rel File, Maybe (Expr Void Import))] -- ^ Generated files in that directory
    -> [Path Rel Dir]                              -- ^ Generated directories in that directory
    -> DocParams                                   -- ^ Parameters for the documentation
    -> Html ()
indexToHtml :: Path Rel Dir
-> [(Path Rel File, Maybe (Expr Void Import))]
-> [Path Rel Dir]
-> DocParams
-> Html ()
indexToHtml Path Rel Dir
indexDir [(Path Rel File, Maybe (Expr Void Import))]
files [Path Rel Dir]
dirs params :: DocParams
params@DocParams{FilePath
Text
CharacterSet
characterSet :: CharacterSet
packageName :: Text
relativeResourcesPath :: FilePath
characterSet :: DocParams -> CharacterSet
packageName :: DocParams -> Text
relativeResourcesPath :: DocParams -> FilePath
..} = Html () -> Html ()
forall (m :: * -> *) a. Applicative m => HtmlT m a -> HtmlT m a
doctypehtml_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> DocParams -> Html ()
headContents Text
htmlTitle DocParams
params
    Html () -> Html ()
forall arg result. Term arg result => arg -> result
body_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
        DocParams -> Html ()
navBar DocParams
params
        Html () -> Html ()
mainContainer (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
            DocParams -> HtmlFileType -> Breadcrumb -> Html ()
setPageTitle DocParams
params HtmlFileType
Index Breadcrumb
breadcrumbs
            Text -> Html ()
copyToClipboardButton Text
htmlTitle
            [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
br_ []
            Bool -> Html () -> Html ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless ([(Path Rel File, Maybe (Expr Void Import))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Path Rel File, Maybe (Expr Void Import))]
files) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                Html () -> Html ()
forall arg result. Term arg result => arg -> result
h3_ Html ()
"Exported files: "
                Html () -> Html ()
forall arg result. Term arg result => arg -> result
ul_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ ((Path Rel File, Maybe (Expr Void Import)) -> Html ())
-> [(Path Rel File, Maybe (Expr Void Import))] -> [Html ()]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File, Maybe (Expr Void Import)) -> Html ()
listFile [(Path Rel File, Maybe (Expr Void Import))]
files

            Bool -> Html () -> Html ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless ([Path Rel Dir] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel Dir]
dirs) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                Html () -> Html ()
forall arg result. Term arg result => arg -> result
h3_ Html ()
"Exported packages: "
                Html () -> Html ()
forall arg result. Term arg result => arg -> result
ul_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> Html ()) -> [Path Rel Dir] -> [Html ()]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> Html ()
listDir [Path Rel Dir]
dirs

  where
    listFile :: (Path Rel File, Maybe (Expr Void Import)) -> Html ()
    listFile :: (Path Rel File, Maybe (Expr Void Import)) -> Html ()
listFile (Path Rel File
file, Maybe (Expr Void Import)
maybeType) =
        let fileRef :: Text
fileRef = FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File -> FilePath
Path.fromRelFile Path Rel File
file
            itemText :: Text
itemText = FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File -> FilePath
tryToTakeExt Path Rel File
file
        in Html () -> Html ()
forall arg result. Term arg result => arg -> result
li_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
            [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ Text
fileRef] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
itemText
            Maybe (Expr Void Import)
-> (Expr Void Import -> Html ()) -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Data.Foldable.forM_ Maybe (Expr Void Import)
maybeType ((Expr Void Import -> Html ()) -> Html ())
-> (Expr Void Import -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \Expr Void Import
typeExpr -> do
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"of-type-token"] Html ()
":"
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"dhall-type source-code"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CharacterSet -> ExprType -> Expr Void Import -> Html ()
renderCodeSnippet CharacterSet
characterSet ExprType
TypeAnnotation Expr Void Import
typeExpr


    listDir :: Path Rel Dir -> Html ()
    listDir :: Path Rel Dir -> Html ()
listDir Path Rel Dir
dir =
        let dirPath :: Text
dirPath = FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> FilePath
Path.fromRelDir Path Rel Dir
dir in
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
li_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ (Text
dirPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"index.html")] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
dirPath

    tryToTakeExt :: Path Rel File -> FilePath

    tryToTakeExt :: Path Rel File -> FilePath
tryToTakeExt Path Rel File
file = Path Rel File -> FilePath
Path.fromRelFile (Path Rel File -> FilePath) -> Path Rel File -> FilePath
forall a b. (a -> b) -> a -> b
$ case Path Rel File -> Maybe (Path Rel File, FilePath)
forall (m :: * -> *) b.
MonadThrow m =>
Path b File -> m (Path b File, FilePath)
Path.splitExtension Path Rel File
file of
        Maybe (Path Rel File, FilePath)
Nothing -> Path Rel File
file
        Just (Path Rel File
f, FilePath
_) -> Path Rel File
f

    breadcrumbs :: Breadcrumb
breadcrumbs = Path Rel Dir -> Breadcrumb
forall a. Path Rel a -> Breadcrumb
relPathToBreadcrumb Path Rel Dir
indexDir
    htmlTitle :: Text
htmlTitle = Breadcrumb -> Text
breadCrumbsToText Breadcrumb
breadcrumbs

copyToClipboardButton :: Text -> Html ()
copyToClipboardButton :: Text -> Html ()
copyToClipboardButton Text
filePath =
    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ Text
"copy-to-clipboard", Text -> Text -> Attribute
data_ Text
"path" Text
filePath]
        (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
forall arg result. Term arg result => arg -> result
i_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
forall arg result. Term arg result => arg -> result
small_ Html ()
"Copy path to clipboard"


setPageTitle :: DocParams -> HtmlFileType -> Breadcrumb -> Html ()
setPageTitle :: DocParams -> HtmlFileType -> Breadcrumb -> Html ()
setPageTitle DocParams{FilePath
Text
CharacterSet
characterSet :: CharacterSet
packageName :: Text
relativeResourcesPath :: FilePath
characterSet :: DocParams -> CharacterSet
packageName :: DocParams -> Text
relativeResourcesPath :: DocParams -> FilePath
..} HtmlFileType
htmlFileType Breadcrumb
breadcrumb =
    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h2_ [Text -> Attribute
class_ Text
"doc-title"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"crumb-divider"] Html ()
"/"
        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
relativeResourcesPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"index.html"]
            (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
packageName
        HtmlFileType -> Breadcrumb -> Html ()
breadCrumbsToHtml HtmlFileType
htmlFileType Breadcrumb
breadcrumb


-- | ADT for handling bread crumbs. This is essentially a backwards list
--   See `relPathToBreadcrumb` for more information.
data Breadcrumb
    = Crumb Breadcrumb String
    | EmptyCrumb
    deriving Int -> Breadcrumb -> FilePath -> FilePath
[Breadcrumb] -> FilePath -> FilePath
Breadcrumb -> FilePath
(Int -> Breadcrumb -> FilePath -> FilePath)
-> (Breadcrumb -> FilePath)
-> ([Breadcrumb] -> FilePath -> FilePath)
-> Show Breadcrumb
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Breadcrumb] -> FilePath -> FilePath
$cshowList :: [Breadcrumb] -> FilePath -> FilePath
show :: Breadcrumb -> FilePath
$cshow :: Breadcrumb -> FilePath
showsPrec :: Int -> Breadcrumb -> FilePath -> FilePath
$cshowsPrec :: Int -> Breadcrumb -> FilePath -> FilePath
Show

data HtmlFileType = NotIndex | Index

{-| Convert a relative path to a `Breadcrumb`.

>>> relPathToBreadcrumb [reldir|a/b/c|]
Crumb (Crumb (Crumb EmptyCrumb "a") "b") "c"
>>> relPathToBreadcrumb [reldir|.|]
Crumb EmptyCrumb ""
>>> relPathToBreadcrumb [relfile|c/foo.baz|]
Crumb (Crumb EmptyCrumb "c") "foo.baz"
-}
relPathToBreadcrumb :: Path Rel a -> Breadcrumb
relPathToBreadcrumb :: Path Rel a -> Breadcrumb
relPathToBreadcrumb Path Rel a
relPath = (Breadcrumb -> FilePath -> Breadcrumb)
-> Breadcrumb -> [FilePath] -> Breadcrumb
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Breadcrumb -> FilePath -> Breadcrumb
Crumb Breadcrumb
EmptyCrumb [FilePath]
splittedRelPath
  where
    filePath :: FilePath
filePath = Path Rel a -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path Rel a
relPath

    splittedRelPath :: [String]
    splittedRelPath :: [FilePath]
splittedRelPath = case FilePath -> FilePath
FilePath.dropTrailingPathSeparator FilePath
filePath of
        FilePath
"." -> [FilePath
""]
        FilePath
_ -> FilePath -> [FilePath]
FilePath.splitDirectories FilePath
filePath

-- | Render breadcrumbs as `Html ()`
breadCrumbsToHtml :: HtmlFileType -> Breadcrumb -> Html ()
breadCrumbsToHtml :: HtmlFileType -> Breadcrumb -> Html ()
breadCrumbsToHtml HtmlFileType
htmlFileType = Int -> Breadcrumb -> Html ()
go Int
startLevel
  where
    startLevel :: Int
startLevel = case HtmlFileType
htmlFileType of
        HtmlFileType
NotIndex -> -Int
1
        HtmlFileType
Index -> Int
0

    -- copyBreadcrumbButton :: Html ()
    -- copyBreadcrumbButton =
    --     button_
    --         [ class_ "btn copy-breadcrumb"
    --         , data_ "breadcrumb" $ breadCrumbsToText breadcrumb
    --         ] ""

    go :: Int -> Breadcrumb -> Html ()
    go :: Int -> Breadcrumb -> Html ()
go Int
_ Breadcrumb
EmptyCrumb = () -> Html ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Int
level (Crumb Breadcrumb
bc FilePath
name) = do
        Int -> Breadcrumb -> Html ()
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Breadcrumb
bc
        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"crumb-divider"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Text
"/" :: Text)
        [Attribute] -> Html () -> Html ()
elem_ [Text -> Attribute
class_ Text
"title-crumb", Text -> Attribute
href_ Text
hrefTarget] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml FilePath
name
      where
        hrefTarget :: Text
hrefTarget = Int -> Text -> Text
Data.Text.replicate Int
level Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"index.html"
        elem_ :: [Attribute] -> Html () -> Html ()
elem_ = if Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLevel then [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ else [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_


-- | Render breadcrumbs as plain text
breadCrumbsToText :: Breadcrumb -> Text
breadCrumbsToText :: Breadcrumb -> Text
breadCrumbsToText Breadcrumb
EmptyCrumb = Text
""
breadCrumbsToText (Crumb Breadcrumb
bc FilePath
c) = Breadcrumb -> Text
breadCrumbsToText Breadcrumb
bc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Data.Text.pack FilePath
c


-- | nav-bar component of the HTML documentation
navBar
    :: DocParams -- ^ Parameters for doc generation
    -> Html ()
navBar :: DocParams -> Html ()
navBar DocParams{FilePath
Text
CharacterSet
characterSet :: CharacterSet
packageName :: Text
relativeResourcesPath :: FilePath
characterSet :: DocParams -> CharacterSet
packageName :: DocParams -> Text
relativeResourcesPath :: DocParams -> FilePath
..} = [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"nav-bar"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do

    -- Left side of the nav-bar
    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
img_ [ Text -> Attribute
class_ Text
"dhall-icon"
         , Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
relativeResourcesPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"dhall-icon.svg"
         ]
    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
p_ [Text -> Attribute
class_ Text
"package-title"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
packageName

    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"nav-bar-content-divider"] Html ()
""

    -- Right side of the nav-bar
    -- with makeOption [id_ "go-to-source-code"] "Source code"
    (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
makeOption [Text -> Attribute
id_ Text
"switch-light-dark-mode"] Html ()
"Switch Light/Dark Mode"
  where
    makeOption :: Html () -> Html ()
makeOption = (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ Text
"nav-option"]


headContents :: Text -> DocParams -> Html ()
headContents :: Text -> DocParams -> Html ()
headContents Text
title DocParams{FilePath
Text
CharacterSet
characterSet :: CharacterSet
packageName :: Text
relativeResourcesPath :: FilePath
characterSet :: DocParams -> CharacterSet
packageName :: DocParams -> Text
relativeResourcesPath :: DocParams -> FilePath
..} =
    Html () -> Html ()
forall arg result. Term arg result => arg -> result
head_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
title_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
title
        FilePath -> Html ()
stylesheet (FilePath -> Html ()) -> FilePath -> Html ()
forall a b. (a -> b) -> a -> b
$ FilePath
relativeResourcesPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"index.css"
        FilePath -> Html ()
stylesheet FilePath
"https://fonts.googleapis.com/css2?family=Fira+Code:wght@400;500;600;700&family=Lato:ital,wght@0,400;0,700;1,400&display=swap"
        FilePath -> Html ()
script FilePath
relativeResourcesPath
        [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
meta_ [Text -> Attribute
charset_ Text
"UTF-8"]

-- | main-container component builder of the HTML documentation
mainContainer :: Html() -> Html ()
mainContainer :: Html () -> Html ()
mainContainer = [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"main-container"]

stylesheet :: FilePath -> Html ()
stylesheet :: FilePath -> Html ()
stylesheet FilePath
path =
    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_
        [ Text -> Attribute
rel_ Text
"stylesheet"
        , Text -> Attribute
type_ Text
"text/css"
        , Text -> Attribute
href_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack FilePath
path]

script :: FilePath -> Html ()
script :: FilePath -> Html ()
script FilePath
relativeResourcesPath =
    [Attribute] -> Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
script_
        [ Text -> Attribute
type_ Text
"text/javascript"
        , Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
relativeResourcesPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"index.js"]
        (Text
"" :: Text)