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

import Control.Lens ((^.))

import Language.Drasil
import Drasil.DocLang (inReq, mkQRTuple, mkQRTupleRef, mkValsSourceTable, 
  mkMaintainableNFR, mkPortableNFR, mkCorrectNFR, mkVerifiableNFR, 
  mkUnderstandableNFR, mkReusableNFR)
import Drasil.DocLang.SRS (datCon)
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, condition, 
  datumConstraint, funcReqDom, message, output_, system, 
  type_, value)
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 = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
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     = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
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   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
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           = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"checkGlassSafety"           Sentence
checkGlassSafetyDesc           String
"Check-Glass-Safety"                      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

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

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

sysSetValsFollowingAssumpsDesc :: Sentence
sysSetValsFollowingAssumpsDesc = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
system), String -> Sentence
S String
"shall set the known",
    IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"as described in the table for", LabelledContent -> Sentence -> Sentence
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 = [(QuantityDict, Sentence)] -> String -> Sentence -> LabelledContent
forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable ([QuantityDict] -> [ConceptInstance] -> [(QuantityDict, Sentence)]
forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef [QuantityDict]
r2AQs [ConceptInstance]
r2ARs [(QuantityDict, Sentence)]
-> [(QuantityDict, Sentence)] -> [(QuantityDict, Sentence)]
forall a. [a] -> [a] -> [a]
++ [DataDefinition] -> [(QuantityDict, Sentence)]
forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [DataDefinition]
r2DDs) String
"ReqAssignments"
                                  (String -> Sentence
S String
"Required Assignments" Sentence -> ConceptInstance -> Sentence
forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` ConceptInstance
sysSetValsFollowingAssumps)
  where
    r2AQs :: [QuantityDict]
r2AQs = DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
loadSF QuantityDict -> [QuantityDict] -> [QuantityDict]
forall a. a -> [a] -> [a]
: (ConstQDef -> QuantityDict) -> [ConstQDef] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map ConstQDef -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw (Int -> [ConstQDef] -> [ConstQDef]
forall a. Int -> [a] -> [a]
take Int
4 [ConstQDef]
assumptionConstants)
    r2ARs :: [ConceptInstance]
r2ARs = ConceptInstance
assumpGL ConceptInstance -> [ConceptInstance] -> [ConceptInstance]
forall a. a -> [a] -> [a]
: Int -> ConceptInstance -> [ConceptInstance]
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 [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
system), String -> Sentence
S String
"shall 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, 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", 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"]

outputValsAndKnownValuesDesc :: Sentence
outputValsAndKnownValuesDesc = [Sentence] -> Sentence
foldlSent [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
inValue),
  String -> Sentence
S String
"from", ConceptInstance -> Sentence
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", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value,
  String -> Sentence
S String
"from", ConceptInstance -> Sentence
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 (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ QuantityDict -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QuantityDict
isSafePb ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$&& QuantityDict -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
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
+:+ InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
pbIsSafe Sentence -> Sentence -> Sentence
`S.and_` InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
lrIsSafe) Sentence -> Sentence -> Sentence
`sC`
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
message), Sentence -> Sentence
Quote (ConceptChunk
safeMessage ConceptChunk -> Getting Sentence ConceptChunk Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConceptChunk Sentence
forall c. Definition c => Lens' c Sentence
Lens' ConceptChunk Sentence
defn),
  String -> Sentence
S String
"If the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
condition, String -> Sentence
S String
"is false, then", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
output_,
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
message), Sentence -> Sentence
Quote (ConceptChunk
notSafe ConceptChunk -> Getting Sentence ConceptChunk Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConceptChunk Sentence
forall c. Definition c => Lens' c Sentence
Lens' ConceptChunk Sentence
defn)]

outputValuesDesc :: Sentence
outputValuesDesc :: Sentence
outputValuesDesc = [Sentence] -> Sentence
foldlSent [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
output_, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
value), String -> Sentence
S String
"from the table for", LabelledContent -> Sentence -> Sentence
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 = [(QuantityDict, Sentence)] -> String -> Sentence -> LabelledContent
forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable ([InstanceModel] -> [(QuantityDict, Sentence)]
forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [InstanceModel]
iMods [(QuantityDict, Sentence)]
-> [(QuantityDict, Sentence)] -> [(QuantityDict, Sentence)]
forall a. [a] -> [a] -> [a]
++ [DataDefinition] -> [(QuantityDict, Sentence)]
forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple [DataDefinition]
r6DDs) String
"ReqOutputs"
                              (String -> Sentence
S String
"Required" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
output_ Sentence -> ConceptInstance -> Sentence
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 = 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
"Portablity"