module Drasil.SSP.Requirements (funcReqs, funcReqTables, nonFuncReqs) where

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

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

import Data.Drasil.Concepts.Computation (inDatum)
import Data.Drasil.Concepts.Documentation (assumption, code,
  datum, funcReqDom, input_, likelyChg, mg, mis, module_, name_, nonFuncReqDom,
  output_, physicalConstraint, property, requirement, srs, symbol_,
  traceyMatrix, unlikelyChg, user, value, propOfCorSol)
import Data.Drasil.Concepts.Physics (twoD)
import Data.Drasil.TheoryConcepts (dataDefn, genDefn, inModel, thModel)

import Drasil.SSP.Defs (crtSlpSrf, slope, slpSrf)
import Drasil.SSP.IMods (fctSfty, nrmShrFor, intsliceFs, crtSlpId)
import Drasil.SSP.Unitals (constF, coords, fs, fsMin, intNormForce, 
  intShrForce, inputs, xMaxExtSlip, xMaxEtrSlip, xMinExtSlip, xMinEtrSlip, 
  yMaxSlip, yMinSlip)

{-Functional Requirements-}

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
readAndStore, ConceptInstance
verifyInput, ConceptInstance
determineCritSlip, ConceptInstance
verifyOutput, 
  ConceptInstance
displayInput, ConceptInstance
displayGraph, ConceptInstance
displayFS, ConceptInstance
displayNormal, ConceptInstance
displayShear, 
  ConceptInstance
writeToFile]

funcReqTables :: [LabelledContent]
funcReqTables :: [LabelledContent]
funcReqTables = [LabelledContent
inputDataTable, LabelledContent
inputsToOutputTable]

readAndStore, verifyInput, determineCritSlip, verifyOutput, displayInput, 
  displayGraph, displayFS, displayNormal, displayShear, 
  writeToFile :: ConceptInstance

readAndStore :: ConceptInstance
readAndStore = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "readAndStore" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Read the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
input_ Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "shown in the table", 
  LabelledContent -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef LabelledContent
inputDataTable (String -> Sentence
S "Required Inputs") Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "and store the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
datum]) 
  "Read-and-Store" ConceptChunk
funcReqDom

verifyInput :: ConceptInstance
verifyInput = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifyInput" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Verify that the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
inDatum, String -> Sentence
S "lie within the",
  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)])
  "Verify-Input" ConceptChunk
funcReqDom

determineCritSlip :: ConceptInstance
determineCritSlip = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "determineCritSlip" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Determine the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf, String -> Sentence
S "for the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
input_, 
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "corresponding to the minimum", ConstrConcept -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConstrConcept
fs Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S "by using", Sentence
usingIMs, String -> Sentence
S "to calculate the", ConstrConcept -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConstrConcept
fs, String -> Sentence
S "for a", 
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
slpSrf Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "using", InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
crtSlpId, String -> Sentence
S "to find the", 
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
slpSrf, String -> Sentence
S "that minimizes it"]) 
  "Determine-Critical-Slip-Surface" ConceptChunk
funcReqDom

verifyOutput :: ConceptInstance
verifyOutput = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifyOutput" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Verify that the", DefinedQuantityDict -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase DefinedQuantityDict
fsMin Sentence -> Sentence -> Sentence
`S.and_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf, String -> Sentence
S "satisfy the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
physicalConstraint, String -> Sentence
S "shown 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)])
  "Verify-Output" ConceptChunk
funcReqDom

displayInput :: ConceptInstance
displayInput = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "displayInput" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Display as", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
user) Sentence -> Sentence -> Sentence
:+: String -> Sentence
S "-supplied",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
input_, String -> Sentence
S "listed in", LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
inputsToOutputTable])
  "Display-Input" ConceptChunk
funcReqDom

displayGraph :: ConceptInstance
displayGraph = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "displayGraph" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Display", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf Sentence -> Sentence -> Sentence
`S.the_ofThe` CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
twoD, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S "as determined from", InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
crtSlpId Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "graphically"]) 
  "Display-Graph" ConceptChunk
funcReqDom

displayFS :: ConceptInstance
displayFS = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "displayFS" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Display", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value Sentence -> Sentence -> Sentence
`S.the_ofThe` ConstrConcept -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConstrConcept
fs, String -> Sentence
S "for the", 
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "as determined from", Sentence
usingIMs]) 
  "Display-Factor-of-Safety" ConceptChunk
funcReqDom

displayNormal :: ConceptInstance
displayNormal = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "displayNormal" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Using", Sentence
usingIMs Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "calculate and graphically display the",
  UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural UnitalChunk
intNormForce]) "Display-Interslice-Normal-Forces" ConceptChunk
funcReqDom

displayShear :: ConceptInstance
displayShear = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "displayShear" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Using", Sentence
usingIMs Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "calculate and graphically display the",
  UnitalChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural UnitalChunk
intShrForce]) "Display-Interslice-Shear-Forces" ConceptChunk
funcReqDom

writeToFile :: ConceptInstance
writeToFile = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "writeToFile" ( [Sentence] -> Sentence
foldlSent [
  String -> Sentence
S "Provide the option of writing the output result data, as given in", 
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((ConceptInstance -> Sentence) -> [ConceptInstance] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [ConceptInstance
displayInput, ConceptInstance
displayGraph, ConceptInstance
displayFS, 
  ConceptInstance
displayNormal, ConceptInstance
displayShear]) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "to a file"]) "Write-Results-To-File" 
  ConceptChunk
funcReqDom

usingIMs :: Sentence
usingIMs :: Sentence
usingIMs = 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 -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [InstanceModel
fctSfty, InstanceModel
nrmShrFor, InstanceModel
intsliceFs]

------------------
inputDataTable :: LabelledContent
inputDataTable :: LabelledContent
inputDataTable = [DefinedQuantityDict] -> ConceptInstance -> LabelledContent
forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> r -> LabelledContent
mkInputPropsTable (ConstrConcept -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr ConstrConcept
coords DefinedQuantityDict
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. a -> [a] -> [a]
: (DefinedQuantityDict -> DefinedQuantityDict)
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [DefinedQuantityDict]
inputs) ConceptInstance
readAndStore
  --FIXME: this has to be seperate since coords is a different type

inputsToOutput :: [DefinedQuantityDict]
inputsToOutput :: [DefinedQuantityDict]
inputsToOutput = DefinedQuantityDict
constF DefinedQuantityDict
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. a -> [a] -> [a]
: (UncertQ -> DefinedQuantityDict)
-> [UncertQ] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UncertQ
xMaxExtSlip, UncertQ
xMaxEtrSlip, UncertQ
xMinExtSlip, 
  UncertQ
xMinEtrSlip, UncertQ
yMaxSlip, UncertQ
yMinSlip]

inputsToOutputTable :: LabelledContent
inputsToOutputTable :: LabelledContent
inputsToOutputTable = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeTabRef "inputsToOutputTable") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$
  [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
symbol_, NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
name_] ([DefinedQuantityDict -> Sentence]
-> [DefinedQuantityDict] -> [[Sentence]]
forall a b. [a -> b] -> [a] -> [[b]]
mkTable [DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch, DefinedQuantityDict -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase] [DefinedQuantityDict]
inputsToOutput)
  (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' NamedChunk
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "to be returned as" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
output_) Bool
True

{-Nonfunctional Requirements-}
nonFuncReqs :: [ConceptInstance]
nonFuncReqs :: [ConceptInstance]
nonFuncReqs = [ConceptInstance
correct, 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
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
propCorSol [] [])
  ]) "Correct" 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 Sentence -> Sentence -> Sentence
`S.inThe` 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