{-# LANGUAGE TupleSections #-}

-- | 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)

import qualified Drasil.DblPend.Body as DblPend (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.SWHSNoPCM.Body as NoPCM (fullSI)
import qualified Drasil.PDController.Body as PDController (fullSI)
import qualified Drasil.Projectile.Body as Projectile (fullSI)
import qualified Drasil.SglPend.Body as SglPend (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.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 (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,
  -- | 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
DblPend.fullSI, SystemInformation
GamePhysics.fullSI, SystemInformation
GlassBR.fullSI, SystemInformation
HGHC.fullSI, SystemInformation
NoPCM.fullSI, SystemInformation
PDController.fullSI, SystemInformation
Projectile.fullSI, SystemInformation
SglPend.fullSI, SystemInformation
SSP.fullSI, SystemInformation
SWHS.fullSI]

-- 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.codeChoices], [Choices]
Projectile.choiceCombos, [], [], []]

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

-- * Functions to create the list of examples

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

-- | Create each example point and call 'individualExList' to do the rest.
allExampleList :: [Example] -> [ItemType]
allExampleList :: [Example] -> [ItemType]
allExampleList = forall a b. (a -> b) -> [a] -> [b]
map (\Example
x -> Header -> ListType -> ItemType
Nested (Example -> Header
nameAndDesc Example
x) forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (, forall a. Maybe a
Nothing) (Example -> [ItemType]
individualExList Example
x))
  where
    nameAndDesc :: Example -> Header
nameAndDesc E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys, _purpose :: SystemInformation -> Purpose
_purpose = Purpose
purp}} = FilePath -> Header
S (forall c. CommonIdea c => c -> FilePath
abrv a
sys) Header -> Header -> Header
+:+ FilePath -> Header
S FilePath
" - To" Header -> Header -> Header
+:+. forall a. [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 E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [], codePath :: Example -> FilePath
codePath = FilePath
srsP} = 
  [Header -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
"SRS:" Header -> Header -> Header
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP FilePath
"html" forall a b. (a -> b) -> a -> b
$ forall c. CommonIdea c => c -> FilePath
programName a
sys) (FilePath -> Header
S FilePath
"[HTML]") Header -> Header -> Header
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP FilePath
"pdf" forall a b. (a -> b) -> a -> b
$ forall c. CommonIdea c => c -> FilePath
programName a
sys) (FilePath -> Header
S FilePath
"[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} = 
  [Header -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
"SRS:" Header -> Header -> Header
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP FilePath
"html" forall a b. (a -> b) -> a -> b
$ forall c. CommonIdea c => c -> FilePath
programName a
sys) (FilePath -> Header
S FilePath
"[HTML]") Header -> Header -> Header
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsP FilePath
"pdf" forall a b. (a -> b) -> a -> b
$ forall c. CommonIdea c => c -> FilePath
programName a
sys) (FilePath -> Header
S FilePath
"[PDF]"),
  Header -> ListType -> ItemType
Nested (FilePath -> Header
S FilePath
generatedCodeTitle) forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (, forall a. Maybe a
Nothing) ((Example -> Lang -> FilePath -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> FilePath -> Reference
getCodeRef Example
ex),
  Header -> ListType -> ItemType
Nested (FilePath -> Header
S FilePath
generatedCodeDocsTitle) forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe FilePath)] -> ListType
Bullet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (, forall a. Maybe a
Nothing) ((Example -> Lang -> FilePath -> Reference) -> Example -> [ItemType]
versionList Example -> Lang -> FilePath -> Reference
getDoxRef Example
noSwiftEx)]
    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 = forall a b. (a -> b) -> [a] -> [b]
map (\Choices
x -> Choices
x {lang :: [Lang]
lang = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Lang
Swift) forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x}) 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 Example -> Lang -> FilePath -> 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 -> FilePath -> Reference
getRef ex :: Example
ex@E{sysInfoE :: Example -> SystemInformation
sysInfoE = SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices]
chcs} =
  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 forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S (Choices -> FilePath
verName Choices
chc) Header -> Header -> Header
+:+ Purpose -> Header
foldlSent_ (forall a b. (a -> b) -> [a] -> [b]
map (Choices -> Lang -> Header
makeLangRef Choices
chc) 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 = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Header -> Header
namedRef (Example -> Lang -> FilePath -> Reference
getRef Example
ex Lang
lng forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
chc) forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S forall a b. (a -> b) -> a -> b
$ FilePath
"[" forall a. [a] -> [a] -> [a]
++ Lang -> FilePath
showLang Lang
lng forall a. [a] -> [a] -> [a]
++ FilePath
"]"

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

-- | Show function to display program languages to user.
showLang :: Lang -> String
showLang :: Lang -> FilePath
showLang Lang
Cpp = FilePath
"C++"
showLang Lang
CSharp = FilePath
"C Sharp" -- Drasil printers dont like # symbol, so use full word instead.
showLang Lang
l = 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 FilePath
codePth FilePath
srsDoxPth = 
  Header -> [Contents] -> [Section] -> Reference -> Section
section Header
exampleTitle -- Title
  [Header -> Contents
mkParagraph Header
exampleIntro, UnlabelledContent -> Contents
UlC forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> RawContent
fullExList FilePath
codePth FilePath
srsDoxPth] -- Contents
  [] forall a b. (a -> b) -> a -> b
$ FilePath -> Header -> Reference
makeSecRef FilePath
"Examples" forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
"Examples" -- Section reference

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

-- | Example section introduction.
exampleIntro :: Sentence
exampleIntro :: Header
exampleIntro = FilePath -> Header
S FilePath
"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."

-- | Example list titles.
generatedCodeTitle, generatedCodeDocsTitle :: String
generatedCodeTitle :: FilePath
generatedCodeTitle = FilePath
"Generated Code:"
generatedCodeDocsTitle :: FilePath
generatedCodeDocsTitle = FilePath
"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 Lang
Cpp = FilePath
"cpp"
convertLang Lang
CSharp = FilePath
"csharp"
convertLang Lang
Java = FilePath
"java"
convertLang Lang
Python = FilePath
"python"
convertLang Lang
Swift = FilePath
"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} Lang
l 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 = FilePath
"codeRef" forall a. [a] -> [a] -> [a]
++ FilePath
sysName 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 = Header -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
refUID

    -- System name, different between one set of choices and multiple sets.
    sysName :: FilePath
sysName = case [Choices]
chcs of 
      [Choices
_] -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall c. CommonIdea c => c -> FilePath
programName a
sys
      [Choices]
_   -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall c. CommonIdea c => c -> FilePath
programName a
sys) forall a. [a] -> [a] -> [a]
++ 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} Lang
l FilePath
verName = 
  FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
refUID FilePath
refURI ShortName
refShortNm
  where
    refUID :: FilePath
refUID = FilePath
"doxRef" forall a. [a] -> [a] -> [a]
++ FilePath
progName forall a. [a] -> [a] -> [a]
++ FilePath
programLang
    refURI :: FilePath
refURI = FilePath -> FilePath -> FilePath -> FilePath
getDoxPath (Example -> FilePath
srsDoxPath Example
ex) FilePath
progName FilePath
programLang
    refShortNm :: ShortName
refShortNm = Header -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
refUID

    progName :: FilePath
progName = forall c. CommonIdea c => c -> FilePath
programName 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 
      [Choices
_] -> Lang -> FilePath
convertLang Lang
l
      [Choices]
_   -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
verName forall a. [a] -> [a] -> [a]
++ 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 FilePath
path FilePath
sufx FilePath
ex = FilePath -> FilePath -> ShortName -> Reference
makeURI FilePath
refUID (FilePath -> FilePath -> FilePath -> FilePath
getSRSPath FilePath
path (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sufx) FilePath
ex) forall a b. (a -> b) -> a -> b
$ Header -> ShortName
shortname' forall a b. (a -> b) -> a -> b
$ FilePath -> Header
S FilePath
refUID
  where
    refUID :: FilePath
refUID = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sufx forall a. [a] -> [a] -> [a]
++ FilePath
"Ref" 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 FilePath
path FilePath
sufx FilePath
ex = 
  FilePath
path
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
ex -- FIXME: The majority of these `map toLower`s are implicit knowledge!!! 
  forall a. [a] -> [a] -> [a]
++ FilePath
"/SRS/srs/"
  forall a. [a] -> [a] -> [a]
++ FilePath
ex forall a. [a] -> [a] -> [a]
++ FilePath
"_SRS." forall a. [a] -> [a] -> [a]
++ 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 FilePath
path FilePath
ex FilePath
programLang = FilePath
path forall a. [a] -> [a] -> [a]
++ FilePath
"code/stable/" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
ex forall a. [a] -> [a] -> [a]
++ FilePath
"/src/" forall a. [a] -> [a] -> [a]
++ FilePath
programLang -- need repoCommit path
-- | Uses 'exRt' path (srsDoxPath in this module).
getDoxPath :: FilePath -> FilePath -> FilePath -> FilePath
getDoxPath FilePath
path FilePath
ex FilePath
programLang = FilePath
path forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
ex forall a. [a] -> [a] -> [a]
++ FilePath
"/doxygen/" forall a. [a] -> [a] -> [a]
++ FilePath
programLang forall a. [a] -> [a] -> [a]
++ FilePath
"/index.html" -- need example path

-- | Gather all references used in making the Examples section.
exampleRefs :: FilePath -> FilePath -> [Reference]
exampleRefs :: FilePath -> FilePath -> [Reference]
exampleRefs FilePath
codePth FilePath
srsDoxPth = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [Reference]
getCodeRefDB (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) forall a. [a] -> [a] -> [a]
++
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [Reference]
getDoxRefDB (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsDoxPth FilePath
"html" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Example -> FilePath
getAbrv) (FilePath -> FilePath -> [Example]
examples FilePath
codePth FilePath
srsDoxPth) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath -> Reference
getSRSRef FilePath
srsDoxPth FilePath
"pdf" 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 Example
ex = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Choices
x -> forall a b. (a -> b) -> [a] -> [b]
map (\Lang
y -> Example -> Lang -> FilePath -> Reference
getCodeRef Example
ex Lang
y forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
x) forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x) 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 Example
ex = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Choices
x -> forall a b. (a -> b) -> [a] -> [b]
map (\Lang
y -> Example -> Lang -> FilePath -> Reference
getDoxRef Example
ex Lang
y forall a b. (a -> b) -> a -> b
$ Choices -> FilePath
verName Choices
x) forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
x) 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}} = forall c. CommonIdea c => c -> FilePath
programName a
sys