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

import Control.Lens ((^.))

import Drasil.Metadata (dataDefn, genDefn, inModel, thModel)

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 Language.Drasil.ShortHands (lX,lY)

import Data.Drasil.Concepts.Documentation (analysis, assumption, goalStmt,
  likelyChg, physSyst, property, requirement, refBy, refName, 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)

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

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

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

----Other Common Phrases----
soil, layer, material, intrslce, slip, slope, slice, stability,
  morPrice :: IdeaDict
intrslce :: IdeaDict
intrslce = String -> NP -> IdeaDict
nc String
"interslice" (String -> NP
cn' String
"interslice")
layer :: IdeaDict
layer    = String -> NP -> IdeaDict
nc String
"layer"      (String -> NP
cn' String
"layer")
material :: IdeaDict
material = String -> NP -> IdeaDict
nc String
"material"   (String -> NP
cn' String
"material")
slice :: IdeaDict
slice    = String -> NP -> IdeaDict
nc String
"slice"      (String -> NP
cn' String
"slice")
slip :: IdeaDict
slip     = String -> NP -> IdeaDict
nc String
"slip"       (String -> NP
cn  String
"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 :: IdeaDict
slope    = String -> NP -> IdeaDict
nc String
"slope"      (String -> NP
cn' String
"slope")
soil :: IdeaDict
soil     = String -> NP -> IdeaDict
nc String
"soil"       (String -> NP
cn  String
"soil")
stability :: IdeaDict
stability = String -> NP -> IdeaDict
nc String
"stability" (String -> NP
cn String
"stability")

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

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

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

slpSrf :: ConceptChunk
slpSrf = String -> NP -> Sentence -> ConceptChunk
dccWDS String
"slip surface" (IdeaDict
slpSrfCon IdeaDict -> Getting NP IdeaDict NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP IdeaDict NP
forall c. NamedIdea c => Lens' c NP
Lens' IdeaDict NP
term)
  (NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
a_ ConceptChunk
surface)) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"within a" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
slope Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that has the" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"potential to fail or displace due to load or other" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall 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 String
"plane strain" (String -> NP
cn' String
"plane strain")
  (String -> Sentence
S String
"A condition where the resultant" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
stress Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"in one of" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"the directions" Sentence -> Sentence -> Sentence
`S.ofA` CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
threeD Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"material can be" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"approximated as zero. This condition results when a body is" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"constrained to not deform in one direction, or when the" Sentence -> Sentence -> Sentence
+:+
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
len Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of one" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
dimension Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"body" Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"dominates the others" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"to the point where it can be assumed as" Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"infinite" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
stress Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"in the direction" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"dominant" Sentence -> Sentence -> Sentence
+:+
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
dimension Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"can be approximated as zero")

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

fsConcept :: ConceptChunk
fsConcept = String -> NP -> Sentence -> ConceptChunk
dccWDS String
"FS" NP
factorOfSafety
  (String -> Sentence
S String
"The global stability metric" Sentence -> Sentence -> Sentence
`S.ofA` NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP (ConceptChunk
slpSrf ConceptChunk -> IdeaDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofA` IdeaDict
slope)) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"defined as the ratio" Sentence -> Sentence -> Sentence
`S.of_` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
shearRes Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"to" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall 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 String
"water table" (String -> NP
cn' String
"water table") (String
"The upper boundary of a" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" saturated zone in the ground")

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

---------
-- HACK: this belongs in drasil-data
minim, maxim :: IdeaDict -- else clashes with Prelude
minim :: IdeaDict
minim = String -> NP -> IdeaDict
nc String
"minimum" (String -> NP
cn' String
"minimum")
maxim :: IdeaDict
maxim = String -> NP -> IdeaDict
nc String
"maximum" (String -> NP
cn' String
"maximum")

-- Some sentences want plurals (because of arrays) of things that are normally singular.
xCoords, yCoords :: ConceptChunk
xCoords :: ConceptChunk
xCoords = String -> NP -> String -> ConceptChunk
dcc String
"xCoords" (NPStruct -> NP
nounPhraseSent (NPStruct -> NP) -> NPStruct -> NP
forall a b. (a -> b) -> a -> b
$ Symbol -> NPStruct
D.P Symbol
lX NPStruct -> NPStruct -> NPStruct
D.:-: String -> NPStruct
D.S String
"-coordinates") String
"the location of the points on the x-axis"
yCoords :: ConceptChunk
yCoords = String -> NP -> String -> ConceptChunk
dcc String
"yCoords" (NPStruct -> NP
nounPhraseSent (NPStruct -> NP) -> NPStruct -> NP
forall a b. (a -> b) -> a -> b
$ Symbol -> NPStruct
D.P Symbol
lY NPStruct -> NPStruct -> NPStruct
D.:-: String -> NPStruct
D.S String
"-coordinates") String
"the location of the points on the y-axis"