-- | Gathers and organizes all the information for the [Drasil website](https://jacquescarette.github.io/Drasil/).
module Drasil.Website.Body where

import Control.Lens ((^.))

import Language.Drasil.Printers (PrintingInformation(..), defaultConfiguration)
import Database.Drasil
import SysInfo.Drasil
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)
import Data.Drasil.Concepts.Documentation (game, physics, condition, safety)
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

-- | Printing info to get document to generate. Takes in the 'FolderLocation'.
printSetting :: FolderLocation -> PrintingInformation
printSetting :: FolderLocation -> PrintingInformation
printSetting FolderLocation
fl = ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI (FolderLocation -> ChunkDB
symbMap FolderLocation
fl) Stage
Equational PrintingConfiguration
defaultConfiguration

-- | Instead of being an 'SRSDecl', this takes the folder locations and generates the document from there.
mkWebsite :: FolderLocation -> Document
mkWebsite :: FolderLocation -> Document
mkWebsite FolderLocation
fl =
    --Document  -- Title  --  author  (hack for now to show up in proper spot) -- no table of contents -- [Section]
    Title -> Title -> ShowTableOfContents -> [Section] -> Document
Document (String -> Title
S String
websiteTitle) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Title -> Title
namedRef Reference
gitHubRef (String -> Title
S String
"Link to GitHub Repository")) ShowTableOfContents
NoToC forall a b. (a -> b) -> a -> b
$ FolderLocation -> [Section]
sections FolderLocation
fl

-- | 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 -> String
depL :: FilePath
    -- | Haddock documentation root file path. After using @make deploy@, this should be @deploy/docs@.
  , FolderLocation -> String
docsRt :: FilePath
    -- | Example root file path. After using @make deploy@, this should be @deploy/examples@.
  , FolderLocation -> String
exRt :: FilePath
    -- | Package dependency graph root file path. After using @make deploy@, this should be @deploy/graphs@.
  , FolderLocation -> String
graphRt :: FilePath
    -- | Analysis root file path. After using @make deploy@, this should be @deploy/analysis@.
  , FolderLocation -> String
analysisRt :: FilePath
    -- | Type graphs root file path. After using @make deploy@, this should be @deploy\/analysis\/TypeDependencyGraphs@.
  , FolderLocation -> String
typeGraphFolder :: FilePath
    -- | Class-instance graphs root file path. After using @make deploy@, this should be @deploy\/analysis\/DataTable\/packagegraphs@.
  , FolderLocation -> String
classInstFolder :: FilePath
    -- | Repository root, used for linking to generated code in GitHub.
  , FolderLocation -> String
repoRt :: FilePath
    -- | Deploy build number. Currently unused.
  , FolderLocation -> String
buildNum :: FilePath
    -- | Deploy build path. Currently unused.
  , FolderLocation -> String
buildPth :: FilePath
    -- | List of Drasil packages taken from the @Makefile@.
  , FolderLocation -> [String]
packages :: [String]
    }

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

-- | System information.
si :: FolderLocation -> SystemInformation
si :: FolderLocation -> SystemInformation
si FolderLocation
fl = SI {
    _sys :: CI
_sys         = CI
webName,
    _kind :: CI
_kind        = CI
web,
    _authors :: [Person]
_authors     = [] :: [Person],
    _quants :: [QuantityDict]
_quants      = [] :: [QuantityDict],
    _purpose :: Purpose
_purpose     = [],
    _background :: Purpose
_background  = [],
    _concepts :: [UnitalChunk]
_concepts    = [] :: [UnitalChunk],
    _instModels :: [InstanceModel]
_instModels  = [],
    _datadefs :: [DataDefinition]
_datadefs    = [],
    _configFiles :: [String]
_configFiles = [],
    _inputs :: [QuantityDict]
_inputs      = [] :: [QuantityDict],
    _outputs :: [QuantityDict]
_outputs     = [] :: [QuantityDict],
    _defSequence :: [Block SimpleQDef]
_defSequence = [] :: [Block SimpleQDef],
    _constraints :: [ConstrainedChunk]
_constraints = [] :: [ConstrainedChunk],
    _constants :: [ConstQDef]
_constants   = [] :: [ConstQDef],
    _sysinfodb :: ChunkDB
_sysinfodb   = FolderLocation -> ChunkDB
symbMap FolderLocation
fl,
    _usedinfodb :: ChunkDB
_usedinfodb  = ChunkDB
usedDB,
    refdb :: ReferenceDB
refdb        = BibRef -> [ConceptInstance] -> ReferenceDB
rdb [] []
}

-- | 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
-> Section
aboutSec (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref Section
caseStudySec) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref forall a b. (a -> b) -> a -> b
$ String -> Section
docsSec forall a b. (a -> b) -> a -> b
$ FolderLocation -> String
docsRt FolderLocation
fl) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> [String] -> Section
analysisSec (FolderLocation -> String
analysisRt FolderLocation
fl) 
  (FolderLocation -> String
typeGraphFolder FolderLocation
fl) (FolderLocation -> String
classInstFolder FolderLocation
fl) (FolderLocation -> String
graphRt FolderLocation
fl) forall a b. (a -> b) -> a -> b
$ FolderLocation -> [String]
packages FolderLocation
fl) Reference
gitHubRef Reference
wikiRef Reference
infoEncodingWiki Reference
chunksWiki Reference
recipesWiki 
  Reference
paperGOOL Reference
papersWiki, String -> String -> Section
exampleSec (FolderLocation -> String
repoRt FolderLocation
fl) (FolderLocation -> String
exRt FolderLocation
fl), Section
caseStudySec, String -> Section
docsSec (FolderLocation -> String
docsRt FolderLocation
fl), String -> String -> String -> String -> [String] -> Section
analysisSec (FolderLocation -> String
analysisRt FolderLocation
fl) 
  (FolderLocation -> String
typeGraphFolder FolderLocation
fl) (FolderLocation -> String
classInstFolder FolderLocation
fl) (FolderLocation -> String
graphRt FolderLocation
fl) forall a b. (a -> b) -> a -> b
$ FolderLocation -> [String]
packages FolderLocation
fl, FolderLocation -> Section
footer FolderLocation
fl]

-- | Needed for references and terms to work.
symbMap :: FolderLocation -> ChunkDB
symbMap :: FolderLocation -> ChunkDB
symbMap FolderLocation
fl = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ([] :: [QuantityDict]) (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI
webName, CI
web, CI
phsChgMtrl] forall a. [a] -> [a] -> [a]
++ 
  forall a b. (a -> b) -> [a] -> [b]
map SystemInformation -> IdeaDict
getSysName [SystemInformation]
allExampleSI forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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] forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ InstanceModel
fctSfty forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs] forall a. [a] -> [a] -> [a]
++ [IdeaDict
game, IdeaDict
physics, IdeaDict
condition, IdeaDict
glaSlab, IdeaDict
intrslce,
  IdeaDict
slope, IdeaDict
safety, IdeaDict
factor]) ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] 
  [] [] [] forall a b. (a -> b) -> a -> b
$ FolderLocation -> [Reference]
allRefs FolderLocation
fl

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

-- | Empty database needed for 'si' to work.
usedDB :: ChunkDB
usedDB :: ChunkDB
usedDB = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ([] :: [QuantityDict]) ([] :: [IdeaDict])
           ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] [] [] [] ([] :: [Reference])

-- | 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] 
  forall a. [a] -> [a] -> [a]
++ String -> String -> [Reference]
exampleRefs (FolderLocation -> String
repoRt FolderLocation
fl) (FolderLocation -> String
exRt FolderLocation
fl) 
  forall a. [a] -> [a] -> [a]
++ String -> [Reference]
docRefs (FolderLocation -> String
docsRt FolderLocation
fl) 
  forall a. [a] -> [a] -> [a]
++ String -> String -> String -> String -> [String] -> [Reference]
analysisRefs (FolderLocation -> String
analysisRt FolderLocation
fl) (FolderLocation -> String
typeGraphFolder FolderLocation
fl) (FolderLocation -> String
classInstFolder FolderLocation
fl) (FolderLocation -> String
graphRt FolderLocation
fl) (FolderLocation -> [String]
packages FolderLocation
fl)
  forall a. [a] -> [a] -> [a]
++ 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, web :: CI
webName :: CI
webName = String -> NP -> String -> [UID] -> CI
commonIdea String
"websiteName" (String -> NP
cn String
websiteTitle) String
"Drasil" []
web :: CI
web = String -> NP -> String -> [UID] -> CI
commonIdea String
"website" (String -> NP
cn String
"website") String
"web" []

-- * Header Section

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

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

-- | Used for the repository link.
gitHubRef :: Reference
gitHubRef :: Reference
gitHubRef = String -> String -> ShortName -> Reference
makeURI String
"gitHubRepo" String
gitHubInfoURL (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"gitHubRepo")
wikiRef :: Reference
wikiRef :: Reference
wikiRef = String -> String -> ShortName -> Reference
makeURI String
"gitHubWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"gitHubWiki")
infoEncodingWiki :: Reference
infoEncodingWiki :: Reference
infoEncodingWiki = String -> String -> ShortName -> Reference
makeURI String
"InfoEncodingWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Information-Encoding") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"InfoEncodingWiki")
chunksWiki :: Reference
chunksWiki :: Reference
chunksWiki = String -> String -> ShortName -> Reference
makeURI String
"chunksWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Chunks") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"chunksWiki")
recipesWiki :: Reference
recipesWiki :: Reference
recipesWiki = String -> String -> ShortName -> Reference
makeURI String
"recipesWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Recipes") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"recipesWiki")
paperGOOL :: Reference
paperGOOL :: Reference
paperGOOL = String -> String -> ShortName -> Reference
makeURI String
"GOOLPaper" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/blob/master/Papers/GOOL/GOOL.pdf") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"GOOLPaper")
papersWiki :: Reference
papersWiki :: Reference
papersWiki = String -> String -> ShortName -> Reference
makeURI String
"papersWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Drasil-Papers-and-Documents") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"papersWiki")
quickStartWiki :: Reference
quickStartWiki :: Reference
quickStartWiki = String -> String -> ShortName -> Reference
makeURI String
"quickStartWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"#quick-start") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"quickStartWiki")
newWorkspaceSetupWiki :: Reference
newWorkspaceSetupWiki :: Reference
newWorkspaceSetupWiki = String -> String -> ShortName -> Reference
makeURI String
"newWorkspaceSetupWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/New-Workspace-Setup") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"newWorkspaceSetupWiki")
contribGuideWiki :: Reference
contribGuideWiki :: Reference
contribGuideWiki = String -> String -> ShortName -> Reference
makeURI String
"contribGuideWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Contributor's-Guide") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"contribGuideWiki")
workflowWiki :: Reference
workflowWiki :: Reference
workflowWiki = String -> String -> ShortName -> Reference
makeURI String
"workflowWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Workflow") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"workflowWiki")
createProjWiki :: Reference
createProjWiki :: Reference
createProjWiki = String -> String -> ShortName -> Reference
makeURI String
"createProjWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Creating-Your-Project-in-Drasil") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"createProjWiki")
debuggingWiki :: Reference
debuggingWiki :: Reference
debuggingWiki = String -> String -> ShortName -> Reference
makeURI String
"debuggingWiki" (String
gitHubInfoURL forall a. [a] -> [a] -> [a]
++ String
"/wiki/Debugging-in-Drasil") (Title -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ String -> Title
S String
"debuggingWiki")

-- | Hardcoded info for the title, URL, and image path.
websiteTitle :: String
gitHubInfoURL, imagePath :: FilePath
websiteTitle :: String
websiteTitle = String
"Drasil - Generate All the Things!"
gitHubInfoURL :: String
gitHubInfoURL = String
"https://github.com/JacquesCarette/Drasil"
imagePath :: String
imagePath = String
"./images/Icon.png"

-- * Footer Section

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

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

-- uncomment to add in build number and path information
--buildInfo :: String -> String -> Sentence
--buildInfo bnum bPath = S $ "Build number: " ++ bnum ++ ". Generated from " ++ bPath ++ "."