module Drasil.GlassBR.Requirements (funcReqs, funcReqsTables, inReqDesc, nonfuncReqs) where

import Control.Lens ((^.))

import Language.Drasil
import Drasil.DocLang (inReq, mkQRTuple, mkQRTupleRef, mkValsSourceTable, mkMaintainableNFR)
import Drasil.DocLang.SRS (datCon, propCorSol)
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 (DataDefinition)

import Data.Drasil.Concepts.Computation (inValue)
import Data.Drasil.Concepts.Documentation (characteristic, code,
  condition, datumConstraint, environment, funcReqDom, message, mg,
  mis, nonFuncReqDom, output_, property, system, type_, value, vavPlan)
import Data.Drasil.Concepts.Math (calculation)
import Data.Drasil.Concepts.PhysicalProperties (dimension)
import Data.Drasil.Concepts.Software (errMsg)

import Drasil.GlassBR.Assumptions (assumpSV, assumpGL, assumptionConstants)
import Drasil.GlassBR.Concepts (glass)
import Drasil.GlassBR.DataDefs (aspRat, glaTyFac, hFromt, loadDF, standOffDis)
import Drasil.GlassBR.IMods (iMods, pbIsSafe, lrIsSafe)
import Drasil.GlassBR.Unitals (blast, isSafeLR, isSafePb, loadSF, notSafe,
  pbTolfail, safeMessage)

{--Functional Requirements--}

funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
sysSetValsFollowingAssumps, ConceptInstance
checkInputWithDataCons,
  ConceptInstance
outputValsAndKnownValues, ConceptInstance
checkGlassSafety, ConceptInstance
outputValues]

funcReqsTables :: [LabelledContent]
funcReqsTables :: [LabelledContent]
funcReqsTables = [LabelledContent
sysSetValsFollowingAssumpsTable, LabelledContent
outputValuesTable]

sysSetValsFollowingAssumps, checkInputWithDataCons,
  outputValsAndKnownValues, checkGlassSafety, outputValues :: ConceptInstance

sysSetValsFollowingAssumps :: ConceptInstance
sysSetValsFollowingAssumps = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"sysSetValsFollowingAssumps" Sentence
sysSetValsFollowingAssumpsDesc String
"System-Set-Values-Following-Assumptions" ConceptChunk
funcReqDom
checkInputWithDataCons :: ConceptInstance
checkInputWithDataCons     = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"checkInputWithDataCons"     Sentence
checkInputWithDataConsDesc     String
"Check-Input-with-Data_Constraints"       ConceptChunk
funcReqDom
outputValsAndKnownValues :: ConceptInstance
outputValsAndKnownValues   = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"outputValsAndKnownValues"   Sentence
outputValsAndKnownValuesDesc   String
"Output-Values-and-Known-Values"          ConceptChunk
funcReqDom
checkGlassSafety :: ConceptInstance
checkGlassSafety           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"checkGlassSafety"           Sentence
checkGlassSafetyDesc           String
"Check-Glass-Safety"                      ConceptChunk
funcReqDom
outputValues :: ConceptInstance
outputValues               = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"outputValues"               Sentence
outputValuesDesc               String
"Output-Values"                           ConceptChunk
funcReqDom

inReqDesc, sysSetValsFollowingAssumpsDesc, checkInputWithDataConsDesc, outputValsAndKnownValuesDesc, checkGlassSafetyDesc :: Sentence

inReqDesc :: Sentence
inReqDesc = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [forall n. NounPhrase n => n -> Sentence
pluralNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
glass ConceptChunk
dimension)),
  forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
type_ forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` IdeaDict
glass), forall n. NamedIdea n => n -> Sentence
phrase ConstrainedChunk
pbTolfail, forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict
characteristic forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` ConceptChunk
blast)]

sysSetValsFollowingAssumpsDesc :: Sentence
sysSetValsFollowingAssumpsDesc = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
system), String -> Sentence
S String
"shall set the known",
    forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"as described in the table for", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef LabelledContent
sysSetValsFollowingAssumpsTable (String -> Sentence
S String
"Required Assignments")]

sysSetValsFollowingAssumpsTable :: LabelledContent
sysSetValsFollowingAssumpsTable :: LabelledContent
sysSetValsFollowingAssumpsTable = forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable (forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef [QuantityDict]
r2AQs [ConceptInstance]
r2ARs forall a. [a] -> [a] -> [a]
++ forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [DataDefinition]
r2DDs) String
"ReqAssignments"
                                  (String -> Sentence
S String
"Required Assignments" forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` ConceptInstance
sysSetValsFollowingAssumps)
  where
    r2AQs :: [QuantityDict]
r2AQs = forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
loadSF forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw (forall a. Int -> [a] -> [a]
take Int
4 [ConstQDef]
assumptionConstants)
    r2ARs :: [ConceptInstance]
r2ARs = ConceptInstance
assumpGL forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
4 ConceptInstance
assumpSV
    r2DDs :: [DataDefinition]
r2DDs = [DataDefinition
loadDF, DataDefinition
hFromt, DataDefinition
glaTyFac, DataDefinition
standOffDis, DataDefinition
aspRat]

--FIXME:should constants, LDF, and LSF have some sort of field that holds
-- the assumption(s) that're being followed? (Issue #349)

checkInputWithDataConsDesc :: Sentence
checkInputWithDataConsDesc = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
system), String -> Sentence
S String
"shall 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" Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NamedIdea n => n -> Sentence
plural IdeaDict
inValue, String -> Sentence
S String
"are out" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"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"]

outputValsAndKnownValuesDesc :: Sentence
outputValsAndKnownValuesDesc = [Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_, forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
inValue),
  String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS (Sentence -> ConceptInstance
inReq Sentence
EmptyS) Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"known", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value,
  String -> Sentence
S String
"from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
sysSetValsFollowingAssumps]

checkGlassSafetyDesc :: Sentence
checkGlassSafetyDesc = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"If", ModelExpr -> Sentence
eS forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
isSafePb forall r. ExprC r => r -> r -> r
$&& forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
isSafeLR,
  Sentence -> Sentence
sParen (String -> Sentence
S String
"from" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
pbIsSafe Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
lrIsSafe) Sentence -> Sentence -> Sentence
`sC`
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_, forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
message), Sentence -> Sentence
Quote (ConceptChunk
safeMessage forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn),
  String -> Sentence
S String
"If the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
condition, String -> Sentence
S String
"is false, then", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_,
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the IdeaDict
message), Sentence -> Sentence
Quote (ConceptChunk
notSafe forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn)]

outputValuesDesc :: Sentence
outputValuesDesc :: Sentence
outputValuesDesc = [Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_, forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
value), String -> Sentence
S String
"from the table for", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef LabelledContent
outputValuesTable (String -> Sentence
S String
"Required Outputs")]

outputValuesTable :: LabelledContent
outputValuesTable :: LabelledContent
outputValuesTable = forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable (forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [InstanceModel]
iMods forall a. [a] -> [a] -> [a]
++ forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [DataDefinition]
r6DDs) String
"ReqOutputs"
                              (String -> Sentence
S String
"Required" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
output_ forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` ConceptInstance
outputValues)
  where
    r6DDs :: [DataDefinition]
    r6DDs :: [DataDefinition]
r6DDs = [DataDefinition
glaTyFac, DataDefinition
hFromt, DataDefinition
aspRat]

{--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
refS ([Contents] -> [Section] -> Section
propCorSol [] [])
  ]) 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. NamedIdea n => n -> Sentence
phrase CI
mg Sentence -> Sentence -> Sentence
`S.and_` forall n. NamedIdea n => n -> Sentence
phrase 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