{-# LANGUAGE TupleSections #-}
-- | Case Studies table for the different choices available when generating code from Drasil.
-- To be used in the Drasil website.
module Drasil.Website.CaseStudy where

import Language.Drasil hiding (E, Var)
import Language.Drasil.Code hiding (CS)
import SysInfo.Drasil
import Drasil.GOOL (CodeType(..))

import Drasil.Website.Example (examples, Example(..))
import qualified Drasil.Projectile.Choices as Projectile (codedDirName)


-- * Case Studies Section

-- | Creates the Case Study Section.
caseStudySec :: Section
caseStudySec :: Section
caseStudySec =
  Sentence -> [Contents] -> [Section] -> Reference -> Section
section (String -> Sentence
S String
caseStudiesTitle) -- Title
  [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
caseStudiesDesc, Reference -> RawContent -> Contents
mkFig (String -> Reference
makeTabRef String
"CaseStudy") RawContent
mkCaseTable,
    Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
legendIntro, UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents) -> UnlabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc RawContent
caseStudyLegend] -- Contents
  [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ String -> Sentence -> Reference
makeSecRef String
"CaseStudy" (Sentence -> Reference) -> Sentence -> Reference
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
caseStudiesTitle -- Section Reference

caseStudiesTitle, caseStudiesDesc, legendIntro :: String
-- | Section title.
caseStudiesTitle :: String
caseStudiesTitle = String
"Case Studies"
-- | Section description.
caseStudiesDesc :: String
caseStudiesDesc = String
"Drasil allows some design decisions to be made by the user when generating \
  \code. The table below summarizes the design decisions made for each case \
  \study, followed by a guide giving the meaning of the short-forms used in the \
  \table:"
-- | Introduce the Case Study Table Legend as a list.
legendIntro :: String
legendIntro = String
"The legend for the Case Studies Table is listed below according to the column header:"

-- | Creates the Case Study Table
mkCaseTable :: RawContent
mkCaseTable :: RawContent
mkCaseTable = [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [Sentence]
headerRow ([CaseStudy] -> [[Sentence]]
tableBody ([CaseStudy] -> [[Sentence]]) -> [CaseStudy] -> [[Sentence]]
forall a b. (a -> b) -> a -> b
$ (Example -> [CaseStudy]) -> [Example] -> [CaseStudy]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Example -> [CaseStudy]
mkCaseStudy ([Example] -> [CaseStudy]) -> [Example] -> [CaseStudy]
forall a b. (a -> b) -> a -> b
$ String -> String -> [Example]
examples String
"" String
"")  Sentence
EmptyS Bool
False

-- * Manipulating info from 'Example' -> 'CaseStudy'
--
-- $ExampleToCaseStudy
--
-- After taking the information about the examples from Example.hs,
-- convert each example into its own case study.

-- | Holds individual case studies. System info may not be needed,
-- but it is still nice to keep around for now.
data CaseStudy = CS {
  -- | Each case study needs a name, so use system information. 
  CaseStudy -> SystemInformation
sysInfoCS :: SystemInformation,
  -- | A case study may have different program names for the same example (ex. Projectile).
  CaseStudy -> Sentence
progName :: Sentence,
  -- | Each case study has code that is generated from a set of choices.
  CaseStudy -> Choices
choicesCS :: Choices}

-- | Converts a list of examples into a list of CaseStudies. 
-- Currently, projectile is the only one that has more than one set of choices,
-- so we take the naming scheme from there.
mkCaseStudy :: Example -> [CaseStudy]
mkCaseStudy :: Example -> [CaseStudy]
mkCaseStudy E{choicesE :: Example -> [Choices]
choicesE = []} = []
mkCaseStudy E{sysInfoE :: Example -> SystemInformation
sysInfoE = si :: SystemInformation
si@SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices
x]} = [CS{sysInfoCS :: SystemInformation
sysInfoCS = SystemInformation
si, progName :: Sentence
progName = String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ a -> String
forall c. CommonIdea c => c -> String
programName a
sys, choicesCS :: Choices
choicesCS = Choices
x}]
mkCaseStudy E{sysInfoE :: Example -> SystemInformation
sysInfoE = si :: SystemInformation
si@SI{_sys :: ()
_sys = a
sys}, choicesE :: Example -> [Choices]
choicesE = [Choices]
xs} = (Choices -> CaseStudy) -> [Choices] -> [CaseStudy]
forall a b. (a -> b) -> [a] -> [b]
map (\Choices
x -> CS{sysInfoCS :: SystemInformation
sysInfoCS = SystemInformation
si, progName :: Sentence
progName = String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String -> Choices -> String
Projectile.codedDirName (a -> String
forall c. CommonIdea c => c -> String
programName a
sys) Choices
x, choicesCS :: Choices
choicesCS = Choices
x}) [Choices]
xs

-- * Display 'CaseStudy' Information as a Table
--
-- $CaseStudy
--
-- We first need the helper functions to convert 'Choices' into a displayable format (as a 'Sentence').
-- Those are defined in the section below to reduce clutter.
-- Then we make the header row, table body, and helper for the table body functions.

-- | Hardcoded header row for the Case studies table
headerRow :: [Sentence]
headerRow :: [Sentence]
headerRow = (String -> Sentence) -> [String] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map String -> Sentence
S [String
caseStudyTitle, String
modularityTitle, String
implementTypeTitle, String
loggingTitle, String
inStructTitle, String
conStructTitle, String
conRepTitle, String
realNumRepTitle]

-- | Creates the case study table body.
tableBody :: [CaseStudy] -> [[Sentence]]
tableBody :: [CaseStudy] -> [[Sentence]]
tableBody = (CaseStudy -> [Sentence]) -> [CaseStudy] -> [[Sentence]]
forall a b. (a -> b) -> [a] -> [b]
map CaseStudy -> [Sentence]
displayCS

-- | Converts a case study into a table row for easy display.
displayCS :: CaseStudy -> [Sentence]
displayCS :: CaseStudy -> [Sentence]
displayCS CS{progName :: CaseStudy -> Sentence
progName = Sentence
nm,
  choicesCS :: CaseStudy -> Choices
choicesCS = Choices{
    architecture :: Choices -> Architecture
architecture = Architecture
a,
    dataInfo :: Choices -> DataInfo
dataInfo = DataInfo
d,
    maps :: Choices -> Maps
maps = Maps
m,
    optFeats :: Choices -> OptionalFeatures
optFeats = OptionalFeatures
o
    }} = [Sentence
nm, Modularity -> Sentence
getMod (Modularity -> Sentence) -> Modularity -> Sentence
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity Architecture
a, ImplementationType -> Sentence
getImp (ImplementationType -> Sentence) -> ImplementationType -> Sentence
forall a b. (a -> b) -> a -> b
$ Architecture -> ImplementationType
impType Architecture
a, [Logging] -> Sentence
getLog ([Logging] -> Sentence) -> [Logging] -> Sentence
forall a b. (a -> b) -> a -> b
$ LogConfig -> [Logging]
logging (LogConfig -> [Logging]) -> LogConfig -> [Logging]
forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> LogConfig
logConfig OptionalFeatures
o,
          Structure -> Sentence
getInstr (Structure -> Sentence) -> Structure -> Sentence
forall a b. (a -> b) -> a -> b
$ DataInfo -> Structure
inputStructure DataInfo
d, ConstantStructure -> Sentence
getConstr (ConstantStructure -> Sentence) -> ConstantStructure -> Sentence
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantStructure
constStructure DataInfo
d, ConstantRepr -> Sentence
getConRep (ConstantRepr -> Sentence) -> ConstantRepr -> Sentence
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantRepr
constRepr DataInfo
d,
           [CodeType] -> Sentence
getRealNum (Maps -> SpaceMatch
spaceMatch Maps
m Space
Real)]

-- * Case Studies Table Legend
--
-- $CSLegend
--
-- Next, we need the legend to explain the Case Studies Table.
-- These functions are essentially hard-coded and also defined below.

-- | Each entry for the case studies table legend.
-- The title should be the same as the header.
data CSLegend = CSL {
  -- | Legend title.
  CSLegend -> String
ttle :: String, -- String for now, should eventually move to at least a Sentence
  -- | Legend symbols along with their respective definitions.
  CSLegend -> [(String, String)]
symbAndDefs :: [(String, String)]
}

-- | Make the legend for the case study table as a list.
caseStudyLegend :: RawContent
caseStudyLegend :: RawContent
caseStudyLegend = 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
$ (CSLegend -> (ItemType, Maybe String))
-> [CSLegend] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map ((, Maybe String
forall a. Maybe a
Nothing) (ItemType -> (ItemType, Maybe String))
-> (CSLegend -> ItemType) -> CSLegend -> (ItemType, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSLegend -> ItemType
mkLegendListFunc) [CSLegend]
legendEntries

-- | Helper to convert the Case Study legends into list items.
mkLegendListFunc :: CSLegend -> ItemType
mkLegendListFunc :: CSLegend -> ItemType
mkLegendListFunc CSLegend
csleg = Sentence -> ListType -> ItemType
Nested (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ CSLegend -> String
ttle CSLegend
csleg) (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
$ ((String, String) -> (ItemType, Maybe String))
-> [(String, String)] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map ((, Maybe String
forall a. Maybe a
Nothing) (ItemType -> (ItemType, Maybe String))
-> ((String, String) -> ItemType)
-> (String, String)
-> (ItemType, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> ItemType
mkTandDSent) ([(String, String)] -> [(ItemType, Maybe String)])
-> [(String, String)] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> a -> b
$ CSLegend -> [(String, String)]
symbAndDefs CSLegend
csleg

-- | Should eventually take Sentences instead of Strings. Converts into the format of "symbol - definition".
mkTandDSent :: (String, String) -> ItemType
mkTandDSent :: (String, String) -> ItemType
mkTandDSent (String
sym,String
def) = Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sym Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"-" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
def

-- | Case Study Table column headers.
caseStudyTitle, modularityTitle, implementTypeTitle, loggingTitle, inStructTitle, conStructTitle,
  conRepTitle, realNumRepTitle :: String

caseStudyTitle :: String
caseStudyTitle = String
"Case Study"
modularityTitle :: String
modularityTitle = String
"Modularity"
implementTypeTitle :: String
implementTypeTitle = String
"Implementation Type"
loggingTitle :: String
loggingTitle = String
"Logging"
inStructTitle :: String
inStructTitle = String
"Input Structure"
conStructTitle :: String
conStructTitle = String
"Constant Structure"
conRepTitle :: String
conRepTitle = String
"Constant Representation"
realNumRepTitle :: String
realNumRepTitle = String
"Real Number Representation"

-- | Case study legend entries.
legendEntries :: [CSLegend]
legendEntries :: [CSLegend]
legendEntries = [CSLegend
modularityLegend, CSLegend
implementationTypeLegend, CSLegend
loggingLegend, CSLegend
inputStrLegend, CSLegend
conStrLegend, CSLegend
conRepLegend, CSLegend
realNumRepLegend]

-- | Modularity or Separation of software.
modularityLegend :: CSLegend
modularityLegend :: CSLegend
modularityLegend = CSL{
  ttle :: String
ttle = String
modularityTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"U", String
"Unmodular"),
                  (String
"M", String
"Modular")]
}

-- | Software implementation type.
implementationTypeLegend :: CSLegend
implementationTypeLegend :: CSLegend
implementationTypeLegend = CSL {
  ttle :: String
ttle = String
implementTypeTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"P", String
"Program"),
                  (String
"L", String
"Library")]
}

-- | Compiler logging statements.
loggingLegend :: CSLegend
loggingLegend :: CSLegend
loggingLegend = CSL {
  ttle :: String
ttle = String
loggingTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"NoL", String
"No Logging statements"),
                  (String
"L", String
"Logging statements included")]
}

-- | Input value structure.
inputStrLegend :: CSLegend
inputStrLegend :: CSLegend
inputStrLegend = CSL {
  ttle :: String
ttle = String
inStructTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"B", String
"Inputs are Bundled in a class"),
                  (String
"U", String
"Inputs are Unbundled")]
}

-- | Constant value structure.
conStrLegend :: CSLegend
conStrLegend :: CSLegend
conStrLegend = CSL {
  ttle :: String
ttle = String
conStructTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"I", String
"Constant values are Inlined"),
                  (String
"WI", String
"Constants are stored With the Inputs"),
                  (String
"B", String
"Constants are stored in variables that are Bundled in a class"),
                  (String
"U", String
"Constants are stored in variables that are Unbundled")]
}

-- | Constant value representation.
conRepLegend :: CSLegend
conRepLegend :: CSLegend
conRepLegend = CSL {
  ttle :: String
ttle = String
conRepTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"V", String
"Constants are stored as Variables"),
                  (String
"C", String
"Constants are stored as Constants")]
}

-- | Real number representation.
realNumRepLegend :: CSLegend
realNumRepLegend :: CSLegend
realNumRepLegend = CSL {
  ttle :: String
ttle = String
realNumRepTitle,
  symbAndDefs :: [(String, String)]
symbAndDefs = [ (String
"D", String
"Real numbers are represented as Doubles"),
                  (String
"F", String
"Real numbers are represented as Floats")]
}

-- * Helper functions to create the case study table rows.
--
-- $helpCSRow
--
-- These functions act like a version of 'show' for each
-- different type of 'Choices', but tweaked to fit inside a table.

getMod :: Modularity -> Sentence
getMod :: Modularity -> Sentence
getMod Modularity
Unmodular = String -> Sentence
S String
"U"
getMod Modularity
Modular   = String -> Sentence
S String
"M"

getImp :: ImplementationType -> Sentence
getImp :: ImplementationType -> Sentence
getImp ImplementationType
Program = String -> Sentence
S String
"P"
getImp ImplementationType
Library = String -> Sentence
S String
"L"

getLog :: [Logging] -> Sentence
getLog :: [Logging] -> Sentence
getLog [] = String -> Sentence
S String
"NoL"
getLog [Logging]
_ = String -> Sentence
S String
"L"

getInstr :: Structure -> Sentence
getInstr :: Structure -> Sentence
getInstr Structure
Bundled = String -> Sentence
S String
"B"
getInstr Structure
Unbundled = String -> Sentence
S String
"U"

getConstr :: ConstantStructure -> Sentence
getConstr :: ConstantStructure -> Sentence
getConstr ConstantStructure
Inline = String -> Sentence
S String
"I"
getConstr ConstantStructure
WithInputs = String -> Sentence
S String
"WI"
getConstr (Store Structure
Bundled) = String -> Sentence
S String
"B"
getConstr (Store Structure
Unbundled) = String -> Sentence
S String
"U"

getConRep :: ConstantRepr -> Sentence
getConRep :: ConstantRepr -> Sentence
getConRep ConstantRepr
Var = String -> Sentence
S String
"V"
getConRep ConstantRepr
Const = String -> Sentence
S String
"C"

getRealNum :: [CodeType] -> Sentence
getRealNum :: [CodeType] -> Sentence
getRealNum (CodeType
Double:[CodeType]
_) = String -> Sentence
S String
"D"
getRealNum (CodeType
Float:[CodeType]
_) = String -> Sentence
S String
"F"
getRealNum [CodeType]
_ = String -> Sentence
forall a. HasCallStack => String -> a
error String
"This shouldn't happen. Make sure Real numbers have a preferred type."