{-# LANGUAGE PostfixOperators #-}
module Drasil.SglPend.Body where

import Control.Lens ((^.))

import Drasil.Metadata (inModel)
import Language.Drasil hiding (organization, section)
import Theory.Drasil (TheoryModel, output)
import Drasil.SRSDocument
import Database.Drasil.ChunkDB (cdb)
import qualified Drasil.DocLang.SRS as SRS
import Language.Drasil.Chunk.Concept.NamedCombinators (the)
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.People (olu)
import Data.Drasil.Concepts.Math (mathcon')
import Data.Drasil.Concepts.Physics (physicCon', motion, pendulum, angular, displacement, iPos, gravitationalConst, gravity, rigidBody, weight, shm)
import Data.Drasil.Concepts.PhysicalProperties (mass, physicalcon)
import Data.Drasil.Quantities.PhysicalProperties (len)
import Data.Drasil.Theories.Physics (newtonSLR)

import Drasil.DblPend.Body (justification, externalLinkRef, charsOfReader,
  sysCtxIntro, sysCtxDesc, sysCtxList, stdFields, scope, terms,
  userCharacteristicsIntro)
import qualified Drasil.DblPend.Body as DPD (tMods)
import Drasil.DblPend.Concepts (concepts, rod)
import Drasil.DblPend.Requirements (nonFuncReqs)
import Drasil.DblPend.Unitals (acronyms)
import Drasil.DblPend.References (citations)

import Drasil.SglPend.Assumptions (assumpSingle)
import Drasil.SglPend.Figures (figMotion, sysCtxFig1)
import Drasil.SglPend.Goals (goals, goalsInputs)
import Drasil.SglPend.DataDefs (dataDefs)
import Drasil.SglPend.IMods (iMods)
import Drasil.SglPend.MetaConcepts (progName)
import Drasil.SglPend.GenDefs (genDefns)
import Drasil.SglPend.Unitals (inputs, outputs, inConstraints, outConstraints, symbols)
import Drasil.SglPend.Requirements (funcReqs)

import Drasil.System (SystemKind(Specification), mkSystem)

srs :: Document
srs :: Document
srs = SRSDecl -> (IdeaDict -> IdeaDict -> Sentence) -> System -> Document
mkDoc SRSDecl
mkSRS ((IdeaDict -> Sentence)
-> (IdeaDict -> Sentence) -> IdeaDict -> IdeaDict -> Sentence
forall c d.
(c -> Sentence) -> (d -> Sentence) -> c -> d -> Sentence
S.forGen IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase) System
si

fullSI :: System
fullSI :: System
fullSI = SRSDecl -> System -> System
fillcdbSRS SRSDecl
mkSRS System
si

printSetting :: PrintingInformation
printSetting :: PrintingInformation
printSetting = System -> Stage -> PrintingConfiguration -> PrintingInformation
piSys System
fullSI Stage
Equational PrintingConfiguration
defaultConfiguration

mkSRS :: SRSDecl
mkSRS :: SRSDecl
mkSRS = [DocSection
TableOfContents, -- This creates the Table of Contents
  RefSec -> DocSection
RefSec (RefSec -> DocSection) -> RefSec -> DocSection
forall a b. (a -> b) -> a -> b
$      --This creates the Reference section of the SRS
    Contents -> [RefTab] -> RefSec
RefProg Contents
intro      -- This add the introduction blob to the reference section  
      [ RefTab
TUnits         -- Adds table of unit section with a table frame
      , [TSIntro] -> RefTab
tsymb [TSIntro
TSPurpose, [TConvention] -> TSIntro
TypogConvention [Emphasis -> TConvention
Vector Emphasis
Bold], TSIntro
SymbOrder, TSIntro
VectorUnits] -- Adds table of symbol section with a table frame
      --introductory blob (TSPurpose), TypogConvention, bolds vector parameters (Vector Bold), orders the symbol, and adds units to symbols 
      , [IdeaDict] -> RefTab
TAandA [IdeaDict]
abbreviationsList         -- Add table of abbreviation and acronym section
      ],
  IntroSec -> DocSection
IntroSec (IntroSec -> DocSection) -> IntroSec -> DocSection
forall a b. (a -> b) -> a -> b
$
    Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg (CI -> Sentence
justification CI
progName) (CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
progName)
      [[Sentence] -> IntroSub
IPurpose ([Sentence] -> IntroSub) -> [Sentence] -> IntroSub
forall a b. (a -> b) -> a -> b
$ CI -> Verbosity -> [Sentence]
purpDoc CI
progName Verbosity
Verbose,
       Sentence -> IntroSub
IScope Sentence
scope,
       [Sentence] -> [Sentence] -> [Sentence] -> IntroSub
IChar [] [Sentence]
charsOfReader [],
       CI -> Section -> Sentence -> IntroSub
IOrgSec CI
inModel ([Contents] -> [Section] -> Section
SRS.inModel [] []) Sentence
EmptyS],
  GSDSec -> DocSection
GSDSec (GSDSec -> DocSection) -> GSDSec -> DocSection
forall a b. (a -> b) -> a -> b
$ 
    [GSDSub] -> GSDSec
GSDProg [
      [Contents] -> GSDSub
SysCntxt [CI -> Contents
sysCtxIntro CI
progName, LabelledContent -> Contents
LlC LabelledContent
sysCtxFig1, Contents
sysCtxDesc, CI -> Contents
sysCtxList CI
progName],
      [Contents] -> GSDSub
UsrChars [CI -> Contents
userCharacteristicsIntro CI
progName], 
      [Contents] -> [Section] -> GSDSub
SystCons [] []],                            
  SSDSec -> DocSection
SSDSec (SSDSec -> DocSection) -> SSDSec -> DocSection
forall a b. (a -> b) -> a -> b
$ 
    [SSDSub] -> SSDSec
SSDProg
      [ ProblemDescription -> SSDSub
SSDProblem (ProblemDescription -> SSDSub) -> ProblemDescription -> SSDSub
forall a b. (a -> b) -> a -> b
$ Sentence -> [Section] -> [PDSub] -> ProblemDescription
PDProg Sentence
purp []                -- This adds a is used to define the problem your system will solve
        [ Maybe Sentence -> [ConceptChunk] -> PDSub
forall c. Concept c => Maybe Sentence -> [c] -> PDSub
TermsAndDefs Maybe Sentence
forall a. Maybe a
Nothing [ConceptChunk]
terms               -- This is used to define the terms to be defined in terminology sub section
      , CI -> [Sentence] -> LabelledContent -> [Contents] -> PDSub
forall a.
Idea a =>
a -> [Sentence] -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
progName [Sentence]
physSystParts LabelledContent
figMotion [] -- This defines the Physicalsystem sub-section, define the parts
                                                          -- of the system using physSysParts, figMotion is a function in figures for the image
      , [Sentence] -> PDSub
Goals [Sentence]
goalsInputs] -- This adds a goals section and goals input is defined for the preample of the goal.
      , SolChSpec -> SSDSub
SSDSolChSpec (SolChSpec -> SSDSub) -> SolChSpec -> SSDSub
forall a b. (a -> b) -> a -> b
$ [SCSSub] -> SolChSpec
SCSProg --This creates the solution characteristics section with a preamble
        [ SCSSub
Assumptions
        , [Sentence] -> Fields -> SCSSub
TMs [] (Field
Label Field -> Fields -> Fields
forall a. a -> [a] -> [a]
: Fields
stdFields)
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
GDs [] ([Field
Label, Field
Units] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
DDs [] ([Field
Label, Field
Symbol, Field
Units] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , [Sentence] -> Fields -> DerivationDisplay -> SCSSub
IMs [] ([Field
Label, Field
Input, Field
Output, Field
InConstraints, Field
OutConstraints] Fields -> Fields -> Fields
forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation
        , Sentence -> [UncertQ] -> SCSSub
forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
EmptyS [UncertQ]
inConstraints
        , [UncertQ] -> [Contents] -> SCSSub
forall c.
(Quantity c, Constrained c) =>
[c] -> [Contents] -> SCSSub
CorrSolnPpties [UncertQ]
outConstraints []
       ]
     ],
  ReqrmntSec -> DocSection
ReqrmntSec (ReqrmntSec -> DocSection) -> ReqrmntSec -> DocSection
forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg
    [ Sentence -> [LabelledContent] -> ReqsSub
FReqsSub Sentence
EmptyS []
    , ReqsSub
NonFReqsSub
    ],
  TraceabilitySec -> DocSection
TraceabilitySec (TraceabilitySec -> DocSection) -> TraceabilitySec -> DocSection
forall a b. (a -> b) -> a -> b
$ [TraceConfig] -> TraceabilitySec
TraceabilityProg ([TraceConfig] -> TraceabilitySec)
-> [TraceConfig] -> TraceabilitySec
forall a b. (a -> b) -> a -> b
$ System -> [TraceConfig]
traceMatStandard System
si,
  AuxConstntSec -> DocSection
AuxConstntSec (AuxConstntSec -> DocSection) -> AuxConstntSec -> DocSection
forall a b. (a -> b) -> a -> b
$
     CI -> [ConstQDef] -> AuxConstntSec
AuxConsProg CI
progName [],  -- Adds Auxilliary constraint section
  DocSection
Bibliography                    -- Adds reference section
  ]

si :: System
si :: System
si = CI
-> SystemKind
-> People
-> [Sentence]
-> [Sentence]
-> [Sentence]
-> [Sentence]
-> [DefinedQuantityDict]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [DefinedQuantityDict]
-> [DefinedQuantityDict]
-> [UncertQ]
-> [ConstQDef]
-> ChunkDB
-> 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
-> [Sentence]
-> [Sentence]
-> [Sentence]
-> [Sentence]
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> System
mkSystem CI
progName SystemKind
Specification [Person
olu]
  [Sentence
purp] [] [] []
  [DefinedQuantityDict]
symbols
  [TheoryModel]
tMods [GenDefn]
genDefns [DataDefinition]
dataDefs [InstanceModel]
iMods
  []
  [DefinedQuantityDict]
inputs [DefinedQuantityDict]
outputs [UncertQ]
inConstraints []
  ChunkDB
symbMap

purp :: Sentence
purp :: Sentence
purp = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"predict the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.ofA` String -> Sentence
S String
"single", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
pendulum]

ideaDicts :: [IdeaDict]
ideaDicts :: [IdeaDict]
ideaDicts = 
  -- Actual IdeaDicts
  [IdeaDict]
concepts [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++
  -- CIs
  CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
progName IdeaDict -> [IdeaDict] -> [IdeaDict]
forall a. a -> [a] -> [a]
: (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
mathcon' [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
physicCon'

conceptChunks :: [ConceptChunk]
conceptChunks :: [ConceptChunk]
conceptChunks =
  -- ConceptChunks
  [ConceptChunk]
physicalcon [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++ [ConceptChunk
angular, ConceptChunk
displacement, ConceptChunk
iPos, ConceptChunk
pendulum, ConceptChunk
motion,
  ConceptChunk
gravitationalConst, ConceptChunk
gravity, ConceptChunk
rigidBody, ConceptChunk
weight, ConceptChunk
shm] [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++
  -- Unital Chunks
  [UnitalChunk -> ConceptChunk
forall c. Concept c => c -> ConceptChunk
cw UnitalChunk
len]

abbreviationsList :: [IdeaDict]
abbreviationsList :: [IdeaDict]
abbreviationsList =
  -- CIs
  CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
progName IdeaDict -> [IdeaDict] -> [IdeaDict]
forall a. a -> [a] -> [a]
: (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++
  -- QuantityDicts
  (DefinedQuantityDict -> IdeaDict)
-> [DefinedQuantityDict] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [DefinedQuantityDict]
symbols

symbMap :: ChunkDB
symbMap :: ChunkDB
symbMap = [DefinedQuantityDict]
-> [IdeaDict]
-> [ConceptChunk]
-> [UnitDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [LabelledContent]
-> [Reference]
-> [Citation]
-> ChunkDB
forall q c u.
(Quantity q, MayHaveUnit q, Concept q, Concept c, IsUnit u) =>
[q]
-> [IdeaDict]
-> [c]
-> [u]
-> [DataDefinition]
-> [InstanceModel]
-> [GenDefn]
-> [TheoryModel]
-> [ConceptInstance]
-> [LabelledContent]
-> [Reference]
-> [Citation]
-> ChunkDB
cdb ((InstanceModel -> DefinedQuantityDict)
-> [InstanceModel] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map (InstanceModel
-> Getting DefinedQuantityDict InstanceModel DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict InstanceModel DefinedQuantityDict
forall c. HasOutput c => Getter c DefinedQuantityDict
Getter InstanceModel DefinedQuantityDict
output) [InstanceModel]
iMods [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ [DefinedQuantityDict]
symbols) [IdeaDict]
ideaDicts [ConceptChunk]
conceptChunks
  ([] :: [UnitDefn]) [DataDefinition]
dataDefs [InstanceModel]
iMods [GenDefn]
genDefns [TheoryModel]
tMods [ConceptInstance]
concIns [] [Reference]
allRefs [Citation]
citations

-- | Holds all references and links used in the document.
allRefs :: [Reference]
allRefs :: [Reference]
allRefs = [Reference
externalLinkRef]

concIns :: [ConceptInstance]
concIns :: [ConceptInstance]
concIns = [ConceptInstance]
assumpSingle [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
goals [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
funcReqs [ConceptInstance] -> [ConceptInstance] -> [ConceptInstance]
forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
nonFuncReqs

------------------------------
-- Section : INTRODUCTION --
------------------------------

-------------------------------
-- 2.1 : Purpose of Document --
-------------------------------
-- Purpose of Document automatically generated in IPurpose

---------------------------------
-- 2.2 : Scope of Requirements --
---------------------------------

----------------------------------------------
-- 2.3 : Characteristics of Intended Reader --
----------------------------------------------

-------------------------------------
-- 2.4 : Organization of Documents --
-------------------------------------

-------------------------------------------
-- Section 3: GENERAL SYSTEM DESCRIPTION --
-------------------------------------------
-- Description of Genreal System automatically generated in GSDProg

--------------------------
-- 3.1 : System Context --
--------------------------

--------------------------------
-- 3.2 : User Characteristics --
--------------------------------

------------------------------
-- 3.3 : System Constraints --
------------------------------
-- System Constraints automatically generated in SystCons


--------------------------------------------
-- Section 4: Specific System Description --
--------------------------------------------
-- Description of Specific System automatically generated in SSDProg

------------------------------
-- 4.1 : System Constraints --
------------------------------

---------------------------------
-- 4.1.1 Terminology and Definitions --
---------------------------------

-----------------------------------
-- 4.1.2 Physical System Description --
-----------------------------------
physSystParts :: [Sentence]
physSystParts :: [Sentence]
physSystParts = (NP -> Sentence) -> [NP] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (Sentence -> Sentence
(!.) (Sentence -> Sentence) -> (NP -> Sentence) -> NP -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP) [IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
rod, ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
mass]

-----------------------------
-- 4.1.3 : Goal Statements --
-----------------------------

--------------------------------------------------
-- 4.2 : Solution Characteristics Specification --
--------------------------------------------------

-------------------------
-- 4.2.1 : Assumptions --
-------------------------
-- Assumptions defined in Assumptions

--------------------------------
-- 4.2.2 : Theoretical Models --
--------------------------------
-- Theoretical Models defined in TMs
tMods :: [TheoryModel]
tMods :: [TheoryModel]
tMods = [TheoryModel]
DPD.tMods [TheoryModel] -> [TheoryModel] -> [TheoryModel]
forall a. [a] -> [a] -> [a]
++ [TheoryModel
newtonSLR]

---------------------------------
-- 4.2.3 : General Definitions --
---------------------------------
-- General Definitions defined in GDs

------------------------------
-- 4.2.4 : Data Definitions --
------------------------------
-- Data Definitions defined in DDs

-----------------------------
-- 4.2.5 : Instance Models --
-----------------------------
-- Instance Models defined in IMs

-----------------------------
-- 4.2.6 : Data Constraints --
-----------------------------
-- Data Constraints defined in Constraints

-----------------------------
-- 4.2.7 : Properties of a Correct Solution --
-----------------------------
-- Properties of a Correct Solution defined in CorrSolnPpties

------------------------------
-- SECTION 5 : REQUIREMENTS --
------------------------------
-- in Requirements.hs

-----------------------------------
-- 5.1 : Functional Requirements --
-----------------------------------

--------------------------------------
-- 5.2 : Nonfunctional Requirements --
--------------------------------------

--------------------------------
-- SECTION 6 : LIKELY CHANGES --
--------------------------------

--------------------------------
-- SECTION 6b : UNLIKELY CHANGES --
--------------------------------

--------------------------------------------------
-- Section 7 : TRACEABILITY MATRICES AND GRAPHS --
--------------------------------------------------

------------------------------------------------
-- Section 8 : Specification Parameter Values --
------------------------------------------------

----------------------------
-- Section 9 : References --
----------------------------