module Drasil.SSP.Defs where --export all of this file

import Language.Drasil
import Data.Drasil.Domains (civilEng)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (analysis, assumption, goalStmt,
  likelyChg, physSyst, property, requirement, safety, srs, typUnc, unlikelyChg)
import Data.Drasil.Concepts.Education (mechanics)
import Data.Drasil.Concepts.Math (surface)
import Data.Drasil.Concepts.Physics (twoD, threeD, force, stress)
import Data.Drasil.Concepts.PhysicalProperties (dimension, len)
import Data.Drasil.Concepts.SolidMechanics (mobShear, normForce, nrmStrss,shearRes)
import Data.Drasil.TheoryConcepts (dataDefn, genDefn, inModel, thModel)

----Acronyms-----
acronyms :: [CI]
acronyms :: [CI]
acronyms = [CI
twoD, CI
threeD, CI
assumption, CI
dataDefn, CI
genDefn, CI
goalStmt, CI
inModel, CI
likelyChg,
  CI
physSyst, CI
requirement, CI
srs, CI
ssp, CI
thModel, CI
typUnc, CI
unlikelyChg]

ssp :: CI
ssp :: CI
ssp = String -> NP -> String -> [IdeaDict] -> CI
commonIdeaWithDict "ssp" (String -> NP
pn' "Slope Stability analysis Program") "SSP"   [IdeaDict
civilEng]

defs :: [NamedChunk]
defs :: [NamedChunk]
defs = [NamedChunk
factor, NamedChunk
soil, NamedChunk
material, NamedChunk
intrslce, NamedChunk
layer, NamedChunk
slip, NamedChunk
slope, NamedChunk
slice, NamedChunk
morPrice,
  NamedChunk
soilPrpty, NamedChunk
mtrlPrpty, NamedChunk
itslPrpty, NamedChunk
slopeSrf, NamedChunk
soilLyr, NamedChunk
soilMechanics, 
  NamedChunk
stabAnalysis, NamedChunk
ssa]

defs' :: [ConceptChunk]
defs' :: [ConceptChunk]
defs' = [ConceptChunk
slpSrf, ConceptChunk
crtSlpSrf, ConceptChunk
plnStrn, ConceptChunk
fsConcept, ConceptChunk
waterTable]

----Other Common Phrases----
soil, layer, material, intrslce, slip, slope, slice, stability,
  morPrice :: NamedChunk
intrslce :: NamedChunk
intrslce = String -> NP -> NamedChunk
nc "interslice" (String -> NP
cn' "interslice")
layer :: NamedChunk
layer    = String -> NP -> NamedChunk
nc "layer"      (String -> NP
cn' "layer")
material :: NamedChunk
material = String -> NP -> NamedChunk
nc "material"   (String -> NP
cn' "material")
slice :: NamedChunk
slice    = String -> NP -> NamedChunk
nc "slice"      (String -> NP
cn' "slice")
slip :: NamedChunk
slip     = String -> NP -> NamedChunk
nc "slip"       (String -> NP
cn  "slip") --FIXME: verb (escape or get loose from (a means of restraint))/noun 
                                        --       (an act of sliding unintentionally for a short distance)?
                                        --       (related to issue #129)
slope :: NamedChunk
slope    = String -> NP -> NamedChunk
nc "slope"      (String -> NP
cn' "slope")
soil :: NamedChunk
soil     = String -> NP -> NamedChunk
nc "soil"       (String -> NP
cn  "soil")
stability :: NamedChunk
stability = String -> NP -> NamedChunk
nc "stability" (String -> NP
cn "stability")

morPrice :: NamedChunk
morPrice = String -> NP -> NamedChunk
nc "morPrice"   (String -> NP
pn  "Morgenstern-Price")

soilPrpty, mtrlPrpty, itslPrpty, slopeSrf, soilLyr, soilMechanics, 
  stabAnalysis, ssa :: NamedChunk
--slpSrf    = compoundNC slip surface
soilPrpty :: NamedChunk
soilPrpty = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
soil     NamedChunk
property
mtrlPrpty :: NamedChunk
mtrlPrpty = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
material NamedChunk
property
itslPrpty :: NamedChunk
itslPrpty = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
intrslce NamedChunk
property
slopeSrf :: NamedChunk
slopeSrf  = NamedChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
slope ConceptChunk
surface
soilLyr :: NamedChunk
soilLyr   = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
soil NamedChunk
layer
soilMechanics :: NamedChunk
soilMechanics = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
soil NamedChunk
mechanics
stabAnalysis :: NamedChunk
stabAnalysis = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
stability NamedChunk
analysis
ssa :: NamedChunk
ssa = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
slope NamedChunk
stabAnalysis

effFandS, slpSrf, crtSlpSrf, plnStrn, fsConcept, waterTable :: ConceptChunk
effFandS :: ConceptChunk
effFandS = String -> NP -> Sentence -> ConceptChunk
dccWDS "effective forces and stresses" 
  (String -> NP
cn "effective forces and stresses") 
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
normForce) Sentence -> Sentence -> Sentence
`S.or_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
nrmStrss Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "carried by the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
soil Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "skeleton" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "composed of the effective" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
force Sentence -> Sentence -> Sentence
`S.or_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
stress Sentence -> Sentence -> Sentence
`S.andThe`
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
force Sentence -> Sentence -> Sentence
`S.or_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
stress Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "exerted by water")

slpSrf :: ConceptChunk
slpSrf = String -> NP -> Sentence -> ConceptChunk
dccWDS "slip surface" (String -> NP
cn' "slip surface")
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
a_ ConceptChunk
surface) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "within a" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
slope Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "that has the" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "potential to fail or displace due to load or other" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
force)

--FIXME: move to Concepts/soldMechanics.hs? They are too specific though
plnStrn :: ConceptChunk
plnStrn = String -> NP -> Sentence -> ConceptChunk
dccWDS "plane strain" (String -> NP
cn' "plane strain") 
  (String -> Sentence
S "A condition where the resultant" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
stress Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "in one of" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "the directions of a " Sentence -> Sentence -> Sentence
+:+ CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
threeD Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "material can be" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "approximated as zero. This condition results when a body is" Sentence -> Sentence -> Sentence
+:+ 
  String -> Sentence
S "constrained to not deform in one direction, or when the" Sentence -> Sentence -> Sentence
+:+ 
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
len Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "of one" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
dimension Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "of the body" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "dominates the others, to the point where it can be assumed as" Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S "infinite" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
stress Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "in the direction of the" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "dominant" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
dimension Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "can be approximated as zero")

crtSlpSrf :: ConceptChunk
crtSlpSrf = String -> NP -> Sentence -> ConceptChunk
dccWDS "critical slip surface" (String -> NP
cn' "critical slip surface") 
  (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk
slpSrf ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` NamedChunk
slope) Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S "that has the lowest" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
fsConcept Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S "and is therefore most likely to experience failure")

fsConcept :: ConceptChunk
fsConcept = String -> NP -> Sentence -> ConceptChunk
dccWDS "FS" NP
factorOfSafety
  (String -> Sentence
S "The global stability metric" Sentence -> Sentence -> Sentence
`S.ofA` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
slpSrf ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofA` NamedChunk
slope) Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S "defined as the ratio of" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
shearRes Sentence -> Sentence -> Sentence
+:+ 
  String -> Sentence
S "to" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
mobShear)
-- OLD DEFN: Stability metric. How likely a slip surface is to
-- experience failure through slipping.

waterTable :: ConceptChunk
waterTable = String -> NP -> String -> ConceptChunk
dcc "water table" (String -> NP
cn' "water table") ("The upper boundary of a" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  " saturated zone in the ground")

--
factor :: NamedChunk --FIXME: this is here becuase this phrase is
                     --used in datadefs and instance models
factor :: NamedChunk
factor = String -> NP -> NamedChunk
nc "factor" (String -> NP
cn' "factor") -- possible use this everywhere
                                      -- (fs, fs_rc, fsConcept...)
factorOfSafety :: NP
factorOfSafety :: NP
factorOfSafety = NamedChunk
factor NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_PS` NamedChunk
safety