{-# LANGUAGE PostfixOperators#-}
 module Drasil.SglPend.Goals (goals, goalsInputs) where

 import Language.Drasil
 import Language.Drasil.Chunk.Concept.NamedCombinators
 import qualified Language.Drasil.Sentence.Combinators as S
 import qualified Language.Drasil.NounPhrase.Combinators as NP

 import Data.Drasil.Concepts.Documentation (goalStmtDom)
 import qualified Data.Drasil.Concepts.PhysicalProperties as CPP (mass, len)
 import Data.Drasil.Concepts.Physics (gravitationalConst, motion)
 import Data.Drasil.Concepts.Math (iAngle)
 import Drasil.DblPend.Concepts (rod)


 goals :: [ConceptInstance]
 goals :: [ConceptInstance]
goals = [ConceptInstance
motionMass]

 goalsInputs :: [Sentence]
 goalsInputs :: [Sentence]
goalsInputs = [forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
CPP.mass NP -> NP -> NP
`NP.and_` (ConceptChunk
CPP.len  forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
rod)) Sentence -> Sentence -> Sentence
`sC` 
         forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
iAngle forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
CPP.mass) Sentence -> Sentence -> Sentence
`S.and_` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
gravitationalConst) ]

 motionMass :: ConceptInstance
 motionMass :: ConceptInstance
motionMass = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"motionMass" 
   (String -> Sentence
S String
"Calculate" Sentence -> Sentence -> Sentence
+:+ forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
motion forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
CPP.mass) !.)
   String
"Motion-of-the-mass" ConceptChunk
goalStmtDom