-- | Utilities to get grab certain chunks (from 'Expr', 'Sentence', etc) by 'UID' and
-- dereference the chunk it refers to.
module SysInfo.Drasil.GetChunk (ccss, ccss', combine, vars, citeDB) where

import Language.Drasil
import Language.Drasil.Development
import Language.Drasil.ModelExpr.Development (meDep)

import Database.Drasil (ChunkDB, defResolve, symbResolve, citationTable)

import SysInfo.Drasil.SystemInformation (SystemInformation, sysinfodb)

import Control.Lens ((^.))
import Data.List (nub, sortBy)
import qualified Data.Map as M

-- | Gets a list of quantities ('QuantityDict') from an equation in order to print.
vars :: ModelExpr -> ChunkDB -> [QuantityDict]
vars :: ModelExpr -> ChunkDB -> [QuantityDict]
vars ModelExpr
e ChunkDB
m = (UID -> QuantityDict) -> [UID] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> UID -> QuantityDict
symbResolve ChunkDB
m) ([UID] -> [QuantityDict]) -> [UID] -> [QuantityDict]
forall a b. (a -> b) -> a -> b
$ ModelExpr -> [UID]
meDep ModelExpr
e

-- | Gets a list of quantities ('QuantityDict') from a 'Sentence' in order to print.
vars' :: Sentence -> ChunkDB -> [QuantityDict]
vars' :: Sentence -> ChunkDB -> [QuantityDict]
vars' Sentence
a ChunkDB
m = (UID -> QuantityDict) -> [UID] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> UID -> QuantityDict
symbResolve ChunkDB
m) ([UID] -> [QuantityDict]) -> [UID] -> [QuantityDict]
forall a b. (a -> b) -> a -> b
$ Sentence -> [UID]
sdep Sentence
a

-- | Combines the functions of 'vars' and 'concpt' to create a list of 'DefinedQuantityDict's from a 'Sentence'.
combine :: Sentence -> ChunkDB -> [DefinedQuantityDict]
combine :: Sentence -> ChunkDB -> [DefinedQuantityDict]
combine Sentence
a ChunkDB
m = (QuantityDict -> ConceptChunk -> DefinedQuantityDict)
-> [QuantityDict] -> [ConceptChunk] -> [DefinedQuantityDict]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith QuantityDict -> ConceptChunk -> DefinedQuantityDict
forall c.
(Quantity c, MayHaveUnit c) =>
c -> ConceptChunk -> DefinedQuantityDict
dqdQd (Sentence -> ChunkDB -> [QuantityDict]
vars' Sentence
a ChunkDB
m) (Sentence -> ChunkDB -> [ConceptChunk]
concpt Sentence
a ChunkDB
m)

-- | Combines the functions of 'vars' and 'concpt' to create a list of 'DefinedQuantityDict's from an equation.
combine' :: ModelExpr -> ChunkDB -> [DefinedQuantityDict]
combine' :: ModelExpr -> ChunkDB -> [DefinedQuantityDict]
combine' ModelExpr
a ChunkDB
m = (QuantityDict -> ConceptChunk -> DefinedQuantityDict)
-> [QuantityDict] -> [ConceptChunk] -> [DefinedQuantityDict]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith QuantityDict -> ConceptChunk -> DefinedQuantityDict
forall c.
(Quantity c, MayHaveUnit c) =>
c -> ConceptChunk -> DefinedQuantityDict
dqdQd (ModelExpr -> ChunkDB -> [QuantityDict]
vars ModelExpr
a ChunkDB
m) (ModelExpr -> ChunkDB -> [ConceptChunk]
concpt' ModelExpr
a ChunkDB
m)

-- | Gets a list of defined quantities ('DefinedQuantityDict's) from 'Sentence's and expressions that are contained in the database ('ChunkDB').
ccss :: [Sentence] -> [ModelExpr] -> ChunkDB -> [DefinedQuantityDict]
ccss :: [Sentence] -> [ModelExpr] -> ChunkDB -> [DefinedQuantityDict]
ccss [Sentence]
s [ModelExpr]
e ChunkDB
c = [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. Eq a => [a] -> [a]
nub ([DefinedQuantityDict] -> [DefinedQuantityDict])
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a b. (a -> b) -> a -> b
$ (Sentence -> [DefinedQuantityDict])
-> [Sentence] -> [DefinedQuantityDict]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Sentence -> ChunkDB -> [DefinedQuantityDict]
`combine` ChunkDB
c) [Sentence]
s [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (ModelExpr -> [DefinedQuantityDict])
-> [ModelExpr] -> [DefinedQuantityDict]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> ChunkDB -> [DefinedQuantityDict]
`combine'` ChunkDB
c) [ModelExpr]
e

-- | Gets a list of quantities ('QuantityDict's) from 'Sentence's and expressions that are contained in the database ('ChunkDB').
ccss' :: [Sentence] -> [ModelExpr] -> ChunkDB -> [QuantityDict]
ccss' :: [Sentence] -> [ModelExpr] -> ChunkDB -> [QuantityDict]
ccss' [Sentence]
s [ModelExpr]
e ChunkDB
c = [QuantityDict] -> [QuantityDict]
forall a. Eq a => [a] -> [a]
nub ([QuantityDict] -> [QuantityDict])
-> [QuantityDict] -> [QuantityDict]
forall a b. (a -> b) -> a -> b
$ (Sentence -> [QuantityDict]) -> [Sentence] -> [QuantityDict]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Sentence -> ChunkDB -> [QuantityDict]
`vars'` ChunkDB
c) [Sentence]
s [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (ModelExpr -> [QuantityDict]) -> [ModelExpr] -> [QuantityDict]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> ChunkDB -> [QuantityDict]
`vars` ChunkDB
c) [ModelExpr]
e

-- | Gets a list of concepts ('ConceptChunk') from a 'Sentence' in order to print.
concpt :: Sentence -> ChunkDB -> [ConceptChunk]
concpt :: Sentence -> ChunkDB -> [ConceptChunk]
concpt Sentence
a ChunkDB
m = (UID -> ConceptChunk) -> [UID] -> [ConceptChunk]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> UID -> ConceptChunk
defResolve ChunkDB
m) ([UID] -> [ConceptChunk]) -> [UID] -> [ConceptChunk]
forall a b. (a -> b) -> a -> b
$ Sentence -> [UID]
sdep Sentence
a

-- | Gets a list of concepts ('ConceptChunk') from an expression in order to print.
concpt' :: ModelExpr -> ChunkDB -> [ConceptChunk]
concpt' :: ModelExpr -> ChunkDB -> [ConceptChunk]
concpt' ModelExpr
a ChunkDB
m = (UID -> ConceptChunk) -> [UID] -> [ConceptChunk]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> UID -> ConceptChunk
defResolve ChunkDB
m) ([UID] -> [ConceptChunk]) -> [UID] -> [ConceptChunk]
forall a b. (a -> b) -> a -> b
$ ModelExpr -> [UID]
meDep ModelExpr
a

-- | Helper for extracting a bibliography from the system information.
citeDB :: SystemInformation -> BibRef
citeDB :: SystemInformation -> BibRef
citeDB SystemInformation
si = (Citation -> Citation -> Ordering) -> BibRef -> BibRef
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Citation -> Citation -> Ordering
forall c. HasFields c => c -> c -> Ordering
compareAuthYearTitle (BibRef -> BibRef) -> BibRef -> BibRef
forall a b. (a -> b) -> a -> b
$ ((Citation, Int) -> Citation) -> [(Citation, Int)] -> BibRef
forall a b. (a -> b) -> [a] -> [b]
map (Citation, Int) -> Citation
forall a b. (a, b) -> a
fst ([(Citation, Int)] -> BibRef) -> [(Citation, Int)] -> BibRef
forall a b. (a -> b) -> a -> b
$ Map UID (Citation, Int) -> [(Citation, Int)]
forall k a. Map k a -> [a]
M.elems (Map UID (Citation, Int) -> [(Citation, Int)])
-> Map UID (Citation, Int) -> [(Citation, Int)]
forall a b. (a -> b) -> a -> b
$ SystemInformation
si SystemInformation
-> Getting
     (Map UID (Citation, Int))
     SystemInformation
     (Map UID (Citation, Int))
-> Map UID (Citation, Int)
forall s a. s -> Getting a s a -> a
^. ((ChunkDB -> Const (Map UID (Citation, Int)) ChunkDB)
-> SystemInformation
-> Const (Map UID (Citation, Int)) SystemInformation
forall c. HasSystemInformation c => Lens' c ChunkDB
Lens' SystemInformation ChunkDB
sysinfodb ((ChunkDB -> Const (Map UID (Citation, Int)) ChunkDB)
 -> SystemInformation
 -> Const (Map UID (Citation, Int)) SystemInformation)
-> ((Map UID (Citation, Int)
     -> Const (Map UID (Citation, Int)) (Map UID (Citation, Int)))
    -> ChunkDB -> Const (Map UID (Citation, Int)) ChunkDB)
-> Getting
     (Map UID (Citation, Int))
     SystemInformation
     (Map UID (Citation, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map UID (Citation, Int)
 -> Const (Map UID (Citation, Int)) (Map UID (Citation, Int)))
-> ChunkDB -> Const (Map UID (Citation, Int)) ChunkDB
Lens' ChunkDB (Map UID (Citation, Int))
citationTable)