{-# LANGUAGE TupleSections #-}

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

import Control.Lens ((^.))

import Language.Drasil hiding (E)
import Drasil.System (System(..), programName, sysName)
import Language.Drasil.Code (Choices(..), Lang(..))
import Data.Char (toLower)
import Language.Drasil.Printers (Format(..))
import Drasil.Generator (codedDirName)

import qualified Drasil.DblPend.Body as DblPend (si)
import qualified Drasil.GamePhysics.Body as GamePhysics (si)
import qualified Drasil.GlassBR.Body as GlassBR (si)
import qualified Drasil.HGHC.Body as HGHC (si)
import qualified Drasil.SWHSNoPCM.Body as NoPCM (si)
import qualified Drasil.PDController.Body as PDController (si)
import qualified Drasil.Projectile.Body as Projectile (si)
import qualified Drasil.SglPend.Body as SglPend (si)
import qualified Drasil.SSP.Body as SSP (si)
import qualified Drasil.SWHS.Body as SWHS (si)

-- import choices for code generation
import qualified Drasil.DblPend.Choices as DblPend (choices)
import qualified Drasil.GlassBR.Choices as GlassBR (choices)
import qualified Drasil.SWHSNoPCM.Choices as NoPCM (choices)
import qualified Drasil.PDController.Choices as PDController (choices)
import qualified Drasil.Projectile.Choices as Projectile (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 -> System
systemE :: System,
  -- | 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 -> String
codePath :: FilePath,
  -- | Generated documents & doxygen path
  Example -> String
srsDoxPath :: FilePath
}
-- TODO: Automate the gathering of system information, descriptions, and choices.

-- | Records example system information.
allExampleSI :: [System]
allExampleSI :: [System]
allExampleSI = [
  System
DblPend.si,
  System
GamePhysics.si,
  System
GlassBR.si,
  System
HGHC.si,
  System
NoPCM.si,
  System
PDController.si,
  System
Projectile.si,
  System
SglPend.si,
  System
SSP.si,
  System
SWHS.si]

-- 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
DblPend.choices], [], [Choices
GlassBR.choices], [], [Choices
NoPCM.choices], [Choices
PDController.choices], ((Choices, [Mod]) -> Choices) -> [(Choices, [Mod])] -> [Choices]
forall a b. (a -> b) -> [a] -> [b]
map (Choices, [Mod]) -> Choices
forall a b. (a, b) -> a
fst [(Choices, [Mod])]
Projectile.choiceCombos, [], [], []]

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

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

-- * Functions to create the list of examples

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

-- | 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 (\Example
x -> Header -> ListType -> ItemType
Nested (Example -> Header
nameAndDesc Example
x) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe String)] -> ListType
Bullet ([(ItemType, Maybe String)] -> ListType)
-> [(ItemType, Maybe String)] -> ListType
forall a b. (a -> b) -> a -> b
$ (ItemType -> (ItemType, Maybe String))
-> [ItemType] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (, Maybe String
forall a. Maybe a
Nothing) (Example -> [ItemType]
individualExList Example
x))
  where
    nameAndDesc :: Example -> Header
nameAndDesc E{systemE :: Example -> System
systemE = si :: System
si@SI{_purpose :: System -> Purpose
_purpose = Purpose
purp}} = String -> Header
S (CI -> String
forall c. CommonIdea c => c -> String
abrv (CI -> String) -> CI -> String
forall a b. (a -> b) -> a -> b
$ System
si System -> Getting CI System CI -> CI
forall s a. s -> Getting a s a -> a
^. Getting CI System CI
forall c. HasSystem c => Lens' c CI
Lens' System CI
sysName) Header -> Header -> Header
+:+ String -> Header
S String
" - To" Header -> Header -> Header
+:+. Purpose -> Header
forall a. HasCallStack => [a] -> a
head Purpose
purp

-- | 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 ex :: Example
ex@E{choicesE :: Example -> [Choices]
choicesE = [], codePath :: Example -> String
codePath = String
srsP} =
  [Header -> ItemType
Flat (Header -> ItemType) -> Header -> ItemType
forall a b. (a -> b) -> a -> b
$ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (Example -> Reference
buildDrasilExSrcRef Example
ex) (String -> Header
S String
"Drasil Source Code"),
  Header -> ItemType
Flat (Header -> ItemType) -> Header -> ItemType
forall a b. (a -> b) -> a -> b
$ String -> Header
S String
"SRS:" Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
HTML (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[HTML]")
  Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
TeX (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[PDF]")
  Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
MDBook (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[mdBook]")]
-- Anything else means we need to display program information, so use versionList.
individualExList ex :: Example
ex@E{codePath :: Example -> String
codePath = String
srsP} =
  [Header -> ItemType
Flat (Header -> ItemType) -> Header -> ItemType
forall a b. (a -> b) -> a -> b
$ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (Example -> Reference
buildDrasilExSrcRef Example
ex) (String -> Header
S String
"Drasil Source Code"),
  Header -> ItemType
Flat (Header -> ItemType) -> Header -> ItemType
forall a b. (a -> b) -> a -> b
$ String -> Header
S String
"SRS:" Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
HTML (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[HTML]")
  Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
TeX (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[PDF]")
  Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
MDBook (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[mdBook]")
  Header -> Header -> Header
+:+ Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (String -> Format -> String -> Reference
getSRSRef String
srsP Format
Jupyter (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex) (String -> Header
S String
"[Jupyter (HTML)]"),
  Header -> ListType -> ItemType
Nested (String -> Header
S String
generatedCodeTitle) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe String)] -> ListType
Bullet ([(ItemType, Maybe String)] -> ListType)
-> [(ItemType, Maybe String)] -> ListType
forall a b. (a -> b) -> a -> b
$ (ItemType -> (ItemType, Maybe String))
-> [ItemType] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (, Maybe String
forall a. Maybe a
Nothing) ((Example -> Lang -> String -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> String -> Reference
getCodeRef Example
ex),
  Header -> ListType -> ItemType
Nested (String -> Header
S String
generatedCodeDocsTitle) (ListType -> ItemType) -> ListType -> ItemType
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe String)] -> ListType
Bullet ([(ItemType, Maybe String)] -> ListType)
-> [(ItemType, Maybe String)] -> ListType
forall a b. (a -> b) -> a -> b
$ (ItemType -> (ItemType, Maybe String))
-> [ItemType] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (, Maybe String
forall a. Maybe a
Nothing) ((Example -> Lang -> String -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> String -> Reference
getDoxRef Example
noSwiftJlEx)]
    where
      -- For now, swift does not generate any references using doxygen, so we pretend it doesn't exist in the doxygen list
      noSwiftJlEx :: Example
noSwiftJlEx = Example
ex {choicesE = map (\Choices
x -> Choices
x {lang = filter
        (\Lang
l -> Lang
l Lang -> Lang -> Bool
forall a. Eq a => a -> a -> Bool
/= Lang
Swift Bool -> Bool -> Bool
&& Lang
l Lang -> Lang -> Bool
forall a. Eq a => a -> a -> Bool
/= Lang
Julia) $ lang x}) $ choicesE 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 -> String -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> String -> Reference
_ 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 Example -> Lang -> String -> Reference
getRef ex :: Example
ex@E{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 Choices
chc = Header -> ItemType
Flat (Header -> ItemType) -> Header -> ItemType
forall a b. (a -> b) -> a -> b
$ String -> Header
S (Choices -> String
verName Choices
chc) Header -> Header -> Header
+:+ Purpose -> Header
foldlSent_ ((Lang -> Header) -> [Lang] -> Purpose
forall a b. (a -> b) -> [a] -> [b]
map (Choices -> Lang -> Header
makeLangRef Choices
chc) ([Lang] -> Purpose) -> [Lang] -> Purpose
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 -> Header
makeLangRef Choices
chc Lang
lng = Reference -> Header -> Header
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (Example -> Lang -> String -> Reference
getRef Example
ex Lang
lng (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> String
verName Choices
chc) (Header -> Header) -> Header -> Header
forall a b. (a -> b) -> a -> b
$ String -> Header
S (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Lang -> String
showLang Lang
lng String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

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

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

-- * Examples Section Functions

-- | Example section function generator. Makes a list of examples and generated artifacts.
exampleSec :: FilePath -> FilePath -> Section
exampleSec :: String -> String -> Section
exampleSec String
codePth String
srsDoxPth =
  Header -> [Contents] -> [Section] -> Reference -> Section
section Header
exampleTitle -- Title
  [Header -> Contents
mkParagraph Header
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
$ String -> String -> RawContent
fullExList String
codePth String
srsDoxPth] -- Contents
  [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ String -> Header -> Reference
makeSecRef String
"Examples" (Header -> Reference) -> Header -> Reference
forall a b. (a -> b) -> a -> b
$ String -> Header
S String
"Examples" -- Section reference

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

-- | Example section introduction.
exampleIntro :: Sentence
exampleIntro :: Header
exampleIntro = String -> Header
S String
"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 contains its own generated PDF and HTML reports, and in some cases, \
  \its own generated code to solve the problem defined in their respective SRS documents."

-- | Example list titles.
generatedCodeTitle, generatedCodeDocsTitle :: String
generatedCodeTitle :: String
generatedCodeTitle = String
"Generated Code:"
generatedCodeDocsTitle :: String
generatedCodeDocsTitle = String
"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 -> String
convertLang Lang
Cpp = String
"cpp"
convertLang Lang
CSharp = String
"csharp"
convertLang Lang
Java = String
"java"
convertLang Lang
Python = String
"python"
convertLang Lang
Swift = String
"swift"
convertLang Lang
Julia = String
"julia"

-- | 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 -> String -> Reference
getCodeRef ex :: Example
ex@E{choicesE :: Example -> [Choices]
choicesE = [Choices]
chcs} Lang
l String
verName =
  String -> String -> ShortName -> Reference
makeURI String
refUID String
refURI ShortName
refShortNm
  where
    -- Append system name and program language to ensure a unique id for each.
    refUID :: String
refUID = String
"codeRef" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exFolder String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
programLang
    -- Finds the folder path that holds code for the respective program and system.
    refURI :: String
refURI = String -> String -> String -> String
getCodePath (Example -> String
codePath Example
ex) String
exFolder String
programLang
    -- Shortname is the same as the UID, just converted to a Sentence.
    refShortNm :: ShortName
refShortNm = Header -> ShortName
shortname' (Header -> ShortName) -> Header -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Header
S String
refUID

    -- System name, different between one set of choices and multiple sets.
    exFolder :: String
exFolder = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++
      if [Choices] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Choices]
chcs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
verName else String
""
    -- Program language converted for use in file folder navigation.
    programLang :: String
programLang = Lang -> String
convertLang Lang
l

-- | Similar to 'getCodeRef', but builds the source code references
buildDrasilExSrcRef :: Example -> Reference
buildDrasilExSrcRef :: Example -> Reference
buildDrasilExSrcRef Example
ex =
  String -> String -> ShortName -> Reference
makeURI String
refUID String
refURI ShortName
refShortNm
  where
    refUID :: String
refUID = String
"srcCodeRef" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exFolder
    refURI :: String
refURI = String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"code/drasil-example/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exFolder
    refShortNm :: ShortName
refShortNm = Header -> ShortName
shortname' (Header -> ShortName) -> Header -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Header
S String
refUID
    exFolder :: String
exFolder = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Example -> String
exName Example
ex
    path :: String
path = Example -> String
codePath Example
ex

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

    progName :: String
progName = Example -> String
exName Example
ex
    -- 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 :: String
programLang = case [Choices]
chcs of
      [Choices
_] -> Lang -> String
convertLang Lang
l
      [Choices]
_   -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
verName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Lang -> String
convertLang Lang
l

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

-- | Get the paths of where each reference exist for SRS files. Some example abbreviations have spaces,
-- so we just filter those out.
getSRSPath :: FilePath -> Format -> String -> FilePath
getSRSPath :: String -> Format -> String -> String
getSRSPath String
path Format
format String
ex = String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/SRS/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
format String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
sufx Format
format
  where
    sufx :: Format -> String
sufx Format
MDBook  = String
"book"
    sufx Format
HTML    = String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_SRS.html"
    sufx Format
TeX     = String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_SRS.pdf"
    sufx Format
Jupyter = String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_SRS.html"
    sufx Format
Plain   = String -> String
forall a. HasCallStack => String -> a
error String
"Plain SRS display is not supported."

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

-- | Gather all references used in making the Examples section.
exampleRefs :: FilePath -> FilePath -> [Reference]
exampleRefs :: String -> String -> [Reference]
exampleRefs String
codePth String
srsDoxPth =
  (Example -> [Reference]) -> [Example] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [Reference]
getCodeRefDB (String -> String -> [Example]
examples String
codePth String
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 (String -> String -> [Example]
examples String
codePth String
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Format -> String -> Reference
getSRSRef String
srsDoxPth Format
HTML (String -> Reference)
-> (Example -> String) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> String
exName) (String -> String -> [Example]
examples String
codePth String
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Format -> String -> Reference
getSRSRef String
srsDoxPth Format
TeX (String -> Reference)
-> (Example -> String) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> String
exName) (String -> String -> [Example]
examples String
codePth String
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Format -> String -> Reference
getSRSRef String
srsDoxPth Format
MDBook (String -> Reference)
-> (Example -> String) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> String
exName) (String -> String -> [Example]
examples String
codePth String
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Format -> String -> Reference
getSRSRef String
srsDoxPth Format
Jupyter (String -> Reference)
-> (Example -> String) -> Example -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> String
exName) (String -> String -> [Example]
examples String
codePth String
srsDoxPth) [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++
  (Example -> Reference) -> [Example] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Example -> Reference
buildDrasilExSrcRef (String -> String -> [Example]
examples String
codePth String
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 Example
ex = (Choices -> [Reference]) -> [Choices] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Choices
x -> (Lang -> Reference) -> [Lang] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (\Lang
y -> Example -> Lang -> String -> Reference
getCodeRef Example
ex Lang
y (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> String
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 -> String
verName = String -> Choices -> String
codedDirName (Example -> String
exName Example
ex)
getDoxRefDB :: Example -> [Reference]
getDoxRefDB Example
ex = (Choices -> [Reference]) -> [Choices] -> [Reference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Choices
x -> (Lang -> Reference) -> [Lang] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map (\Lang
y -> Example -> Lang -> String -> Reference
getDoxRef Example
ex Lang
y (String -> Reference) -> String -> Reference
forall a b. (a -> b) -> a -> b
$ Choices -> String
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 -> String
verName = String -> Choices -> String
codedDirName (Example -> String
exName Example
ex)

-- | Helper to pull the system name (abbreviation) from an 'Example'.
exName :: Example -> String
exName :: Example -> String
exName E{systemE :: Example -> System
systemE = System
si} = System
si System -> Getting String System String -> String
forall s a. s -> Getting a s a -> a
^. Getting String System String
forall c. HasSystem c => Lens' c String
Lens' System String
programName