{-# LANGUAGE PostfixOperators #-}
module Drasil.GlassBR.Body where

import Control.Lens ((^.))
import Language.Drasil hiding (organization, section, variable)
import Drasil.SRSDocument
import Drasil.DocLang (auxSpecSent, termDefnF')
import qualified Drasil.DocLang.SRS as SRS (reference, assumpt, inModel)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Computation (computerApp, inDatum, compcon, algorithm)
import Data.Drasil.Concepts.Documentation as Doc (appendix, assumption,
  characteristic, company, condition, dataConst, datum, doccon, doccon',
  environment, input_, interface, model, physical, problem, product_,
  software, softwareConstraint, softwareSys, srsDomains, standard, sysCont,
  system, term_, user, value, variable, reference, definition)
import qualified Data.Drasil.Concepts.Documentation as Doc (srs)
import Data.Drasil.TheoryConcepts as Doc (dataDefn, inModel, thModel)
import Data.Drasil.Concepts.Education as Edu (civilEng, scndYrCalculus, structuralMechanics,
  educon)
import Data.Drasil.Concepts.Math (graph, mathcon, mathcon')
import Data.Drasil.Concepts.PhysicalProperties (dimension, physicalcon, materialProprty)
import Data.Drasil.Concepts.Physics (distance)
import Data.Drasil.Concepts.Software (correctness, verifiability,
  understandability, reusability, maintainability, portability, softwarecon)
import Data.Drasil.Software.Products (sciCompS)

import Data.Drasil.People (mCampidelli, nikitha, spencerSmith)
import Data.Drasil.SI_Units (kilogram, metre, newton, pascal, second, fundamentals,
  derived)

import Drasil.GlassBR.Assumptions (assumptionConstants, assumptions)
import Drasil.GlassBR.Changes (likelyChgs, unlikelyChgs)
import Drasil.GlassBR.Concepts (acronyms, blastRisk, glaPlane, glaSlab, glassBR, 
  ptOfExplsn, con, con', glass)
import Drasil.GlassBR.DataDefs (configFp)
import qualified Drasil.GlassBR.DataDefs as GB (dataDefs)
import Drasil.GlassBR.Figures
import Drasil.GlassBR.Goals (goals)
import Drasil.GlassBR.IMods (symb, iMods, instModIntro, qDefns)
import Drasil.GlassBR.References (astm2009, astm2012, astm2016, citations)
import Drasil.GlassBR.Requirements (funcReqs, inReqDesc, funcReqsTables, nonfuncReqs)
import Drasil.GlassBR.Symbols (symbolsForTable, thisSymbols)
import Drasil.GlassBR.TMods (tMods)
import Drasil.GlassBR.Unitals (blast, blastTy, bomb, explosion, constants,
  constrained, inputDataConstraints, inputs, outputs, specParamVals, glassTy,
  glassTypes, glBreakage, lateralLoad, load, loadTypes, pbTol, probBr, stressDistFac, probBreak,
  sD, termsWithAccDefn, termsWithDefsOnly, terms)

srs :: Document
srs :: Document
srs = SRSDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> SystemInformation
-> Document
mkDoc SRSDecl
mkSRS (forall c d.
(c -> Sentence) -> (d -> Sentence) -> c -> d -> Sentence
S.forGen forall n. NamedIdea n => n -> Sentence
titleize forall n. NamedIdea n => n -> Sentence
phrase) SystemInformation
si

fullSI :: SystemInformation
fullSI :: SystemInformation
fullSI = SRSDecl -> SystemInformation -> SystemInformation
fillcdbSRS SRSDecl
mkSRS SystemInformation
si

printSetting :: PrintingInformation
printSetting :: PrintingInformation
printSetting = SystemInformation
-> Stage -> PrintingConfiguration -> PrintingInformation
piSys SystemInformation
fullSI Stage
Equational PrintingConfiguration
defaultConfiguration

si :: SystemInformation
si :: SystemInformation
si = SI {
  _sys :: CI
_sys         = CI
glassBR,
  _kind :: CI
_kind        = CI
Doc.srs,
  _authors :: [Person]
_authors     = [Person
nikitha, Person
spencerSmith],
  _purpose :: Purpose
_purpose     = [Sentence
purp],
  _background :: Purpose
_background  = [],
  _quants :: [QuantityDict]
_quants      = [QuantityDict]
symbolsForTable,
  _concepts :: [DefinedQuantityDict]
_concepts    = [] :: [DefinedQuantityDict],
  _instModels :: [InstanceModel]
_instModels  = [InstanceModel]
iMods,
  _datadefs :: [DataDefinition]
_datadefs    = [DataDefinition]
GB.dataDefs,
  _configFiles :: [String]
_configFiles = [String]
configFp,
  _inputs :: [QuantityDict]
_inputs      = [QuantityDict]
inputs,
  _outputs :: [QuantityDict]
_outputs     = [QuantityDict]
outputs,
  _defSequence :: [Block SimpleQDef]
_defSequence = [Block SimpleQDef]
qDefns,
  _constraints :: [ConstrainedChunk]
_constraints = [ConstrainedChunk]
constrained,
  _constants :: [ConstQDef]
_constants   = [ConstQDef]
constants,
  _sysinfodb :: ChunkDB
_sysinfodb   = ChunkDB
symbMap,
  _usedinfodb :: ChunkDB
_usedinfodb  = ChunkDB
usedDB,
   refdb :: ReferenceDB
refdb       = ReferenceDB
refDB
}
  --FIXME: All named ideas, not just acronyms.

mkSRS :: SRSDecl
mkSRS :: SRSDecl
mkSRS = [DocSection
TableOfContents,
  RefSec -> DocSection
RefSec forall a b. (a -> b) -> a -> b
$ Contents -> [RefTab] -> RefSec
RefProg Contents
intro [RefTab
TUnits, [TSIntro] -> RefTab
tsymb [TSIntro
TSPurpose, TSIntro
SymbOrder], RefTab
TAandA],
  IntroSec -> DocSection
IntroSec forall a b. (a -> b) -> a -> b
$
    Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg (forall n. NamedIdea n => n -> Sentence -> CI -> Sentence
startIntro IdeaDict
software Sentence
blstRskInvWGlassSlab CI
glassBR)
      (forall c. Idea c => c -> Sentence
short CI
glassBR)
    [Purpose -> IntroSub
IPurpose forall a b. (a -> b) -> a -> b
$ CI -> Verbosity -> Purpose
purpDoc CI
glassBR Verbosity
Verbose,
     Sentence -> IntroSub
IScope Sentence
scope,
     Purpose -> Purpose -> Purpose -> IntroSub
IChar [] (Purpose
undIR forall a. [a] -> [a] -> [a]
++ Purpose
appStanddIR) [],
     CI -> Section -> Sentence -> IntroSub
IOrgSec CI
Doc.dataDefn ([Contents] -> [Section] -> Section
SRS.inModel [] []) Sentence
orgOfDocIntroEnd],
  StkhldrSec -> DocSection
StkhldrSec forall a b. (a -> b) -> a -> b
$
    [StkhldrSub] -> StkhldrSec
StkhldrProg
      [CI -> Sentence -> StkhldrSub
Client CI
glassBR forall a b. (a -> b) -> a -> b
$ forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
a_ IdeaDict
company)
        Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"named Entuitive" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"It is developed by Dr." Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S (forall n. HasName n => n -> String
name Person
mCampidelli),
      CI -> StkhldrSub
Cstmr CI
glassBR],
  GSDSec -> DocSection
GSDSec forall a b. (a -> b) -> a -> b
$ [GSDSub] -> GSDSec
GSDProg [[Contents] -> GSDSub
SysCntxt [Contents
sysCtxIntro, LabelledContent -> Contents
LlC LabelledContent
sysCtxFig, Contents
sysCtxDesc, Contents
sysCtxList],
    [Contents] -> GSDSub
UsrChars [Contents
userCharacteristicsIntro], [Contents] -> [Section] -> GSDSub
SystCons [] [] ],
  SSDSec -> DocSection
SSDSec forall a b. (a -> b) -> a -> b
$
    [SSDSub] -> SSDSec
SSDProg
      [ProblemDescription -> SSDSub
SSDProblem forall a b. (a -> b) -> a -> b
$ Sentence -> [Section] -> [PDSub] -> ProblemDescription
PDProg Sentence
purp [Section
termsAndDesc]
        [ forall a.
Idea a =>
a -> Purpose -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
glassBR Purpose
physSystParts LabelledContent
physSystFig []
        , Purpose -> PDSub
Goals Purpose
goalInputs],
       SolChSpec -> SSDSub
SSDSolChSpec forall a b. (a -> b) -> a -> b
$ [SCSSub] -> SolChSpec
SCSProg
        [ SCSSub
Assumptions
        , Purpose -> Fields -> SCSSub
TMs [] (Field
Label forall a. a -> [a] -> [a]
: Fields
stdFields)
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
GDs [] [] DerivationDisplay
HideDerivation -- No Gen Defs for GlassBR
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
DDs [] ([Field
Label, Field
Symbol, Field
Units] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
IMs [Sentence
instModIntro] ([Field
Label, Field
Input, Field
Output, Field
InConstraints, Field
OutConstraints] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
HideDerivation
        , forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
auxSpecSent [UncertainChunk]
inputDataConstraints
        , forall c.
(Quantity c, Constrained c) =>
[c] -> [Contents] -> SCSSub
CorrSolnPpties [ConstrainedChunk
probBr, ConstrainedChunk
stressDistFac] []
        ]
      ],
  ReqrmntSec -> DocSection
ReqrmntSec forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg [
    Sentence -> [LabelledContent] -> ReqsSub
FReqsSub Sentence
inReqDesc [LabelledContent]
funcReqsTables,
    ReqsSub
NonFReqsSub
  ],
  DocSection
LCsSec,
  DocSection
UCsSec,
  TraceabilitySec -> DocSection
TraceabilitySec forall a b. (a -> b) -> a -> b
$ [TraceConfig] -> TraceabilitySec
TraceabilityProg forall a b. (a -> b) -> a -> b
$ SystemInformation -> [TraceConfig]
traceMatStandard SystemInformation
si,
  AuxConstntSec -> DocSection
AuxConstntSec forall a b. (a -> b) -> a -> b
$ CI -> [ConstQDef] -> AuxConstntSec
AuxConsProg CI
glassBR [ConstQDef]
auxiliaryConstants,
  DocSection
Bibliography,
  AppndxSec -> DocSection
AppndxSec forall a b. (a -> b) -> a -> b
$ [Contents] -> AppndxSec
AppndxProg [Contents
appdxIntro, LabelledContent -> Contents
LlC LabelledContent
demandVsSDFig, LabelledContent -> Contents
LlC LabelledContent
dimlessloadVsARFig]]

purp :: Sentence
purp :: Sentence
purp = Purpose -> Sentence
foldlSent_ [String -> Sentence
S String
"predict whether a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
glaSlab, String -> Sentence
S String
"can withstand a", 
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
blast, String -> Sentence
S String
"under given", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition]

symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb [QuantityDict]
thisSymbols (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
thisSymbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
con
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
con' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
terms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
doccon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
doccon' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
educon
  forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw IdeaDict
sciCompS] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
compcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
mathcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
mathcon'
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
softwarecon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
terms forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw IdeaDict
lateralLoad, forall c. Idea c => c -> IdeaDict
nw IdeaDict
materialProprty]
   forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw ConceptChunk
distance, forall c. Idea c => c -> IdeaDict
nw ConceptChunk
algorithm] forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
fundamentals forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
derived forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicalcon)
  (forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [UnitalChunk]
symb forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
terms forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
Doc.srsDomains) (forall a b. (a -> b) -> [a] -> [b]
map forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
metre, UnitDefn
second, UnitDefn
kilogram]
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
pascal, UnitDefn
newton]) [DataDefinition]
GB.dataDefs [InstanceModel]
iMods [] [TheoryModel]
tMods [ConceptInstance]
concIns [Section]
section
  [LabelledContent]
labCon []

concIns :: [ConceptInstance]
concIns :: [ConceptInstance]
concIns = [ConceptInstance]
assumptions forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
goals forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
likelyChgs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
unlikelyChgs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
funcReqs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
nonfuncReqs

labCon :: [LabelledContent]
labCon :: [LabelledContent]
labCon = [LabelledContent]
funcReqsTables forall a. [a] -> [a] -> [a]
++ [LabelledContent
demandVsSDFig, LabelledContent
dimlessloadVsARFig]

usedDB :: ChunkDB
usedDB :: ChunkDB
usedDB = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ([] :: [QuantityDict]) (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
thisSymbols)
 ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] [] [] [] ([] :: [Reference])

refDB :: ReferenceDB
refDB :: ReferenceDB
refDB = BibRef -> [ConceptInstance] -> ReferenceDB
rdb BibRef
citations [ConceptInstance]
concIns

section :: [Section]
section :: [Section]
section = Document -> [Section]
extractSection Document
srs

stdFields :: Fields
stdFields :: Fields
stdFields = [Field
DefiningEquation, Verbosity -> InclUnits -> Field
Description Verbosity
Verbose InclUnits
IncludeUnits, Field
Notes, Field
Source, Field
RefBy]

--------------------------------------------------------------------------------
termsAndDescBullets :: Contents
termsAndDescBullets :: Contents
termsAndDescBullets = UnlabelledContent -> Contents
UlC forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc forall a b. (a -> b) -> a -> b
$ ListType -> RawContent
Enumerationforall a b. (a -> b) -> a -> b
$ 
  [(ItemType, Maybe String)] -> ListType
Numeric forall a b. (a -> b) -> a -> b
$
    [ItemType] -> [(ItemType, Maybe String)]
noRefs forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map forall s. Concept s => s -> ItemType
tAndDOnly [ConceptChunk]
termsWithDefsOnly 
      forall a. [a] -> [a] -> [a]
++ [ItemType]
termsAndDescBulletsGlTySubSec 
      forall a. [a] -> [a] -> [a]
++ [ItemType]
termsAndDescBulletsLoadSubSec 
      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall s. Concept s => s -> ItemType
tAndDWAcc [ConceptChunk]
termsWithAccDefn 
      forall a. [a] -> [a] -> [a]
++ [forall s a. (Concept s, Quantity a) => s -> a -> ItemType
tAndDWSym ConceptChunk
probBreak ConstrainedChunk
probBr]
   --FIXME: merge? Needs 2 arguments because there is no instance for (SymbolForm ConceptChunk)...

termsAndDescBulletsGlTySubSec, termsAndDescBulletsLoadSubSec :: [ItemType]

termsAndDescBulletsGlTySubSec :: [ItemType]
termsAndDescBulletsGlTySubSec = [Sentence -> ListType -> ItemType
Nested (Sentence
EmptyS Sentence -> Sentence -> Sentence
+: forall n. NamedIdea n => n -> Sentence
titleize ConceptChunk
glassTy) forall a b. (a -> b) -> a -> b
$
  [(ItemType, Maybe String)] -> ListType
Bullet forall a b. (a -> b) -> a -> b
$ [ItemType] -> [(ItemType, Maybe String)]
noRefs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall s. Concept s => s -> ItemType
tAndDWAcc [ConceptChunk]
glassTypes]

termsAndDescBulletsLoadSubSec :: [ItemType]
termsAndDescBulletsLoadSubSec = [Sentence -> ListType -> ItemType
Nested (forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
load Sentence -> Sentence -> Sentence
`sDash` Sentence -> Sentence
capSent (ConceptChunk
load forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) !.) forall a b. (a -> b) -> a -> b
$
  [(ItemType, Maybe String)] -> ListType
Bullet forall a b. (a -> b) -> a -> b
$ [ItemType] -> [(ItemType, Maybe String)]
noRefs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall s. Concept s => s -> ItemType
tAndDWAcc (forall a. Int -> [a] -> [a]
take Int
2 [ConceptChunk]
loadTypes)
  forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map forall s. Concept s => s -> ItemType
tAndDOnly (forall a. Int -> [a] -> [a]
drop Int
2 [ConceptChunk]
loadTypes)]

solChSpecSubsections :: [CI]
solChSpecSubsections :: [CI]
solChSpecSubsections = [CI
thModel, CI
inModel, CI
Doc.dataDefn, CI
dataConst]

--Used in "Values of Auxiliary Constants" Section--
auxiliaryConstants :: [ConstQDef]
auxiliaryConstants :: [ConstQDef]
auxiliaryConstants = [ConstQDef]
assumptionConstants forall a. [a] -> [a] -> [a]
++ [ConstQDef]
specParamVals

--Used in "Non-Functional Requirements" Section--
priorityNFReqs :: [ConceptChunk]
priorityNFReqs :: [ConceptChunk]
priorityNFReqs = [ConceptChunk
correctness, ConceptChunk
verifiability, ConceptChunk
understandability,
  ConceptChunk
reusability, ConceptChunk
maintainability, ConceptChunk
portability]

--------------------------------------------------------------------------------

{--INTRODUCTION--}

startIntro :: (NamedIdea n) => n -> Sentence -> CI -> Sentence
startIntro :: forall n. NamedIdea n => n -> Sentence -> CI -> Sentence
startIntro n
prgm Sentence
sfwrPredicts CI
progName = Purpose -> Sentence
foldlSent [
  forall n. NamedIdea n => n -> Sentence
atStart n
prgm, String -> Sentence
S String
"is helpful to efficiently" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"correctly predict the"
  Sentence -> Sentence -> Sentence
+:+. Sentence
sfwrPredicts, ConceptChunk -> Sentence
underConsidertn ConceptChunk
blast,
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
the n
prgm) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"herein called", forall c. Idea c => c -> Sentence
short CI
progName Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"aims to predict the", Sentence
sfwrPredicts, String -> Sentence
S String
"using an intuitive",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
interface]

undIR, appStanddIR :: [Sentence]
undIR :: Purpose
undIR = [forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
scndYrCalculus, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
structuralMechanics, forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
glBreakage,
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
blastRisk, forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict
computerApp forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`in_PS` IdeaDict
Edu.civilEng)]
appStanddIR :: Purpose
appStanddIR = [String -> Sentence
S String
"applicable" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
standard Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"for constructions using glass from" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> Purpose -> Sentence
foldlList SepType
Comma FoldType
List
  (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [Citation
astm2009, Citation
astm2012, Citation
astm2016]) Sentence -> Sentence -> Sentence
`S.in_`
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.reference ([]::[Contents]) ([]::[Section])) (forall n. NamedIdea n => n -> Sentence
plural IdeaDict
reference)]

scope :: Sentence
scope :: Sentence
scope = Purpose -> Sentence
foldlSent_ [String -> Sentence
S String
"determining the safety of a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
glaSlab,
  String -> Sentence
S String
"under a", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
blast, String -> Sentence
S String
"loading following the ASTM", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
standard,
  Sentence -> Sentence
sParen forall a b. (a -> b) -> a -> b
$ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
astm2009]

{--Purpose of Document--}
-- Purpose of Document automatically generated in IPurpose


{--Scope of Requirements--}

{--Organization of Document--}

orgOfDocIntroEnd :: Sentence
orgOfDocIntroEnd :: Sentence
orgOfDocIntroEnd = Purpose -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
atStartNP' (forall c. NamedIdea c => c -> NP
the CI
dataDefn) Sentence -> Sentence -> Sentence
`S.are`
  String -> Sentence
S String
"used to support", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
definition Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S String
"different", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
model]

{--STAKEHOLDERS--}

{--The Client--}
{--The Customer--}

{--GENERAL SYSTEM DESCRIPTION--}

{--System Context--}
  
sysCtxIntro :: Contents
sysCtxIntro :: Contents
sysCtxIntro = Purpose -> Contents
foldlSP
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
sysCtxFig Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"shows the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
sysCont,
   String -> Sentence
S String
"A circle represents an external entity outside the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software
   Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
the IdeaDict
user), String -> Sentence
S String
"in this case. A rectangle represents the",
   forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
softwareSys, String -> Sentence
S String
"itself", (Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
glassBR) !.),
   String -> Sentence
S String
"Arrows are used to show the data flow between the" Sentence -> Sentence -> Sentence
+:+ forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
system
   forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andIts` IdeaDict
environment)]

sysCtxDesc :: Contents
sysCtxDesc :: Contents
sysCtxDesc = Purpose -> Contents
foldlSPCol
  [String -> Sentence
S String
"The interaction between the", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
product_ forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` IdeaDict
user),
   String -> Sentence
S String
"is through a user" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
interface,
   String -> Sentence
S String
"The responsibilities of the", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
user forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` IdeaDict
system),
   String -> Sentence
S String
"are as follows"]
   
sysCtxUsrResp :: [Sentence]
sysCtxUsrResp :: Purpose
sysCtxUsrResp = [String -> Sentence
S String
"Provide the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inDatum Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"related to the" Sentence -> Sentence -> Sentence
+:+
  forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
glaSlab forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
blastTy) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"ensuring no errors in the" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datum Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"entry",
  String -> Sentence
S String
"Ensure that consistent units are used for" Sentence -> Sentence -> Sentence
+:+. forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
input_ IdeaDict
variable),
  String -> Sentence
S String
"Ensure required" Sentence -> Sentence -> Sentence
+:+ 
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.assumpt [] []) (forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
software CI
assumption))
    Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"are appropriate for any particular" Sentence -> Sentence -> Sentence
+:+
    forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
problem Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"input to the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software]

sysCtxSysResp :: [Sentence]
sysCtxSysResp :: Purpose
sysCtxSysResp = [String -> Sentence
S String
"Detect data type mismatch, such as a string of characters" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
input_ Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"instead of a floating point number",
  String -> Sentence
S String
"Determine if the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"satisfy the required" Sentence -> Sentence -> Sentence
+:+.
  forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict
physical forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` IdeaDict
softwareConstraint),
  String -> Sentence
S String
"Predict whether the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
glaSlab Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is safe or not"]
  
sysCtxResp :: [Sentence]
sysCtxResp :: Purpose
sysCtxResp = [forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
user Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"Responsibilities",
  forall c. Idea c => c -> Sentence
short CI
glassBR Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"Responsibilities"]

sysCtxList :: Contents
sysCtxList :: Contents
sysCtxList = UnlabelledContent -> Contents
UlC forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc forall a b. (a -> b) -> a -> b
$ ListType -> RawContent
Enumeration forall a b. (a -> b) -> a -> b
$ Purpose -> [ListType] -> ListType
bulletNested Purpose
sysCtxResp forall a b. (a -> b) -> a -> b
$
  forall a b. (a -> b) -> [a] -> [b]
map Purpose -> ListType
bulletFlat [Purpose
sysCtxUsrResp, Purpose
sysCtxSysResp]
   
{--User Characteristics--}

userCharacteristicsIntro :: Contents
userCharacteristicsIntro :: Contents
userCharacteristicsIntro = Purpose -> Contents
enumBulletU forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent
  [[String -> Sentence
S String
"The end user of GlassBR is expected to have completed at least the",
    String -> Sentence
S String
"equivalent of the second year of an undergraduate degree in civil engineering or structural engineering"],
  [String -> Sentence
S String
"The end user is expected to have an understanding of theory behind glass",
    String -> Sentence
S String
"breakage and blast risk"],
  [String -> Sentence
S String
"The end user is expected to have basic computer literacy to handle the software"]]

{--System Constraints--}

{--SPECIFIC SYSTEM DESCRIPTION--}

--Automatically generated

{--PROBLEM DESCRIPTION--}

--Introduction of Problem Description section derived from purp

{--Terminology and Definitions--}

termsAndDesc :: Section
termsAndDesc :: Section
termsAndDesc = Maybe Sentence -> [Contents] -> Section
termDefnF' (forall a. a -> Maybe a
Just (String -> Sentence
S String
"All of the" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
term_ Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"are extracted from" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
astm2009)) [Contents
termsAndDescBullets]

{--Physical System Description--}

physSystParts :: [Sentence]
physSystParts :: Purpose
physSystParts = [(forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
the IdeaDict
glaSlab)!.),
  Purpose -> Sentence
foldlSent [(forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
the IdeaDict
ptOfExplsn) !.), String -> Sentence
S String
"Where the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
bomb Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"or", (ConceptChunk
blast forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) Sentence -> Sentence -> Sentence
`sC` (String -> Sentence
S String
"is located" !.), forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
the ConceptChunk
sD) Sentence -> Sentence -> Sentence
`S.isThe`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
distance, String -> Sentence
S String
"between the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
ptOfExplsn Sentence -> Sentence -> Sentence
`S.and_` forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
the IdeaDict
glass)]]

{--Goal Statements--}

goalInputs :: [Sentence]
goalInputs :: Purpose
goalInputs = [forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
dimension forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` IdeaDict
glaPlane), forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
the ConceptChunk
glassTy),
  forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict
characteristic forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` ConceptChunk
explosion), forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
the UncertainChunk
pbTol)]

{--SOLUTION CHARACTERISTICS SPECIFICATION--}

--Automatically generated

{--Assumptions--}

{--Theoretical Models--}

{--Data Definitions--}

{--Data Constraints--}

{--REQUIREMENTS--}

{--Functional Requirements--}

{--Nonfunctional Requirements--}

{--LIKELY CHANGES--}

{--UNLIKELY CHANGES--}

{--TRACEABLITY MATRICES AND GRAPHS--}

{--VALUES OF AUXILIARY CONSTANTS--}

{--REFERENCES--}

{--APPENDIX--}

appdxIntro :: Contents
appdxIntro :: Contents
appdxIntro = Purpose -> Contents
foldlSP [
  String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
appendix, String -> Sentence
S String
"holds the", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
graph,
  Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
demandVsSDFig Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
dimlessloadVsARFig),
  String -> Sentence
S String
"used for interpolating", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"needed in the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
model]

blstRskInvWGlassSlab :: Sentence
blstRskInvWGlassSlab :: Sentence
blstRskInvWGlassSlab = forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
blastRisk Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"involved with the" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
glaSlab