module Database.Drasil.ChunkDB (
  cdb
) where

import Database.Drasil (ChunkDB (symbolTable, termTable, conceptChunkTable, _unitTable, _dataDefnTable,
  _insmodelTable, _gendefTable, _theoryModelTable, _conceptinsTable,
  _citationTable, _labelledcontentTable, _traceTable, _refbyTable, _refTable,
  CDB), idMap, symbolMap, termMap, conceptMap, unitMap, addCdb)
import Language.Drasil (IdeaDict, Quantity, MayHaveUnit, Concept, IsUnit,
  ConceptChunk, ConceptInstance, Citation, Reference, LabelledContent, nw, DefinedQuantityDict)
import Data.Drasil.Concepts.Documentation (doccon, doccon', srsDomains)
import Data.Drasil.Software.Products (prodtcon)
import Data.Drasil.Concepts.Education (educon)
import Data.Drasil.Concepts.Computation (compcon, algorithm)
import Data.Drasil.Concepts.Software (errMsg, program)
import Data.Drasil.Concepts.Math (mathcon)

import qualified Data.Map as Map (empty)
import Data.Drasil.SI_Units (siUnits)
import Theory.Drasil (DataDefinition, InstanceModel, TheoryModel, GenDefn)
import Language.Drasil.Code (codeDQDs)

basisSymbols :: [DefinedQuantityDict]
basisSymbols :: [DefinedQuantityDict]
basisSymbols =
  -- | DefinedQuantityDicts
  --  * codeDQDs - A list of DefinedQuantityDicts that are used for general
  --               code generation in all case studies
  [DefinedQuantityDict]
codeDQDs
-- | The basic idea dicts that are used to construct the basis chunk database.
-- Every chunk added here is added to every new chunk database created that uses
--  the cdb constructor. This ensures that the information in these idea dicts
--  is always available in the chunk database.
basisIdeaDicts :: [IdeaDict]
basisIdeaDicts :: [IdeaDict]
basisIdeaDicts =
  -- | Actual IdeaDicts
  --  * doccon - General documentation related IdeaDicts. Included in the basis
  --             as it is data which all the cases studies use and is not specific
  --             to a particular case study.
  --  * prodtcon - A list of a few IdeaDicts that are terms related to software products.
  --              This is included in the basis as it can be used to describe
  --              any software, which each of the case study examples produce.
  --              For example, one of the chunks, `sciCompS`, can be used to describe
  --              all of the software that Drasil generates, since it is all scientific
  --              computing software.
  --  * educon - IdeaDict chunks with information about education. Included in the basis
  --            as each case study should provide information about the expected users,
  --            which usually means describing the expected education level in related
  --            fields.
  --  * compcon - Computing related IdeaDicts. Since all of the case studies are
  --              concerned with software, this is included in the basis as the
  --              computing chunks are relevant to all of them.
  [IdeaDict]
doccon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [IdeaDict]
prodtcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [IdeaDict]
educon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ [IdeaDict]
compcon [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++
  -- CIs
  --  * doccon' - A list of CommonIdeas that are added for the same purpose as `doccon`.
  (CI -> IdeaDict) -> [CI] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [CI]
doccon'

basisConceptChunks :: [ConceptChunk]
basisConceptChunks :: [ConceptChunk]
basisConceptChunks =
  -- | ConceptChunks
  --  * algorithm - A concept chunk that describes algorithms. This is included in the
  --                basis as algorithms are a commonly used concept in the case studies.
  --                but did not fit into the other lists
  --  * errMsg - Concept chunk defining an error message. Error messages are common in
  --             any software, so this is included in the basis.
  --  * program - A concept chunk defining a computer program. This is included 
  --              in the basis as all of the case studies are concerned with software.
  --  * srsDomains - SRS related concepts. These are included in the basis as every
  --                 case study should have a generated SRS, and these concepts would
  --                 be needed for that.
  --  * mathcon - Math concepts. Math is widespread throughout all of the case studies
  --              and scientific computing software in general, so it is included
  --              in the basis.
  [ConceptChunk
algorithm, ConceptChunk
errMsg, ConceptChunk
program] [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
srsDomains [ConceptChunk] -> [ConceptChunk] -> [ConceptChunk]
forall a. [a] -> [a] -> [a]
++ [ConceptChunk]
mathcon

-- | The basis chunk database, which contains the basic idea dicts, concept chunks,
--  and units that are used in all of the case studies. This database is then added
-- to all of the new chunk databases created using the cdb constructor.
basisCDB :: ChunkDB
basisCDB :: ChunkDB
basisCDB =
  CDB {
    -- CHUNKS
    symbolTable :: SymbolMap
symbolTable           = [DefinedQuantityDict] -> SymbolMap
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
[c] -> SymbolMap
symbolMap [DefinedQuantityDict]
basisSymbols,
    termTable :: TermMap
termTable             = [IdeaDict] -> TermMap
forall c. Idea c => [c] -> TermMap
termMap [IdeaDict]
basisIdeaDicts,
    conceptChunkTable :: ConceptMap
conceptChunkTable     = [ConceptChunk] -> ConceptMap
forall c. Concept c => [c] -> ConceptMap
conceptMap [ConceptChunk]
basisConceptChunks,
    _unitTable :: UnitMap
_unitTable            = [UnitDefn] -> UnitMap
forall u. IsUnit u => [u] -> UnitMap
unitMap [UnitDefn]
siUnits, -- SI units are important to all case studies since they rely on physical quantities
    _dataDefnTable :: DatadefnMap
_dataDefnTable        = DatadefnMap
forall k a. Map k a
Map.empty,
    _insmodelTable :: InsModelMap
_insmodelTable        = InsModelMap
forall k a. Map k a
Map.empty,
    _gendefTable :: GendefMap
_gendefTable          = GendefMap
forall k a. Map k a
Map.empty,
    _theoryModelTable :: TheoryModelMap
_theoryModelTable     = TheoryModelMap
forall k a. Map k a
Map.empty,
    _conceptinsTable :: ConceptInstanceMap
_conceptinsTable      = ConceptInstanceMap
forall k a. Map k a
Map.empty,
    _citationTable :: CitationMap
_citationTable        = CitationMap
forall k a. Map k a
Map.empty, 
    -- NOT CHUNKS
    _labelledcontentTable :: LabelledContentMap
_labelledcontentTable = LabelledContentMap
forall k a. Map k a
Map.empty,
    _traceTable :: TraceMap
_traceTable           = TraceMap
forall k a. Map k a
Map.empty,
    _refbyTable :: TraceMap
_refbyTable           = TraceMap
forall k a. Map k a
Map.empty,
    _refTable :: ReferenceMap
_refTable             = ReferenceMap
forall k a. Map k a
Map.empty
  }

  -- | Smart constructor for chunk databases. Takes in the following:
--
--     * ['Quantity'] (for 'SymbolMap'), 
--     * 'NamedIdea's (for 'TermMap'),
--     * 'Concept's (for 'ConceptMap'),
--     * Units (something that 'IsUnit' for 'UnitMap'),
--     * 'DataDefinition's (for 'DatadefnMap'),
--     * 'InstanceModel's (for 'InsModelMap'),
--     * 'GenDefn's (for 'GendefMap'),
--     * 'TheoryModel's (for 'TheoryModelMap'),
--     * 'ConceptInstance's (for 'ConceptInstanceMap'),
--     * 'LabelledContent's (for 'LabelledContentMap').
-- Creates a ChunkDB with basic data already included. Should be used over
-- cdb' in Database.Drasil, which does not include the basic data.
cdb :: (Quantity q, MayHaveUnit q, Concept q, Concept c, IsUnit u) =>
    [q] -> [IdeaDict] -> [c] -> [u] -> [DataDefinition] -> [InstanceModel] ->
    [GenDefn] -> [TheoryModel] -> [ConceptInstance] ->
    [LabelledContent] -> [Reference] -> [Citation] -> ChunkDB
cdb :: 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 [q]
s [IdeaDict]
t [c]
c [u]
u [DataDefinition]
d [InstanceModel]
ins [GenDefn]
gd [TheoryModel]
tm [ConceptInstance]
ci [LabelledContent]
lc [Reference]
r [Citation]
cits =
  CDB {
    -- CHUNKS
    symbolTable :: SymbolMap
symbolTable = [q] -> SymbolMap
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
[c] -> SymbolMap
symbolMap [q]
s,
    termTable :: TermMap
termTable = [IdeaDict] -> TermMap
forall c. Idea c => [c] -> TermMap
termMap [IdeaDict]
t,
    conceptChunkTable :: ConceptMap
conceptChunkTable = [c] -> ConceptMap
forall c. Concept c => [c] -> ConceptMap
conceptMap [c]
c,
    _unitTable :: UnitMap
_unitTable = [u] -> UnitMap
forall u. IsUnit u => [u] -> UnitMap
unitMap [u]
u,
    _dataDefnTable :: DatadefnMap
_dataDefnTable = String -> [DataDefinition] -> DatadefnMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"DataDefnMap" [DataDefinition]
d,
    _insmodelTable :: InsModelMap
_insmodelTable = String -> [InstanceModel] -> InsModelMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"InsModelMap" [InstanceModel]
ins,
    _gendefTable :: GendefMap
_gendefTable = String -> [GenDefn] -> GendefMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"GenDefnmap" [GenDefn]
gd,
    _theoryModelTable :: TheoryModelMap
_theoryModelTable = String -> [TheoryModel] -> TheoryModelMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"TheoryModelMap" [TheoryModel]
tm,
    _conceptinsTable :: ConceptInstanceMap
_conceptinsTable = String -> [ConceptInstance] -> ConceptInstanceMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"ConcInsMap" [ConceptInstance]
ci,
    _citationTable :: CitationMap
_citationTable = String -> [Citation] -> CitationMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"CiteMap" [Citation]
cits,
    -- NOT CHUNKS
    _labelledcontentTable :: LabelledContentMap
_labelledcontentTable = String -> [LabelledContent] -> LabelledContentMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"LLCMap" [LabelledContent]
lc,
    _traceTable :: TraceMap
_traceTable = TraceMap
forall k a. Map k a
Map.empty,
    _refbyTable :: TraceMap
_refbyTable = TraceMap
forall k a. Map k a
Map.empty,
    _refTable :: ReferenceMap
_refTable = String -> [Reference] -> ReferenceMap
forall a. HasUID a => String -> [a] -> Map UID (a, Int)
idMap String
"RefMap" [Reference]
r
  } ChunkDB -> ChunkDB -> ChunkDB
`addCdb` ChunkDB
basisCDB