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

import Control.Lens ((^.))

import Language.Drasil hiding (organization, section, variable)
import Drasil.SRSDocument
import qualified Drasil.DocLang.SRS as SRS (inModel)
import Theory.Drasil (GenDefn, InstanceModel, output)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import qualified Data.Drasil.Concepts.Documentation as Doc (srs)
import Data.Drasil.TheoryConcepts as Doc (inModel)
import Data.Drasil.Concepts.Computation (algorithm, compcon)
import Data.Drasil.Concepts.Documentation as Doc (assumption, column,
  condition, constraint, corSol, datum, document, environment,input_, model,
  output_, physical, physics, property, quantity, software, softwareSys,
  solution, srsDomains, sysCont, system, user, value, variable, doccon,
  doccon')
import Data.Drasil.Concepts.Education (calculus, educon, engineering)
import Data.Drasil.Concepts.Math (de, equation, ode, rightSide, unit_, mathcon, mathcon')
import Data.Drasil.Concepts.PhysicalProperties (materialProprty, physicalcon)
import Data.Drasil.Concepts.Physics (physicCon)
import Data.Drasil.Concepts.Software (program, softwarecon, correctness,
  understandability, reusability, maintainability, verifiability)
import Data.Drasil.Concepts.Thermodynamics (enerSrc, heatTrans, htFlux,
  htTransTheo, lawConsEnergy, thermalAnalysis, thermalConduction, thermalEnergy,
  thermocon)
import Data.Drasil.Quantities.Math (surArea, surface, uNormalVect)
import Data.Drasil.Quantities.PhysicalProperties (vol)
import Data.Drasil.Quantities.Physics (energy, time, physicscon)
import Data.Drasil.Quantities.Thermodynamics (heatCapSpec, latentHeat)
import Data.Drasil.Software.Products (prodtcon)

import Data.Drasil.People (brooks, spencerSmith, thulasi)
import Data.Drasil.SI_Units (metre, kilogram, second, centigrade, joule, watt,
  fundamentals, derived, m_2, m_3)

import Drasil.SWHS.Assumptions (assumpPIS, assumptions)
import Drasil.SWHS.Changes (likelyChgs, unlikelyChgs)
import Drasil.SWHS.Concepts (acronymsFull, coil, con, phaseChangeMaterial,
  phsChgMtrl, progName, sWHT, swhsPCM, tank, tankPCM, transient, water)
import qualified Drasil.SWHS.DataDefs as SWHS (dataDefs)
import Drasil.SWHS.GenDefs (genDefs, htFluxWaterFromCoil, htFluxPCMFromWater)
import Drasil.SWHS.Goals (goals)
import Drasil.SWHS.IMods (eBalanceOnWtr, eBalanceOnPCM, heatEInWtr, heatEInPCM,
  iMods, instModIntro)
import Drasil.SWHS.References (citations)
import Drasil.SWHS.Requirements (funcReqs, inReqDesc, nfRequirements, verifyEnergyOutput)
import Drasil.SWHS.TMods (tMods)
import Drasil.SWHS.Unitals (absTol, coilHTC, coilSA, consTol, constrained,
  htFluxC, htFluxP, inputs, inputConstraints, outputs, pcmE, pcmHTC, pcmSA,
  relTol, simTime, specParamValList, symbols, symbolsAll, tempC, tempPCM,
  tempW, thickness, unitalChuncks, watE)

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

srs :: Document
srs :: Document
srs = SRSDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> SystemInformation
-> Document
mkDoc SRSDecl
mkSRS forall c d. (NamedIdea c, NamedIdea d) => c -> d -> Sentence
S.forT 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

resourcePath :: String
resourcePath :: String
resourcePath = String
"../../../../datafiles/swhs/"

units :: [UnitDefn]
units :: [UnitDefn]
units = forall a b. (a -> b) -> [a] -> [b]
map forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
metre, UnitDefn
kilogram, UnitDefn
second] forall a. [a] -> [a] -> [a]
++ 
  forall a b. (a -> b) -> [a] -> [b]
map forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
centigrade, UnitDefn
joule, UnitDefn
watt]
--Will there be a table of contents?

si :: SystemInformation
si :: SystemInformation
si = SI {
  _sys :: CI
_sys         = CI
swhsPCM,
  _kind :: CI
_kind        = CI
Doc.srs, 
  _authors :: [Person]
_authors     = [Person
thulasi, Person
brooks, Person
spencerSmith],
  _purpose :: Purpose
_purpose     = [Sentence
purp],
  _background :: Purpose
_background  = [],
  _quants :: [DefinedQuantityDict]
_quants      = [DefinedQuantityDict]
symbols,
  _concepts :: [DefinedQuantityDict]
_concepts    = [] :: [DefinedQuantityDict],
  _instModels :: [InstanceModel]
_instModels  = [InstanceModel]
insModel,
  _datadefs :: [DataDefinition]
_datadefs    = [DataDefinition]
SWHS.dataDefs,
  _configFiles :: [String]
_configFiles = [],
  _inputs :: [QuantityDict]
_inputs      = [QuantityDict]
inputs,
  _outputs :: [QuantityDict]
_outputs     = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstrConcept]
outputs,
  _defSequence :: [Block SimpleQDef]
_defSequence = [] :: [Block SimpleQDef],
  _constraints :: [ConstrConcept]
_constraints = [ConstrConcept]
constrained,
  _constants :: [ConstQDef]
_constants   = [ConstQDef]
specParamValList,
  _sysinfodb :: ChunkDB
_sysinfodb   = ChunkDB
symbMap,
  _usedinfodb :: ChunkDB
_usedinfodb  = ChunkDB
usedDB,
   refdb :: ReferenceDB
refdb       = ReferenceDB
refDB
}

purp :: Sentence
purp :: Sentence
purp = Purpose -> Sentence
foldlSent_ [String -> Sentence
S String
"investigate the effect" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"employing",
  forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"within a", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
sWHT]

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 (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw (InstanceModel
heatEInPCM forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c QuantityDict
output) forall a. a -> [a] -> [a]
: [QuantityDict]
symbolsAll) -- heatEInPCM ?
  (forall c. Idea c => c -> IdeaDict
nw InstanceModel
heatEInPCM forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronymsFull
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
thermocon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
units forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn
m_2, UnitDefn
m_3] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UncertainChunk
absTol, UncertainChunk
relTol]
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitalChunk]
physicscon 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 [ConceptChunk]
softwarecon 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 [ConceptChunk]
con
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
prodtcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicCon 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 [ConstQDef]
specParamValList
  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 [IdeaDict]
educon 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. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitalChunk]
unitalChuncks
  forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw CI
swhsPCM, 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 [IdeaDict]
compcon forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw IdeaDict
materialProprty])
  (forall c. Concept c => c -> ConceptChunk
cw InstanceModel
heatEInPCM forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [DefinedQuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
srsDomains forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [ConstQDef]
specParamValList) -- FIXME: heatEInPCM?
  ([UnitDefn]
units forall a. [a] -> [a] -> [a]
++ [UnitDefn
m_2, UnitDefn
m_3]) [DataDefinition]
SWHS.dataDefs [InstanceModel]
insModel [GenDefn]
genDefs [TheoryModel]
tMods [ConceptInstance]
concIns [Section]
section [] []

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 [DefinedQuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronymsFull)
 ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] [] [] [] ([] :: [Reference])

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

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] -> LFunc -> RefTab
tsymb'' [TSIntro]
tSymbIntro forall a b. (a -> b) -> a -> b
$ [DefinedQuantityDict] -> LFunc
TermExcept [DefinedQuantityDict
uNormalVect],
    RefTab
TAandA],
  IntroSec -> DocSection
IntroSec forall a b. (a -> b) -> a -> b
$
    Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg (Sentence
introStart Sentence -> Sentence -> Sentence
+:+ Sentence
introStartSWHS) (Sentence -> CI -> Sentence
introEnd (forall n. NamedIdea n => n -> Sentence
plural CI
swhsPCM) CI
progName)
    [Purpose -> IntroSub
IPurpose forall a b. (a -> b) -> a -> b
$ CI -> Verbosity -> Purpose
purpDoc CI
progName Verbosity
Verbose,
     Sentence -> IntroSub
IScope Sentence
scope,
     Purpose -> Purpose -> Purpose -> IntroSub
IChar [] Purpose
charsOfReader [],
     CI -> Section -> Sentence -> IntroSub
IOrgSec CI
inModel ([Contents] -> [Section] -> Section
SRS.inModel [] []) Sentence
orgDocEnd
    ],
  GSDSec -> DocSection
GSDSec forall a b. (a -> b) -> a -> b
$ [GSDSub] -> GSDSec
GSDProg
    [ [Contents] -> GSDSub
SysCntxt [CI -> Contents
sysCntxtDesc CI
progName, LabelledContent -> Contents
LlC LabelledContent
sysCntxtFig, CI -> Contents
sysCntxtRespIntro CI
progName, CI -> Contents
systContRespBullets CI
progName]
    , [Contents] -> GSDSub
UsrChars [CI -> Contents
userChars CI
progName]
    , [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 []
        [ forall c. Concept c => Maybe Sentence -> [c] -> PDSub
TermsAndDefs forall a. Maybe a
Nothing [ConceptChunk]
terms
        , forall a.
Idea a =>
a -> Purpose -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
progName Purpose
physSystParts LabelledContent
figTank []
        , 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 [] ([Field
Label, Field
Units] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , 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
ShowDerivation
        , forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
dataConTail [UncertQ]
inputConstraints
        , forall c.
(Quantity c, Constrained c) =>
[c] -> [Contents] -> SCSSub
CorrSolnPpties [ConstrConcept]
outputConstraints [Contents]
propsDeriv
        ]
      ],
  ReqrmntSec -> DocSection
ReqrmntSec forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg [
    Sentence -> [LabelledContent] -> ReqsSub
FReqsSub Sentence
inReqDesc [],
    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
progName [ConstQDef]
specParamValList,
  DocSection
Bibliography]

tSymbIntro :: [TSIntro]
tSymbIntro :: [TSIntro]
tSymbIntro = [TSIntro
TSPurpose, [Literature] -> TSIntro
SymbConvention
  [IdeaDict -> Literature
Lit (forall c. Idea c => c -> IdeaDict
nw ConceptChunk
heatTrans), IdeaDict -> Literature
Doc' (forall c. Idea c => c -> IdeaDict
nw CI
progName)], TSIntro
SymbOrder, TSIntro
VectorUnits]

insModel :: [InstanceModel]
insModel :: [InstanceModel]
insModel = [InstanceModel
eBalanceOnWtr, InstanceModel
eBalanceOnPCM, InstanceModel
heatEInWtr, InstanceModel
heatEInPCM]

concIns :: [ConceptInstance]
concIns :: [ConceptInstance]
concIns = [ConceptInstance]
goals forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
assumptions 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]
nfRequirements

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]

priorityNFReqs :: [ConceptChunk]
priorityNFReqs :: [ConceptChunk]
priorityNFReqs = [ConceptChunk
correctness, ConceptChunk
verifiability, ConceptChunk
understandability, ConceptChunk
reusability,
  ConceptChunk
maintainability]
-- It is sometimes hard to remember to add new sections both here and above.

-- =================================== --
-- SOFTWARE REQUIREMENTS SPECIFICATION --
-- =================================== --

------------------------------
-- Section 2 : INTRODUCTION --
------------------------------

introStart :: Sentence
introStart :: Sentence
introStart = Purpose -> Sentence
foldlSent [String -> Sentence
S String
"Due to", SepType -> FoldType -> Purpose -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map String -> Sentence
S
  [String
"increasing costs", String
"diminishing availability", String
"negative environmental impact"]) Sentence -> Sentence -> Sentence
`S.of_`
  String -> Sentence
S String
"fossil fuels" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"the demand is high for renewable", forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
enerSrc forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_PS`
  UnitalChunk
energy), String -> Sentence
S String
"storage technology"]

introStartSWHS :: Sentence
introStartSWHS :: Sentence
introStartSWHS = Purpose -> Sentence
foldlSent [Sentence -> Sentence
capSent forall a b. (a -> b) -> a -> b
$ forall n. NounPhrase n => n -> Sentence
pluralNP forall a b. (a -> b) -> a -> b
$ CI
progName forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term, String -> Sentence
S String
"incorporating",
  forall n. NamedIdea n => n -> Sentence
phrase CI
phsChgMtrl, Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
phsChgMtrl), String -> Sentence
S String
"use a renewable",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
enerSrc Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"provide a novel way of storing" Sentence -> Sentence -> Sentence
+:+.  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy,
  forall n. NamedIdea n => n -> Sentence
atStart CI
swhsPCM, String -> Sentence
S String
"improve over the traditional", forall n. NamedIdea n => n -> Sentence
plural CI
progName,
  String -> Sentence
S String
"because of their smaller size. The smaller size is possible because of the ability" Sentence -> Sentence -> Sentence
`S.of_`
  forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"to store", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
thermalEnergy, String -> Sentence
S String
"as", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
latentHeat Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"which allows higher", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
thermalEnergy, String -> Sentence
S String
"storage capacity per",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
unit_, String -> Sentence
S String
"weight"]

introEnd :: Sentence -> CI -> Sentence
introEnd :: Sentence -> CI -> Sentence
introEnd Sentence
progSent CI
pro = Purpose -> Sentence
foldlSent_ [(Sentence
progSent !.), String -> Sentence
S String
"The developed",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
program, String -> Sentence
S String
"will be referred to as", forall n. NamedIdea n => n -> Sentence
titleize CI
pro, Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
pro)]
  -- SSP has same style sentence here

-------------------------------
-- 2.1 : Purpose of Document --
-------------------------------
-- Purpose of Document automatically generated in IPurpose

--How to italicize words in sentence?
--How to cite?

---------------------------------
-- 2.2 : Scope of Requirements --
---------------------------------

scope :: Sentence
scope :: Sentence
scope = Purpose -> Sentence
foldlSent_ [forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
thermalAnalysis Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"a single" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tankPCM,
  String -> Sentence
S String
"This entire", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"written assuming that the substances inside the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
sWHT Sentence -> Sentence -> Sentence
`S.are` forall n. NounPhrase n => n -> Sentence
phraseNP (forall c d. (c -> Sentence) -> (d -> Sentence) -> c -> d -> NP
and_Gen forall n. NamedIdea n => n -> Sentence
phrase forall c. Idea c => c -> Sentence
short ConceptChunk
water CI
phsChgMtrl)]

-- There is a similar paragraph in each example, but there's a lot of specific
-- info here. Would need to abstract out the object of analysis (i.e. solar
-- water heating tank rating PCM, 2D slope composed of homogeneous soil
-- layers, glass slab and blast, or 2D bodies acted on by forces) and also
-- abstract out the overall goal of the program (i.e. predict the temperature
-- and energy histories for the water and PCM, simulate how 2D rigid bodies
-- interact with each other, predict whether the glass slab is safe to use or
-- not, etc.). If that is done, then this paragraph can also be abstracted out.

----------------------------------------------
-- 2.3 : Characteristics of Intended Reader --
----------------------------------------------

charsOfReader :: [Sentence]
charsOfReader :: Purpose
charsOfReader = [Sentence
charReaderHTT, Sentence
charReaderDE]

charReaderHTT :: Sentence
charReaderHTT :: Sentence
charReaderHTT = Purpose -> Sentence
foldlSent_ [forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
htTransTheo, String -> Sentence
S String
"from level 3 or 4",
  String -> Sentence
S String
"mechanical",  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
engineering]

charReaderDE :: Sentence
charReaderDE :: Sentence
charReaderDE = forall n. NamedIdea n => n -> Sentence
plural CI
de Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"from level 1 and 2" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
calculus

------------------------------------
-- 2.4 : Organization of Document --
------------------------------------
orgDocEnd :: Sentence
orgDocEnd :: Sentence
orgDocEnd = Purpose -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the CI
inModel), 
  String -> Sentence
S String
"to be solved are referred to as" 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 [InstanceModel]
iMods), String -> Sentence
S String
"The", forall n. NamedIdea n => n -> Sentence
plural CI
inModel,
  String -> Sentence
S String
"provide the", forall n. NamedIdea n => n -> Sentence
plural CI
ode, Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
ode Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"s") Sentence -> Sentence -> Sentence
`S.and_` 
  String -> Sentence
S String
"algebraic", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S String
"that", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model, 
  (forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the CI
swhsPCM) !.), forall c. Idea c => c -> Sentence
short CI
progName, String -> Sentence
S String
"solves these", forall c. Idea c => c -> Sentence
short CI
ode Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"s"]

-- This paragraph is mostly general (besides program name and number of IMs),
-- but there are some differences between the examples that I'm not sure how to
-- account for. Specifically, the glass example references a Volere paper that
-- is not used for the other examples. Besides that, this paragraph could
-- probably be abstracted out with some changes (i.e. the other examples don't
-- include the last sentence, so we might not need to know the number of IMs
-- after all if we just leave that sentence out)

-- IM1 to IM4 : reference later

-- how to cite/reference?

-- If all SRS have the same basic layout, is it possible to automate
-- the sectioning? This would also improve the tediousness of declaring
-- LayoutObjs

--------------------------------------------
-- Section 3: GENERAL SYSTEM DESCRIPTION --
--------------------------------------------

--------------------------
-- 3.1 : System Context --
--------------------------

sysCntxtDesc :: CI -> Contents
sysCntxtDesc :: CI -> Contents
sysCntxtDesc CI
pro = Purpose -> Contents
foldlSP [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
sysCntxtFig, 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",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
user) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"in this case",
  String -> Sentence
S String
"A rectangle represents the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
softwareSys, String -> Sentence
S String
"itself" Sentence -> Sentence -> Sentence
+:+.
  Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
pro), String -> Sentence
S String
"Arrows are used to show the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datum,
  String -> Sentence
S String
"flow between the", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
system forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andIts` IdeaDict
environment)]

sysCntxtFig :: LabelledContent
sysCntxtFig :: LabelledContent
sysCntxtFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"SysCon") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (Purpose -> Sentence
foldlSent_
  [forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
sysCntxtFig Sentence -> Sentence -> Sentence
+: Sentence
EmptyS, forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
sysCont])
  forall a b. (a -> b) -> a -> b
$ String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"SystemContextFigure.png"

sysCntxtRespIntro :: CI -> Contents
sysCntxtRespIntro :: CI -> Contents
sysCntxtRespIntro CI
pro = Purpose -> Contents
foldlSPCol [forall c. Idea c => c -> Sentence
short CI
pro Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is mostly self-contained",
  String -> Sentence
S String
"The only external interaction is through the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
user Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"interface", String -> Sentence
S String
"responsibilities" Sentence -> Sentence -> Sentence
`S.the_ofTheC` forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
user forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe`
  IdeaDict
system) Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"as follows"]

systContRespBullets :: CI -> Contents
systContRespBullets :: CI -> Contents
systContRespBullets CI
prog = 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
  [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
prog Sentence -> Sentence -> Sentence
+: String -> Sentence
S String
"Responsibilities"]
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Purpose -> ListType
bulletFlat [Purpose
userResp, Purpose
swhsResp]

userResp :: [Sentence]
userResp :: Purpose
userResp = forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent_ [
  [String -> Sentence
S String
"Provide the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
input_, forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datum Sentence -> Sentence -> Sentence
`S.toThe`
    forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"ensuring no errors in the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datum, String -> Sentence
S String
"entry"],
  [String -> Sentence
S String
"Take care that consistent", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
unit_, String -> Sentence
S String
"are used for",
    forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
input_, forall n. NamedIdea n => n -> Sentence
plural IdeaDict
variable]
  ]

swhsResp :: [Sentence]
swhsResp :: Purpose
swhsResp = forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent_ [
  [String -> Sentence
S String
"Detect", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datum, String -> Sentence
S String
"type mismatch, such as a string" Sentence -> Sentence -> Sentence
`S.of_`
    String -> Sentence
S String
"characters instead of a floating point number"],
  [String -> Sentence
S String
"Determine if the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
input_, String -> Sentence
S String
"satisfy the required",
    forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
physical forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` IdeaDict
software), forall n. NamedIdea n => n -> Sentence
plural IdeaDict
constraint],
  [String -> Sentence
S String
"Calculate the required", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
output_]
  ]

--------------------------------
-- 3.2 : User Characteristics --
--------------------------------

userChars :: CI -> Contents
userChars :: CI -> Contents
userChars CI
pro = Purpose -> Contents
foldlSP [String -> Sentence
S String
"The end", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
user Sentence -> Sentence -> Sentence
`S.of_` forall c. Idea c => c -> Sentence
short CI
pro,
  String -> Sentence
S String
"should have an understanding of undergraduate Level 1 Calculus" Sentence -> Sentence -> Sentence
`S.and_`
  forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
Doc.physics]

-- Some of these course names are repeated between examples, could potentially
-- be abstracted out.

------------------------------
-- 3.3 : System Constraints --
------------------------------

---------------------------------------------
-- Section 4 : SPECIFIC SYSTEM DESCRIPTION --
---------------------------------------------

-------------------------------
-- 4.1 : Problem Description --
-------------------------------

-- Introduction of Problem Description section derived from purp

-----------------------------------------
-- 4.1.1 : Terminology and Definitions --
-----------------------------------------

terms :: [ConceptChunk]
terms :: [ConceptChunk]
terms = forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [ConceptChunk
htFlux, ConceptChunk
phaseChangeMaterial, forall c. Concept c => c -> ConceptChunk
cw UnitalChunk
heatCapSpec, ConceptChunk
thermalConduction, ConceptChunk
transient]

-- Included heat flux and specific heat in NamedChunks even though they are
-- already in SWHSUnits

-----------------------------------------
-- 4.1.2 : Physical System Description --
-----------------------------------------

physSystParts :: [Sentence]
physSystParts :: Purpose
physSystParts = forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent_ [ConceptChunk -> ConceptChunk -> Purpose
physSyst1 ConceptChunk
tank ConceptChunk
water, ConceptChunk -> ConceptChunk -> UnitalChunk -> Purpose
physSyst2 ConceptChunk
coil ConceptChunk
tank UnitalChunk
htFluxC,
  [forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"suspended in" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
tank,
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"represents the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
htFluxP)]]

physSyst1 :: ConceptChunk -> ConceptChunk -> [Sentence]
physSyst1 :: ConceptChunk -> ConceptChunk -> Purpose
physSyst1 ConceptChunk
ta ConceptChunk
wa = [forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
ta, String -> Sentence
S String
"containing" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
wa]

physSyst2 :: ConceptChunk -> ConceptChunk -> UnitalChunk -> [Sentence]
physSyst2 :: ConceptChunk -> ConceptChunk -> UnitalChunk -> Purpose
physSyst2 ConceptChunk
co ConceptChunk
ta UnitalChunk
hfc = [forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
co, String -> Sentence
S String
"at bottom of" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
ta,
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
hfc Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"represents the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
hfc)]

-- Structure of list would be same between examples but content is completely
-- different

figTank :: LabelledContent
figTank :: LabelledContent
figTank = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"Tank") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (
  Purpose -> Sentence
foldlSent_ [forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
sWHT Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"with", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
htFluxC Sentence -> Sentence -> Sentence
`S.of_`
  forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxC Sentence -> Sentence -> Sentence
`S.and_` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
htFluxP Sentence -> Sentence -> Sentence
`S.of_` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
htFluxP])
  forall a b. (a -> b) -> a -> b
$ String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"Tank.png"

-----------------------------
-- 4.1.3 : Goal Statements --
-----------------------------

goalInputs :: [Sentence]
goalInputs :: Purpose
goalInputs  = [forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UncertQ
tempC),
  String -> Sentence
S String
"the initial" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"for the" Sentence -> Sentence -> Sentence
+:+ forall n. NounPhrase n => n -> Sentence
phraseNP (ConstrConcept
tempW forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` ConstrConcept
tempPCM),
  String -> Sentence
S String
"the material" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural IdeaDict
property]

-- 2 examples include this paragraph, 2 don't. The "givens" would need to be
-- abstracted out if this paragraph were to be abstracted out.

--------------------------------------------------
-- 4.2 : Solution Characteristics Specification --
--------------------------------------------------

-------------------------
-- 4.2.1 : Assumptions --
-------------------------

-- Can booktabs colored links be used? The box links completely cover nearby
-- punctuation.

--------------------------------
-- 4.2.2 : Theoretical Models --
--------------------------------

-- Theory has to be RelationChunk....
-- No way to include "Source" or "Ref. By" sections?

---------------------------------
-- 4.2.3 : General Definitions --
---------------------------------

-- SECTION 4.2.3 --
{--- General Definitions is automatically generated in solChSpecF
s4_2_3_genDefs :: [Contents]
s4_2_3_genDefs = map reldefn swhsRC

s4_2_3_deriv :: [Contents]
s4_2_3_deriv = [s4_2_3_deriv_1 rOfChng temp,
  s4_2_3_deriv_2 consThermE vol,
  s4_2_3_deriv_3,
  s4_2_3_deriv_4 gaussDiv surface vol thFluxVect uNormalVect unit_,
  s4_2_3_deriv_5,
  s4_2_3_deriv_6 vol volHtGen,
  s4_2_3_deriv_7,
  s4_2_3_deriv_8 htFluxIn htFluxOut inSA outSA density heatCapSpec
    temp vol assumption assump3 assump4 assump5 assump6,
  s4_2_3_deriv_9,
  s4_2_3_deriv_10 density mass vol,
  s4_2_3_deriv_11]-}

-- General Definitions is automatically generated 

------------------------------
-- 4.2.4 : Data Definitions --
------------------------------
-----------------------------
-- 4.2.5 : Instance Models --
-----------------------------
----------------------------
-- 4.2.6 Data Constraints --
----------------------------
-- I do not think Table 2 will end up being necessary for the Drasil version
---- The info from table 2 will likely end up in table 1.
dataConTail :: Sentence
dataConTail :: Sentence
dataConTail = Sentence
dataContMid Sentence -> Sentence -> Sentence
+:+ Sentence
dataContFooter

dataContMid :: Sentence
dataContMid :: Sentence
dataContMid = Purpose -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
column) Sentence -> Sentence -> Sentence
`S.for` forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
software
  IdeaDict
constraint), String -> Sentence
S String
"restricts the range" Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
plural IdeaDict
input_,
  String -> Sentence
S String
"to reasonable", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value]

dataContFooter :: Sentence
dataContFooter :: Sentence
dataContFooter = Purpose -> Sentence
foldlSent_ forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent [

  [Sentence -> Sentence
sParen (String -> Sentence
S String
"*"), String -> Sentence
S String
"These", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
quantity, String -> Sentence
S String
"cannot be equal to zero" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"or there will be a divide by zero in the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model],

  [Sentence -> Sentence
sParen (String -> Sentence
S String
"+"), String -> Sentence
S String
"These", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
quantity, String -> Sentence
S String
"cannot be zero" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"or there would be freezing", Sentence -> Sentence
sParen (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpPIS)],

  [Sentence -> Sentence
sParen (String -> Sentence
S String
"++"), forall n. NounPhrase n => n -> Sentence
atStartNP' (NP -> NP
NP.the (IdeaDict
constraint forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThePS` UnitalChunk
surArea)),
  String -> Sentence
S String
"are calculated by considering the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea, String -> Sentence
S String
"to", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
vol Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"ratio", forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the CI
assumption), String -> Sentence
S String
"is that the lowest ratio is 1" Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"the highest possible is", ModelExpr -> Sentence
eS (forall r. LiteralC r => Integer -> r
exactDbl Integer
2 forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
thickness) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"where", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
thickness,
  String -> Sentence
S String
"is the thickness of a" Sentence -> Sentence -> Sentence
+:+. (Sentence -> Sentence
Quote (String -> Sentence
S String
"sheet") Sentence -> Sentence -> Sentence
`S.of_` forall c. Idea c => c -> Sentence
short CI
phsChgMtrl),
  String -> Sentence
S String
"A thin sheet has the greatest", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surArea, String -> Sentence
S String
"to", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
vol, String -> Sentence
S String
"ratio"],

  [Sentence -> Sentence
sParen (String -> Sentence
S String
"**"), forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
constraint), String -> Sentence
S String
"on the maximum", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
time,
  String -> Sentence
S String
"at the end of the simulation is the total number of seconds in one day"]
  
  ]
------------------------------
-- Data Constraint: Table 1 --
------------------------------

------------------------------
-- Data Constraint: Table 2 --
------------------------------

------------------------------
-- Data Constraint: Table 3 --
------------------------------

outputConstraints :: [ConstrConcept]
outputConstraints :: [ConstrConcept]
outputConstraints = [ConstrConcept
tempW, ConstrConcept
tempPCM, ConstrConcept
watE, ConstrConcept
pcmE] --FIXME: add "(by A11)" in Physical Constraints of `tempW` and `tempPCM`?

-- Other Notes:
---- Will there be a way to have asterisks for certain pieces of the table?

----------------------------------------------
-- 4.2.7 : Properties of A Correct Solution --
----------------------------------------------
{-Properties of a Correct Solution-}

propsDeriv :: [Contents]
propsDeriv :: [Contents]
propsDeriv = [
  forall b h.
(NamedIdea b, NamedIdea h) =>
ConceptChunk
-> b
-> UnitalChunk
-> ConceptChunk
-> CI
-> GenDefn
-> GenDefn
-> h
-> ConceptChunk
-> Contents
propCorSolDeriv1 ConceptChunk
lawConsEnergy ConstrConcept
watE UnitalChunk
energy ConceptChunk
coil CI
phsChgMtrl
                   GenDefn
htFluxWaterFromCoil GenDefn
htFluxPCMFromWater UnitalChunk
surface ConceptChunk
heatTrans,
  Contents
propCorSolDeriv2,
  forall a.
NamedIdea a =>
a -> UnitalChunk -> CI -> ConceptChunk -> Contents
propCorSolDeriv3 ConstrConcept
pcmE UnitalChunk
energy CI
phsChgMtrl ConceptChunk
water,
  Contents
propCorSolDeriv4,
  ConceptChunk -> CI -> CI -> Contents
propCorSolDeriv5 ConceptChunk
equation CI
progName CI
rightSide]

propCorSolDeriv1 :: (NamedIdea b, NamedIdea h) => ConceptChunk -> b -> UnitalChunk ->
  ConceptChunk -> CI -> GenDefn -> GenDefn -> h -> ConceptChunk -> Contents
propCorSolDeriv1 :: forall b h.
(NamedIdea b, NamedIdea h) =>
ConceptChunk
-> b
-> UnitalChunk
-> ConceptChunk
-> CI
-> GenDefn
-> GenDefn
-> h
-> ConceptChunk
-> Contents
propCorSolDeriv1 ConceptChunk
lce b
ewat UnitalChunk
en ConceptChunk
co CI
pcmat GenDefn
g1hfc GenDefn
g2hfp h
su ConceptChunk
ht  =
  Purpose -> Contents
foldlSPCol [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
a_ IdeaDict
corSol), String -> Sentence
S String
"must exhibit" Sentence -> Sentence -> Sentence
+:+.
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
lce), String -> Sentence
S String
"This means that", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the b
ewat),
  String -> Sentence
S String
"should equal the difference between the total", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
en,
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
input_, String -> Sentence
S String
"from", forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
co NP -> NP -> NP
`NP.andThe`
  forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI UnitalChunk
en IdeaDict
output_), String -> Sentence
S String
"to the" Sentence -> Sentence -> Sentence
+:+. forall c. Idea c => c -> Sentence
short CI
pcmat,
  String -> Sentence
S String
"This can be shown as an", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"by taking",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
g1hfc Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
g2hfp Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"multiplying each by their respective", forall n. NamedIdea n => n -> Sentence
phrase h
su,
  String -> Sentence
S String
"area of", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
ht Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and integrating each",
  String -> Sentence
S String
"over the", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
simTime Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"as follows"]

propCorSolDeriv2 :: Contents
propCorSolDeriv2 :: Contents
propCorSolDeriv2 = ModelExpr -> Contents
unlbldExpr
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
watE forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
coilHTC forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
coilSA forall r. ExprC r => r -> r -> r
`mulRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
tempC forall r. ExprC r => r -> r -> r
$- forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time))
  forall r. ExprC r => r -> r -> r
$- forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
pcmHTC forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
pcmSA forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time forall r. ExprC r => r -> r -> r
$-
  forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time)))

propCorSolDeriv3 :: NamedIdea a => a -> UnitalChunk -> CI -> ConceptChunk -> Contents
propCorSolDeriv3 :: forall a.
NamedIdea a =>
a -> UnitalChunk -> CI -> ConceptChunk -> Contents
propCorSolDeriv3 a
epcm UnitalChunk
en CI
pcmat ConceptChunk
wa =
  Purpose -> Contents
foldlSP_ [String -> Sentence
S String
"In addition, the", forall n. NamedIdea n => n -> Sentence
phrase a
epcm, String -> Sentence
S String
"should equal the",
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
en, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
input_, String -> Sentence
S String
"to the", forall c. Idea c => c -> Sentence
short CI
pcmat,
  String -> Sentence
S String
"from the" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
wa, String -> Sentence
S String
"This can be expressed as"]

propCorSolDeriv4 :: Contents
propCorSolDeriv4 :: Contents
propCorSolDeriv4 = ModelExpr -> Contents
unlbldExpr
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
pcmE forall r. ExprC r => r -> r -> r
$= forall r. ExprC r => Symbol -> r -> r -> r -> r
defint (forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
time) (forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)
  (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
pcmHTC forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UncertQ
pcmSA forall r. ExprC r => r -> r -> r
`mulRe` (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempW UnitalChunk
time forall r. ExprC r => r -> r -> r
$- 
  forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 ConstrConcept
tempPCM UnitalChunk
time)))

propCorSolDeriv5 :: ConceptChunk -> CI -> CI -> Contents
propCorSolDeriv5 :: ConceptChunk -> CI -> CI -> Contents
propCorSolDeriv5 ConceptChunk
eq CI
pro CI
rs = Purpose -> Contents
foldlSP [forall n. NamedIdea n => n -> Sentence
titleize' ConceptChunk
eq, String -> Sentence
S String
"(FIXME: Equation 7)" 
  Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"(FIXME: Equation 8) can be used as", Sentence -> Sentence
Quote (String -> Sentence
S String
"sanity") Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"checks to gain confidence in any", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
solution,
  String -> Sentence
S String
"computed by" Sentence -> Sentence -> Sentence
+:+. forall c. Idea c => c -> Sentence
short CI
pro, String -> Sentence
S String
"The relative",
  String -> Sentence
S String
"error between the results computed by", forall c. Idea c => c -> Sentence
short CI
pro Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"the results calculated from the", forall c. Idea c => c -> Sentence
short CI
rs, String -> Sentence
S String
"of these",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
eq, String -> Sentence
S String
"should be less than", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
consTol, forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
verifyEnergyOutput]

-- Remember to insert references in above derivation when available

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

---------------------------------------
-- 5.2 : Non-functional Requirements --
---------------------------------------
--------------------------------
-- Section 6 : LIKELY CHANGES --
--------------------------------

--------------------------------
-- Section 6b : UNLIKELY CHANGES --
--------------------------------

--------------------------------------------------
-- Section 7 : TRACEABILITY MATRICES AND GRAPHS --
--------------------------------------------------

------------------------
-- Traceabilty Graphs --
------------------------
-------------------------------------------------
-- Section 8 :  Specification Parameter Values --
-------------------------------------------------
----------------------------
-- Section 9 : References --
----------------------------