module Drasil.Projectile.Lesson.Body where

import Data.List (nub)
import Language.Drasil hiding (Notebook)
import Drasil.Database (ChunkDB)
import Drasil.Generator (cdb)
import Drasil.System (System, mkSystem, SystemKind(Notebook))

-- TODO: Add export parameters in a module
import Drasil.DocLang (LsnDecl, LsnChapter(BibSec, LearnObj, Review, CaseProb, Example),
  LearnObj(..), Review(..), CaseProb(..), Example(..))

import qualified Data.Drasil.Quantities.Physics as Qs (iSpeed, ixSpeed, iySpeed,
  speed, constAccel, gravitationalAccel, xAccel, yAccel, time, ixPos, iyPos,
  xPos, yPos, ixVel, iyVel, xVel, yVel, scalarPos, iPos, height)
import qualified Data.Drasil.Concepts.Physics as CCs (motion, acceleration,
  velocity, force, verticalMotion, gravity, position)

import Data.Drasil.People (spencerSmith)

import Drasil.Projectile.Concepts (concepts)
import Drasil.Projectile.Expressions (eqnRefs)

import Drasil.Projectile.Lesson.LearnObj (learnObjContext)
import Drasil.Projectile.Lesson.Review (reviewContent)
import Drasil.Projectile.Lesson.CaseProb (caseProbCont, figRefs)
import Drasil.Projectile.Lesson.Example (exampleContent, horiz_velo)

nbDecl :: LsnDecl
nbDecl :: LsnDecl
nbDecl = [
    LearnObj -> LsnChapter
LearnObj (LearnObj -> LsnChapter) -> LearnObj -> LsnChapter
forall a b. (a -> b) -> a -> b
$ [Contents] -> LearnObj
LrnObjProg [Contents
learnObjContext],
    Review -> LsnChapter
Review (Review -> LsnChapter) -> Review -> LsnChapter
forall a b. (a -> b) -> a -> b
$ [Contents] -> Review
ReviewProg [Contents]
reviewContent,
    CaseProb -> LsnChapter
CaseProb (CaseProb -> LsnChapter) -> CaseProb -> LsnChapter
forall a b. (a -> b) -> a -> b
$ [Contents] -> CaseProb
CaseProbProg [Contents]
caseProbCont,
    Example -> LsnChapter
Example (Example -> LsnChapter) -> Example -> LsnChapter
forall a b. (a -> b) -> a -> b
$ [Contents] -> Example
ExampleProg [Contents]
exampleContent,
    LsnChapter
BibSec
  ]

si :: System
si :: System
si = CI
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [DefinedQuantityDict]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [DefinedQuantityDict]
-> [DefinedQuantityDict]
-> [ConstrConcept]
-> [ConstQDef]
-> ChunkDB
-> [Reference]
-> System
forall a e h i j.
(CommonIdea a, Idea a, Quantity e, Eq e, MayHaveUnit e, Concept e,
 Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> [Reference]
-> System
mkSystem
  CI
projectileMotionLesson SystemKind
Notebook [Person
spencerSmith]
  [] [] [] []
  ([] :: [DefinedQuantityDict])
  [] [] [] [] []
  ([] :: [DefinedQuantityDict]) ([] :: [DefinedQuantityDict]) ([] :: [ConstrConcept]) []
  ChunkDB
symbMap
  [Reference]
allRefs

symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = [DefinedQuantityDict]
-> [IdeaDict]
-> [ConceptChunk]
-> [UnitDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Citation]
-> [LabelledContent]
-> ChunkDB
cdb [DefinedQuantityDict]
symbols [IdeaDict]
ideaDicts [ConceptChunk]
conceptChunks ([] :: [UnitDefn]) [] [] [] [] [] [] []

ideaDicts :: [IdeaDict]
ideaDicts :: [IdeaDict]
ideaDicts = CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
projectileMotionLesson IdeaDict -> [IdeaDict] -> [IdeaDict]
forall a. a -> [a] -> [a]
: [IdeaDict]
concepts

conceptChunks :: [ConceptChunk]
conceptChunks :: [ConceptChunk]
conceptChunks = [ConceptChunk
CCs.motion, ConceptChunk
CCs.acceleration, ConceptChunk
CCs.velocity, ConceptChunk
CCs.force,
  ConceptChunk
CCs.verticalMotion, ConceptChunk
CCs.gravity, ConceptChunk
CCs.position]

symbols :: [DefinedQuantityDict]
symbols :: [DefinedQuantityDict]
symbols = (UnitalChunk -> DefinedQuantityDict)
-> [UnitalChunk] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UnitalChunk
Qs.iSpeed, UnitalChunk
Qs.ixSpeed, UnitalChunk
Qs.iySpeed, UnitalChunk
Qs.speed, UnitalChunk
Qs.constAccel,
  UnitalChunk
Qs.gravitationalAccel, UnitalChunk
Qs.xAccel, UnitalChunk
Qs.yAccel, UnitalChunk
Qs.time, UnitalChunk
Qs.ixPos, UnitalChunk
Qs.iyPos,
  UnitalChunk
Qs.xPos, UnitalChunk
Qs.yPos, UnitalChunk
Qs.ixVel, UnitalChunk
Qs.iyVel, UnitalChunk
Qs.xVel, UnitalChunk
Qs.yVel, UnitalChunk
Qs.scalarPos,
  UnitalChunk
Qs.iPos, UnitalChunk
Qs.height, UnitalChunk
horiz_velo]

projectileMotionLesson :: CI
projectileMotionLesson :: CI
projectileMotionLesson = String -> NP -> String -> [UID] -> CI
commonIdea String
"projMotLsn" (String -> NP
pn String
"Projectile Motion Lesson") String
"Projectile Motion" []

allRefs :: [Reference]
allRefs :: [Reference]
allRefs = [Reference] -> [Reference]
forall a. Eq a => [a] -> [a]
nub ([Reference]
figRefs [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ [Reference]
eqnRefs)