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

import Control.Lens ((^.))

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 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 = [NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP ((ConceptChunk -> NPStruct) -> ConceptChunk -> NP
forall t. (t -> NPStruct) -> t -> NP
theGen (\ConceptChunk
x -> NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
pluralNP (ConceptChunk
x ConceptChunk -> Getting NP ConceptChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP ConceptChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' ConceptChunk NP
term)) ConceptChunk
CPP.mass)) Sentence -> Sentence -> Sentence
`sC`
               NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
pluralNP (ConceptChunk
CPP.len ConceptChunk -> IdeaDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
rod)) Sentence -> Sentence -> Sentence
`sC`
               NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
pluralNP (ConceptChunk
iAngle ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
CPP.mass)) Sentence -> Sentence -> Sentence
`S.and_`
               NPStruct -> Sentence
D.toSent (NP -> NPStruct
forall n. NounPhrase n => n -> NPStruct
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
gravitationalConst))]

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