module Drasil.GlassBR.Assumptions (assumpGT, assumpGC, assumpES, assumpSV,
  assumpGL, assumpBC, assumpRT, assumpLDFC, assumptionConstants,
  assumptions) where

import Language.Drasil hiding (organization)
import qualified Drasil.DocLang.SRS as SRS (valsOfAuxCons)
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 (assumpDom, condition,
  constant, practice, reference, scenario, system, value)
import Data.Drasil.Concepts.Math (calculation, surface, shape)
import Data.Drasil.Concepts.PhysicalProperties (materialProprty)

import Drasil.GlassBR.Concepts (beam, cantilever, edge, glaSlab, glass, glassBR, 
  lShareFac, plane, responseTy)
import Drasil.GlassBR.References (astm2009)
import Drasil.GlassBR.Unitals (constantK, constantLoadDur, 
  constantLoadSF, constantM, constantModElas, explosion, lateral, lDurFac,
  loadDur)

assumptions :: [ConceptInstance]
assumptions :: [ConceptInstance]
assumptions = [ConceptInstance
assumpGT, ConceptInstance
assumpGC, ConceptInstance
assumpES, ConceptInstance
assumpSV, ConceptInstance
assumpGL, ConceptInstance
assumpBC,
  ConceptInstance
assumpRT, ConceptInstance
assumpLDFC]

assumptionConstants :: [ConstQDef]
assumptionConstants :: [ConstQDef]
assumptionConstants = [ConstQDef
constantM, ConstQDef
constantK, ConstQDef
constantModElas,
  ConstQDef
constantLoadDur, ConstQDef
constantLoadSF]

assumpGT, assumpGC, assumpES, assumpSV, assumpGL, assumpBC, assumpRT, assumpLDFC :: ConceptInstance
assumpGT :: ConceptInstance
assumpGT           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpGT"   Sentence
glassTypeDesc                     String
"glassType"           ConceptChunk
Doc.assumpDom
assumpGC :: ConceptInstance
assumpGC           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpGC"   Sentence
glassConditionDesc                String
"glassCondition"      ConceptChunk
Doc.assumpDom
assumpES :: ConceptInstance
assumpES           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpES"   Sentence
explainScenarioDesc               String
"explainScenario"     ConceptChunk
Doc.assumpDom
assumpSV :: ConceptInstance
assumpSV           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpSV"   (UnitaryChunk -> Sentence
standardValuesDesc UnitaryChunk
loadDur)      String
"standardValues"      ConceptChunk
Doc.assumpDom
assumpGL :: ConceptInstance
assumpGL           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpGL"   Sentence
glassLiteDesc                     String
"glassLite"           ConceptChunk
Doc.assumpDom
assumpBC :: ConceptInstance
assumpBC           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpBC"   Sentence
boundaryConditionsDesc            String
"boundaryConditions"  ConceptChunk
Doc.assumpDom
assumpRT :: ConceptInstance
assumpRT           = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpRT"   Sentence
responseTypeDesc                  String
"responseType"        ConceptChunk
Doc.assumpDom
assumpLDFC :: ConceptInstance
assumpLDFC         = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"assumpLDFC" (QuantityDict -> Sentence
ldfConstantDesc QuantityDict
lDurFac)         String
"ldfConstant"         ConceptChunk
Doc.assumpDom

glassTypeDesc :: Sentence
glassTypeDesc :: Sentence
glassTypeDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The standard E1300-09a for",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
calculation, String -> Sentence
S String
"applies only to", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
Options forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Sentence
S [String
"monolithic",
  String
"laminated", String
"insulating"], String -> Sentence
S String
"glass constructions" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"rectangular", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
shape, 
  String -> Sentence
S String
"with continuous", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
lateral, String -> Sentence
S String
"support along",
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
Options (forall a b. (a -> b) -> [a] -> [b]
map String -> Sentence
S [String
"one", String
"two", String
"three", String
"four"]) Sentence -> Sentence -> Sentence
+:+.
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
edge, String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
practice Sentence -> Sentence -> Sentence
+: String -> Sentence
S String
"assumes that",
  EnumType
-> WrapType -> SepType -> FoldType -> [Sentence] -> Sentence
foldlEnumList EnumType
Numb WrapType
Parens SepType
SemiCol FoldType
List forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent_
  [[String -> Sentence
S String
"the supported glass", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
edge, String -> Sentence
S String
"for two, three" Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"four-sided support", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition, String -> Sentence
S String
"are simply supported" Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"free to slip in", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
plane], 
  [String -> Sentence
S String
"glass supported on two sides acts as a simply supported", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
beam], 
  [String -> Sentence
S String
"glass supported on one side acts as a", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
cantilever]]]

glassConditionDesc :: Sentence
glassConditionDesc :: Sentence
glassConditionDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Following", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> RefInfo -> Sentence
complexRef Citation
astm2009 ([Int] -> RefInfo
Page [Int
1]) Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S String
"this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
practice, String -> Sentence
S String
"does not apply to any form of", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
Options forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Sentence
S [String
"wired",
  String
"patterned", String
"etched", String
"sandblasted", String
"drilled", String
"notched", String
"grooved glass"], String -> Sentence
S String
"with", 
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
surface Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"edge treatments that alter the glass strength"]

explainScenarioDesc :: Sentence
explainScenarioDesc :: Sentence
explainScenarioDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system, String -> Sentence
S String
"only considers the external", 
  forall n. NounPhrase n => n -> Sentence
phraseNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
explosion IdeaDict
scenario), String -> Sentence
S String
"for its", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation]

standardValuesDesc :: UnitaryChunk -> Sentence
standardValuesDesc :: UnitaryChunk -> Sentence
standardValuesDesc UnitaryChunk
mainIdea = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the IdeaDict
value), String -> Sentence
S String
"provided in",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ [Contents] -> [Section] -> Section
SRS.valsOfAuxCons ([]::[Contents]) ([]::[Section]), String -> Sentence
S String
"are assumed for the", forall n. NamedIdea n => n -> Sentence
phrase UnitaryChunk
mainIdea, 
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitaryChunk
mainIdea) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
materialProprty Sentence -> Sentence -> Sentence
`S.of_` 
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (forall a. Int -> [a] -> [a]
take Int
3 [ConstQDef]
assumptionConstants))]

glassLiteDesc :: Sentence
glassLiteDesc :: Sentence
glassLiteDesc = [Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
glass, String -> Sentence
S String
"under consideration is assumed to be a single", 
  String -> Sentence
S String
"lite; hence, the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
value Sentence -> Sentence -> Sentence
`S.of_` forall c. Idea c => c -> Sentence
short CI
lShareFac, String -> Sentence
S String
"is equal to 1 for all",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation Sentence -> Sentence -> Sentence
`S.in_` forall c. Idea c => c -> Sentence
short CI
glassBR]

boundaryConditionsDesc :: Sentence
boundaryConditionsDesc :: Sentence
boundaryConditionsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Boundary", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition, String -> Sentence
S String
"for the",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
glaSlab, String -> Sentence
S String
"are assumed to be 4-sided support for",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
calculation]

responseTypeDesc :: Sentence
responseTypeDesc :: Sentence
responseTypeDesc = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
responseTy), String -> Sentence
S String
"considered in",
  forall c. Idea c => c -> Sentence
short CI
glassBR, String -> Sentence
S String
"is flexural"]

ldfConstantDesc :: QuantityDict -> Sentence
ldfConstantDesc :: QuantityDict -> Sentence
ldfConstantDesc QuantityDict
mainConcept = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"With", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
reference, String -> Sentence
S String
"to",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
assumpSV Sentence -> Sentence -> Sentence
`sC` forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> NP
NP.the (IdeaDict
value forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`of_`
  QuantityDict
mainConcept)), Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
mainConcept) Sentence -> Sentence -> Sentence
`S.is` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
a_ IdeaDict
constant)
  Sentence -> Sentence -> Sentence
`S.in_` forall c. Idea c => c -> Sentence
short CI
glassBR]