module Drasil.PDController.Body (pidODEInfo, printSetting, si, srs, fullSI) where

import Language.Drasil
import Drasil.SRSDocument
import qualified Drasil.DocLang.SRS as SRS (inModel)
import Theory.Drasil (DataDefinition, GenDefn, InstanceModel, TheoryModel)
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (doccon, doccon', srsDomains)
import qualified Data.Drasil.Concepts.Documentation as Doc (srs)
import Data.Drasil.Concepts.Math (mathcon, mathcon', ode)
import Data.Drasil.Concepts.Software (program)
import Data.Drasil.Software.Products (sciCompS)
import Data.Drasil.ExternalLibraries.ODELibraries
       (apacheODESymbols, arrayVecDepVar, odeintSymbols, osloSymbols,
        scipyODESymbols)
import qualified Data.Drasil.TheoryConcepts as IDict (dataDefn)
import Data.Drasil.Quantities.Physics (physicscon)
import Data.Drasil.Concepts.PhysicalProperties (physicalcon)
import Data.Drasil.Concepts.Physics (angular, linear) -- FIXME: should not be needed?
import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.SI_Units (second, kilogram)
import Data.Drasil.Quantities.Math (posInf, negInf)

import Drasil.PDController.Assumptions (assumptions)
import Drasil.PDController.Changes (likelyChgs)
import Drasil.PDController.Concepts (acronyms, pdControllerApp,
  pidC, concepts, defs)
import Drasil.PDController.DataDefs (dataDefinitions)
import Drasil.PDController.GenDefs (genDefns)
import Drasil.PDController.GenSysDesc
       (gsdSysContextFig, gsdSysContextList, gsdSysContextP1, gsdSysContextP2,
        gsduserCharacteristics)
import Drasil.PDController.IModel (instanceModels, imPD)
import Drasil.PDController.IntroSection (introPara, introPurposeOfDoc,
       introUserChar1, introUserChar2, introscopeOfReq)
import Drasil.PDController.References (citations)
import Drasil.PDController.Requirements (funcReqs, nonfuncReqs)
import Drasil.PDController.SpSysDesc (goals, sysFigure, sysGoalInput, sysParts)
import Drasil.PDController.TModel (theoreticalModels)
import Drasil.PDController.Unitals (symbols, inputs, outputs, inputsUC,
  inpConstrained, pidConstants, pidDqdConstants, opProcessVariable)
import Drasil.PDController.ODEs (pidODEInfo)
import Language.Drasil.Code (quantvar)

naveen :: Person
naveen :: Person
naveen = String -> String -> Person
person String
"Naveen Ganesh" String
"Muralidharan"

srs :: Document
srs :: Document
srs = SRSDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> SystemInformation
-> Document
mkDoc SRSDecl
mkSRS (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

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

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

mkSRS :: SRSDecl
mkSRS :: SRSDecl
mkSRS
  = [DocSection
TableOfContents,
    RefSec -> DocSection
RefSec forall a b. (a -> b) -> a -> b
$ Contents -> [RefTab] -> RefSec
RefProg Contents
intro [RefTab
TUnits, [TSIntro] -> RefTab
tsymb [TSIntro
TSPurpose, TSIntro
SymbOrder], RefTab
TAandA],
     IntroSec -> DocSection
IntroSec forall a b. (a -> b) -> a -> b
$
       Sentence -> Sentence -> [IntroSub] -> IntroSec
IntroProg Sentence
introPara (forall n. NamedIdea n => n -> Sentence
phrase CI
pdControllerApp)
         [[Sentence] -> IntroSub
IPurpose [Sentence
introPurposeOfDoc], Sentence -> IntroSub
IScope Sentence
introscopeOfReq,
          [Sentence] -> [Sentence] -> [Sentence] -> IntroSub
IChar [Sentence]
introUserChar1 [Sentence]
introUserChar2 [],
          CI -> Section -> Sentence -> IntroSub
IOrgSec CI
IDict.dataDefn ([Contents] -> [Section] -> Section
SRS.inModel [] [])
            (String -> Sentence
S String
"The instance model referred as" Sentence -> Sentence -> Sentence
+:+ forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
imPD Sentence -> Sentence -> Sentence
+:+
               String -> Sentence
S String
"provides an"
               Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
titleize CI
ode Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall c. Idea c => c -> Sentence
short CI
ode)
               Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"that models the"
               Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
pidC)],
     GSDSec -> DocSection
GSDSec forall a b. (a -> b) -> a -> b
$
       [GSDSub] -> GSDSec
GSDProg
         [[Contents] -> GSDSub
SysCntxt
            [Contents
gsdSysContextP1, LabelledContent -> Contents
LlC LabelledContent
gsdSysContextFig, Contents
gsdSysContextP2,
             Contents
gsdSysContextList],
          [Contents] -> GSDSub
UsrChars [Contents
gsduserCharacteristics], [Contents] -> [Section] -> GSDSub
SystCons [] []],
     SSDSec -> DocSection
SSDSec forall a b. (a -> b) -> a -> b
$
       [SSDSub] -> SSDSec
SSDProg
         [ProblemDescription -> SSDSub
SSDProblem forall a b. (a -> b) -> a -> b
$
            Sentence -> [Section] -> [PDSub] -> ProblemDescription
PDProg Sentence
purp []
              [forall c. Concept c => Maybe Sentence -> [c] -> PDSub
TermsAndDefs forall a. Maybe a
Nothing [ConceptChunk]
defs,
               forall a.
Idea a =>
a -> [Sentence] -> LabelledContent -> [Contents] -> PDSub
PhySysDesc CI
pdControllerApp [Sentence]
sysParts LabelledContent
sysFigure [],
               [Sentence] -> PDSub
Goals [Sentence]
sysGoalInput],
          SolChSpec -> SSDSub
SSDSolChSpec forall a b. (a -> b) -> a -> b
$
            [SCSSub] -> SolChSpec
SCSProg
              [SCSSub
Assumptions, [Sentence] -> Fields -> SCSSub
TMs [] (Field
Label forall a. a -> [a] -> [a]
: Fields
stdFields),
               [Sentence] -> Fields -> DerivationDisplay -> SCSSub
GDs [] (Field
Label forall a. a -> [a] -> [a]
: Fields
stdFields) DerivationDisplay
HideDerivation,
               [Sentence] -> Fields -> DerivationDisplay -> SCSSub
DDs [] ([Field
Label, Field
Symbol, Field
Units] forall a. [a] -> [a] -> [a]
++ Fields
stdFields) DerivationDisplay
ShowDerivation,
               [Sentence] -> Fields -> DerivationDisplay -> SCSSub
IMs []
                 ([Field
Label, Field
Input, Field
Output, Field
InConstraints, Field
OutConstraints] forall a. [a] -> [a] -> [a]
++
                    Fields
stdFields)
                 DerivationDisplay
ShowDerivation,
               forall c.
(HasUncertainty c, Quantity c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
Sentence -> [c] -> SCSSub
Constraints Sentence
EmptyS [UncertQ]
inputsUC]],

     ReqrmntSec -> DocSection
ReqrmntSec forall a b. (a -> b) -> a -> b
$ [ReqsSub] -> ReqrmntSec
ReqsProg [Sentence -> [LabelledContent] -> ReqsSub
FReqsSub Sentence
EmptyS [], ReqsSub
NonFReqsSub], DocSection
LCsSec,
     TraceabilitySec -> DocSection
TraceabilitySec forall a b. (a -> b) -> a -> b
$ [TraceConfig] -> TraceabilitySec
TraceabilityProg forall a b. (a -> b) -> a -> b
$ SystemInformation -> [TraceConfig]
traceMatStandard SystemInformation
si, DocSection
Bibliography]

si :: SystemInformation
si :: SystemInformation
si = SI {
  _sys :: CI
_sys = CI
pdControllerApp,
  _kind :: CI
_kind = CI
Doc.srs,
  _authors :: [Person]
_authors = [Person
naveen],
  _purpose :: [Sentence]
_purpose = [Sentence
purp],
  _background :: [Sentence]
_background  = [],
  _quants :: [QuantityDict]
_quants = [QuantityDict]
symbolsAll,
  _concepts :: [DefinedQuantityDict]
_concepts = [] :: [DefinedQuantityDict],
  _datadefs :: [DataDefinition]
_datadefs = [DataDefinition]
dataDefinitions,
  _instModels :: [InstanceModel]
_instModels = [InstanceModel]
instanceModels,
  _configFiles :: [String]
_configFiles = [],
  _inputs :: [QuantityDict]
_inputs = [QuantityDict]
inputs,
  _outputs :: [QuantityDict]
_outputs = [QuantityDict]
outputs,
  _defSequence :: [Block SimpleQDef]
_defSequence = [] :: [Block SimpleQDef],
  _constraints :: [ConstrainedChunk]
_constraints = forall a b. (a -> b) -> [a] -> [b]
map forall c.
(Quantity c, Constrained c, HasReasVal c, MayHaveUnit c) =>
c -> ConstrainedChunk
cnstrw [ConstrConcept]
inpConstrained,
  _constants :: [ConstQDef]
_constants = [ConstQDef]
pidConstants,
  _sysinfodb :: ChunkDB
_sysinfodb = ChunkDB
symbMap,
  _usedinfodb :: ChunkDB
_usedinfodb = ChunkDB
usedDB,
   refdb :: ReferenceDB
refdb = ReferenceDB
refDB}

purp :: Sentence
purp :: Sentence
purp = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"provide a model of a", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
pidC,
         String -> Sentence
S String
"that can be used for the tuning of the gain constants before",
         String -> Sentence
S String
"the deployment of the controller"]

symbolsAll :: [QuantityDict]
symbolsAll :: [QuantityDict]
symbolsAll = [QuantityDict]
symbols forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
pidDqdConstants forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstQDef]
pidConstants
  forall a. [a] -> [a] -> [a]
++ [QuantityDict]
scipyODESymbols forall a. [a] -> [a] -> [a]
++ [QuantityDict]
osloSymbols forall a. [a] -> [a] -> [a]
++ [QuantityDict]
apacheODESymbols forall a. [a] -> [a] -> [a]
++ [QuantityDict]
odeintSymbols 
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeVarChunk -> CodeVarChunk
listToArray forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar ConstrConcept
opProcessVariable, ODEInfo -> CodeVarChunk
arrayVecDepVar ODEInfo
pidODEInfo]

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]
symbolsAll forall a. [a] -> [a] -> [a]
++ [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
posInf, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
negInf])
  (forall c. Idea c => c -> IdeaDict
nw CI
pdControllerApp forall a. a -> [a] -> [a]
: [forall c. Idea c => c -> IdeaDict
nw ConceptChunk
program, forall c. Idea c => c -> IdeaDict
nw ConceptChunk
angular, forall c. Idea c => c -> IdeaDict
nw ConceptChunk
linear] forall a. [a] -> [a] -> [a]
++ [forall c. Idea c => c -> IdeaDict
nw IdeaDict
sciCompS]
  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]
++ [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 [CI]
mathcon' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitDefn
second, UnitDefn
kilogram] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
symbols 
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [UnitalChunk]
physicscon forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [CI]
acronyms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
physicalcon)
  (forall a b. (a -> b) -> [a] -> [b]
map forall c. Concept c => c -> ConceptChunk
cw [ConstrConcept]
inpConstrained forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
srsDomains)
  (forall a b. (a -> b) -> [a] -> [b]
map forall u. IsUnit u => u -> UnitDefn
unitWrapper [UnitDefn
second, UnitDefn
kilogram])
  [DataDefinition]
dataDefinitions
  [InstanceModel]
instanceModels
  [GenDefn]
genDefns
  [TheoryModel]
theoreticalModels
  [ConceptInstance]
conceptInstances
  ([] :: [Section])
  ([] :: [LabelledContent])
  ([] :: [Reference])

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 [CI]
acronyms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. Idea c => c -> IdeaDict
nw [QuantityDict]
symbolsAll)
  ([] :: [ConceptChunk])
  ([] :: [UnitDefn])
  ([] :: [DataDefinition])
  ([] :: [InstanceModel])
  ([] :: [GenDefn])
  ([] :: [TheoryModel])
  ([] :: [ConceptInstance])
  ([] :: [Section])
  ([] :: [LabelledContent])
  ([] :: [Reference])

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

conceptInstances :: [ConceptInstance]
conceptInstances :: [ConceptInstance]
conceptInstances = [ConceptInstance]
assumptions forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
goals forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
funcReqs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
nonfuncReqs forall a. [a] -> [a] -> [a]
++ [ConceptInstance]
likelyChgs

stdFields :: Fields
stdFields :: Fields
stdFields
  = [Field
DefiningEquation, Verbosity -> InclUnits -> Field
Description Verbosity
Verbose InclUnits
IncludeUnits, Field
Notes, Field
Source, Field
RefBy]