-- | Defines functions used to create the Specific System Description section.
module Drasil.Sections.SpecificSystemDescription (
  -- * Specific System Description
  specSysDescr,
  -- ** Problem Description
  probDescF,
  termDefnF, termDefnF',
  physSystDesc,
  goalStmtF,
  -- ** Solution Characteristics Specification
  solutionCharSpecIntro,
  assumpF,
  thModF,
  genDefnF,
  dataDefnF,
  inModelF,
  datConF,
  inDataConstTbl, outDataConstTbl, propCorSolF, auxSpecSent,
  tInDataCstRef, tOutDataCstRef,
  helperCI,
  -- * Subsection Stubs
  tmStub, ddStub, imStub, pdStub
  ) where

import Language.Drasil hiding (variable)
import Language.Drasil.Development (showUID)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (assumption, column, constraint, corSol,
  datum, datumConstraint, inDatumConstraint, outDatumConstraint, definition, element, general, goalStmt, information,
  input_, limitation, model, output_, physical, physicalConstraint, physicalSystem,
  physSyst, problem, problemDescription, property, purpose, quantity, requirement,
  scope, section_, softwareConstraint, solutionCharacteristic, specification,
  symbol_, system, theory, typUnc, uncertainty, user, value, variable, table_, problemDescription)
import qualified Data.Drasil.Concepts.Documentation as DCD (sec)
import Data.Drasil.Concepts.Math (equation, parameter)
import Data.Drasil.TheoryConcepts (inModel, thModel, dataDefn, genDefn)
import SysInfo.Drasil (SystemInformation)
import Drasil.DocumentLanguage.Definitions (helperRefs)
import qualified Drasil.DocLang.SRS as SRS

import Control.Lens ((^.), over)
import Data.Maybe

-- Takes the system and subsections.
-- | Specific System Description section builder.
specSysDescr :: [Section] -> Section
specSysDescr :: [Section] -> Section
specSysDescr = [Contents] -> [Section] -> Section
SRS.specSysDes [Contents
intro_]

-- FIXME: this all should be broken down and mostly generated.
-- Generates an introduction based on the system.
-- Creates a general introduction for the Specific System Description section.
intro_ :: Contents
intro_ :: Contents
intro_ = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, String -> Sentence
S "first presents the", 
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problemDescription Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "which gives a high-level view of the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problem, String -> Sentence
S "to be solved. This is followed by the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
solutionCharacteristic,
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
specification Sentence -> Sentence -> Sentence
`sC`  String -> Sentence
S "which presents the",
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
assumption, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
theory, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
definition], String -> Sentence
S "that are used"]

-- | Describes a problem the system is needed to accomplish.
probDescF :: Sentence -> [Section] -> Section
probDescF :: Sentence -> [Section] -> Section
probDescF prob :: Sentence
prob = [Contents] -> [Section] -> Section
SRS.probDesc [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
a_ NamedChunk
system) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "needed to", Sentence
prob]]
                  
-- | Creates the Terms and Definitions section. Can take a ('Just' 'Sentence') if needed or 'Nothing' if not. Also takes 'Concept's that contain the definitions.
termDefnF :: Concept c => Maybe Sentence -> [c] -> Section
termDefnF :: Maybe Sentence -> [c] -> Section
termDefnF end :: Maybe Sentence
end lst :: [c]
lst = [Contents] -> [Section] -> Section
SRS.termAndDefn [Contents
intro, [Sentence] -> Contents
enumBulletU ([Sentence] -> Contents) -> [Sentence] -> Contents
forall a b. (a -> b) -> a -> b
$ (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall s. (NamedIdea s, Definition s) => s -> Sentence
termDef [c]
lst] []
  where intro :: Contents
intro = [Sentence] -> Contents
foldlSP_ [
                  String -> Sentence
S "This subsection provides a list of terms that are used in the subsequent",
                  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
section_ Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "their meaning, with the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
purpose Sentence -> Sentence -> Sentence
`S.of_`
                  String -> Sentence
S "reducing ambiguity and making it easier to correctly understand the" Sentence -> Sentence -> Sentence
+:+.
                  CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
requirement, Sentence -> Maybe Sentence -> Sentence
forall a. a -> Maybe a -> a
fromMaybe Sentence
EmptyS Maybe Sentence
end]
        termDef :: s -> Sentence
termDef x :: s
x = s -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart s
x Sentence -> Sentence -> Sentence
+: Sentence
EmptyS Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
capSent (s
x s -> Getting Sentence s Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence s Sentence
forall c. Definition c => Lens' c Sentence
defn)

-- | Similar to 'termDefnF', except does not take definitions from the list of terms. 
termDefnF' :: Maybe Sentence -> [Contents] -> Section
termDefnF' :: Maybe Sentence -> [Contents] -> Section
termDefnF' end :: Maybe Sentence
end otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.termAndDefn (Contents
intro Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []
      where intro :: Contents
intro = [Sentence] -> Contents
foldlSP [String -> Sentence
S "This subsection provides a list of terms", 
                    String -> Sentence
S "that are used in the subsequent", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
section_, 
                    String -> Sentence
S "and their meaning, with the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
purpose, 
                    String -> Sentence
S "of reducing ambiguity and making it easier to correctly", 
                    String -> Sentence
S "understand the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
requirement Sentence -> Sentence -> Sentence
:+: Sentence -> (Sentence -> Sentence) -> Maybe Sentence -> Sentence
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sentence
EmptyS (String -> Sentence
S "." Sentence -> Sentence -> Sentence
+:+) Maybe Sentence
end]

-- | General introduction for the Physical System Description section.
physSystDesc :: Idea a => a -> [Sentence] -> LabelledContent -> [Contents] -> Section
physSystDesc :: a -> [Sentence] -> LabelledContent -> [Contents] -> Section
physSystDesc progName :: a
progName parts :: [Sentence]
parts fg :: LabelledContent
fg other :: [Contents]
other = [Contents] -> [Section] -> Section
SRS.physSyst (Contents
intro Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: Contents
bullets Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: LabelledContent -> Contents
LlC LabelledContent
fg Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
other) []
  where intro :: Contents
intro = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSentCol [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
physicalSystem) Sentence -> Sentence -> Sentence
`S.of_` a -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short a
progName Sentence -> Sentence -> Sentence
`sC`
                String -> Sentence
S "as shown in", LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
fg Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "includes the following", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
element]
        bullets :: Contents
bullets = Integer -> Sentence -> [Sentence] -> Contents
enumSimpleU 1 (CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
physSyst) [Sentence]
parts

-- | General constructor for the Goal Statement section. Takes the given inputs ('Sentence's) and the descriptions ('Contents').
goalStmtF :: [Sentence] -> [Contents] -> Section
goalStmtF :: [Sentence] -> [Contents] -> Section
goalStmtF givenInputs :: [Sentence]
givenInputs otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.goalStmt (Contents
introContents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
:[Contents]
otherContents) []
  where intro :: Contents
intro = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S "Given" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
givenInputs Sentence -> Sentence -> Sentence
`sC` 
                NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (CI -> NP
forall c. NamedIdea c => c -> NP
the CI
goalStmt) Sentence -> Sentence -> Sentence
+: String -> Sentence
S "are"

-- | General introduction for the Solution Characteristics Specification section. Takes the program name and a section of instance models. 
solutionCharSpecIntro :: (Idea a) => a -> Section -> Contents
solutionCharSpecIntro :: a -> Section -> Contents
solutionCharSpecIntro progName :: a
progName instModelSection :: Section
instModelSection = [Sentence] -> Contents
foldlSP [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (CI -> NP
forall c. NamedIdea c => c -> NP
the CI
inModel), 
  String -> Sentence
S "that govern", a -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short a
progName, String -> Sentence
S "are presented in the" Sentence -> Sentence -> Sentence
+:+. 
  Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
instModelSection (CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize CI
inModel Sentence -> Sentence -> Sentence
+:+ CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize CI
DCD.sec), NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
information), String -> Sentence
S "to understand", 
  String -> Sentence
S "meaning" Sentence -> Sentence -> Sentence
`S.the_ofThe` CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
inModel, 
  String -> Sentence
S "and their derivation is also presented, so that the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
inModel, 
  String -> Sentence
S "can be verified"]


-- Wrappers for assumpIntro. Use assumpF' if genDefs is not needed
-- | Creates an Assumptions section by prepending a general introduction to other related 'Contents'.
assumpF :: [Contents] -> Section
assumpF :: [Contents] -> Section
assumpF otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.assumpt (Contents
assumpIntro Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []
  where
    assumpIntro :: Contents
assumpIntro = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent 
      [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, String -> Sentence
S "simplifies the original", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problem,
       String -> Sentence
S "and helps in developing the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
thModel, String -> Sentence
S "by filling in the", 
       String -> Sentence
S "missing", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
information, String -> Sentence
S "for the" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physicalSystem,
       NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (CI -> NP
forall c. NamedIdea c => c -> NP
the CI
assumption), String -> Sentence
S "refine the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
scope,
       String -> Sentence
S "by providing more detail"]

-- | Wrapper for 'thModelIntro'. Takes the program name and other 'Contents'.
thModF :: (Idea a) => a -> [Contents] -> Section
thModF :: a -> [Contents] -> Section
thModF progName :: a
progName otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.thModel (a -> Contents
forall a. Idea a => a -> Contents
thModIntro a
progName Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []

-- | Creates a eneralized Theoretical Model introduction given the program name.
thModIntro :: (Idea a) => a -> Contents
thModIntro :: a -> Contents
thModIntro progName :: a
progName = [Sentence] -> Contents
foldlSP [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, String -> Sentence
S "focuses on the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
general, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "laws that", a -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short a
progName, String -> Sentence
S "is based on"]

-- | Creates a General Definitions section with a general introduction.
-- Takes in relevant general definitions ('Contents'). Use empty list if none are needed.
genDefnF :: [Contents] -> Section
genDefnF :: [Contents] -> Section
genDefnF otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.genDefn ([Contents] -> Contents
forall t. [t] -> Contents
generalDefinitionIntro [Contents]
otherContents Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []

-- | Creates the introduction used in 'genDefnF'. If the given list is empty, the returned 'Sentence' is "There are no general definitions."
generalDefinitionIntro :: [t] -> Contents
generalDefinitionIntro :: [t] -> Contents
generalDefinitionIntro [] = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S "There are no general definitions."
generalDefinitionIntro _ = [Sentence] -> Contents
foldlSP [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, 
  String -> Sentence
S "collects the laws and", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, 
  String -> Sentence
S "that will be used to build the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
inModel]

                       
-- | Similar to 'genDefnF', but for Data Definitions. It also uses 'EmptyS' if the ending 'Sentence' is not needed rather than an empty list.
dataDefnF :: Sentence -> [Contents] -> Section
dataDefnF :: Sentence -> [Contents] -> Section
dataDefnF endingSent :: Sentence
endingSent otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.dataDefn
  (Sentence -> Contents
dataDefinitionIntro Sentence
endingSent Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []

-- | Creates a general Data Definition introduction. Appends the given 'Sentence' to the end.
dataDefinitionIntro :: Sentence -> Contents
dataDefinitionIntro :: Sentence -> Contents
dataDefinitionIntro closingSent :: Sentence
closingSent = Sentence -> Contents
mkParagraph ([Sentence] -> Sentence
foldlSent [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, 
    String -> Sentence
S "collects and defines all the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
datum, 
    String -> Sentence
S "needed to build the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
inModel] Sentence -> Sentence -> Sentence
+:+ Sentence
closingSent)

-- wrappers for inModelIntro. Use inModelF' if genDef are not needed
-- | Constructor for Instance Models. Takes the problem description,
-- data definition, theoretical model, general definition, and any other relevant contents.
inModelF :: Section -> Section -> Section -> Section -> [Contents] -> Section
inModelF :: Section -> Section -> Section -> Section -> [Contents] -> Section
inModelF probDes :: Section
probDes datDef :: Section
datDef theMod :: Section
theMod genDef :: Section
genDef otherContents :: [Contents]
otherContents = [Contents] -> [Section] -> Section
SRS.inModel 
  (Section -> Section -> Section -> Section -> Contents
inModelIntro Section
probDes Section
datDef Section
theMod Section
genDef Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents) []

-- | Creates a general Instance Model introduction. Requires four references to function. Nothing can be input into the last reference if only three tables are present.
inModelIntro :: Section -> Section -> Section -> Section -> Contents
inModelIntro :: Section -> Section -> Section -> Section -> Contents
inModelIntro r1 :: Section
r1 r2 :: Section
r2 r3 :: Section
r3 r4 :: Section
r4 = [Sentence] -> Contents
foldlSP [String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
section_, 
  String -> Sentence
S "transforms the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problem, String -> Sentence
S "defined in the", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
r1 (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problemDescription,
  String -> Sentence
S "into one which is expressed in mathematical terms. It uses concrete", 
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
symbol_, String -> Sentence
S "defined in the", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
r2 (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
dataDefn, String -> Sentence
S "to replace the abstract",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NP -> Sentence) -> NP -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk
symbol_ NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThePP` NamedChunk
model, String -> Sentence
S "identified in", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
r3 (CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
thModel) Sentence -> Sentence -> Sentence
`S.and_`
  Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
r4 (CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural CI
genDefn)]

-- | Constructor for Data Constraints section. Takes a trailing 'Sentence' (use 'EmptyS' if none) and data constraints.
datConF :: (HasUncertainty c, Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) => 
  Sentence -> [c] -> Section
datConF :: Sentence -> [c] -> Section
datConF _ [] = [Contents] -> [Section] -> Section
SRS.datCon [Sentence -> Contents
mkParagraph (String -> Sentence
S "There are no" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
datumConstraint)] []
datConF t :: Sentence
t c :: [c]
c  = [Contents] -> [Section] -> Section
SRS.datCon [Sentence -> Contents
dataConstraintParagraph Sentence
t, LabelledContent -> Contents
LlC (LabelledContent -> Contents) -> LabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ [c] -> LabelledContent
forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
[c] -> LabelledContent
inDataConstTbl [c]
c] []
  
-- optional trailing sentence(s) -> data constraints tables -> Contents
-- | Constructor for the paragraph of the Data Constraints section. Takes in a trailing 'Sentence'.
dataConstraintParagraph :: Sentence -> Contents
dataConstraintParagraph :: Sentence -> Contents
dataConstraintParagraph trailingSent :: Sentence
trailingSent = [Sentence] -> Contents
foldlSP_ [Sentence
inputTableSent, Sentence
physConsSent,
  Sentence
uncertSent, Sentence
conservConsSent, Sentence
typValSent, Sentence
trailingSent]

-- | General 'Sentence' that describes the data constraints on the input variables.
inputTableSent :: Sentence
inputTableSent :: Sentence
inputTableSent = [Sentence] -> Sentence
foldlSent [String -> Sentence
S "The", LabelledContent -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([UncertQ] -> LabelledContent
forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
[c] -> LabelledContent
inDataConstTbl ([] :: [UncertQ])) (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
datumConstraint Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
table_, String -> Sentence
S "shows the",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk
datumConstraint NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThePS` NamedChunk
input_), NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
variable]

-- | General 'Sentence' that describes the physical constraints/limitations on the variables.
physConsSent :: Sentence
physConsSent :: Sentence
physConsSent = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> Sentence) -> NP -> Sentence
forall a b. (a -> b) -> a -> b
$ NP -> NP
NP.the (NP -> NP) -> NP -> NP
forall a b. (a -> b) -> a -> b
$ NamedChunk
column NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` NamedChunk
physical,
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
constraint, String -> Sentence
S "gives the",  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physical, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
limitation,
  String -> Sentence
S "on the range" Sentence -> Sentence -> Sentence
`S.of_` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
value, String -> Sentence
S "that can be taken by the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
variable]

-- | General 'Sentence' that describes the uncertainty on the input variables.
uncertSent :: Sentence
uncertSent :: Sentence
uncertSent = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
uncertainty), NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
column,
  String -> Sentence
S "provides an estimate of the confidence with which the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physical,
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
quantity Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "can be measured", String -> Sentence
S "This", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
information,
  String -> Sentence
S "would be part of the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
input_, String -> Sentence
S "if one were performing an",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
uncertainty, String -> Sentence
S "quantification exercise"]

-- | General 'Sentence' that describes some conservative constraints on the model.
conservConsSent :: Sentence
conservConsSent :: Sentence
conservConsSent = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
constraint) Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S "conservative" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "to give", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
user Sentence -> Sentence -> Sentence
`S.the_ofThe` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
model,
  String -> Sentence
S "the flexibility to experiment with unusual situations"]

-- | General 'Sentence' that describes the typical values.
typValSent :: Sentence
typValSent :: Sentence
typValSent = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
column) Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S "typical",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
value Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "intended to provide a feel for a common scenario"]

-- | General 'Sentence' that describes some auxiliary specifications of the system.
auxSpecSent :: Sentence
auxSpecSent :: Sentence
auxSpecSent = [Sentence] -> Sentence
foldlSent [String -> Sentence
S "The", Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.valsOfAuxCons [] []) (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S "auxiliary constants", String -> Sentence
S "give",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
value Sentence -> Sentence -> Sentence
`S.the_ofThe` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
specification, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
parameter, String -> Sentence
S "used in the",
  LabelledContent -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([UncertQ] -> LabelledContent
forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
[c] -> LabelledContent
inDataConstTbl ([] :: [UncertQ])) (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
datumConstraint Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
table_]

-- | Creates a Data Constraints table. Takes in Columns, reference, and a label.
mkDataConstraintTable :: [(Sentence, [Sentence])] -> UID -> Sentence -> LabelledContent
mkDataConstraintTable :: [(Sentence, [Sentence])] -> UID -> Sentence -> LabelledContent
mkDataConstraintTable col :: [(Sentence, [Sentence])]
col rf :: UID
rf lab :: Sentence
lab = Reference -> RawContent -> LabelledContent
llcc (UID -> Reference
makeTabRef' UID
rf) (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent)
-> ([Sentence], [[Sentence]]) -> Sentence -> Bool -> RawContent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table
  ([(Sentence, [Sentence])] -> ([Sentence], [[Sentence]])
mkTableFromColumns [(Sentence, [Sentence])]
col) Sentence
lab Bool
True

-- | Creates the input Data Constraints Table.
inDataConstTbl :: (HasUncertainty c, Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) => 
  [c] -> LabelledContent
inDataConstTbl :: [c] -> LabelledContent
inDataConstTbl qlst :: [c]
qlst = [(Sentence, [Sentence])] -> UID -> Sentence -> LabelledContent
mkDataConstraintTable [(String -> Sentence
S "Var", (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ([c] -> [Sentence]) -> [c] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [c] -> [c]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [c]
qlst),
            (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
physicalConstraint, (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (Constrained c, Quantity c) => c -> Sentence
fmtPhys ([c] -> [Sentence]) -> [c] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [c] -> [c]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [c]
qlst),
            (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
softwareConstraint, (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (Constrained c, Quantity c) => c -> Sentence
fmtSfwr ([c] -> [Sentence]) -> [c] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [c] -> [c]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [c]
qlst),
            (String -> Sentence
S "Typical Value", (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (\q :: c
q -> Sentence -> c -> Sentence
forall a. MayHaveUnit a => Sentence -> a -> Sentence
fmtU (ModelExpr -> Sentence
eS (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ Expr -> ModelExpr
forall c. Express c => c -> ModelExpr
express (Expr -> ModelExpr) -> Expr -> ModelExpr
forall a b. (a -> b) -> a -> b
$ c -> Expr
forall s. (HasUID s, HasReasVal s) => s -> Expr
getRVal c
q) c
q) ([c] -> [Sentence]) -> [c] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [c] -> [c]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [c]
qlst),
            (CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
typUnc, (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. HasUncertainty c => c -> Sentence
typUncr ([c] -> [Sentence]) -> [c] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [c] -> [c]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [c]
qlst)] (NamedChunk
inDatumConstraint NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid) (Sentence -> LabelledContent) -> Sentence -> LabelledContent
forall a b. (a -> b) -> a -> b
$
            NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
inDatumConstraint
  where
    getRVal :: s -> Expr
getRVal c :: s
c = Expr -> Maybe Expr -> Expr
forall a. a -> Maybe a -> a
fromMaybe (String -> Expr
forall a. HasCallStack => String -> a
error (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ "getRVal found no Expr for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. HasUID a => a -> String
showUID s
c) (s
c s -> Getting (Maybe Expr) s (Maybe Expr) -> Maybe Expr
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Expr) s (Maybe Expr)
forall c. HasReasVal c => Lens' c (Maybe Expr)
reasVal)

-- | Creates the output Data Constraints Table.
outDataConstTbl :: (Quantity c, Constrained c) => [c] -> LabelledContent
outDataConstTbl :: [c] -> LabelledContent
outDataConstTbl qlst :: [c]
qlst = [(Sentence, [Sentence])] -> UID -> Sentence -> LabelledContent
mkDataConstraintTable [(String -> Sentence
S "Var", (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch [c]
qlst),
            (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
physicalConstraint, (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (Constrained c, Quantity c) => c -> Sentence
fmtPhys [c]
qlst),
            (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
softwareConstraint, (c -> Sentence) -> [c] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map c -> Sentence
forall c. (Constrained c, Quantity c) => c -> Sentence
fmtSfwr [c]
qlst)] (NamedChunk
outDatumConstraint NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid) (Sentence -> LabelledContent) -> Sentence -> LabelledContent
forall a b. (a -> b) -> a -> b
$
            NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
outDatumConstraint

--Not actually used here, for exporting references
-- | Input/Output Data Constraint Table references.
tInDataCstRef, tOutDataCstRef :: Reference
tInDataCstRef :: Reference
tInDataCstRef  = UID -> Reference
makeTabRef' (NamedChunk
inDatumConstraint NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid)
tOutDataCstRef :: Reference
tOutDataCstRef = UID -> Reference
makeTabRef' (NamedChunk
outDatumConstraint NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid)

-- | Formats Physical Constraints into a 'Sentence'.
fmtPhys :: (Constrained c, Quantity c) => c -> Sentence
fmtPhys :: c -> Sentence
fmtPhys c :: c
c = c -> [ConstraintE] -> Sentence
forall c. Quantity c => c -> [ConstraintE] -> Sentence
foldConstraints c
c ([ConstraintE] -> Sentence) -> [ConstraintE] -> Sentence
forall a b. (a -> b) -> a -> b
$ (ConstraintE -> Bool) -> [ConstraintE] -> [ConstraintE]
forall a. (a -> Bool) -> [a] -> [a]
filter ConstraintE -> Bool
forall e. Constraint e -> Bool
isPhysC (c
c c -> Getting [ConstraintE] c [ConstraintE] -> [ConstraintE]
forall s a. s -> Getting a s a -> a
^. Getting [ConstraintE] c [ConstraintE]
forall c. Constrained c => Lens' c [ConstraintE]
constraints)

-- | Formats Software Constraints into a 'Sentence'.
fmtSfwr :: (Constrained c, Quantity c) => c -> Sentence
fmtSfwr :: c -> Sentence
fmtSfwr c :: c
c = c -> [ConstraintE] -> Sentence
forall c. Quantity c => c -> [ConstraintE] -> Sentence
foldConstraints c
c ([ConstraintE] -> Sentence) -> [ConstraintE] -> Sentence
forall a b. (a -> b) -> a -> b
$ (ConstraintE -> Bool) -> [ConstraintE] -> [ConstraintE]
forall a. (a -> Bool) -> [a] -> [a]
filter ConstraintE -> Bool
forall e. Constraint e -> Bool
isSfwrC (c
c c -> Getting [ConstraintE] c [ConstraintE] -> [ConstraintE]
forall s a. s -> Getting a s a -> a
^. Getting [ConstraintE] c [ConstraintE]
forall c. Constrained c => Lens' c [ConstraintE]
constraints)

-- | Creates the Properties of a Correct Solution section.
propCorSolF :: (Quantity c, Constrained c) => [c] -> [Contents] -> Section
propCorSolF :: [c] -> [Contents] -> Section
propCorSolF []  [] = [Contents] -> [Section] -> Section
SRS.propCorSol [Sentence -> Contents
mkParagraph Sentence
noPropsSent] []
propCorSolF [] con :: [Contents]
con = [Contents] -> [Section] -> Section
SRS.propCorSol [Contents]
con []
propCorSolF c :: [c]
c  con :: [Contents]
con = [Contents] -> [Section] -> Section
SRS.propCorSol ([Contents
propsIntro, LabelledContent -> Contents
LlC (LabelledContent -> Contents) -> LabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ [c] -> LabelledContent
forall c. (Quantity c, Constrained c) => [c] -> LabelledContent
outDataConstTbl [c]
c] [Contents] -> [Contents] -> [Contents]
forall a. [a] -> [a] -> [a]
++ [Contents]
con) []

-- | General 'Sentence' that states there are no properties of a correct solution. Used in 'propCorSolF'.
noPropsSent :: Sentence
noPropsSent :: Sentence
noPropsSent = [Sentence] -> Sentence
foldlSent [String -> Sentence
S "There are no", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NP -> Sentence) -> NP -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk
property NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofAPS` NamedChunk
corSol]

-- | Creates the Properties of a Correct Solution introduction.
propsIntro :: Contents
propsIntro :: Contents
propsIntro = [Sentence] -> Contents
foldlSP_ [Sentence
outputTableSent, Sentence
physConsSent]

-- | Outputs a data constraint table as a 'Sentence'.
outputTableSent :: Sentence
outputTableSent :: Sentence
outputTableSent = [Sentence] -> Sentence
foldlSent [String -> Sentence
S "The", LabelledContent -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([UncertQ] -> LabelledContent
forall c. (Quantity c, Constrained c) => [c] -> LabelledContent
outDataConstTbl ([] :: [UncertQ])) (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' NamedChunk
datumConstraint Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
table_, String -> Sentence
S "shows the",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk
datumConstraint NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThePS` NamedChunk
output_), NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
variable]

-- | Helper for making a 'ConceptInstance' with a reference to the system information.
-- Used to find where a particular assumption is referenced.
helperCI :: ConceptInstance -> SystemInformation -> ConceptInstance
helperCI :: ConceptInstance -> SystemInformation -> ConceptInstance
helperCI a :: ConceptInstance
a c :: SystemInformation
c = ASetter ConceptInstance ConceptInstance Sentence Sentence
-> (Sentence -> Sentence) -> ConceptInstance -> ConceptInstance
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConceptInstance ConceptInstance Sentence Sentence
forall c. Definition c => Lens' c Sentence
defn (\x :: Sentence
x -> [Sentence] -> Sentence
foldlSent_ [Sentence
x, Sentence -> Sentence
refby (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ ConceptInstance -> SystemInformation -> Sentence
forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs ConceptInstance
a SystemInformation
c]) ConceptInstance
a
  where
    refby :: Sentence -> Sentence
refby EmptyS = Sentence
EmptyS
    refby sent :: Sentence
sent   = Sentence -> Sentence
sParen (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S "RefBy:" Sentence -> Sentence -> Sentence
+:+. Sentence
sent

-- | Section stubs for implicit referencing of different models and definitions.
tmStub, ddStub, imStub, pdStub :: Section
tmStub :: Section
tmStub = [Contents] -> [Section] -> Section
SRS.thModel   [] []
ddStub :: Section
ddStub = [Contents] -> [Section] -> Section
SRS.dataDefn  [] []
imStub :: Section
imStub = [Contents] -> [Section] -> Section
SRS.inModel   [] []
pdStub :: Section
pdStub = [Contents] -> [Section] -> Section
SRS.probDesc  [] []