{-#LANGUAGE PostfixOperators#-}
module Drasil.PDController.Requirements where

import Data.Drasil.Concepts.Documentation (funcReqDom, nonFuncReqDom, datumConstraint)

import Drasil.DocLang.SRS (datCon)

import Drasil.PDController.Concepts
import Drasil.PDController.IModel

import Language.Drasil

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
verifyInputs, ConceptInstance
calculateValues, ConceptInstance
outputValues]

verifyInputs, calculateValues, outputValues :: ConceptInstance
verifyInputs :: ConceptInstance
verifyInputs
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifyInputs" Sentence
verifyInputsDesc "Verify-Input-Values" ConceptChunk
funcReqDom
calculateValues :: ConceptInstance
calculateValues
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "calculateValues" Sentence
calculateValuesDesc "Calculate-Values" ConceptChunk
funcReqDom
outputValues :: ConceptInstance
outputValues = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "outputValues" Sentence
outputValuesDesc "Output-Values" ConceptChunk
funcReqDom

verifyInputsDesc, calculateValuesDesc, outputValuesDesc :: Sentence

verifyInputsDesc :: Sentence
verifyInputsDesc
  = [Sentence] -> Sentence
foldlSent_
      [String -> Sentence
S "Ensure that the input values are within the",
         String -> Sentence
S "limits specified in the"
         Sentence -> Sentence -> Sentence
+:+. 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
datumConstraint)]

calculateValuesDesc :: Sentence
calculateValuesDesc
  = [Sentence] -> Sentence
foldlSent
      [String -> Sentence
S "Calculate the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
processVariable, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
imPD,
         String -> Sentence
S "over the simulation time"]

outputValuesDesc :: Sentence
outputValuesDesc
  = [Sentence] -> Sentence
foldlSent
      [String -> Sentence
S "Output the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
processVariable, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
imPD,
         String -> Sentence
S "over the simulation time"]

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

nonfuncReqs :: [ConceptInstance]
nonfuncReqs :: [ConceptInstance]
nonfuncReqs = [ConceptInstance
portability, ConceptInstance
security, ConceptInstance
maintainability, ConceptInstance
verifiability]

portability :: ConceptInstance
portability :: ConceptInstance
portability
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "portability"
      (String -> Sentence
S "The code shall be portable to multiple Operating Systems" Sentence -> Sentence
!.)
      "Portable"
      ConceptChunk
nonFuncReqDom

security :: ConceptInstance
security :: ConceptInstance
security
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "security"
      ([Sentence] -> Sentence
foldlSent
         [String -> Sentence
S "The code shall be immune to common security problems such as memory",
            String -> Sentence
S "leaks, divide by zero errors, and the square root of negative numbers"])
      "Secure"
      ConceptChunk
nonFuncReqDom

maintainability :: ConceptInstance
maintainability :: ConceptInstance
maintainability
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "maintainability"
      ([Sentence] -> Sentence
foldlSent
         [String -> Sentence
S "The dependencies among the instance models, requirements,",
            String -> Sentence
S "likely changes, assumptions and all other relevant sections of",
            String -> Sentence
S "this document shall be traceable to each other in the trace matrix"])
      "Maintainable"
      ConceptChunk
nonFuncReqDom

verifiability :: ConceptInstance
verifiability :: ConceptInstance
verifiability
  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "verifiability"
      (String -> Sentence
S "The code shall be verifiable against a Verification and Validation plan" Sentence -> Sentence
!.)
      "Verifiable"
      ConceptChunk
nonFuncReqDom