{-# LANGUAGE PostfixOperators #-}
module Drasil.DblPendulum.Assumptions (twoDMotion, cartSys, cartSysR,
  yAxisDir, startOriginSingle, startOriginDouble, firstPend, secondPend, assumpSingle, assumpDouble) where
    
import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (assumpDom) 
import Data.Drasil.Concepts.Math (cartesian, xAxis, yAxis, direction, origin, positive)
import Data.Drasil.Concepts.Physics (gravity, twoD, pendulum)
import Drasil.DblPendulum.Concepts (pendMotion, firstRod, secondRod, firstObject, secondObject)

assumpBasic :: [ConceptInstance]
assumpBasic :: [ConceptInstance]
assumpBasic = [ConceptInstance
twoDMotion, ConceptInstance
cartSys, ConceptInstance
cartSysR, ConceptInstance
yAxisDir]

assumpSingle :: [ConceptInstance]
assumpSingle :: [ConceptInstance]
assumpSingle = [ConceptInstance]
assumpBasic [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance
startOriginSingle]

assumpDouble :: [ConceptInstance]
assumpDouble :: [ConceptInstance]
assumpDouble = [ConceptInstance]
assumpSingle [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance
startOriginDouble, ConceptInstance
firstPend, ConceptInstance
secondPend]

twoDMotion, cartSys, cartSysR, yAxisDir, startOriginSingle, startOriginDouble,
  firstPend, secondPend:: ConceptInstance 

twoDMotion :: ConceptInstance
twoDMotion        = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "twoDMotion"    Sentence
twoDMotionDesc          "twoDMotion"    ConceptChunk
assumpDom
cartSys :: ConceptInstance
cartSys           = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "cartSys"       Sentence
cartSysDesc             "cartSys"       ConceptChunk
assumpDom
cartSysR :: ConceptInstance
cartSysR          = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "cartSysR"      Sentence
cartSysRDesc            "cartSysR"      ConceptChunk
assumpDom
yAxisDir :: ConceptInstance
yAxisDir          = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "yAxisDir"      Sentence
yAxisDirDesc            "yAxisDir"      ConceptChunk
assumpDom
startOriginSingle :: ConceptInstance
startOriginSingle = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "startOrigin"   Sentence
startOriginDescSingle   "startOrigin"   ConceptChunk
assumpDom
startOriginDouble :: ConceptInstance
startOriginDouble = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "startOrigin"   Sentence
startOriginDescDouble   "startOrigin"   ConceptChunk
assumpDom
firstPend :: ConceptInstance
firstPend         = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "firstPend"     Sentence
firstPendDesc           "firstPend"     ConceptChunk
assumpDom
secondPend :: ConceptInstance
secondPend        = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "secondPend"    Sentence
secondPendDesc          "secondPend"    ConceptChunk
assumpDom

twoDMotionDesc :: Sentence
twoDMotionDesc :: Sentence
twoDMotionDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
pendMotion) Sentence -> Sentence -> Sentence
`S.is` CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
twoD Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
twoD)

cartSysDesc :: Sentence
cartSysDesc :: Sentence
cartSysDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
a_ ConceptChunk
cartesian) Sentence -> Sentence -> Sentence
`S.is` (String -> Sentence
S "used" Sentence -> Sentence
!.)

cartSysRDesc :: Sentence
cartSysRDesc :: Sentence
cartSysRDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
cartesian) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "right-handed where" Sentence -> Sentence -> Sentence
+:+ 
    NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP -> NP
forall c. NamedIdea c => c -> NP -> NP
combineNINP ConceptChunk
positive (ConceptChunk
xAxis ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
yAxis)) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "point right up"

yAxisDirDesc :: Sentence
yAxisDirDesc :: Sentence
yAxisDirDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk
direction ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
yAxis) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "directed opposite to" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
gravity

startOriginDescDouble :: Sentence
startOriginDescDouble :: Sentence
startOriginDescDouble = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
firstRod) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "attached" Sentence -> Sentence -> Sentence
`S.toThe` (ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
origin Sentence -> Sentence
!.)

startOriginDescSingle :: Sentence
startOriginDescSingle :: Sentence
startOriginDescSingle = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
pendulum) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "attached" Sentence -> Sentence -> Sentence
`S.toThe` (ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
origin Sentence -> Sentence
!.)

firstPendDesc:: Sentence
firstPendDesc :: Sentence
firstPendDesc = [Sentence] -> Sentence
foldlSent[
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
firstRod) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "has two sides", 
  String -> Sentence
S "One side attaches" Sentence -> Sentence -> Sentence
`S.toThe` (ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
origin Sentence -> Sentence
!.), 
  String -> Sentence
S "Another side attaches" Sentence -> Sentence -> Sentence
`S.toThe` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
firstObject]

secondPendDesc:: Sentence
secondPendDesc :: Sentence
secondPendDesc = [Sentence] -> Sentence
foldlSent[
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NamedChunk -> NP
forall t. NamedIdea t => t -> NP
the NamedChunk
secondRod) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "has two sides", 
  String -> Sentence
S "One side attaches" Sentence -> Sentence -> Sentence
`S.toThe` (NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
firstObject Sentence -> Sentence
!.),
  String -> Sentence
S "Another side attaches" Sentence -> Sentence -> Sentence
`S.toThe` NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
secondObject]