module Drasil.Projectile.Requirements (funcReqs, nonfuncReqs) where

import Language.Drasil
import Drasil.DocLang.SRS (datCon, propCorSol)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.DocLang (mkMaintainableNFR)

import Data.Drasil.Concepts.Computation (inValue)
import Data.Drasil.Concepts.Documentation (code, datumConstraint,
  environment, funcReqDom, mg, mis, nonFuncReqDom, output_,
  property, value, vavPlan, propOfCorSol)
import Data.Drasil.Concepts.Math (calculation)
import Data.Drasil.Concepts.Software (errMsg)

import Drasil.Projectile.IMods (landPosIM, messageIM, offsetIM, timeIM)
import Drasil.Projectile.Unitals (flightDur, landPos, message, offset)

{--Functional Requirements--}

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
verifyInVals, ConceptInstance
calcValues, ConceptInstance
outputValues]

verifyInVals, calcValues, outputValues :: ConceptInstance

verifyInVals :: ConceptInstance
verifyInVals = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"verifyInVals" Sentence
verifyParamsDesc String
"Verify-Input-Values" ConceptChunk
funcReqDom
calcValues :: ConceptInstance
calcValues   = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"calcValues"   Sentence
calcValuesDesc   String
"Calculate-Values"    ConceptChunk
funcReqDom
outputValues :: ConceptInstance
outputValues = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"outputValues" Sentence
outputValuesDesc String
"Output-Values"       ConceptChunk
funcReqDom

verifyParamsDesc, calcValuesDesc, outputValuesDesc :: Sentence
verifyParamsDesc :: Sentence
verifyParamsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Check the entered", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inValue,
  String -> Sentence
S String
"to ensure that they do not exceed the" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
datCon [] []) (forall n. NamedIdea n => n -> Sentence
plural IdeaDict
datumConstraint),
  String -> Sentence
S String
"If any of the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inValue, String -> Sentence
S String
"are out of bounds" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"an", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
errMsg, String -> Sentence
S String
"is displayed" Sentence -> Sentence -> Sentence
`S.andThe` forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation, String -> Sentence
S String
"stop"]
calcValuesDesc :: Sentence
calcValuesDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Calculate the following" Sentence -> Sentence -> Sentence
+: forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value,
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [
    forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur Sentence -> Sentence -> Sentence
+:+ forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
timeIM,
    forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
landPos   Sentence -> Sentence -> Sentence
+:+ forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
landPosIM,
    forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
offset    Sentence -> Sentence -> Sentence
+:+ forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
offsetIM,
    forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
message   Sentence -> Sentence -> Sentence
+:+ forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
messageIM
  ]]
outputValuesDesc :: Sentence
outputValuesDesc = forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
output_ Sentence -> Sentence -> Sentence
+:+. Sentence
outputs
  where
    outputs :: Sentence
outputs = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent_ [ 
        [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
timeIM],
        [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
message, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
messageIM], 
        [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
offset, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
offsetIM]
      ]

{--Nonfunctional Requirements--}

nonfuncReqs :: [ConceptInstance]
nonfuncReqs :: [ConceptInstance]
nonfuncReqs = [ConceptInstance
correct, ConceptInstance
verifiable, ConceptInstance
understandable, ConceptInstance
reusable, ConceptInstance
maintainable, ConceptInstance
portable]

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

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

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

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

portable :: ConceptInstance
portable :: ConceptInstance
portable = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"portable" ([Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
code), String -> Sentence
S String
"is able to be run in different", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
environment])
  String
"Portable" ConceptChunk
nonFuncReqDom