-- | Create the list of Generated Examples for the Drasil website.
module Drasil.Website.Example where

import Language.Drasil hiding (E)
import SysInfo.Drasil (SystemInformation(..))
import Language.Drasil.Code (Choices(..), Lang(..))
import Data.Char (toLower, isSpace)

import qualified Drasil.DblPendulum.Body as DblPendulum (fullSI)
import qualified Drasil.GamePhysics.Body as GamePhysics (fullSI)
import qualified Drasil.GlassBR.Body as GlassBR (fullSI)
import qualified Drasil.HGHC.Body as HGHC (fullSI)
import qualified Drasil.NoPCM.Body as NoPCM (fullSI)
import qualified Drasil.PDController.Body as PDController (fullSI)
import qualified Drasil.Projectile.Body as Projectile (fullSI)
import qualified Drasil.SglPendulum.Body as SglPendulum (fullSI)
import qualified Drasil.SSP.Body as SSP (fullSI)
import qualified Drasil.SWHS.Body as SWHS (fullSI)

-- import choices for code generation
import qualified Drasil.GlassBR.Choices as GlassBR (choices)
import qualified Drasil.NoPCM.Choices as NoPCM (choices)
import qualified Drasil.PDController.Choices as PDController (codeChoices)
import qualified Drasil.Projectile.Choices as Projectile (codedDirName, choiceCombos)
-- the other examples currently do not generate any code.


-- * Gather Example Information
--
-- $example
--
-- First gather all information needed to create an example. This includes system information, descriptions, and choices.
-- These will also be exported for use in CaseStudy.hs.

-- | Each Example gets placed in here.
data Example = E {
  -- | Example system information. Used to get the system name and abbreviation.
  Example -> SystemInformation
sysInfoE :: SystemInformation,
  -- | System description. Currently hard-coded.
  Example -> Sentence
descE :: Sentence,
  -- | Some examples have generated code with specific choices.
  -- They may also have more than one set of choices, so we need a list.
  Example -> [Choices]
choicesE :: [Choices],
  -- | Generated code path.
  Example -> FilePath
codePath :: FilePath,
  -- | Generated documents & doxygen path
  Example -> FilePath
srsDoxPath :: FilePath
}
-- TODO: Automate the gathering of system information, descriptions, and choices.

-- | Records example system information.
allExampleSI :: [SystemInformation]
allExampleSI :: [SystemInformation]
allExampleSI = [SystemInformation
DblPendulum.fullSI, SystemInformation
GamePhysics.fullSI, SystemInformation
GlassBR.fullSI, SystemInformation
HGHC.fullSI, SystemInformation
NoPCM.fullSI, SystemInformation
PDController.fullSI, SystemInformation
Projectile.fullSI, SystemInformation
SglPendulum.fullSI, SystemInformation
SSP.fullSI, SystemInformation
SWHS.fullSI]

-- | Records example descriptions.
allExampleDesc :: [Sentence]
allExampleDesc :: [Sentence]
allExampleDesc = [Sentence
dblPendulumDesc, Sentence
gamePhysDesc, Sentence
glassBRDesc, Sentence
hghcDesc, Sentence
noPCMDesc, Sentence
pdControllerDesc, Sentence
projectileDesc, Sentence
sglPendulumDesc, Sentence
sspDesc, Sentence
swhsDesc]

-- To developer: Fill this list in when more examples can run code. The list
-- needs to be of this form since projectile comes with a list of choice combos.
-- | Records example choices. The order of the list must match up with
-- that in `allExampleSI`, or the Case Studies Table will be incorrect.
allExampleChoices :: [[Choices]]
allExampleChoices :: [[Choices]]
allExampleChoices = [[], [], [Choices
GlassBR.choices], [], [Choices
NoPCM.choices], [Choices
PDController.codeChoices], [Choices]
Projectile.choiceCombos, [], [], []]

-- | Combine system info, description, choices, and file paths into one nice package.
allExamples :: [SystemInformation] -> [Sentence] -> [[Choices]] -> FilePath -> FilePath -> [Example]
allExamples :: [SystemInformation]
-> [Sentence] -> [[Choices]] -> FilePath -> FilePath -> [Example]
allExamples si :: [SystemInformation]
si desc :: [Sentence]
desc choi :: [[Choices]]
choi srsP :: FilePath
srsP doxP :: FilePath
doxP = (SystemInformation -> Sentence -> [Choices] -> Example)
-> [SystemInformation] -> [Sentence] -> [[Choices]] -> [Example]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\x :: SystemInformation
x y :: Sentence
y z :: [Choices]
z -> SystemInformation
-> Sentence -> [Choices] -> FilePath -> FilePath -> Example
E SystemInformation
x Sentence
y [Choices]
z FilePath
srsP FilePath
doxP) [SystemInformation]
si [Sentence]
desc [[Choices]]
choi

-- | Calls 'allExamples' on 'allExampleSI', 'allExampleDesc', and 'allExampleChoices'.
-- Can be considered a "default" version of 'allExamples'.
examples :: FilePath -> FilePath -> [Example]
examples :: FilePath -> FilePath -> [Example]
examples = [SystemInformation]
-> [Sentence] -> [[Choices]] -> FilePath -> FilePath -> [Example]
allExamples [SystemInformation]
allExampleSI [Sentence]
allExampleDesc [[Choices]]
allExampleChoices

-- * Functions to create the list of examples

-- | Create the full list of examples.
fullExList :: FilePath -> FilePath -> RawContent
fullExList :: FilePath -> FilePath -> RawContent
fullExList codePth :: FilePath
codePth srsDoxPth :: FilePath
srsDoxPth = ListType -> RawContent
Enumeration (ListType -> RawContent) -> ListType -> RawContent
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet ([(ItemType, Maybe FilePath)] -> ListType)
-> [(ItemType, Maybe FilePath)] -> ListType
forall a b. (a -> b) -> a -> b
$ [ItemType] -> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Example] -> [ItemType]
allExampleList ([Example] -> [ItemType]) -> [Example] -> [ItemType]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) ([Maybe FilePath] -> [(ItemType, Maybe FilePath)])
-> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> [Maybe FilePath]
forall a. a -> [a]
repeat Maybe FilePath
forall a. Maybe a
Nothing

-- | Create each example point and call 'individualExList' to do the rest.
allExampleList :: [Example] -> [ItemType]
allExampleList :: [Example] -> [ItemType]
allExampleList = (Example -> ItemType) -> [Example] -> [ItemType]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Example
x -> Sentence -> ListType -> ItemType
Nested (Example -> Sentence
nameAndDesc Example
x) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet ([(ItemType, Maybe FilePath)] -> ListType)
-> [(ItemType, Maybe FilePath)] -> ListType
forall a b. (a -> b) -> a -> b
$ [ItemType] -> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Example -> [ItemType]
individualExList Example
x) ([Maybe FilePath] -> [(ItemType, Maybe FilePath)])
-> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> [Maybe FilePath]
forall a. a -> [a]
repeat Maybe FilePath
forall a. Maybe a
Nothing)
  where
    nameAndDesc :: Example -> Sentence
nameAndDesc E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, descE :: Example -> Sentence
descE = Sentence
desc} = FilePath -> Sentence
S (a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) Sentence -> Sentence -> Sentence
+:+ Sentence
desc

-- | Display the points for generated documents and call 'versionList' to display the code.
individualExList :: Example -> [ItemType]
-- No choices mean no generated code, so we do not need to display generated code and thus do not call versionList.
individualExList :: Example -> [ItemType]
individualExList E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [], codePath :: Example -> FilePath
codePath = FilePath
srsP} = 
  [Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S (a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_SRS") Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP "html" (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) (FilePath -> Sentence
S "[HTML]") Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP "pdf" (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) (FilePath -> Sentence
S "[PDF]")]
-- Anything else means we need to display program information, so use versionList.
individualExList ex :: Example
ex@E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, codePath :: Example -> FilePath
codePath = FilePath
srsP} = 
  [Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S (a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_SRS") Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP "html" (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) (FilePath -> Sentence
S "[HTML]") Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP "pdf" (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) (FilePath -> Sentence
S "[PDF]"),
  Sentence -> ListType -> ItemType
Nested (FilePath -> Sentence
S FilePath
generatedCodeTitle) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet ([(ItemType, Maybe FilePath)] -> ListType)
-> [(ItemType, Maybe FilePath)] -> ListType
forall a b. (a -> b) -> a -> b
$ [ItemType] -> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Example -> Lang -> FilePath -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> FilePath -> Reference
getCodeRef Example
ex) ([Maybe FilePath] -> [(ItemType, Maybe FilePath)])
-> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> [Maybe FilePath]
forall a. a -> [a]
repeat Maybe FilePath
forall a. Maybe a
Nothing,
  Sentence -> ListType -> ItemType
Nested (FilePath -> Sentence
S FilePath
generatedCodeDocsTitle) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet ([(ItemType, Maybe FilePath)] -> ListType)
-> [(ItemType, Maybe FilePath)] -> ListType
forall a b. (a -> b) -> a -> b
$ [ItemType] -> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Example -> Lang -> FilePath -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> FilePath -> Reference
getDoxRef Example
noSwiftEx) ([Maybe FilePath] -> [(ItemType, Maybe FilePath)])
-> [Maybe FilePath] -> [(ItemType, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> [Maybe FilePath]
forall a. a -> [a]
repeat Maybe FilePath
forall a. Maybe a
Nothing]
    where
      -- For now, swift does not generate any references using doxygen, so we pretend it doesn't exist in the doxygen list
      noSwiftEx :: Example
noSwiftEx = Example
ex {choicesE :: [Choices]
choicesE = (Choices -> Choices) -> [Choices] -> [Choices]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Choices
x -> Choices
x {lang :: [Lang]
lang = (Lang -> Bool) -> [Lang] -> [Lang]
forall a. (a -> Bool) -> [a] -> [a]
filter (Lang -> Lang -> Bool
forall a. Eq a => a -> a -> Bool
/= Lang
Swift) ([Lang] -> [Lang]) -> [Lang] -> [Lang]
forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x}) ([Choices] -> [Choices]) -> [Choices] -> [Choices]
forall a b. (a -> b) -> a -> b
$ Example -> [Choices]
choicesE Example
ex}

-- | Takes a function that gets the needed references (either references for the code or doxygen references)
-- and the example to create the list out of. For examples that have more than one version of generated code (more than one set of choices)
-- like Projectile, we generate the code and doxygen references for each.
versionList :: (Example -> Lang -> String -> Reference) -> Example -> [ItemType]
versionList :: (Example -> Lang -> FilePath -> Reference) -> Example -> [ItemType]
versionList _ E{choicesE :: Example -> [Choices]
choicesE = []} = [] -- If the choices are empty, then we don't do anything. This pattern should never
                                    -- match (this case should be caught in the function that calls this one),
                                    -- but it is here just to be extra careful.
versionList getRef :: Example -> Lang -> FilePath -> Reference
getRef ex :: Example
ex@E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices]
chcs} =
  (Choices -> ItemType) -> [Choices] -> [ItemType]
forall a b. (a -> b) -> [a] -> [b]
map Choices -> ItemType
versionItem [Choices]
chcs 
  where
    -- Version item displays version name and appends the languages of generated code below.
    versionItem :: Choices -> ItemType
versionItem chc :: Choices
chc = Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S (Choices -> FilePath
verName Choices
chc) Sentence -> Sentence -> Sentence
+:+ [Sentence] -> Sentence
foldlSent_ ((Lang -> Sentence) -> [Lang] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (Choices -> Lang -> Sentence
makeLangRef Choices
chc) ([Lang] -> [Sentence]) -> [Lang] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
chc)
    -- Makes references to the generated languages and formats them nicely.
    makeLangRef :: Choices -> Lang -> Sentence
makeLangRef chc :: Choices
chc lng :: Lang
lng = Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (Example -> Lang -> FilePath -> Reference
getRef Example
ex Lang
lng (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
chc) (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S (FilePath -> Sentence) -> FilePath -> Sentence
forall a b. (a -> b) -> a -> b
$ "[" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Lang -> FilePath
showLang Lang
lng FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "]"

    -- Determine the version name based on the system name and if there is more than one set of choices.
    verName :: Choices -> FilePath
verName chc :: Choices
chc = case [Choices]
chcs of
      -- If there is one set of choices, then the program does not have multiple versions.
      [_] -> a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys
      -- If the above two don't match, we have more than one set of choices and must display every version.
      _   -> FilePath -> Choices -> FilePath
Projectile.codedDirName (a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) Choices
chc

-- | Show function to display program languages to user.
showLang :: Lang -> String
showLang :: Lang -> FilePath
showLang Cpp = "C++"
showLang CSharp = "C Sharp" -- Drasil printers dont like # symbol, so use full word instead.
showLang l :: Lang
l = Lang -> FilePath
forall a. Show a => a -> FilePath
show Lang
l

-- * Examples Section Functions

-- | Example section function generator. Makes a list of examples and generated artifacts.
exampleSec :: FilePath -> FilePath -> Section
exampleSec :: FilePath -> FilePath -> Section
exampleSec codePth :: FilePath
codePth srsDoxPth :: FilePath
srsDoxPth = 
  Sentence -> [Contents] -> [Section] -> Reference -> Section
section Sentence
exampleTitle -- Title
  [Sentence -> Contents
mkParagraph Sentence
exampleIntro, UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents) -> UnlabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> RawContent -> UnlabelledContent
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> RawContent
fullExList FilePath
codePth FilePath
srsDoxPth] -- Contents
  [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence -> Reference
makeSecRef "Examples" (Sentence -> Reference) -> Sentence -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S "Examples" -- Section reference

-- | Example section title.
exampleTitle :: Sentence
exampleTitle :: Sentence
exampleTitle = FilePath -> Sentence
S "Generated Examples"

-- | Example section introduction.
exampleIntro :: Sentence
exampleIntro :: Sentence
exampleIntro = FilePath -> Sentence
S "The development of Drasil follows an example-driven approach, \
  \with a current focus on creating Software Requirement Specifications (SRS). \
  \More specifically, Drasil's knowledge of the domain of Physics has seen significant growth \
  \through the creation of these examples, ranging from mechanics to thermodynamics. Each of the case studies \
  \implemented in Drasil contain their own generated PDF and HTML reports, and in some cases, \
  \their own generated code to solve the problem defined in their respective SRS documents."

-- | Project descriptions.
sglPendulumDesc, dblPendulumDesc, gamePhysDesc, glassBRDesc, hghcDesc, noPCMDesc, pdControllerDesc,
  projectileDesc, sspDesc, swhsDesc :: Sentence

dblPendulumDesc :: Sentence
dblPendulumDesc  = FilePath -> Sentence
S "describes the motion of a double pendulum in 2D."
gamePhysDesc :: Sentence
gamePhysDesc     = FilePath -> Sentence
S "describes the modeling of an open source 2D rigid body physics library used for games."
glassBRDesc :: Sentence
glassBRDesc      = FilePath -> Sentence
S "predicts whether a given glass slab is likely to resist a specified blast."
hghcDesc :: Sentence
hghcDesc         = FilePath -> Sentence
S "describes heat transfer coefficients related to clad."
noPCMDesc :: Sentence
noPCMDesc        = FilePath -> Sentence
S "describes the modelling of a solar water heating system without phase change material."
pdControllerDesc :: Sentence
pdControllerDesc = FilePath -> Sentence
S ""
projectileDesc :: Sentence
projectileDesc   = FilePath -> Sentence
S "describes the motion of a projectile object in free space."
sglPendulumDesc :: Sentence
sglPendulumDesc  = FilePath -> Sentence
S "describes the motion of a single pendulum in 2D."
sspDesc :: Sentence
sspDesc          = FilePath -> Sentence
S "describes the requirements of a slope stability analysis program."
swhsDesc :: Sentence
swhsDesc         = FilePath -> Sentence
S "describes the modelling of a solar water heating system with phase change material."
-- templateDesc     = S "is an empty template document."

-- | Example list titles.
generatedCodeTitle, generatedCodeDocsTitle :: String
generatedCodeTitle :: FilePath
generatedCodeTitle = "Generated Code:"
generatedCodeDocsTitle :: FilePath
generatedCodeDocsTitle = "Generated Code Documentation:"

-- * Helper functions in getting References for SRS, code folders, and Doxygen

-- | Similar to 'showLang', but for use within Drasil for Referencing and UIDs.
convertLang :: Lang -> String
convertLang :: Lang -> FilePath
convertLang Cpp = "cpp"
convertLang CSharp = "csharp"
convertLang Java = "java"
convertLang Python = "python"
convertLang Swift = "swift"

-- | Generate a reference towards the code folder. Uses 'getCodePath' to find the code path.
getCodeRef :: Example -> Lang -> String -> Reference
-- We don't have to worry about the case of empty list when pattern matching
-- since that was checked in an earlier function.
--
-- Pattern matches so that examples that only have a single set of choices will be referenced one way.
getCodeRef :: Example -> Lang -> FilePath -> Reference
getCodeRef ex :: Example
ex@E{sysInfoE :: Example -> SystemInformation
sysInfoE=SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices]
chcs} l :: Lang
l verName :: FilePath
verName = 
  FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
refUID FilePath
refURI ShortName
refShortNm
  where
    -- Append system name and program language to ensure a unique id for each.
    refUID :: FilePath
refUID = "codeRef" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sysName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
programLang
    -- Finds the folder path that holds code for the respective program and system.
    refURI :: FilePath
refURI = FilePath -> FilePath -> FilePath -> FilePath
getCodePath (Example -> FilePath
codePath Example
ex) FilePath
sysName FilePath
programLang
    -- Shortname is the same as the UID, just converted to a Sentence.
    refShortNm :: ShortName
refShortNm = Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
refUID

    -- System name, different between one set of choices and multiple sets.
    sysName :: FilePath
sysName = case [Choices]
chcs of 
      [_] -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys
      _   -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
verName
    -- Program language converted for use in file folder navigation.
    programLang :: FilePath
programLang = Lang -> FilePath
convertLang Lang
l

-- | Similar to 'getCodeRef', but gets the doxygen references and uses 'getDoxRef' instead.
getDoxRef :: Example -> Lang -> String -> Reference
getDoxRef :: Example -> Lang -> FilePath -> Reference
getDoxRef ex :: Example
ex@E{sysInfoE :: Example -> SystemInformation
sysInfoE=SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices]
chcs} l :: Lang
l verName :: FilePath
verName = 
  FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
refUID FilePath
refURI ShortName
refShortNm
  where
    refUID :: FilePath
refUID = "doxRef" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sysName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
programLang
    refURI :: FilePath
refURI = FilePath -> FilePath -> FilePath -> FilePath
getDoxPath (Example -> FilePath
srsDoxPath Example
ex) FilePath
sysName FilePath
programLang
    refShortNm :: ShortName
refShortNm = Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
refUID

    sysName :: FilePath
sysName = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys
    -- Here is the only difference from getCodeRef. When there is more than one set of choices,
    -- we append version name to program language since the organization of folders follows this way.
    programLang :: FilePath
programLang = case [Choices]
chcs of 
      [_] -> Lang -> FilePath
convertLang Lang
l
      _   -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
verName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Lang -> FilePath
convertLang Lang
l

-- | Make references for each of the generated SRS files.
getSRSRef :: FilePath -> String -> String -> Reference
getSRSRef :: FilePath -> FilePath -> FilePath -> Reference
getSRSRef path :: FilePath
path sufx :: FilePath
sufx ex :: FilePath
ex = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
refUID (FilePath -> FilePath -> FilePath -> FilePath
getSRSPath FilePath
path ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sufx) FilePath
ex) (ShortName -> Reference) -> ShortName -> Reference
forall a b. (a -> b) -> a -> b
$ Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S FilePath
refUID
  where
    refUID :: FilePath
refUID = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sufx FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "Ref" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ex

-- | Get the paths of where each reference exist for SRS files. Some example abbreviations have spaces,
-- so we just filter those out. The suffix should only be either html or pdf.
getSRSPath :: FilePath -> String -> String -> FilePath
getSRSPath :: FilePath -> FilePath -> FilePath -> FilePath
getSRSPath path :: FilePath
path sufx :: FilePath
sufx ex :: FilePath
ex = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) FilePath
ex)
  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/SRS/srs/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) FilePath
ex FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_SRS." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sufx

-- | Get the file paths for generated code and doxygen locations.
getCodePath, getDoxPath :: FilePath -> String -> String -> FilePath
-- | Uses 'repoRt' path (codePath in this module).
getCodePath :: FilePath -> FilePath -> FilePath -> FilePath
getCodePath path :: FilePath
path ex :: FilePath
ex programLang :: FilePath
programLang = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "code/stable/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) FilePath
ex) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/src/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
programLang -- need repoCommit path
-- | Uses 'exRt' path (srsDoxPath in this module).
getDoxPath :: FilePath -> FilePath -> FilePath -> FilePath
getDoxPath path :: FilePath
path ex :: FilePath
ex programLang :: FilePath
programLang = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) FilePath
ex) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/doxygen/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
programLang FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/index.html" -- need example path

-- | Gather all references used in making the Examples section.
exampleRefs :: FilePath -> FilePath -> [Reference]
exampleRefs :: FilePath -> FilePath -> [Reference]
exampleRefs codePth :: FilePath
codePth srsDoxPth :: FilePath
srsDoxPth = (Example -> [Reference]) -> [Example] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [Reference]
getCodeRefDB (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> [Reference]) -> [Example] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [Reference]
getDoxRefDB (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsDoxPth "html" (FilePath -> Reference)
-> (Example -> FilePath) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> FilePath
getAbrv) (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsDoxPth "pdf" (FilePath -> Reference)
-> (Example -> FilePath) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> FilePath
getAbrv) (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth)

-- | Helpers to pull code and doxygen references from an example.
-- Creates a reference for every possible choice in every possible language.
getCodeRefDB, getDoxRefDB :: Example -> [Reference]
getCodeRefDB :: Example -> [Reference]
getCodeRefDB ex :: Example
ex = (Choices -> [Reference]) -> [Choices] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Choices
x -> (Lang -> Reference) -> [Lang] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (\y :: Lang
y -> Example -> Lang -> FilePath -> Reference
getCodeRef Example
ex Lang
y (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
x) ([Lang] -> [Reference]) -> [Lang] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x) ([Choices] -> [Reference]) -> [Choices] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Example -> [Choices]
choicesE Example
ex
  where
    verName :: Choices -> FilePath
verName = FilePath -> Choices -> FilePath
Projectile.codedDirName (Example -> FilePath
getAbrv Example
ex)
getDoxRefDB :: Example -> [Reference]
getDoxRefDB ex :: Example
ex = (Choices -> [Reference]) -> [Choices] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Choices
x -> (Lang -> Reference) -> [Lang] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (\y :: Lang
y -> Example -> Lang -> FilePath -> Reference
getDoxRef Example
ex Lang
y (FilePath -> Reference) -> FilePath -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
x) ([Lang] -> [Reference]) -> [Lang] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x) ([Choices] -> [Reference]) -> [Choices] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Example -> [Choices]
choicesE Example
ex
  where
    verName :: Choices -> FilePath
verName = FilePath -> Choices -> FilePath
Projectile.codedDirName (Example -> FilePath
getAbrv Example
ex)

-- | Helper to pull the system name (abbreviation) from an 'Example'.
getAbrv :: Example -> String
getAbrv :: Example -> FilePath
getAbrv E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys=a
sys}} = a -> FilePath
forall c. CommonIdea c => c -> FilePath
abrv a
sys