-- | Gathers and organizes all the information for the [Drasil website](https://jacquescarette.github.io/Drasil/).
module Drasil.Website.Body (
  FolderLocation(..), si, symbMap,
  gitHubRef, sections, websiteTitle,
) where

import Control.Lens ((^.))

import Drasil.Database
import Drasil.Generator (cdb)
import Drasil.System
import Language.Drasil
import Drasil.DocLang (findAllRefs)

import Drasil.Website.Introduction (introSec)
import Drasil.Website.About (aboutSec)
import Drasil.Website.CaseStudy (caseStudySec)
import Drasil.Website.Example (exampleSec, exampleRefs, allExampleSI)
import Drasil.Website.Documentation (docsSec, docRefs)
import Drasil.Website.Analysis (analysisSec, analysisRefs)
import Drasil.Website.GettingStarted (gettingStartedSec)
import Data.Drasil.Concepts.Physics (pendulum, motion, rigidBody, twoD)
import Drasil.GlassBR.Unitals (blast)
import Drasil.GlassBR.Concepts (glaSlab)
import Data.Drasil.Concepts.Thermodynamics (heatTrans)
import Drasil.SWHS.Concepts (sWHT, water, phsChgMtrl)
import Drasil.PDController.Concepts (pidC)
import Drasil.Projectile.Concepts (target, projectile)
import Drasil.SSP.Defs (crtSlpSrf, intrslce, slope, slpSrf, factor)
import Data.Drasil.Concepts.SolidMechanics (shearForce, normForce)
import Drasil.SSP.IMods (fctSfty)

-- * Functions to Generate the Website Through Drasil

-- | Folder locations based on environment variables (using 'getEnv' in "Drasil.Website.Main").
data FolderLocation = Folder {
    -- | Deploy location. Currently unused, but may be needed in the future.
    FolderLocation -> FilePath
depL :: FilePath
    -- | Haddock documentation root file path. After using @make deploy@, this should be @deploy/docs@.
  , FolderLocation -> FilePath
docsRt :: FilePath
    -- | Example root file path. After using @make deploy@, this should be @deploy/examples@.
  , FolderLocation -> FilePath
exRt :: FilePath
    -- | Package dependency graph root file path. After using @make deploy@, this should be @deploy/graphs@.
  , FolderLocation -> FilePath
graphRt :: FilePath
    -- | Analysis root file path. After using @make deploy@, this should be @deploy/analysis@.
  , FolderLocation -> FilePath
analysisRt :: FilePath
    -- | Type graphs root file path. After using @make deploy@, this should be @deploy\/analysis\/TypeDependencyGraphs@.
  , FolderLocation -> FilePath
typeGraphFolder :: FilePath
    -- | Class-instance graphs root file path. After using @make deploy@, this should be @deploy\/analysis\/DataTable\/packagegraphs@.
  , FolderLocation -> FilePath
classInstFolder :: FilePath
    -- | Repository root, used for linking to generated code in GitHub.
  , FolderLocation -> FilePath
repoRt :: FilePath
    -- | Deploy build number. Currently unused.
  , FolderLocation -> FilePath
buildNum :: FilePath
    -- | Deploy build path. Currently unused.
  , FolderLocation -> FilePath
buildPth :: FilePath
    -- | List of Drasil packages taken from the @Makefile@.
  , FolderLocation -> [FilePath]
packages :: [String]
    }

-- TODO: Should the website be using a ``System''? This is primarily for the SmithEtAl template.
--       It seems like the website is primarily that functions on a chunkdb.

-- | System information.
si :: FolderLocation -> System
si :: FolderLocation -> System
si FolderLocation
fl = CI
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [DefinedQuantityDict]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [FilePath]
-> [DefinedQuantityDict]
-> [DefinedQuantityDict]
-> [ConstrConcept]
-> [ConstQDef]
-> ChunkDB
-> [Reference]
-> System
forall a e h i j.
(CommonIdea a, Idea a, Quantity e, Eq e, MayHaveUnit e, Concept e,
 Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [FilePath]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> [Reference]
-> System
mkSystem
  CI
webName SystemKind
Website []
  [] [] [] []
  ([] :: [DefinedQuantityDict])
  [] [] [] []
  []
  ([] :: [DefinedQuantityDict]) ([] :: [DefinedQuantityDict]) ([] :: [ConstrConcept]) []
  ChunkDB
symbMap (FolderLocation -> [Reference]
allRefs FolderLocation
fl)

-- | Puts all the sections in order. Basically the website version of the SRS declaration.
sections :: FolderLocation -> [Section]
sections :: FolderLocation -> [Section]
sections FolderLocation
fl = [Section
headerSec, Section
introSec, Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Section
gettingStartedSec Reference
quickStartWiki Reference
newWorkspaceSetupWiki Reference
contribGuideWiki Reference
workflowWiki
  Reference
createProjWiki Reference
debuggingWiki, Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Reference
-> Section
aboutSec (Section -> Reference
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref Section
caseStudySec) (Section -> Reference
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref (Section -> Reference) -> Section -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath -> Section
docsSec (FilePath -> Section) -> FilePath -> Section
forall a b. (a -> b) -> a -> b
$ FolderLocation -> FilePath
docsRt FolderLocation
fl) (Section -> Reference
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref (Section -> Reference) -> Section -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> FilePath -> FilePath -> [FilePath] -> Section
analysisSec (FolderLocation -> FilePath
analysisRt FolderLocation
fl)
  (FolderLocation -> FilePath
typeGraphFolder FolderLocation
fl) (FolderLocation -> FilePath
classInstFolder FolderLocation
fl) (FolderLocation -> FilePath
graphRt FolderLocation
fl) ([FilePath] -> Section) -> [FilePath] -> Section
forall a b. (a -> b) -> a -> b
$ FolderLocation -> [FilePath]
packages FolderLocation
fl) Reference
gitHubRef Reference
wikiRef Reference
infoEncodingWiki Reference
chunksWiki Reference
recipesWiki
  Reference
paperGOOL Reference
papersWiki Reference
icsePositionPaper Reference
danPoster Reference
wellUnderstoodPaper, FilePath -> FilePath -> Section
exampleSec (FolderLocation -> FilePath
repoRt FolderLocation
fl) (FolderLocation -> FilePath
exRt FolderLocation
fl), Section
caseStudySec, FilePath -> Section
docsSec (FolderLocation -> FilePath
docsRt FolderLocation
fl),
  FilePath
-> FilePath -> FilePath -> FilePath -> [FilePath] -> Section
analysisSec (FolderLocation -> FilePath
analysisRt FolderLocation
fl) (FolderLocation -> FilePath
typeGraphFolder FolderLocation
fl) (FolderLocation -> FilePath
classInstFolder FolderLocation
fl) (FolderLocation -> FilePath
graphRt FolderLocation
fl) ([FilePath] -> Section) -> [FilePath] -> Section
forall a b. (a -> b) -> a -> b
$ FolderLocation -> [FilePath]
packages FolderLocation
fl, FolderLocation -> Section
footer FolderLocation
fl]

-- | Needed for references and terms to work.
symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = [DefinedQuantityDict]
-> [IdeaDict]
-> [ConceptChunk]
-> [UnitDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Citation]
-> [LabelledContent]
-> ChunkDB
cdb ([] :: [DefinedQuantityDict]) ((CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI
webName, CI
phsChgMtrl, CI
twoD] [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++
  (System -> IdeaDict) -> [System] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map System -> IdeaDict
getSysName [System]
allExampleSI [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk
pendulum, ConceptChunk
motion, ConceptChunk
rigidBody, ConceptChunk
blast,
  ConceptChunk
heatTrans, ConceptChunk
sWHT, ConceptChunk
water, ConceptChunk
pidC, ConceptChunk
target, ConceptChunk
projectile, ConceptChunk
crtSlpSrf, ConceptChunk
shearForce,
  ConceptChunk
normForce, ConceptChunk
slpSrf] [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [DefinedQuantityDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (DefinedQuantityDict -> IdeaDict)
-> DefinedQuantityDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ InstanceModel
fctSfty InstanceModel
-> Getting DefinedQuantityDict InstanceModel DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict InstanceModel DefinedQuantityDict
forall d. DefinesQuantity d => Getter d DefinedQuantityDict
Getter InstanceModel DefinedQuantityDict
defLhs] [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [IdeaDict
glaSlab, IdeaDict
intrslce,
  IdeaDict
slope, IdeaDict
factor]) ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] []
  [] [] []

-- | Helper to get the system name as an 'IdeaDict' from 'System'.
getSysName :: System -> IdeaDict
getSysName :: System -> IdeaDict
getSysName SI{_sys :: ()
_sys = a
nm} = a -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw a
nm

-- | Holds all references and links used in the website.
allRefs :: FolderLocation -> [Reference]
allRefs :: FolderLocation -> [Reference]
allRefs FolderLocation
fl = [Reference
gitHubRef, Reference
wikiRef, Reference
infoEncodingWiki, Reference
chunksWiki, Reference
recipesWiki, Reference
paperGOOL, Reference
papersWiki,
  Reference
quickStartWiki, Reference
newWorkspaceSetupWiki, Reference
contribGuideWiki, Reference
workflowWiki, Reference
createProjWiki, Reference
debuggingWiki,
  Reference
icsePositionPaper, Reference
danPoster, Reference
wellUnderstoodPaper]
  [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> [Reference]
exampleRefs (FolderLocation -> FilePath
repoRt FolderLocation
fl) (FolderLocation -> FilePath
exRt FolderLocation
fl)
  [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ FilePath -> [Reference]
docRefs (FolderLocation -> FilePath
docsRt FolderLocation
fl)
  [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ FilePath
-> FilePath -> FilePath -> FilePath -> [FilePath] -> [Reference]
analysisRefs (FolderLocation -> FilePath
analysisRt FolderLocation
fl) (FolderLocation -> FilePath
typeGraphFolder FolderLocation
fl) (FolderLocation -> FilePath
classInstFolder FolderLocation
fl) (FolderLocation -> FilePath
graphRt FolderLocation
fl) (FolderLocation -> [FilePath]
packages FolderLocation
fl)
  [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ (Section -> [Reference]) -> [Section] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section -> [Reference]
findAllRefs (FolderLocation -> [Section]
sections FolderLocation
fl)

-- | Used for system name and kind inside of 'si'.
webName :: CI
webName :: CI
webName = FilePath -> NP -> FilePath -> [UID] -> CI
commonIdea FilePath
"websiteName" (FilePath -> NP
cn FilePath
websiteTitle) FilePath
"Drasil" [] -- FIXME: Improper use of a `CI`.

-- * Header Section

-- | Header section creator.
headerSec :: Section
headerSec :: Section
headerSec =
  Sentence -> [Contents] -> [Section] -> Reference -> Section
section Sentence
EmptyS -- No title
  [LabelledContent -> Contents
LlC LabelledContent
imageContent] -- Contents
  [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence -> Reference
makeSecRef FilePath
"Header" (Sentence -> Reference) -> Sentence -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"Header" -- Section reference

-- | For the drasil tree image on the website.
imageContent :: LabelledContent
imageContent :: LabelledContent
imageContent = Reference -> RawContent -> LabelledContent
llcc (FilePath -> Reference
makeFigRef FilePath
"Drasil") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> FilePath -> MaxWidthPercent -> RawContent
figNoCapWithWidth Sentence
EmptyS FilePath
imagePath MaxWidthPercent
50

-- | Used for the repository link.
gitHubRef :: Reference
gitHubRef :: Reference
gitHubRef = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"gitHubRepo" FilePath
gitHubInfoURL (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"gitHubRepo")
wikiRef :: Reference
wikiRef :: Reference
wikiRef = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"gitHubWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"gitHubWiki")
infoEncodingWiki :: Reference
infoEncodingWiki :: Reference
infoEncodingWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"InfoEncodingWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Information-Encoding") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"InfoEncodingWiki")
chunksWiki :: Reference
chunksWiki :: Reference
chunksWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"chunksWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Chunks") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"chunksWiki")
recipesWiki :: Reference
recipesWiki :: Reference
recipesWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"recipesWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Recipes") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"recipesWiki")
paperGOOL :: Reference
paperGOOL :: Reference
paperGOOL = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"GOOLPaper" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/blob/main/Papers/GOOL/GOOL.pdf") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"GOOLPaper")
papersWiki :: Reference
papersWiki :: Reference
papersWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"papersWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Drasil-Papers-and-Documents") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"papersWiki")
icsePositionPaper :: Reference
icsePositionPaper :: Reference
icsePositionPaper = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"icsePositionPaper" (FilePath
danContributionPath
  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/ICSE%20Workshop%20-%20SE4Science/ICSE_LiterateFrameworkForSCSoftware_LSS.pdf") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"icsePositionPaper")
danPoster :: Reference
danPoster :: Reference
danPoster = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"danPoster" (FilePath
danContributionPath
  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/CAS%20Poster%20Competition/Poster/DrasilPoster.pdf") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"danPoster")
wellUnderstoodPaper :: Reference
wellUnderstoodPaper :: Reference
wellUnderstoodPaper = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"wellUnderstoodPaper" (FilePath
gitHubInfoURL
  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/blob/master/Papers/WellUnderstood/wu.pdf") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"wellUnderstoodPaper")
quickStartWiki :: Reference
quickStartWiki :: Reference
quickStartWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"quickStartWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"#quick-start") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"quickStartWiki")
newWorkspaceSetupWiki :: Reference
newWorkspaceSetupWiki :: Reference
newWorkspaceSetupWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"newWorkspaceSetupWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/New-Workspace-Setup") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"newWorkspaceSetupWiki")
contribGuideWiki :: Reference
contribGuideWiki :: Reference
contribGuideWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"contribGuideWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Contributor's-Guide") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"contribGuideWiki")
workflowWiki :: Reference
workflowWiki :: Reference
workflowWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"workflowWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Workflow") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"workflowWiki")
createProjWiki :: Reference
createProjWiki :: Reference
createProjWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"createProjWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Creating-Your-Project-in-Drasil") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"createProjWiki")
debuggingWiki :: Reference
debuggingWiki :: Reference
debuggingWiki = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
"debuggingWiki" (FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/wiki/Debugging-in-Drasil") (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"debuggingWiki")

-- | Hardcoded info for the title, URL, and image path.
websiteTitle :: String
gitHubInfoURL, imagePath, danContributionPath :: FilePath
websiteTitle :: FilePath
websiteTitle = FilePath
"Drasil - Generate All the Things!"
gitHubInfoURL :: FilePath
gitHubInfoURL = FilePath
"https://github.com/JacquesCarette/Drasil"
danContributionPath :: FilePath
danContributionPath = FilePath
gitHubInfoURL FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/blob/master/People/Dan"
imagePath :: FilePath
imagePath = FilePath
"./images/Icon.png"

-- * Footer Section

-- | Create the footer section.
footer :: FolderLocation -> Section
footer :: FolderLocation -> Section
footer FolderLocation
_ = Sentence -> [Contents] -> [Section] -> Reference -> Section
section Sentence
EmptyS [Sentence -> Contents
mkParagraph Sentence
copyrightInfo] [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence -> Reference
makeSecRef FilePath
"Footer" (Sentence -> Reference) -> Sentence -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
"Footer"

-- | 'footer' contents.
copyrightInfo :: Sentence
copyrightInfo :: Sentence
copyrightInfo = FilePath -> Sentence
S FilePath
"Copyright (c) Jacques Carette, 2021. All rights reserved. This website is a software artifact generated by Drasil."