module Drasil.SWHS.Requirements where --all of this file is exported

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import Drasil.DocLang (inReq)
import Drasil.DocLang.SRS (datCon, propCorSol) 

import Data.Drasil.Concepts.Computation (inValue)
import Data.Drasil.Concepts.Documentation (assumption, code, condition,
  funcReqDom, input_, likelyChg, mg, mis, module_, nonFuncReqDom, output_,
  physicalConstraint, property, requirement, simulation, srs, traceyMatrix,
  unlikelyChg, value, vavPlan, propOfCorSol)
import Data.Drasil.Concepts.Math (parameter)
import Data.Drasil.Concepts.PhysicalProperties (materialProprty)
import Data.Drasil.Concepts.Thermodynamics as CT (lawConsEnergy, melting)

import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.Quantities.Physics (energy, time)

import Data.Drasil.TheoryConcepts (dataDefn, genDefn, inModel, thModel)

import Drasil.SWHS.DataDefs (waterMass, waterVolume, tankVolume, 
  balanceDecayRate, balanceDecayTime, balanceSolidPCM, balanceLiquidPCM)
import Drasil.SWHS.Concepts (phsChgMtrl, tank)
import Drasil.SWHS.IMods (eBalanceOnWtr, eBalanceOnPCM, heatEInWtr, heatEInPCM, 
  iMods)
import Drasil.SWHS.Unitals (consTol, pcmE, tFinalMelt, tInitMelt, tempPCM, 
  tempW, watE)

------------------------------
-- Data Constraint: Table 1 --
------------------------------

------------------------------
-- Section 5 : REQUIREMENTS --
------------------------------
-----------------------------------
-- 5.1 : Functional Requirements --
-----------------------------------

inReqDesc :: Sentence
inReqDesc :: Sentence
inReqDesc = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NP -> NP
NP.the (ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
tank ConceptChunk
parameter)),
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
materialProprty, String -> Sentence
S "initial" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
condition]

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
findMass, ConceptInstance
checkWithPhysConsts, ConceptInstance
outputInputDerivVals,
  ConceptInstance
calcTempWtrOverTime, ConceptInstance
calcTempPCMOverTime, ConceptInstance
calcChgHeatEnergyWtrOverTime,
  ConceptInstance
calcChgHeatEnergyPCMOverTime, ConceptInstance
verifyEnergyOutput, ConceptInstance
calcPCMMeltBegin, ConceptInstance
calcPCMMeltEnd]

findMass, checkWithPhysConsts, outputInputDerivVals, calcTempWtrOverTime,
  calcTempPCMOverTime, calcChgHeatEnergyWtrOverTime, calcChgHeatEnergyPCMOverTime,
  verifyEnergyOutput, calcPCMMeltBegin, calcPCMMeltEnd :: ConceptInstance

--
findMass :: ConceptInstance
findMass = ConceptInstance
-> Sentence
-> [InstanceModel]
-> [DataDefinition]
-> ConceptInstance
forall r s t.
(Referable r, HasShortName r, Referable s, HasShortName s,
 Referable t, HasShortName t) =>
r -> Sentence -> [s] -> [t] -> ConceptInstance
findMassConstruct (Sentence -> ConceptInstance
inReq Sentence
EmptyS) (UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural UnitalChunk
mass) [InstanceModel]
iMods 
  [DataDefinition
waterMass, DataDefinition
waterVolume, DataDefinition
tankVolume]

findMassConstruct :: (Referable r, HasShortName r, Referable s, HasShortName s,
  Referable t, HasShortName t) => r -> Sentence -> [s] -> [t] -> ConceptInstance
findMassConstruct :: r -> Sentence -> [s] -> [t] -> ConceptInstance
findMassConstruct fr :: r
fr m :: Sentence
m ims :: [s]
ims ddefs :: [t]
ddefs = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "findMass" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Use the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
input_ Sentence -> Sentence -> Sentence
`S.in_` r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
fr, String -> Sentence
S "to find the", 
  Sentence
m, String -> Sentence
S "needed for", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((s -> Sentence) -> [s] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map s -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [s]
ims) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "using", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((t -> Sentence) -> [t] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map t -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [t]
ddefs)])
  "Find-Mass" ConceptChunk
funcReqDom
--
checkWithPhysConsts :: ConceptInstance
checkWithPhysConsts = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "checkWithPhysConsts" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Verify that", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
input_), String -> Sentence
S "satisfy the required",
  Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
datCon [] []) (NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
physicalConstraint)])
  "Check-Input-with-Physical_Constraints" ConceptChunk
funcReqDom
--
outputInputDerivVals :: ConceptInstance
outputInputDerivVals = [Sentence] -> ConceptInstance
oIDQConstruct [Sentence]
oIDQVals

oIDQConstruct :: [Sentence] -> ConceptInstance
oIDQConstruct :: [Sentence] -> ConceptInstance
oIDQConstruct x :: [Sentence]
x = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "outputInputDerivVals" ([Sentence] -> Sentence
foldlSentCol [
  NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
inValue) Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S "derived", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
value Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S "following list"] Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
x) "Output-Input-Derived-Values" ConceptChunk
funcReqDom

oIDQVals :: [Sentence]
oIDQVals :: [Sentence]
oIDQVals = ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent_ [
  [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
value), ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource (Sentence -> ConceptInstance
inReq Sentence
EmptyS)],
  [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
mass), ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
findMass],
  [DataDefinition -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DataDefinition
balanceDecayRate, DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceDecayRate],
  [DataDefinition -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DataDefinition
balanceDecayTime, DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceDecayTime],
  [DataDefinition -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DataDefinition
balanceSolidPCM,  DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceSolidPCM],
  [DataDefinition -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DataDefinition
balanceLiquidPCM, DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceLiquidPCM]
  ]
  
--
calcTempWtrOverTime :: ConceptInstance
calcTempWtrOverTime = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcTempWtrOverTime" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConstrConcept -> NP
forall t. NamedIdea t => t -> NP
the ConstrConcept
tempW),
  Sentence -> Sentence
sParen (ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempW Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time)), String -> Sentence
S "over the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
simulation, UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
time, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
eBalanceOnWtr])
  "Calculate-Temperature-Water-Over-Time" ConceptChunk
funcReqDom
--
calcTempPCMOverTime :: ConceptInstance
calcTempPCMOverTime = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcTempPCMOverTime" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConstrConcept -> NP
forall t. NamedIdea t => t -> NP
the ConstrConcept
tempPCM),
  Sentence -> Sentence
sParen (ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
tempPCM Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time)), String -> Sentence
S "over",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (NamedChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
simulation UnitalChunk
time)), InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
eBalanceOnPCM])
  "Calculate-Temperature-PCM-Over-Time" ConceptChunk
funcReqDom
--
calcChgHeatEnergyWtrOverTime :: ConceptInstance
calcChgHeatEnergyWtrOverTime = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcChgHeatEnergyWtrOverTime" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConstrConcept -> NP
forall t. NamedIdea t => t -> NP
the ConstrConcept
watE),
  Sentence -> Sentence
sParen (ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
watE Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time)), String -> Sentence
S "over",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (NamedChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
simulation UnitalChunk
time)), InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
heatEInWtr])
  "Calculate-Change-Heat_Energy-Water-Over-Time" ConceptChunk
funcReqDom
--
calcChgHeatEnergyPCMOverTime :: ConceptInstance
calcChgHeatEnergyPCMOverTime = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcChgHeatEnergyPCMOverTime" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConstrConcept -> NP
forall t. NamedIdea t => t -> NP
the ConstrConcept
pcmE),
  Sentence -> Sentence
sParen (ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
pcmE Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time)), String -> Sentence
S "over",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (NamedChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
simulation UnitalChunk
time)), InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
heatEInPCM])
  "Calculate-Change-Heat_Energy-PCM-Over-Time" ConceptChunk
funcReqDom
--
verifyEnergyOutput :: ConceptInstance
verifyEnergyOutput = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifyEnergyOutput" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Verify that the", UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UnitalChunk
energy, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
output_,
  Sentence -> Sentence
sParen (ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
watE Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time) Sentence -> Sentence -> Sentence
`S.and_` ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
pcmE Sentence -> Sentence -> Sentence
:+:
  Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time)), String -> Sentence
S "follow the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CT.lawConsEnergy Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "as outlined in", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
propCorSol [] []) (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
propOfCorSol) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "with relative error no greater than", DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
consTol])
  "Verify-Energy-Output-Follow-Conservation-of-Energy" ConceptChunk
funcReqDom
--
calcPCMMeltBegin :: ConceptInstance
calcPCMMeltBegin = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcPCMMeltBegin" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
time),
  String -> Sentence
S "at which the", CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S "begins to melt",
  UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tInitMelt, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
eBalanceOnPCM])
  "Calculate-PCM-Melt-Begin-Time" ConceptChunk
funcReqDom
--
calcPCMMeltEnd :: ConceptInstance
calcPCMMeltEnd = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calcPCMMeltEnd" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Calculate and", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
time),
  String -> Sentence
S "at which the", CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S "stops", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CT.melting,
  UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
tFinalMelt, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
eBalanceOnPCM])
  "Calculate-PCM-Melt-End-Time" ConceptChunk
funcReqDom

-- List structure same between all examples

--How to include pi?
--How to add exponents?

---------------------------------------
-- 5.2 : Non-functional Requirements --
---------------------------------------

nfRequirements :: [ConceptInstance]
nfRequirements :: [ConceptInstance]
nfRequirements = [ConceptInstance
correct, ConceptInstance
verifiable, ConceptInstance
understandable, ConceptInstance
reusable, ConceptInstance
maintainable]

correct :: ConceptInstance
correct :: ConceptInstance
correct = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "correct" ([Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP'
  (NamedChunk
output_ NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` NamedChunk
code), String -> Sentence
S "have the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
property, String -> Sentence
S "described in", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
propCorSol [] []) (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
propOfCorSol)
  ]) "Correct" ConceptChunk
nonFuncReqDom
 
verifiable :: ConceptInstance
verifiable :: ConceptInstance
verifiable = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifiable" ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
code), String -> Sentence
S "is tested with complete",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
vavPlan]) "Verifiable" ConceptChunk
nonFuncReqDom

understandable :: ConceptInstance
understandable :: ConceptInstance
understandable = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "understandable" ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
code), String -> Sentence
S "is modularized with complete",
  CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
mg Sentence -> Sentence -> Sentence
`S.and_` CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
mis]) "Understandable" ConceptChunk
nonFuncReqDom

reusable :: ConceptInstance
reusable :: ConceptInstance
reusable = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "reusable" ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
code), String -> Sentence
S "is modularized"]) "Reusable" ConceptChunk
nonFuncReqDom

maintainable :: ConceptInstance
maintainable :: ConceptInstance
maintainable = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "maintainable" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "The traceability between", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
requirement,
  CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
assumption, CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
thModel, CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
genDefn, CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
dataDefn, CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
inModel,
  CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
likelyChg, CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
unlikelyChg, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
module_], String -> Sentence
S "is completely recorded in",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
traceyMatrix, String -> Sentence
S "in the", CI -> Sentence
getAcc CI
srs Sentence -> Sentence -> Sentence
`S.and_` CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
mg]) "Maintainable" ConceptChunk
nonFuncReqDom

-- The second sentence of the above paragraph is repeated in all examples (not
-- exactly, but the general idea is). The first sentence is not always
-- repeated, but it is always either stating that performance is a priority or
-- performance is not a priority. This is probably something that can be
-- abstracted out.