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

import Language.Drasil
import Drasil.DocLang.SRS (datCon)
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.DocLang (mkMaintainableNFR, mkPortableNFR, mkCorrectNFR, 
  mkVerifiableNFR, mkUnderstandableNFR, mkReusableNFR)

import Data.Drasil.Concepts.Computation (inValue)
import Data.Drasil.Concepts.Documentation (datumConstraint,
  funcReqDom, output_, value)
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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"verifyInVals" Sentence
verifyParamsDesc String
"Verify-Input-Values" ConceptChunk
funcReqDom
calcValues :: ConceptInstance
calcValues   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"calcValues"   Sentence
calcValuesDesc   String
"Calculate-Values"    ConceptChunk
funcReqDom
outputValues :: ConceptInstance
outputValues = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
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", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inValue,
  String -> Sentence
S String
"to ensure that they do not exceed the" Sentence -> Sentence -> Sentence
+:+. 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
datumConstraint),
  String -> Sentence
S String
"If any" Sentence -> Sentence -> Sentence
`S.ofThe` IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inValue Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"out of bounds" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"an", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
errMsg, String -> Sentence
S String
"is displayed" Sentence -> Sentence -> Sentence
`S.andThe` ConceptChunk -> Sentence
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
+: IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value,
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [
    ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur Sentence -> Sentence -> Sentence
+:+ InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
timeIM,
    ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
landPos   Sentence -> Sentence -> Sentence
+:+ InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
landPosIM,
    ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
offset    Sentence -> Sentence -> Sentence
+:+ InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
offsetIM,
    QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
message   Sentence -> Sentence -> Sentence
+:+ InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
messageIM
  ]]
outputValuesDesc :: Sentence
outputValuesDesc = IdeaDict -> Sentence
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 ([Sentence] -> Sentence) -> [Sentence] -> Sentence
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent_ [ 
        [ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
flightDur, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
timeIM],
        [QuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
message, InstanceModel -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource InstanceModel
messageIM], 
        [ConstrConcept -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrConcept
offset, InstanceModel -> Sentence
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 = 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"

portable :: ConceptInstance
portable :: ConceptInstance
portable = String -> [String] -> String -> ConceptInstance
mkPortableNFR String
"portable" [String
"Windows", String
"Mac OSX", String
"Linux"] String
"Portability"