module Drasil.SSP.Changes (likelyChgs, unlikelyChgs) where

-- A list of likely and unlikely changes for the SSP example

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Development as D
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.Sentence.Combinators (chgsStart)

import Data.Drasil.Concepts.Documentation (analysis, likeChgDom, model, system, unlikeChgDom)
import Data.Drasil.Concepts.Math (calculation, zDir)
import Data.Drasil.Concepts.Physics (force, stress, threeD, twoD)

-- local
import Drasil.SSP.Assumptions (assumpSLH, assumpINSFL, assumpENSL,
  assumpSF, assumpSL)
import Drasil.SSP.Defs (slope, soil, soilPrpty)
import Drasil.SSP.Unitals (intNormForce, intShrForce, surfLoad)

likelyChgs :: [ConceptInstance]
likelyChgs :: [ConceptInstance]
likelyChgs = [ConceptInstance
likelyChgCISL, ConceptInstance
likelyChgCSF, ConceptInstance
likelyChgCEF]

likelyChgCISL :: ConceptInstance
likelyChgCISL :: ConceptInstance
likelyChgCISL = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"LC_inhomogeneous" Sentence
lcCISLDesc String
"Calculate-Inhomogeneous-Soil-Layers" ConceptChunk
likeChgDom

likelyChgCSF :: ConceptInstance
likelyChgCSF :: ConceptInstance
likelyChgCSF = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"LC_seismic" Sentence
lcCSFDesc String
"Calculate-Seismic-Force" ConceptChunk
likeChgDom

likelyChgCEF :: ConceptInstance
likelyChgCEF :: ConceptInstance
likelyChgCEF = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"LC_external" Sentence
lcCEFDesc String
"Calculate-External-Force" ConceptChunk
likeChgDom

lcCISLDesc :: Sentence
lcCISLDesc :: Sentence
lcCISLDesc = [Sentence] -> Sentence
foldlSent [ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpSLH (String -> Sentence
S String
"The"), IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system,
  String -> Sentence
S String
"currently assumes the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
soil Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"mass is homogeneous",
  String -> Sentence
S String
"In the future" Sentence -> Sentence -> Sentence
`sC` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation,
  String -> Sentence
S String
"can be added for inconsistent", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
soilPrpty, String -> Sentence
S String
"throughout"]

lcCSFDesc :: Sentence
lcCSFDesc :: Sentence
lcCSFDesc = [Sentence] -> Sentence
foldlSent [ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpSF (String -> Sentence
S String
"The"), IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system,
  String -> Sentence
S String
"currently assumes no seismic" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
force, String -> Sentence
S String
"In the future" Sentence -> Sentence -> Sentence
`sC`
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation, String -> Sentence
S String
"can be added" Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"the presence of seismic", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
force]

lcCEFDesc :: Sentence
lcCEFDesc :: Sentence
lcCEFDesc = [Sentence] -> Sentence
foldlSent [ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpSL (String -> Sentence
S String
"The"), IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system,
  String -> Sentence
S String
"currently assumes no" Sentence -> Sentence -> Sentence
+:+. UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
surfLoad, String -> Sentence
S String
"In the future" Sentence -> Sentence -> Sentence
`sC`
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation, String -> Sentence
S String
"can be added" Sentence -> Sentence -> Sentence
`S.for` String -> Sentence
S String
"an imposed surface load on the",
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope]

unlikelyChgs :: [ConceptInstance]
unlikelyChgs :: [ConceptInstance]
unlikelyChgs = [ConceptInstance
unlikelyChgNISLO, ConceptInstance
unlikelyChg2AO]

unlikelyChgNISLO, unlikelyChg2AO :: ConceptInstance

unlikelyChgNISLO :: ConceptInstance
unlikelyChgNISLO = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"UC_normshearlinear" Sentence
ucNASLODesc String
"Normal-And-Shear-Linear-Only" ConceptChunk
unlikeChgDom
unlikelyChg2AO :: ConceptInstance
unlikelyChg2AO   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"UC_2donly"          Sentence
uc2AODesc   String
"2D-Analysis-Only"             ConceptChunk
unlikeChgDom

ucNASLODesc, uc2AODesc :: Sentence

ucNASLODesc :: Sentence
ucNASLODesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Changes related to",
  ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpINSFL, String -> Sentence
S String
"are not possible due to the dependency"
  Sentence -> Sentence -> Sentence
`S.ofThe` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation, String -> Sentence
S String
"on the linear relationship between",
  NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP (UnitalChunk
intNormForce UnitalChunk -> UnitalChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
intShrForce))]

uc2AODesc :: Sentence
uc2AODesc = [Sentence] -> Sentence
foldlSent [ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpENSL, String -> Sentence
S String
"allows for", CI -> Sentence
forall c. Idea c => c -> Sentence
short CI
twoD,
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
analysis, String -> Sentence
S String
"with these", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
model, String -> Sentence
S String
"only because",
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
stress, String -> Sentence
S String
"along the" Sentence -> Sentence -> Sentence
+:+. (ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
zDir Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"zero"),
  String -> Sentence
S String
"These", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
model, String -> Sentence
S String
"do not take into account",
  NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP (ConceptChunk
stress ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
zDir)) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and therefore cannot be used",
  String -> Sentence
S String
"without manipulation to attempt", NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP (CI -> IdeaDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI CI
threeD IdeaDict
analysis))]