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

import Control.Lens ((^.))

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, output)

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, effect, endUser, environment, input_, interest, loss, method_,
  physical, physics, problem, software, softwareSys, srsDomains, symbol_,
  sysCont, system, 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 (prodtcon)
import Data.Drasil.Theories.Physics (physicsTMs)

import Data.Drasil.People (brooks, henryFrankis)
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 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 = String
"../../../../datafiles/ssp/"

si :: SystemInformation
si :: SystemInformation
si = SI {
  _sys :: CI
_sys         = CI
ssp, 
  _kind :: CI
_kind        = CI
Doc.srs, 
  _authors :: [Person]
_authors     = [Person
henryFrankis, Person
brooks],
  _purpose :: Purpose
_purpose     = [Sentence
purp],
  _background :: Purpose
_background  = [],
  _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      = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
inputs,
  _outputs :: [QuantityDict]
_outputs     = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstrConcept]
outputs,
  _defSequence :: [Block SimpleQDef]
_defSequence = [(\[SimpleQDef]
x -> forall a. a -> [a] -> Block a
Parallel (forall a. [a] -> a
head [SimpleQDef]
x) (forall a. [a] -> [a]
tail [SimpleQDef]
x)) forall a b. (a -> b) -> a -> b
$ 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 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 forall a b. (a -> b) -> a -> b
$ Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg Sentence
startIntro Sentence
kSent
    [ Purpose -> IntroSub
IPurpose forall a b. (a -> b) -> a -> b
$ CI -> Verbosity -> Purpose
purpDoc CI
ssp Verbosity
Verbose
    , Sentence -> IntroSub
IScope Sentence
scope
    , Purpose -> Purpose -> Purpose -> IntroSub
IChar []
        [forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
undergraduate Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"level 4" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
Doc.physics,
        forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
undergraduate Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"level 2 or higher" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
solidMechanics]
        [forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soilMechanics]
    , CI -> Section -> Sentence -> IntroSub
IOrgSec CI
inModel ([Contents] -> [Section] -> Section
SRS.inModel [] []) Sentence
orgSecEnd
    ],
    --FIXME: issue #235
  GSDSec -> DocSection
GSDSec 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 forall a b. (a -> b) -> a -> b
$
    [SSDSub] -> SSDSec
SSDProg
      [ ProblemDescription -> SSDSub
SSDProblem forall a b. (a -> b) -> a -> b
$ Sentence -> [Section] -> [PDSub] -> ProblemDescription
PDProg Sentence
purp []
        [ forall c. Concept c => Maybe Sentence -> [c] -> PDSub
TermsAndDefs forall a. Maybe a
Nothing [ConceptChunk]
terms
        , forall a.
Idea a =>
a -> Purpose -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
ssp Purpose
physSystParts LabelledContent
figPhysSyst [Contents]
physSystContents 
        , Purpose -> PDSub
Goals Purpose
goalsInputs]
      , SolChSpec -> SSDSub
SSDSolChSpec forall a b. (a -> b) -> a -> b
$ [SCSSub] -> SolChSpec
SCSProg
        [ SCSSub
Assumptions
        , Purpose -> Fields -> SCSSub
TMs [] (Field
Label forall a. a -> [a] -> [a]
: Fields
stdFields)
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
GDs [] ([Field
Label, Field
Units] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
DDs [] ([Field
Label, Field
Symbol, Field
Units] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , Purpose -> Fields -> DerivationDisplay -> SCSSub
IMs Purpose
instModIntro ([Field
Label, Field
Input, Field
Output, Field
InConstraints, Field
OutConstraints] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
EmptyS [UncertQ]
inputsWUncrtn --FIXME: issue #295
        , forall c.
(Quantity c, Constrained c) =>
[c] -> [Contents] -> SCSSub
CorrSolnPpties [ConstrConcept]
outputs []
        ]
      ],
  ReqrmntSec -> DocSection
ReqrmntSec forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg
    [ [LabelledContent] -> ReqsSub
FReqsSub' [LabelledContent]
funcReqTables
    , ReqsSub
NonFReqsSub
    ],
  DocSection
LCsSec,
  DocSection
UCsSec,
  TraceabilitySec -> DocSection
TraceabilitySec forall a b. (a -> b) -> a -> b
$ [TraceConfig] -> TraceabilitySec
TraceabilityProg forall a b. (a -> b) -> a -> b
$ SystemInformation -> [TraceConfig]
traceMatStandard SystemInformation
si,
  AuxConstntSec -> DocSection
AuxConstntSec forall a b. (a -> b) -> a -> b
$ CI -> [ConstQDef] -> AuxConstntSec
AuxConsProg CI
ssp [],
  DocSection
Bibliography]

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

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

concIns :: [ConceptInstance]
concIns :: [ConceptInstance]
concIns = [ConceptInstance]
goals forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
assumptions forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
funcReqs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
nonFuncReqs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
likelyChgs 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] 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 = 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 (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c QuantityDict
output) [InstanceModel]
SSP.iMods forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
symbols) (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
doccon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
prodtcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [GenDefn]
generalDefinitions forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [InstanceModel]
SSP.iMods
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
defs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
defs' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
softwarecon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicCon 
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [TheoryModel]
physicsTMs
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
mathcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
mathcon' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
solidcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicalcon
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
doccon' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
derived forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
fundamentals forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
educon
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
compcon forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw ConceptChunk
algorithm, forall c. Idea c => c -> IdeaDict
nw CI
ssp] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn]
units)
  (forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [InstanceModel]
SSP.iMods forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [DefinedQuantityDict]
symbols 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 = 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]) (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 forall a b. (a -> b) -> a -> b
$ Purpose -> Sentence
foldlSent_
  [String -> Sentence
S String
"a subscript", forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"indicates that the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value, 
  String -> Sentence
S String
"will be taken at, and analyzed at, a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
`S.or_` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, 
  String -> Sentence
S String
"interface composing the total slip", forall 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 = Purpose -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
a_ IdeaDict
slope), String -> Sentence
S String
"of geological",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
mass Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"composed of", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil, String -> Sentence
S String
"and rock and sometimes",
  String -> Sentence
S String
"water, is subject to the influence" Sentence -> Sentence -> Sentence
`S.of_` (forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
gravity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`onThe` ConceptChunk
mass) !.),
  String -> Sentence
S String
"This can cause instability in the form" Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"or rock movement", forall n. NounPhrase n => n -> Sentence
atStartNP' (NP -> NP
NP.the (IdeaDict
effect forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_PS` IdeaDict
soil)),
  String -> Sentence
S String
"or rock movement can range from inconvenient to",
  String -> Sentence
S String
"seriously hazardous, resulting in significant life and economic" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
loss, forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
slope, String -> Sentence
S String
"stability is of", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
interest,
  String -> Sentence
S String
"both when analysing natural", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
slope Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"and when designing an excavated" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope, forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
ssa Sentence -> Sentence -> Sentence
`S.isThe`
  String -> Sentence
S String
"assessment" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"safety of a" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"identifying the", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
surface,
  String -> Sentence
S String
"most likely to experience", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slip Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"an index of its relative stability known as the", forall n. NamedIdea n => n -> Sentence
phrase ConstrConcept
fs]

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

keySent :: (Idea a, Idea b) => a -> b -> Sentence
keySent :: forall a b. (Idea a, Idea b) => a -> b -> Sentence
keySent a
probType b
pname = Purpose -> Sentence
foldlSent_ [(forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.a_ (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI a
probType IdeaDict
problem)) !.),
  String -> Sentence
S String
"The developed", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
program, String -> Sentence
S String
"will be referred to as the",
  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 = Purpose -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
stabAnalysis forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofA` CI
twoD), Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
twoD),
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
soil ConceptChunk
mass) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"composed of a single homogeneous", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
layer,
  String -> Sentence
S String
"with" Sentence -> Sentence -> Sentence
+:+. forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
constant IdeaDict
mtrlPrpty), forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI IdeaDict
soil ConceptChunk
mass))
  Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"assumed to extend infinitely in the third" Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
dimension, forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
the IdeaDict
analysis), String -> Sentence
S String
"will be at an instant" Sentence -> Sentence -> Sentence
`S.in_`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
time Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
";", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
factor, String -> Sentence
S String
"that may change the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
soilPrpty,
  String -> Sentence
S String
"over", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
time, String -> Sentence
S String
"will not be considered"]

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

-- SECTION 2.4 --
-- Organization automatically generated in IOrgSec
orgSecEnd :: Sentence
orgSecEnd :: Sentence
orgSecEnd   = Purpose -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
atStartNP' (forall c. NamedIdea c => c -> NP
the CI
inModel), String -> Sentence
S String
"provide the set of",
  String -> Sentence
S String
"algebraic", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S String
"that must be solved"]

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

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

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

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

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

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

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

-- SECTION 4 --

-- SECTION 4.1 --

-- Introduction of the Problem Description section derives from purp

{-
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 :: Purpose
physSystParts = forall a b. (a -> b) -> [a] -> [b]
map Purpose -> Sentence
foldlSent [
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
a_ IdeaDict
slope), String -> Sentence
S String
"comprised of one", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soilLyr],
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall c. NamedIdea c => c -> NP
a_ ConceptChunk
waterTable) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"which may or may not exist"]]

figPhysSyst :: LabelledContent
figPhysSyst :: LabelledContent
figPhysSyst = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"PhysicalSystem") forall a b. (a -> b) -> a -> b
$
  Sentence -> String -> RawContent
fig (Purpose -> Sentence
foldlSent_ [String -> Sentence
S String
"An example", forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
slope forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`for` IdeaDict
analysis),
  String -> Sentence
S String
"by", forall n. Idea n => n -> Sentence
short CI
ssp Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"where the dashed line represents the",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
waterTable]) (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"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 = Purpose -> Contents
foldlSP [forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
morPrice, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
analysis, forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
morgenstern1965
  Sentence -> Sentence -> Sentence
`S.ofThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope,  String -> Sentence
S String
"involves representing the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope,
  String -> Sentence
S String
"as a series of vertical" Sentence -> Sentence -> Sentence
+:+. forall n. NamedIdea n => n -> Sentence
plural IdeaDict
slice, String -> Sentence
S String
"As shown in",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figIndexConv Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (forall c. NamedIdea c => c -> NP
the DefinedQuantityDict
index), forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"is used to denote a",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value, String -> Sentence
S String
"for a single", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and an", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intrslce, 
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value, String -> Sentence
S String
"at a given", forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
index, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index, String -> Sentence
S String
"refers to the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value, String -> Sentence
S String
"between", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch DefinedQuantityDict
index Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"adjacent", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice,
  ModelExpr -> Sentence
eS forall a b. (a -> b) -> a -> b
$ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
index forall r. ExprC r => r -> r -> r
`addI` forall r. LiteralC r => Integer -> r
int Integer
1]

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

physSysFbd :: Contents
physSysFbd :: Contents
physSysFbd = Purpose -> Contents
foldlSP [forall n. NounPhrase n => n -> Sentence
atStartNP' (NP -> NP
NP.a_ (ConceptChunk
fbd forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
force)), String -> Sentence
S String
"acting on a",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"displayed in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figForceActing, String -> Sentence
S String
"The specific",
  forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
force forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_PP` IdeaDict
symbol_), String -> Sentence
S String
"will be discussed in detail in",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ([Contents] -> [Section] -> Section
SRS.genDefn [] []) Sentence -> Sentence -> Sentence
`S.and_` 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 String
"ForceDiagram") forall a b. (a -> b) -> a -> b
$
  Sentence -> String -> RawContent
fig (forall n. NounPhrase n => n -> Sentence
atStartNP' (ConceptChunk
fbd forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_` ConceptChunk
force) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"acting on a" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slice) (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"ForceDiagram.png")

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