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 Theory.Drasil (InstanceModel, HasOutput(output))

import Drasil.DocLang (inReq, mkMaintainableNFR, mkCorrectNFR, mkVerifiableNFR, 
  mkUnderstandableNFR, mkReusableNFR)
import Drasil.DocLang.SRS (datCon, propCorSol) 

import Data.Drasil.Concepts.Computation (inValue)
import Data.Drasil.Concepts.Documentation (condition, funcReqDom, input_, output_,
  physicalConstraint, propOfCorSol, value)
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 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, watE)

import Control.Lens ((^.))

------------------------------
-- 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)),
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
materialProprty, String -> Sentence
S String
"initial" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition]

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
findMass, ConceptInstance
checkWithPhysConsts, ConceptInstance
outputInputDerivVals,
  [InstanceModel] -> ConceptInstance
calcValues [InstanceModel]
swhsOutputs, ConceptInstance
verifyEnergyOutput, ConceptInstance
calcPCMMeltBegin, ConceptInstance
calcPCMMeltEnd,
  [InstanceModel] -> ConceptInstance
outputValues [InstanceModel]
swhsOutputs]

findMass, checkWithPhysConsts, outputInputDerivVals, verifyEnergyOutput,
  calcPCMMeltBegin, calcPCMMeltEnd :: ConceptInstance

calcValues, outputValues :: [InstanceModel] -> 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. 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 :: forall r s t.
(Referable r, HasShortName r, Referable s, HasShortName s,
 Referable t, HasShortName t) =>
r -> Sentence -> [s] -> [t] -> ConceptInstance
findMassConstruct r
fr Sentence
m [s]
ims [t]
ddefs = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"findMass" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Use the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
input_ Sentence -> Sentence -> Sentence
`S.in_` r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
fr, String -> Sentence
S String
"to find the", 
  Sentence
m, String -> Sentence
S String
"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 String
"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)])
  String
"Find-Mass" ConceptChunk
funcReqDom
--
checkWithPhysConsts :: ConceptInstance
checkWithPhysConsts = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"checkWithPhysConsts" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Verify that", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
input_), String -> Sentence
S String
"satisfy the required",
  Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
datCon [] []) (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
physicalConstraint)])
  String
"Check-Input-with-Physical_Constraints" ConceptChunk
funcReqDom
--
outputInputDerivVals :: ConceptInstance
outputInputDerivVals = [Sentence] -> ConceptInstance
oIDQConstruct [Sentence]
oIDQVals

oIDQConstruct :: [Sentence] -> ConceptInstance
oIDQConstruct :: [Sentence] -> ConceptInstance
oIDQConstruct [Sentence]
x = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"outputInputDerivVals" ([Sentence] -> Sentence
foldlSentCol [
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
inValue) Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"derived", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"following list"] Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
x) String
"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 (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
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],
  [QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (DataDefinition
balanceDecayRate DataDefinition
-> Getting QuantityDict DataDefinition QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict DataDefinition QuantityDict
forall d. DefinesQuantity d => Getter d QuantityDict
Getter DataDefinition QuantityDict
defLhs), DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceDecayRate],
  [QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (DataDefinition
balanceDecayTime DataDefinition
-> Getting QuantityDict DataDefinition QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict DataDefinition QuantityDict
forall d. DefinesQuantity d => Getter d QuantityDict
Getter DataDefinition QuantityDict
defLhs), DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceDecayTime],
  [QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (DataDefinition
balanceSolidPCM DataDefinition
-> Getting QuantityDict DataDefinition QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict DataDefinition QuantityDict
forall d. DefinesQuantity d => Getter d QuantityDict
Getter DataDefinition QuantityDict
defLhs),  DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceSolidPCM],
  [QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (DataDefinition
balanceLiquidPCM DataDefinition
-> Getting QuantityDict DataDefinition QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict DataDefinition QuantityDict
forall d. DefinesQuantity d => Getter d QuantityDict
Getter DataDefinition QuantityDict
defLhs), DataDefinition -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
balanceLiquidPCM]
  ]

--
calcValues :: [InstanceModel] -> ConceptInstance
calcValues [InstanceModel]
l = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"calcValues" (String -> Sentence
S String
"Calculate the following" Sentence -> Sentence -> Sentence
+: IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value Sentence -> Sentence -> Sentence
+:+.
  [InstanceModel] -> Sentence
outputList [InstanceModel]
l) String
"Calculate-Values" ConceptChunk
funcReqDom
--
verifyEnergyOutput :: ConceptInstance
verifyEnergyOutput = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"verifyEnergyOutput" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Verify that the", UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
energy, IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
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 String
"follow the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CT.lawConsEnergy Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"as outlined in", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
propCorSol [] []) (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
propOfCorSol) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"with relative error no greater than", DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
consTol])
  String
"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 String
"calcPCMMeltBegin" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Calculate and", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
time),
  String -> Sentence
S String
"at which the", CI -> Sentence
forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"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])
  String
"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 String
"calcPCMMeltEnd" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Calculate and", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk -> NP
forall t. NamedIdea t => t -> NP
the UnitalChunk
time),
  String -> Sentence
S String
"at which the", CI -> Sentence
forall c. Idea c => c -> Sentence
short CI
phsChgMtrl, String -> Sentence
S String
"stops", ConceptChunk -> Sentence
forall 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])
  String
"Calculate-PCM-Melt-End-Time" ConceptChunk
funcReqDom
--
outputValues :: [InstanceModel] -> ConceptInstance
outputValues [InstanceModel]
l = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"outputValues" (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_ Sentence -> Sentence -> Sentence
+:+. [InstanceModel] -> Sentence
outputList [InstanceModel]
l)
  String
"Output-Values" ConceptChunk
funcReqDom

outputList :: [InstanceModel] -> Sentence
outputList :: [InstanceModel] -> Sentence
outputList [InstanceModel]
l = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ([Sentence] -> Sentence) -> [Sentence] -> Sentence
forall a b. (a -> b) -> a -> b
$
  (InstanceModel -> Sentence) -> [InstanceModel] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (\InstanceModel
x -> QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (InstanceModel
x InstanceModel
-> Getting QuantityDict InstanceModel QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict InstanceModel QuantityDict
forall c. HasOutput c => Getter c QuantityDict
Getter InstanceModel QuantityDict
output) Sentence -> Sentence -> Sentence
:+: Sentence -> Sentence
sParen (UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
time) Sentence -> Sentence -> Sentence
+:+ InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
x) [InstanceModel]
l

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

-- 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 -> String -> ConceptInstance
mkCorrectNFR String
"correct" String
"Correctness"
 
verifiable :: ConceptInstance
verifiable :: ConceptInstance
verifiable = String -> String -> ConceptInstance
mkVerifiableNFR String
"verifiable" String
"Verifiability"

understandable :: ConceptInstance
understandable :: ConceptInstance
understandable = String -> String -> ConceptInstance
mkUnderstandableNFR String
"understandable" String
"Understandability"

reusable :: ConceptInstance
reusable :: ConceptInstance
reusable = String -> String -> ConceptInstance
mkReusableNFR String
"reusable" String
"Reusability"

maintainable :: ConceptInstance
maintainable :: ConceptInstance
maintainable = String -> Integer -> String -> ConceptInstance
mkMaintainableNFR String
"maintainable" Integer
10 String
"Maintainability"