{-# LANGUAGE PostfixOperators #-}
module Drasil.SSP.Body (srs, si, symbMap, printSetting, fullSI) where

import Language.Drasil hiding (Verb, number, organization, section, variable)
import Drasil.SRSDocument
import qualified Drasil.DocLang.SRS as SRS (inModel, assumpt,
  genDefn, dataDefn, datCon)
import Theory.Drasil (qdEFromDD)

import Prelude hiding (sin, cos, tan)
import Data.Maybe (mapMaybe)
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 as Doc (analysis, assumption,
  constant, document, effect, endUser, environment,
  input_, interest, loss, method_, organization,
  physical, physics, problem, software,
  softwareSys, srsDomains, symbol_, sysCont, system,
  template, type_, user, value, variable, doccon, doccon', datumConstraint)
import qualified Data.Drasil.Concepts.Documentation as Doc (srs)
import Data.Drasil.TheoryConcepts as Doc (inModel)
import Data.Drasil.Concepts.Education (solidMechanics, undergraduate, educon)
import Data.Drasil.Concepts.Math (equation, shape, surface, mathcon, mathcon',
  number)
import Data.Drasil.Concepts.PhysicalProperties (dimension, mass, physicalcon)
import Data.Drasil.Concepts.Physics (cohesion, fbd, force, gravity, isotropy,
  strain, stress, time, twoD, physicCon)
import Data.Drasil.Concepts.Software (program, softwarecon)
import Data.Drasil.Concepts.SolidMechanics (mobShear, normForce, shearForce, 
  shearRes, solidcon)
import Data.Drasil.Concepts.Computation (compcon, algorithm)
import Data.Drasil.Software.Products (sciCompS, prodtcon)
import Data.Drasil.Theories.Physics (physicsTMs)

import Data.Drasil.People (brooks, henryFrankis)
import Data.Drasil.Citations (koothoor2013, smithLai2005)
import Data.Drasil.SI_Units (degree, metre, newton, pascal, kilogram, second, derived, fundamentals)

import Drasil.SSP.Assumptions (assumptions)
import Drasil.SSP.Changes (likelyChgs, unlikelyChgs)
import qualified Drasil.SSP.DataDefs as SSP (dataDefs)
import Drasil.SSP.Defs (acronyms, crtSlpSrf, defs, defs', effFandS, factor, fsConcept,
  intrslce, layer, morPrice, mtrlPrpty, plnStrn, slice, slip, slope, slpSrf, soil,
  soilLyr, soilMechanics, soilPrpty, ssa, ssp, stabAnalysis, waterTable)
import Drasil.SSP.GenDefs (generalDefinitions)
import Drasil.SSP.Goals (goals)
import Drasil.SSP.IMods (instModIntro)
import qualified Drasil.SSP.IMods as SSP (iMods)
import Drasil.SSP.References (citations, morgenstern1965)
import Drasil.SSP.Requirements (funcReqs, funcReqTables, nonFuncReqs)
import Drasil.SSP.TMods (tMods)
import Drasil.SSP.Unitals (constrained, effCohesion, fricAngle, fs, index,
  inputs, inputsWUncrtn, outputs, symbols)

--Document Setup--

srs :: Document
srs :: Document
srs = SRSDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> SystemInformation
-> Document
mkDoc SRSDecl
mkSRS IdeaDict -> IdeaDict -> Sentence
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> Sentence
S.forT SystemInformation
si

printSetting :: PrintingInformation
printSetting :: PrintingInformation
printSetting = SystemInformation
-> Stage -> PrintingConfiguration -> PrintingInformation
piSys SystemInformation
fullSI Stage
Equational PrintingConfiguration
defaultConfiguration

fullSI :: SystemInformation
fullSI :: SystemInformation
fullSI = SRSDecl -> SystemInformation -> SystemInformation
fillcdbSRS SRSDecl
mkSRS SystemInformation
si

resourcePath :: String
resourcePath :: String
resourcePath = "../../../../datafiles/ssp/"

si :: SystemInformation
si :: SystemInformation
si = SI :: forall a b c e f h i j d.
(CommonIdea a, Idea a, Idea b, HasName c, Quantity e, Eq e,
 MayHaveUnit e, Quantity f, MayHaveUnit f, Concept f, Eq f,
 Quantity h, MayHaveUnit h, Quantity i, MayHaveUnit i, HasUID j,
 Constrained j) =>
a
-> b
-> [c]
-> d
-> [e]
-> [f]
-> [InstanceModel]
-> [DataDefinition]
-> [String]
-> [h]
-> [i]
-> [Block SimpleQDef]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> ChunkDB
-> ReferenceDB
-> SystemInformation
SI {
  _sys :: CI
_sys         = CI
ssp, 
  _kind :: CI
_kind        = CI
Doc.srs, 
  _authors :: [Person]
_authors     = [Person
henryFrankis, Person
brooks],
  _purpose :: [Sentence]
_purpose     = CI -> Verbosity -> [Sentence]
purpDoc CI
ssp Verbosity
Verbose,
  _quants :: [DefinedQuantityDict]
_quants      = [DefinedQuantityDict]
symbols,
  _concepts :: [DefinedQuantityDict]
_concepts    = [] :: [DefinedQuantityDict],
  _instModels :: [InstanceModel]
_instModels  = [InstanceModel]
SSP.iMods,
  _datadefs :: [DataDefinition]
_datadefs    = [DataDefinition]
SSP.dataDefs,
  _configFiles :: [String]
_configFiles = [],
  _inputs :: [QuantityDict]
_inputs      = (DefinedQuantityDict -> QuantityDict)
-> [DefinedQuantityDict] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
inputs,
  _outputs :: [QuantityDict]
_outputs     = (ConstrConcept -> QuantityDict)
-> [ConstrConcept] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map ConstrConcept -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstrConcept]
outputs,
  _defSequence :: [Block SimpleQDef]
_defSequence = [(\x :: [SimpleQDef]
x -> SimpleQDef -> [SimpleQDef] -> Block SimpleQDef
forall a. a -> [a] -> Block a
Parallel ([SimpleQDef] -> SimpleQDef
forall a. [a] -> a
head [SimpleQDef]
x) ([SimpleQDef] -> [SimpleQDef]
forall a. [a] -> [a]
tail [SimpleQDef]
x)) ([SimpleQDef] -> Block SimpleQDef)
-> [SimpleQDef] -> Block SimpleQDef
forall a b. (a -> b) -> a -> b
$ (DataDefinition -> Maybe SimpleQDef)
-> [DataDefinition] -> [SimpleQDef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe SimpleQDef
qdEFromDD [DataDefinition]
SSP.dataDefs],
  _constraints :: [ConstrainedChunk]
_constraints = [ConstrainedChunk]
constrained,
  _constants :: [ConstQDef]
_constants   = [],
  _sysinfodb :: ChunkDB
_sysinfodb   = ChunkDB
symbMap,
  _usedinfodb :: ChunkDB
_usedinfodb  = ChunkDB
usedDB,
   refdb :: ReferenceDB
refdb       = ReferenceDB
refDB
}
  
mkSRS :: SRSDecl
mkSRS :: SRSDecl
mkSRS = [DocSection
TableOfContents,
  RefSec -> DocSection
RefSec (RefSec -> DocSection) -> RefSec -> DocSection
forall a b. (a -> b) -> a -> b
$ Contents -> [RefTab] -> RefSec
RefProg Contents
intro
  [RefTab
TUnits, [TSIntro] -> LFunc -> RefTab
tsymb'' [TSIntro]
tableOfSymbIntro LFunc
TAD, RefTab
TAandA],
  IntroSec -> DocSection
IntroSec (IntroSec -> DocSection) -> IntroSec -> DocSection
forall a b. (a -> b) -> a -> b
$ Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg Sentence
startIntro Sentence
kSent
    [ [Sentence] -> IntroSub
IPurpose ([Sentence] -> IntroSub) -> [Sentence] -> IntroSub
forall a b. (a -> b) -> a -> b
$ CI -> Verbosity -> [Sentence]
purpDoc CI
ssp Verbosity
Verbose
    , Sentence -> IntroSub
IScope Sentence
scope
    , [Sentence] -> [Sentence] -> [Sentence] -> IntroSub
IChar []
        [NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
undergraduate Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "level 4" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
Doc.physics,
        NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
undergraduate Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "level 2 or higher" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
solidMechanics]
        [NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soilMechanics]
    , Sentence -> CI -> Section -> Sentence -> IntroSub
IOrgSec Sentence
orgSecStart CI
inModel ([Contents] -> [Section] -> Section
SRS.inModel [] []) Sentence
orgSecEnd
    ],
    --FIXME: issue #235
  GSDSec -> DocSection
GSDSec (GSDSec -> DocSection) -> GSDSec -> DocSection
forall a b. (a -> b) -> a -> b
$ [GSDSub] -> GSDSec
GSDProg
    [ [Contents] -> GSDSub
SysCntxt [Contents
sysCtxIntro, LabelledContent -> Contents
LlC LabelledContent
sysCtxFig1, Contents
sysCtxDesc, Contents
sysCtxList]
    , [Contents] -> GSDSub
UsrChars [Contents
userCharIntro], [Contents] -> [Section] -> GSDSub
SystCons [Contents
sysConstraints] []
    ],
  SSDSec -> DocSection
SSDSec (SSDSec -> DocSection) -> SSDSec -> DocSection
forall a b. (a -> b) -> a -> b
$
    [SSDSub] -> SSDSec
SSDProg
      [ ProblemDescription -> SSDSub
SSDProblem (ProblemDescription -> SSDSub) -> ProblemDescription -> SSDSub
forall a b. (a -> b) -> a -> b
$ Sentence -> [Section] -> [PDSub] -> ProblemDescription
PDProg Sentence
prob []
        [ Maybe Sentence -> [ConceptChunk] -> PDSub
forall c. Concept c => Maybe Sentence -> [c] -> PDSub
TermsAndDefs Maybe Sentence
forall a. Maybe a
Nothing [ConceptChunk]
terms
        , CI -> [Sentence] -> LabelledContent -> [Contents] -> PDSub
forall a.
Idea a =>
a -> [Sentence] -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
ssp [Sentence]
physSystParts LabelledContent
figPhysSyst [Contents]
physSystContents 
        , [Sentence] -> PDSub
Goals [Sentence]
goalsInputs]
      , SolChSpec -> SSDSub
SSDSolChSpec (SolChSpec -> SSDSub) -> SolChSpec -> SSDSub
forall a b. (a -> b) -> a -> b
$ [SCSSub] -> SolChSpec
SCSProg
        [ SCSSub
Assumptions
        , [Sentence] -> Fields -> SCSSub
TMs [] (Field
Label Field -> Fields -> Fields
forall a. a -> [a] -> [a]
: Fields
stdFields)
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
GDs [] ([Field
Label, Field
Units] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
DDs [] ([Field
Label, Field
Symbol, Field
Units] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
IMs [Sentence]
instModIntro ([Field
Label, Field
Input, Field
Output, Field
InConstraints, Field
OutConstraints] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , Sentence -> [UncertQ] -> SCSSub
forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
EmptyS [UncertQ]
inputsWUncrtn --FIXME: issue #295
        , [ConstrConcept] -> [Contents] -> SCSSub
forall c.
(Quantity c, Constrained c) =>
[c] -> [Contents] -> SCSSub
CorrSolnPpties [ConstrConcept]
outputs []
        ]
      ],
  ReqrmntSec -> DocSection
ReqrmntSec (ReqrmntSec -> DocSection) -> ReqrmntSec -> DocSection
forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg
    [ [LabelledContent] -> ReqsSub
FReqsSub' [LabelledContent]
funcReqTables
    , ReqsSub
NonFReqsSub
    ],
  DocSection
LCsSec,
  DocSection
UCsSec,
  TraceabilitySec -> DocSection
TraceabilitySec (TraceabilitySec -> DocSection) -> TraceabilitySec -> DocSection
forall a b. (a -> b) -> a -> b
$ [TraceConfig] -> TraceabilitySec
TraceabilityProg ([TraceConfig] -> TraceabilitySec)
-> [TraceConfig] -> TraceabilitySec
forall a b. (a -> b) -> a -> b
$ SystemInformation -> [TraceConfig]
traceMatStandard SystemInformation
si,
  AuxConstntSec -> DocSection
AuxConstntSec (AuxConstntSec -> DocSection) -> AuxConstntSec -> DocSection
forall a b. (a -> b) -> a -> b
$ CI -> [ConstQDef] -> AuxConstntSec
AuxConsProg CI
ssp [],
  DocSection
Bibliography]

units :: [UnitDefn]
units :: [UnitDefn]
units = (UnitDefn -> UnitDefn) -> [UnitDefn] -> [UnitDefn]
forall a b. (a -> b) -> [a] -> [b]
map UnitDefn -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
metre, UnitDefn
degree, UnitDefn
kilogram, UnitDefn
second] [UnitDefn] -> [UnitDefn] -> [UnitDefn]
forall a. [a] -> [a] -> [a]
++ (UnitDefn -> UnitDefn) -> [UnitDefn] -> [UnitDefn]
forall a b. (a -> b) -> [a] -> [b]
map UnitDefn -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
newton, UnitDefn
pascal]

concIns :: [ConceptInstance]
concIns :: [ConceptInstance]
concIns = [ConceptInstance]
goals [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
assumptions [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
funcReqs [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
nonFuncReqs [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
likelyChgs [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
unlikelyChgs

section :: [Section]
section :: [Section]
section = Document -> [Section]
extractSection Document
srs

labCon :: [LabelledContent]
labCon :: [LabelledContent]
labCon = [LabelledContent
figPhysSyst, LabelledContent
figIndexConv, LabelledContent
figForceActing] [LabelledContent] -> [LabelledContent] -> [LabelledContent]
forall a. [a] -> [a] -> [a]
++ [LabelledContent]
funcReqTables

stdFields :: Fields
stdFields :: Fields
stdFields = [Field
DefiningEquation, Verbosity -> InclUnits -> Field
Description Verbosity
Verbose InclUnits
IncludeUnits, Field
Notes, Field
Source, Field
RefBy]

-- SYMBOL MAP HELPERS --
symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = [QuantityDict]
-> [IdeaDict]
-> [ConceptChunk]
-> [UnitDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ((InstanceModel -> QuantityDict)
-> [InstanceModel] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map InstanceModel -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [InstanceModel]
SSP.iMods [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (DefinedQuantityDict -> QuantityDict)
-> [DefinedQuantityDict] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
symbols) ((DefinedQuantityDict -> IdeaDict)
-> [DefinedQuantityDict] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk]
doccon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk]
prodtcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (GenDefn -> IdeaDict) -> [GenDefn] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map GenDefn -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [GenDefn]
generalDefinitions [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (InstanceModel -> IdeaDict) -> [InstanceModel] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map InstanceModel -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [InstanceModel]
SSP.iMods
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk]
defs [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
defs' [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
softwarecon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicCon 
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (TheoryModel -> IdeaDict) -> [TheoryModel] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map TheoryModel -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [TheoryModel]
physicsTMs
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
mathcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
mathcon' [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
solidcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicalcon
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
doccon' [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (UnitDefn -> IdeaDict) -> [UnitDefn] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitDefn -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
derived [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (UnitDefn -> IdeaDict) -> [UnitDefn] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitDefn -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
fundamentals [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk]
educon
  [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk]
compcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw ConceptChunk
algorithm, CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
ssp] [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (UnitDefn -> IdeaDict) -> [UnitDefn] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitDefn -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
units)
  ((InstanceModel -> ConceptChunk)
-> [InstanceModel] -> [ConceptChunk]
forall a b. (a -> b) -> [a] -> [b]
map InstanceModel -> ConceptChunk
forall c. Concept c => c -> ConceptChunk
cw [InstanceModel]
SSP.iMods [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++ (DefinedQuantityDict -> ConceptChunk)
-> [DefinedQuantityDict] -> [ConceptChunk]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> ConceptChunk
forall c. Concept c => c -> ConceptChunk
cw [DefinedQuantityDict]
symbols [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
srsDomains) [UnitDefn]
units [DataDefinition]
SSP.dataDefs [InstanceModel]
SSP.iMods
  [GenDefn]
generalDefinitions [TheoryModel]
tMods [ConceptInstance]
concIns [Section]
section [LabelledContent]
labCon []

usedDB :: ChunkDB
usedDB :: ChunkDB
usedDB = [QuantityDict]
-> [IdeaDict]
-> [ConceptChunk]
-> [UnitDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ([] :: [QuantityDict]) ((DefinedQuantityDict -> IdeaDict)
-> [DefinedQuantityDict] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms)
 ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] [] [] [] ([] :: [Reference])

refDB :: ReferenceDB
refDB :: ReferenceDB
refDB = BibRef -> [ConceptInstance] -> ReferenceDB
rdb BibRef
citations [ConceptInstance]
concIns

-- SECTION 1 --
--automatically generated in mkSRS -

-- SECTION 1.1 --
--automatically generated in mkSRS

-- SECTION 1.2 --
--automatically generated in mkSRS using the intro below
tableOfSymbIntro :: [TSIntro]
tableOfSymbIntro :: [TSIntro]
tableOfSymbIntro = [TSIntro
TSPurpose, [TConvention] -> TSIntro
TypogConvention [Sentence -> TConvention
Verb (Sentence -> TConvention) -> Sentence -> TConvention
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "a subscript", DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S "indicates that the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value, 
  String -> Sentence
S "will be taken at, and analyzed at, a", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice Sentence -> Sentence -> Sentence
`S.or_` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice, 
  String -> Sentence
S "interface composing the total slip", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
mass]], TSIntro
VectorUnits]

-- SECTION 1.3 --
--automatically generated in mkSRS

-- SECTION 2 --
startIntro, kSent :: Sentence
startIntro :: Sentence
startIntro = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
a_ NamedChunk
slope), String -> Sentence
S "of geological",
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
mass Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "composed of", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soil, String -> Sentence
S "and rock and sometimes",
  String -> Sentence
S "water, is subject to the influence" Sentence -> Sentence -> Sentence
`S.of_` (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
gravity ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` ConceptChunk
mass) Sentence -> Sentence
!.),
  String -> Sentence
S "This can cause instability in the form" Sentence -> Sentence -> Sentence
`S.of_` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soil Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S "or rock movement", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (NP -> NP
NP.the (NamedChunk
effect NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_PS` NamedChunk
soil)),
  String -> Sentence
S "or rock movement can range from inconvenient to",
  String -> Sentence
S "seriously hazardous, resulting in significant life and economic" Sentence -> Sentence -> Sentence
+:+.
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
loss, NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart NamedChunk
slope, String -> Sentence
S "stability is of", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
interest,
  String -> Sentence
S "both when analysing natural", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
slope Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "and when designing an excavated" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope, NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart NamedChunk
ssa Sentence -> Sentence -> Sentence
`S.isThe`
  String -> Sentence
S "assessment" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S "safety of a" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "identifying the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
surface,
  String -> Sentence
S "most likely to experience", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slip Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S "an index of its relative stability known as the", ConstrConcept -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConstrConcept
fs]

kSent :: Sentence
kSent = NamedChunk -> CI -> Sentence
forall a b. (Idea a, Idea b) => a -> b -> Sentence
keySent NamedChunk
ssa CI
ssp

keySent :: (Idea a, Idea b) => a -> b -> Sentence
keySent :: a -> b -> Sentence
keySent probType :: a
probType pname :: b
pname = [Sentence] -> Sentence
foldlSent_ [(NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.a_ (a -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI a
probType NamedChunk
problem)) Sentence -> Sentence
!.),
  String -> Sentence
S "The developed", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
program, String -> Sentence
S "will be referred to as the",
  b -> Sentence
forall n. Idea n => n -> Sentence
introduceAbb b
pname]
  
-- SECTION 2.1 --
-- Purpose of Document automatically generated in IPurpose


-- SECTION 2.2 --
-- Scope of Requirements automatically generated in IScope
scope :: Sentence
scope :: Sentence
scope = [Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
stabAnalysis NamedChunk -> CI -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofA` CI
twoD), Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
twoD),
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
soil ConceptChunk
mass) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "composed of a single homogeneous", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
layer,
  String -> Sentence
S "with" Sentence -> Sentence -> Sentence
+:+. NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
constant NamedChunk
mtrlPrpty), NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (NamedChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
soil ConceptChunk
mass))
  Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "assumed to extend infinitely in the third" Sentence -> Sentence -> Sentence
+:+.
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
dimension, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
analysis), String -> Sentence
S "will be at an instant" Sentence -> Sentence -> Sentence
`S.in_`
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
time Sentence -> Sentence -> Sentence
:+: String -> Sentence
S ";", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
factor, String -> Sentence
S "that may change the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
soilPrpty,
  String -> Sentence
S "over", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
time, String -> Sentence
S "will not be considered"]

-- SECTION 2.3 --
-- Characteristics of the Intended Reader generated in IChar

-- SECTION 2.4 --
-- Organization automatically generated in IOrgSec
orgSecStart, orgSecEnd :: Sentence
orgSecStart :: Sentence
orgSecStart = [Sentence] -> Sentence
foldlSent [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
organization), String -> Sentence
S "of this",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
document, String -> Sentence
S "follows the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
template, String -> Sentence
S "for an",
  CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
Doc.srs Sentence -> Sentence -> Sentence
`S.for` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
sciCompS,
  String -> Sentence
S "proposed by Koothoor", Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
koothoor2013, String -> Sentence
S "as well as Smith" Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S "Lai", Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
smithLai2005]
orgSecEnd :: Sentence
orgSecEnd   = [Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (CI -> NP
forall c. NamedIdea c => c -> NP
the CI
inModel), String -> Sentence
S "provide the set of",
  String -> Sentence
S "algebraic", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S "that must be solved"]

-- SECTION 3 --
-- SECTION 3.1 --
-- System Context automatically generated
sysCtxIntro :: Contents
sysCtxIntro :: Contents
sysCtxIntro = [Sentence] -> Contents
foldlSP
  [LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
sysCtxFig1 Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "shows the" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
sysCont,
   String -> Sentence
S "A circle represents an external entity outside the" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
software, String -> Sentence
S "A rectangle represents the",
   NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
softwareSys, String -> Sentence
S "itself" Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
ssp),
   String -> Sentence
S "Arrows are used to show the data flow between the" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
system
   NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andIts` NamedChunk
environment)]
   
sysCtxFig1 :: LabelledContent
sysCtxFig1 :: LabelledContent
sysCtxFig1 = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef "sysCtxDiag") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
sysCont) (String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "SystemContextFigure.png")

sysCtxDesc :: Contents
sysCtxDesc :: Contents
sysCtxDesc = [Sentence] -> Contents
foldlSPCol
  [String -> Sentence
S "The responsibilities of the", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
user NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` NamedChunk
system),
   String -> Sentence
S "are as follows"]
   
sysCtxUsrResp :: [Sentence]
sysCtxUsrResp :: [Sentence]
sysCtxUsrResp = [String -> Sentence
S "Provide" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
input_) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "data related to" Sentence -> Sentence -> Sentence
+:+
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
soilLyr) Sentence -> Sentence -> Sentence
:+: String -> Sentence
S "(s) and water table (if applicable)" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "ensuring conformation to" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "data format" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "required by" Sentence -> Sentence -> Sentence
+:+ CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
ssp,
  String -> Sentence
S "Ensure that consistent units are used for" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
input_ NamedChunk
variable),
  String -> Sentence
S "Ensure required" Sentence -> Sentence -> Sentence
+:+ Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.assumpt [] []) (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk -> CI -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
software CI
assumption)) 
  Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "are" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "appropriate for the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
problem Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "to which the" Sentence -> Sentence -> Sentence
+:+ 
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
user Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "is applying the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
software]
  
sysCtxSysResp :: [Sentence]
sysCtxSysResp :: [Sentence]
sysCtxSysResp = [String -> Sentence
S "Detect data" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
type_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "mismatch, such as" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "a string of characters" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "instead of a floating" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "point" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
number,
  String -> Sentence
S "Verify that the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "satisfy the required" Sentence -> Sentence -> Sentence
+:+
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physical Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "other" Sentence -> Sentence -> Sentence
+:+ Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.datCon [] []) (NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
datumConstraint),
  String -> Sentence
S "Identify the" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "within the possible" Sentence -> Sentence -> Sentence
+:+
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
input_ Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "range",
  String -> Sentence
S "Find the" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
fsConcept Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "for the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope,
  String -> Sentence
S "Find the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
intrslce Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
normForce ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
shearForce) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "along the" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf]
  
sysCtxResp :: [Sentence]
sysCtxResp :: [Sentence]
sysCtxResp = [NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
user Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "Responsibilities",
  CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
ssp Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "Responsibilities"]

sysCtxList :: Contents
sysCtxList :: Contents
sysCtxList = UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents) -> UnlabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> RawContent -> UnlabelledContent
forall a b. (a -> b) -> a -> b
$ ListType -> RawContent
Enumeration (ListType -> RawContent) -> ListType -> RawContent
forall a b. (a -> b) -> a -> b
$ [Sentence] -> [ListType] -> ListType
bulletNested [Sentence]
sysCtxResp ([ListType] -> ListType) -> [ListType] -> ListType
forall a b. (a -> b) -> a -> b
$
  ([Sentence] -> ListType) -> [[Sentence]] -> [ListType]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> ListType
bulletFlat [[Sentence]
sysCtxUsrResp, [Sentence]
sysCtxSysResp]

-- SECTION 3.2 --
-- User Characteristics automatically generated with the
-- userContraints intro below

userCharIntro :: Contents
userCharIntro :: Contents
userCharIntro = CI -> [Sentence] -> [Sentence] -> [Sentence] -> Contents
forall a.
Idea a =>
a -> [Sentence] -> [Sentence] -> [Sentence] -> Contents
userChar CI
ssp [String -> Sentence
S "Calculus", NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
Doc.physics]
  [NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soil, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
mtrlPrpty] [UncertQ -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UncertQ
effCohesion, UncertQ -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase UncertQ
fricAngle, 
  String -> Sentence
S "unit weight"]

userChar :: (Idea a) => a -> [Sentence] -> [Sentence] -> [Sentence] -> Contents
userChar :: a -> [Sentence] -> [Sentence] -> [Sentence] -> Contents
userChar pname :: a
pname understandings :: [Sentence]
understandings familiarities :: [Sentence]
familiarities specifics :: [Sentence]
specifics = [Sentence] -> Contents
foldlSP [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
the NamedChunk
endUser) Sentence -> Sentence -> Sentence
`S.of_` a -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short a
pname,
  String -> Sentence
S "should have an understanding of undergraduate Level 1",
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
understandings Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "and be familiar with", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
familiarities Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S "specifically", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
specifics]

-- SECTION 3.2 --
sysConstraints :: Contents
sysConstraints :: Contents
sysConstraints = [Sentence] -> Contents
foldlSP [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
morPrice NamedChunk
method_)), 
  Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
morgenstern1965 Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "which involves dividing the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope,
  String -> Sentence
S "into vertical", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
slice Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "will be used to derive the",
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S "for analysing the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope]

-- SECTION 4 --

-- SECTION 4.1 --
prob :: Sentence
prob :: Sentence
prob = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S "evaluate the", ConstrConcept -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConstrConcept
fs Sentence -> Sentence -> Sentence
`S.ofA` NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrasePoss NamedChunk
slope,
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
slpSrf Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "identify", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
crtSlpSrf ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
slope) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "as well as the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
intrslce, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
normForce ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
shearForce),
  String -> Sentence
S "along the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
crtSlpSrf]

{-
From when solution was used in Problem Description:
  It is intended to be used as an educational tool for introducing slope stability
  issues and to facilitate the analysis and design of a safe slope.
-}

-- SECTION 4.1.1 --
terms :: [ConceptChunk]
terms :: [ConceptChunk]
terms = [ConceptChunk
fsConcept, ConceptChunk
slpSrf, ConceptChunk
crtSlpSrf, ConceptChunk
waterTable, ConceptChunk
stress, ConceptChunk
strain, ConceptChunk
normForce,
  ConceptChunk
shearForce, ConceptChunk
mobShear, ConceptChunk
shearRes, ConceptChunk
effFandS, ConceptChunk
cohesion, ConceptChunk
isotropy, ConceptChunk
plnStrn]

  -- most of these are in concepts (physics or solidMechanics)
  -- except for fsConcept, crtSlpSrf & plnStrn which are in defs.hs

-- SECTION 4.1.2 --
physSystParts :: [Sentence]
physSystParts :: [Sentence]
physSystParts = ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall c. NamedIdea c => c -> NP
a_ NamedChunk
slope), String -> Sentence
S "comprised of one", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soilLyr],
  [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
a_ ConceptChunk
waterTable) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "which may or may not exist"]]

figPhysSyst :: LabelledContent
figPhysSyst :: LabelledContent
figPhysSyst = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef "PhysicalSystem") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$
  Sentence -> String -> RawContent
fig ([Sentence] -> Sentence
foldlSent_ [String -> Sentence
S "An example", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
slope NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` NamedChunk
analysis),
  String -> Sentence
S "by", CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
ssp Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "where the dashed line represents the",
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
waterTable]) (String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "PhysSyst.png")

physSystContents :: [Contents]
physSystContents :: [Contents]
physSystContents = [Contents
physSysConv, LabelledContent -> Contents
LlC LabelledContent
figIndexConv, Contents
physSysFbd, LabelledContent -> Contents
LlC LabelledContent
figForceActing]

physSysConv :: Contents
physSysConv :: Contents
physSysConv = [Sentence] -> Contents
foldlSP [NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart NamedChunk
morPrice, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
analysis, Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
morgenstern1965
  Sentence -> Sentence -> Sentence
`S.ofThe` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope,  String -> Sentence
S "involves representing the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope,
  String -> Sentence
S "as a series of vertical" Sentence -> Sentence -> Sentence
+:+. NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
slice, String -> Sentence
S "As shown in",
  LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figIndexConv Sentence -> Sentence -> Sentence
`sC` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (DefinedQuantityDict -> NP
forall c. NamedIdea c => c -> NP
the DefinedQuantityDict
index), DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S "is used to denote a",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value, String -> Sentence
S "for a single", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "and an", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
intrslce, 
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value, String -> Sentence
S "at a given", DefinedQuantityDict -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase DefinedQuantityDict
index, DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S "refers to the",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value, String -> Sentence
S "between", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice, DefinedQuantityDict -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "adjacent", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice,
  ModelExpr -> Sentence
eS (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
`addI` Integer -> ModelExpr
forall r. LiteralC r => Integer -> r
int 1]

figIndexConv :: LabelledContent
figIndexConv :: LabelledContent
figIndexConv = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef "IndexConvention") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ 
  Sentence -> String -> RawContent
fig ([Sentence] -> Sentence
foldlSent_ [String -> Sentence
S "Index convention for", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
slice NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` 
  NamedChunk
intrslce), NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
value]) (String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IndexConvention.png")

physSysFbd :: Contents
physSysFbd :: Contents
physSysFbd = [Sentence] -> Contents
foldlSP [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (NP -> NP
NP.a_ (ConceptChunk
fbd ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
force)), String -> Sentence
S "acting on a",
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "displayed in" Sentence -> Sentence -> Sentence
+:+. LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figForceActing, String -> Sentence
S "The specific",
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
force ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_PP` NamedChunk
symbol_), String -> Sentence
S "will be discussed in detail in",
  Section -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.genDefn [] []) Sentence -> Sentence -> Sentence
`S.and_` Section -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.dataDefn [] [])]

figForceActing :: LabelledContent
figForceActing :: LabelledContent
figForceActing = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef "ForceDiagram") (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$
  Sentence -> String -> RawContent
fig (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (ConceptChunk
fbd ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
force) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "acting on a" Sentence -> Sentence -> Sentence
+:+
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slice) (String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "ForceDiagram.png")

-- SECTION 4.1.3 --
goalsInputs :: [Sentence]
goalsInputs :: [Sentence]
goalsInputs = [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
shape NP -> NP -> NP
`NP.ofThe` NamedChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI NamedChunk
soil ConceptChunk
mass),
  String -> Sentence
S "location" Sentence -> Sentence -> Sentence
`S.the_ofThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
waterTable, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (NamedChunk
mtrlPrpty NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` NamedChunk
soil)]

-- SECTION 4.2 --

-- SECTION 4.2.1 --
-- Assumptions is automatically generated

-- SECTION 4.2.2 --
-- TModels is automatically generated

-- SECTION 4.2.3 --
-- General Definitions is automatically generated

-- SECTION 4.2.4 --
-- Data Definitions is automatically generated
--FIXME: derivations should be with the appropriate DDef

-- SECTION 4.2.5 --
-- Instance Models is automatically generated
--FIXME: derivations should be with the appropriate IMod

-- SECTION 4.2.6 --
-- Data Constraints is automatically generated

{-
{-input data-}
noTypicalVal, vertConvention :: Sentence
noTypicalVal   = short notApp
vertConvention = S "Consecutive vertexes have increasing x" +:+.
  plural value +:+ S "The start and end vertices of all layers" +:+
  S "go to the same x" +:+. plural value --Monotonicly increasing?

verticesConst :: Sentence -> [Sentence]
verticesConst vertexType = [vertVar vertexType, vertConvention,
  noTypicalVal, noTypicalVal, noTypicalVal]

waterVert, slipVert, slopeVert :: [Sentence]
waterVert = verticesConst $ S "water" +:+ phrase table_
slipVert  = verticesConst $ phrase slip
slopeVert = verticesConst $ phrase slope
-}

-- SECTION 4.2.7 --

-- SECTION 5 --

-- SECTION 5.1 --

-- SECTION 5.2 --

-- SECTION 6 --
--Likely Changes is automatically generated

-- SECTION 7 --
-- Table of aux consts is automatically generated