module Drasil.Projectile.Lesson.Body where

import Data.List (nub)
import Language.Drasil
import Language.Drasil.Printers (PrintingInformation(..), defaultConfiguration)
import Database.Drasil
import SysInfo.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

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

import Data.Drasil.Concepts.Documentation (doccon, doccon')
import Data.Drasil.Concepts.Math (mathcon)
import qualified Data.Drasil.Concepts.Documentation as Doc (notebook)
import Data.Drasil.Quantities.Physics (physicscon)
import Data.Drasil.Concepts.Physics (physicCon)

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)

nb :: Document
nb :: Document
nb = LsnDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> SystemInformation
-> Document
mkNb LsnDecl
mkNB (forall c d.
(c -> Sentence) -> (d -> Sentence) -> c -> d -> Sentence
S.forGen forall n. NamedIdea n => n -> Sentence
titleize forall n. NamedIdea n => n -> Sentence
phrase) SystemInformation
si

printSetting :: PrintingInformation
printSetting :: PrintingInformation
printSetting = ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI ChunkDB
symbMap Stage
Equational PrintingConfiguration
defaultConfiguration

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

si :: SystemInformation
si :: SystemInformation
si = SI {
  _sys :: CI
_sys         = CI
projectileMotion,
  _kind :: CI
_kind        = CI
Doc.notebook,
  _authors :: [Person]
_authors     = [Person
spencerSmith],
  _purpose :: Purpose
_purpose     = [],
  _background :: Purpose
_background  = [], 
  _quants :: [QuantityDict]
_quants      = [] :: [QuantityDict],
  _concepts :: [DefinedQuantityDict]
_concepts    = [] :: [DefinedQuantityDict],
  _instModels :: [InstanceModel]
_instModels  = [],
  _datadefs :: [DataDefinition]
_datadefs    = [],
  _configFiles :: [String]
_configFiles  = [],
  _inputs :: [QuantityDict]
_inputs      = [] :: [QuantityDict],
  _outputs :: [QuantityDict]
_outputs     = [] :: [QuantityDict],
  _defSequence :: [Block SimpleQDef]
_defSequence = [] :: [Block SimpleQDef],
  _constraints :: [ConstrainedChunk]
_constraints = [] :: [ConstrainedChunk],
  _constants :: [ConstQDef]
_constants   = [] :: [ConstQDef],
  _sysinfodb :: ChunkDB
_sysinfodb   = ChunkDB
symbMap,
  _usedinfodb :: ChunkDB
_usedinfodb  = ChunkDB
usedDB,
   refdb :: ReferenceDB
refdb       = ReferenceDB
refDB
}

symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb (forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk]
physicscon forall a. [a] -> [a] -> [a]
++ [QuantityDict]
symbols) (forall c. Idea c => c -> IdeaDict
nw CI
projectileMotion forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [IdeaDict]
doccon forall a. [a] -> [a] -> [a]
++ 
  forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
doccon' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicCon forall a. [a] -> [a] -> [a]
++ [IdeaDict]
concepts forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
mathcon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
symbols) 
  ([] :: [ConceptChunk]) ([] :: [UnitDefn]) [] [] [] [] [] [] [] [Reference]
allRefs

usedDB :: ChunkDB
usedDB :: ChunkDB
usedDB = forall q t c u.
(Quantity q, MayHaveUnit q, Idea t, Concept c, IsUnit u) =>
[q]
-> [t]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [Section]
-> [LabelledContent]
-> [Reference]
-> ChunkDB
cdb ([] :: [QuantityDict]) (forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
symbols :: [IdeaDict]) ([] :: [ConceptChunk])
  ([] :: [UnitDefn]) [] [] [] [] ([] :: [ConceptInstance])
  ([] :: [Section]) ([] :: [LabelledContent]) ([] :: [Reference])

symbols :: [QuantityDict]
symbols :: [QuantityDict]
symbols = [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
horiz_velo]

refDB :: ReferenceDB
refDB :: ReferenceDB
refDB = BibRef -> [ConceptInstance] -> ReferenceDB
rdb [] []

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


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