module Drasil.Projectile.Lesson.Review where

import Data.Drasil.Concepts.Physics (motion, position, time)
import qualified Drasil.Projectile.Expressions as E (lcrectVel, lcrectPos, lcrectNoTime)
import Drasil.Projectile.Concepts (projectile)
import qualified Data.Drasil.Quantities.Physics as QP (speed, time, scalarPos, iPos, iSpeed, constAccel)
import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

reviewContent :: [Contents]
reviewContent :: [Contents]
reviewContent = [Contents
reviewContextP1, LabelledContent -> Contents
LlC LabelledContent
E.lcrectVel, LabelledContent -> Contents
LlC LabelledContent
E.lcrectPos, LabelledContent -> Contents
LlC LabelledContent
E.lcrectNoTime, Contents
reviewEqns, Contents
reviewContextP2]

reviewContextP1, reviewEqns, reviewContextP2 :: Contents
reviewContextP1 :: Contents
reviewContextP1
  = [Sentence] -> Contents
foldlSP_
      [String -> Sentence
S "As covered previously, the equations relating velocity", Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.speed)) Sentence -> Sentence -> Sentence
`sC` 
        ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
position, Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.scalarPos)) Sentence -> Sentence -> Sentence
`S.and_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
time, Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.time)) 
        Sentence -> Sentence -> Sentence
`S.for` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.in_` String -> Sentence
S "one dimension with constant acceleration", 
        Sentence -> Sentence
sParen (ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.constAccel)) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "are as follows:"]

reviewEqns :: Contents
reviewEqns 
  = [Sentence] -> Contents
foldlSP 
      [String -> Sentence
S "where", ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iSpeed) Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iPos), 
       String -> Sentence
S "are the initial velocity and position, respectively"]

reviewContextP2 :: Contents
reviewContextP2
  = [Sentence] -> Contents
foldlSP 
      [String -> Sentence
S "Only two of these equations are independent,",
         String -> Sentence
S "since the third equation can always be derived from the other two.",
       String -> Sentence
S "[", LabelledContent -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
E.lcrectNoTime Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "is not in the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
projectile, String -> Sentence
S"SRS]"]