{-# Language GADTs #-}
-- | Defines helper functions for creating subsections within the Solution Characteristics Specification.
-- Namely, for theory models, general definitions, data definitions, and instance models.
module Drasil.DocumentLanguage.Definitions (
  -- * Types
  Field(..), Fields, InclUnits(..), Verbosity(..),
  -- * Constructors
  ddefn, derivation, gdefn,
  instanceModel, tmodel,
  -- * Helpers
  helperRefs, helpToRefField) where

import Data.Map (lookupIndex)
import Data.List (nub)
import Data.Maybe (mapMaybe)
import Control.Lens ((^.))

import Language.Drasil
import Database.Drasil
import SysInfo.Drasil
import Theory.Drasil (DataDefinition, GenDefn, InstanceModel, Theory(..),
  TheoryModel, HasInputs(inputs), HasOutput(output, out_constraints), qdFromDD)

import Drasil.DocumentLanguage.Units (toSentenceUnitless)

-- | Synonym for a list of 'Field's.
type Fields = [Field]

-- | Fields that should be displayed in definitions.
data Field = Label
           | Symbol
           | Units
           | DefiningEquation
           | Description Verbosity InclUnits
           | Input
           | Output
           | InConstraints
           | OutConstraints
           | Notes
           | Source --  I think using attribute makes most sense, as sources can and
              -- will be modified across applications; the underlying knowledge won't.
           | RefBy --TODO: Fill in the field.

-- | Refers to the verbosity of statements.
data Verbosity = Verbose  -- ^ Full Descriptions.
               | Succinct -- ^ Simple Description (do not redefine other symbols).

-- | Determines whether to include or ignore units.
data InclUnits = IncludeUnits -- ^ In description field (for other symbols).
               | IgnoreUnits

-- | Create a theoretical model using a list of fields to be displayed, a database of symbols,
-- and a 'RelationConcept' (called automatically by 'SCSSub' program).
tmodel :: Fields -> SystemInformation -> TheoryModel -> LabelledContent
tmodel :: Fields -> SystemInformation -> TheoryModel -> LabelledContent
tmodel Fields
fs SystemInformation
m TheoryModel
t = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Theory (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TheoryModel
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkTMField TheoryModel
t SystemInformation
m) [] Fields
fs)) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref TheoryModel
t)

-- | Create a data definition using a list of fields, a database of symbols, and a
-- 'QDefinition' (called automatically by 'SCSSub' program).
ddefn :: Fields -> SystemInformation -> DataDefinition -> LabelledContent
ddefn :: Fields -> SystemInformation -> DataDefinition -> LabelledContent
ddefn Fields
fs SystemInformation
m DataDefinition
d = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Data (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DataDefinition
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkDDField DataDefinition
d SystemInformation
m) [] Fields
fs)) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref DataDefinition
d)

-- | Create a general definition using a list of fields, database of symbols,
-- and a 'GenDefn' (general definition) chunk (called automatically by 'SCSSub'
-- program).
gdefn :: Fields -> SystemInformation -> GenDefn -> LabelledContent
gdefn :: Fields -> SystemInformation -> GenDefn -> LabelledContent
gdefn Fields
fs SystemInformation
m GenDefn
g = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
General (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GenDefn
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkGDField GenDefn
g SystemInformation
m) [] Fields
fs)) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref GenDefn
g)

-- | Create an instance model using a list of fields, database of symbols,
-- and an 'InstanceModel' chunk (called automatically by 'SCSSub' program).
instanceModel :: Fields -> SystemInformation -> InstanceModel -> LabelledContent
instanceModel :: Fields -> SystemInformation -> InstanceModel -> LabelledContent
instanceModel Fields
fs SystemInformation
m InstanceModel
i = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Instance (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (InstanceModel
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkIMField InstanceModel
i SystemInformation
m) [] Fields
fs)) (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref InstanceModel
i)

-- | Create a derivation from a chunk's attributes. This follows the TM, DD, GD,
-- or IM definition automatically (called automatically by 'SCSSub' program).
derivation :: (MayHaveDerivation c, HasShortName c, Referable c) => c -> Maybe Contents
derivation :: forall c.
(MayHaveDerivation c, HasShortName c, Referable c) =>
c -> Maybe Contents
derivation c
c = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(Derivation Sentence
h [Sentence]
d) -> LabelledContent -> Contents
LlC forall a b. (a -> b) -> a -> b
$ Reference -> RawContent -> LabelledContent
llcc (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref c
c) forall a b. (a -> b) -> a -> b
$ Sentence -> [RawContent] -> RawContent
DerivBlock Sentence
h forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Sentence -> RawContent
makeDerivCons [Sentence]
d) forall a b. (a -> b) -> a -> b
$
  c
c forall s a. s -> Getting a s a -> a
^. forall c. MayHaveDerivation c => Lens' c (Maybe Derivation)
derivations

-- | Helper function for creating the layout objects
-- (paragraphs and equation blocks) for a derivation.
makeDerivCons :: Sentence -> RawContent
makeDerivCons :: Sentence -> RawContent
makeDerivCons (E ModelExpr
e) = ModelExpr -> RawContent
EqnBlock ModelExpr
e
makeDerivCons Sentence
s     = Sentence -> RawContent
Paragraph Sentence
s

-- | Synonym for easy reading. Model rows are just 'String',['Contents'] pairs.
type ModRow = [(String, [Contents])]

-- | Similar to 'maybe' but for lists.
nonEmpty :: b -> ([a] -> b) -> [a] -> b
nonEmpty :: forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty b
def [a] -> b
_ [] = b
def
nonEmpty b
_   [a] -> b
f [a]
xs = [a] -> b
f [a]
xs

tmDispExprs :: TheoryModel -> [ModelExpr]
tmDispExprs :: TheoryModel -> [ModelExpr]
tmDispExprs TheoryModel
t = forall a b. (a -> b) -> [a] -> [b]
map forall c. Express c => c -> ModelExpr
express (TheoryModel
t forall s a. s -> Getting a s a -> a
^. forall t. Theory t => Lens' t [ModelQDef]
defined_quant) forall a. [a] -> [a] -> [a]
++ TheoryModel
t forall s a. s -> Getting a s a -> a
^. forall t. Theory t => Lens' t [ModelExpr]
invariants

-- | Create the fields for a model from a relation concept (used by 'tmodel').
mkTMField :: TheoryModel -> SystemInformation -> Field -> ModRow -> ModRow
mkTMField :: TheoryModel
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkTMField TheoryModel
t SystemInformation
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs  = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
atStart TheoryModel
t]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t SystemInformation
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Contents
unlbldExpr forall a b. (a -> b) -> a -> b
$ TheoryModel -> [ModelExpr]
tmDispExprs TheoryModel
t) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t SystemInformation
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l,
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\ModelExpr
x -> Verbosity
-> InclUnits
-> ModelExpr
-> SystemInformation
-> [Contents]
-> [Contents]
buildDescription Verbosity
v InclUnits
u ModelExpr
x SystemInformation
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Express c => c -> ModelExpr
express) [] forall a b. (a -> b) -> a -> b
$ TheoryModel -> [ModelExpr]
tmDispExprs TheoryModel
t) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t SystemInformation
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs TheoryModel
t SystemInformation
m]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkTMField TheoryModel
t SystemInformation
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources forall a b. (a -> b) -> a -> b
$ TheoryModel
t forall s a. s -> Getting a s a -> a
^. forall c. HasDecRef c => Lens' c [DecRef]
getDecRefs) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t SystemInformation
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs =
  forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (forall a. Show a => a -> Identifier
show Field
l, forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (TheoryModel
t forall s a. s -> Getting a s a -> a
^. forall c. HasAdditionalNotes c => Lens' c [Sentence]
getNotes)
mkTMField TheoryModel
_ SystemInformation
_ Field
l [(Identifier, [Contents])]
_ = forall a. HasCallStack => Identifier -> a
error forall a b. (a -> b) -> a -> b
$ Identifier
"Label " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Identifier
show Field
l forall a. [a] -> [a] -> [a]
++ Identifier
" not supported " forall a. [a] -> [a] -> [a]
++
  Identifier
"for theory models"

-- | Helper function to make a list of 'Sentence's from the current system information and something that has a 'UID'.
helperRefs :: HasUID t => t -> SystemInformation -> Sentence
helperRefs :: forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs t
t SystemInformation
s = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (UID -> SystemInformation -> Sentence
`helpToRefField` SystemInformation
s) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
  UID -> RefbyMap -> [UID]
refbyLookup (t
t forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) (SystemInformation -> ChunkDB
_sysinfodb SystemInformation
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB RefbyMap
refbyTable)

-- | Creates a reference as a 'Sentence' by finding if the 'UID' is in one of the possible data sets contained in the 'SystemInformation' database.
helpToRefField :: UID -> SystemInformation -> Sentence
helpToRefField :: UID -> SystemInformation -> Sentence
helpToRefField UID
t SystemInformation
si
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (DataDefinition, Int))
dataDefnTable)        = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (DataDefinition, Int) -> DataDefinition
datadefnLookup    UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (DataDefinition, Int))
dataDefnTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (InstanceModel, Int))
insmodelTable)        = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (InstanceModel, Int) -> InstanceModel
insmodelLookup    UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (InstanceModel, Int))
insmodelTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (GenDefn, Int))
gendefTable)          = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (GenDefn, Int) -> GenDefn
gendefLookup      UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (GenDefn, Int))
gendefTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (TheoryModel, Int))
theoryModelTable)     = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (TheoryModel, Int) -> TheoryModel
theoryModelLookup UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (TheoryModel, Int))
theoryModelTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (ConceptInstance, Int))
conceptinsTable)      = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (ConceptInstance, Int) -> ConceptInstance
conceptinsLookup  UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (ConceptInstance, Int))
conceptinsTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (Section, Int))
sectionTable)         = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (Section, Int) -> Section
sectionLookup     UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (Section, Int))
sectionTable)
  | Just Int
_ <- forall k a. Ord k => k -> Map k a -> Maybe Int
lookupIndex UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable) = forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS forall a b. (a -> b) -> a -> b
$ UID -> Map UID (LabelledContent, Int) -> LabelledContent
labelledconLookup UID
t (ChunkDB
s forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable)
  | UID
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map  (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) (SystemInformation -> BibRef
citeDB SystemInformation
si) = Sentence
EmptyS
  | Bool
otherwise = forall a. HasCallStack => Identifier -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Identifier
show UID
t forall a. [a] -> [a] -> [a]
++ Identifier
"Caught."
  where s :: ChunkDB
s = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si

-- | Helper that makes a list of 'Reference's into a 'Sentence'. Then wraps into 'Contents'.
helperSources :: [DecRef] -> [Contents]
helperSources :: [DecRef] -> [Contents]
helperSources [] = [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ Identifier -> Sentence
S Identifier
"--"]
helperSources [DecRef]
rs  = [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\DecRef
r -> UID -> Sentence -> RefInfo -> Sentence
Ref (DecRef
r forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ DecRef -> RefInfo
refInfo DecRef
r) [DecRef]
rs]

-- | Creates the fields for a definition from a 'QDefinition' (used by 'ddefn').
mkDDField :: DataDefinition -> SystemInformation -> Field -> ModRow -> ModRow
mkDDField :: DataDefinition
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
atStart DataDefinition
d]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
Symbol [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Sentence
P forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
Units [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall u. MayHaveUnit u => u -> Sentence
toSentenceUnitless forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [ModelExpr -> Contents
unlbldExpr forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express DataDefinition
d]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d SystemInformation
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, Verbosity
-> InclUnits -> DataDefinition -> SystemInformation -> [Contents]
buildDDescription' Verbosity
v InclUnits
u DataDefinition
d SystemInformation
m) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
t SystemInformation
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs DataDefinition
t SystemInformation
m]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall c. HasDecRef c => Lens' c [DecRef]
getDecRefs) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d SystemInformation
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs = forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (forall a. Show a => a -> Identifier
show Field
l, forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall c. HasAdditionalNotes c => Lens' c [Sentence]
getNotes)
mkDDField DataDefinition
_ SystemInformation
_ Field
l [(Identifier, [Contents])]
_ = forall a. HasCallStack => Identifier -> a
error forall a b. (a -> b) -> a -> b
$ Identifier
"Label " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Identifier
show Field
l forall a. [a] -> [a] -> [a]
++ Identifier
" not supported " forall a. [a] -> [a] -> [a]
++
  Identifier
"for data definitions"

-- | Creates the description field for 'Contents' (if necessary) using the given verbosity and
-- including or ignoring units for a model/general definition.
buildDescription :: Verbosity -> InclUnits -> ModelExpr -> SystemInformation -> [Contents] ->
  [Contents]
buildDescription :: Verbosity
-> InclUnits
-> ModelExpr
-> SystemInformation
-> [Contents]
-> [Contents]
buildDescription Verbosity
Succinct InclUnits
_ ModelExpr
_ SystemInformation
_ [Contents]
_ = []
buildDescription Verbosity
Verbose InclUnits
u ModelExpr
e SystemInformation
m [Contents]
cs = (UnlabelledContent -> Contents
UlC forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ListType -> RawContent
Enumeration forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListTuple] -> ListType
Definitions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall q.
(Quantity q, MayHaveUnit q) =>
InclUnits -> [q] -> [ListTuple]
descPairs InclUnits
u forall a b. (a -> b) -> a -> b
$ ModelExpr -> ChunkDB -> [QuantityDict]
vars ModelExpr
e forall a b. (a -> b) -> a -> b
$ SystemInformation -> ChunkDB
_sysinfodb SystemInformation
m) forall a. a -> [a] -> [a]
: [Contents]
cs

-- | Similar to 'buildDescription' except it takes a 'DataDefinition' that is included as the 'firstPair'' in ['Contents'] (independent of verbosity).
-- The 'Verbose' case also includes more details about the 'DataDefinition' expressions.
buildDDescription' :: Verbosity -> InclUnits -> DataDefinition -> SystemInformation ->
  [Contents]
buildDDescription' :: Verbosity
-> InclUnits -> DataDefinition -> SystemInformation -> [Contents]
buildDDescription' Verbosity
Succinct InclUnits
u DataDefinition
d SystemInformation
_ = [UnlabelledContent -> Contents
UlC forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListType -> RawContent
Enumeration forall a b. (a -> b) -> a -> b
$ [ListTuple] -> ListType
Definitions [InclUnits -> DataDefinition -> ListTuple
firstPair' InclUnits
u DataDefinition
d]]
buildDDescription' Verbosity
Verbose  InclUnits
u DataDefinition
d SystemInformation
m = [UnlabelledContent -> Contents
UlC forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListType -> RawContent
Enumeration forall a b. (a -> b) -> a -> b
$ [ListTuple] -> ListType
Definitions forall a b. (a -> b) -> a -> b
$
  InclUnits -> DataDefinition -> ListTuple
firstPair' InclUnits
u DataDefinition
d forall a. a -> [a] -> [a]
: forall q.
(Quantity q, MayHaveUnit q) =>
InclUnits -> [q] -> [ListTuple]
descPairs InclUnits
u (forall a b c. (a -> b -> c) -> b -> a -> c
flip ModelExpr -> ChunkDB -> [QuantityDict]
vars (SystemInformation -> ChunkDB
_sysinfodb SystemInformation
m) forall a b. (a -> b) -> a -> b
$
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall c. Express c => c -> ModelExpr
express forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) (forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr) (DataDefinition -> Either (QDefinition Expr) ModelQDef
qdFromDD DataDefinition
d))]

-- | Create the fields for a general definition from a 'GenDefn' chunk.
mkGDField :: GenDefn -> SystemInformation -> Field -> ModRow -> ModRow
mkGDField :: GenDefn
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkGDField GenDefn
g SystemInformation
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
atStart GenDefn
g]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkGDField GenDefn
g SystemInformation
_ l :: Field
l@Field
Units [(Identifier, [Contents])]
fs =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Identifier, [Contents])]
fs (\UnitDefn
udef -> (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. USymb -> Sentence
Sy forall a b. (a -> b) -> a -> b
$ forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
udef]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit GenDefn
g)
mkGDField GenDefn
g SystemInformation
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [ModelExpr -> Contents
unlbldExpr forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express GenDefn
g]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkGDField GenDefn
g SystemInformation
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l,
  Verbosity
-> InclUnits
-> ModelExpr
-> SystemInformation
-> [Contents]
-> [Contents]
buildDescription Verbosity
v InclUnits
u (forall c. Express c => c -> ModelExpr
express GenDefn
g) SystemInformation
m []) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkGDField GenDefn
g SystemInformation
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs GenDefn
g SystemInformation
m]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkGDField GenDefn
g SystemInformation
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources forall a b. (a -> b) -> a -> b
$ GenDefn
g forall s a. s -> Getting a s a -> a
^. forall c. HasDecRef c => Lens' c [DecRef]
getDecRefs) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkGDField GenDefn
g SystemInformation
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs = forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (forall a. Show a => a -> Identifier
show Field
l, forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (GenDefn
g forall s a. s -> Getting a s a -> a
^. forall c. HasAdditionalNotes c => Lens' c [Sentence]
getNotes)
mkGDField GenDefn
_ SystemInformation
_ Field
l [(Identifier, [Contents])]
_ = forall a. HasCallStack => Identifier -> a
error forall a b. (a -> b) -> a -> b
$ Identifier
"Label " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Identifier
show Field
l forall a. [a] -> [a] -> [a]
++ Identifier
" not supported for gen defs"

-- | Create the fields for an instance model from an 'InstanceModel' chunk.
mkIMField :: InstanceModel -> SystemInformation -> Field -> ModRow -> ModRow
mkIMField :: InstanceModel
-> SystemInformation
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs  = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
atStart InstanceModel
i]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [ModelExpr -> Contents
unlbldExpr forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express InstanceModel
i]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l,
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ModelExpr
x -> Verbosity
-> InclUnits
-> ModelExpr
-> SystemInformation
-> [Contents]
-> [Contents]
buildDescription Verbosity
v InclUnits
u ModelExpr
x SystemInformation
m) [] [forall c. Express c => c -> ModelExpr
express InstanceModel
i]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall t. HasUID t => t -> SystemInformation -> Sentence
helperRefs InstanceModel
i SystemInformation
m]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources forall a b. (a -> b) -> a -> b
$ InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c. HasDecRef c => Lens' c [DecRef]
getDecRefs) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
Output [(Identifier, [Contents])]
fs = (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph Sentence
x]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
  where x :: Sentence
x = Symbol -> Sentence
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall q. HasSymbol q => q -> Symbol
eqSymb forall a b. (a -> b) -> a -> b
$ InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c QuantityDict
output
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
Input [(Identifier, [Contents])]
fs =
  case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c.
HasInputs c =>
Lens' c [(QuantityDict, Maybe (RealInterval Expr Expr))]
inputs) of
    [] -> (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph Sentence
EmptyS]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs -- FIXME? Should an empty input list be allowed?
    (QuantityDict
_:[QuantityDict]
_) -> (forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Sentence -> Sentence -> Sentence
sC [Sentence]
xs]) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
  where xs :: [Sentence]
xs = forall a b. (a -> b) -> [a] -> [b]
map (Symbol -> Sentence
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall q. HasSymbol q => q -> Symbol
eqSymb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c.
HasInputs c =>
Lens' c [(QuantityDict, Maybe (RealInterval Expr Expr))]
inputs
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
InConstraints [(Identifier, [Contents])]
fs  =
  let ll :: [(QuantityDict, RealInterval Expr Expr)]
ll = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(QuantityDict
x,Maybe (RealInterval Expr Expr)
y) -> Maybe (RealInterval Expr Expr)
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\RealInterval Expr Expr
z -> forall a. a -> Maybe a
Just (QuantityDict
x, RealInterval Expr Expr
z))) (InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c.
HasInputs c =>
Lens' c [(QuantityDict, Maybe (RealInterval Expr Expr))]
inputs) in
  (forall a. Show a => a -> Identifier
show Field
l, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnlabelledContent -> Contents
UlC forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelExpr -> RawContent
EqnBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Express c => c -> ModelExpr
express forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval) [] [(QuantityDict, RealInterval Expr Expr)]
ll) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
OutConstraints [(Identifier, [Contents])]
fs =
  (forall a. Show a => a -> Identifier
show Field
l, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnlabelledContent -> Contents
UlC forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelExpr -> RawContent
EqnBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Express c => c -> ModelExpr
express forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r c. (ExprC r, HasUID c) => c -> RealInterval r r -> r
realInterval (InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c QuantityDict
output)) []
    (InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c [RealInterval Expr Expr]
out_constraints)) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkIMField InstanceModel
i SystemInformation
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs =
  forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (forall a. Show a => a -> Identifier
show Field
l, forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (InstanceModel
i forall s a. s -> Getting a s a -> a
^. forall c. HasAdditionalNotes c => Lens' c [Sentence]
getNotes)
mkIMField InstanceModel
_ SystemInformation
_ Field
l [(Identifier, [Contents])]
_ = forall a. HasCallStack => Identifier -> a
error forall a b. (a -> b) -> a -> b
$ Identifier
"Label " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Identifier
show Field
l forall a. [a] -> [a] -> [a]
++ Identifier
" not supported " forall a. [a] -> [a] -> [a]
++
  Identifier
"for instance models"

-- | Used for making definitions. The first pair is the symbol of the quantity we are
-- defining.
firstPair' :: InclUnits -> DataDefinition -> ListTuple
firstPair' :: InclUnits -> DataDefinition -> ListTuple
firstPair' InclUnits
IgnoreUnits DataDefinition
d  = (Symbol -> Sentence
P forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs, Sentence -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase DataDefinition
d, forall a. Maybe a
Nothing)
firstPair' InclUnits
IncludeUnits DataDefinition
d =
  (Symbol -> Sentence
P forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs, Sentence -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase DataDefinition
d Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall u. MayHaveUnit u => u -> Sentence
toSentenceUnitless forall a b. (a -> b) -> a -> b
$ DataDefinition
d forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs), forall a. Maybe a
Nothing)

-- | Creates the descriptions for each symbol in the relation/equation.
descPairs :: (Quantity q, MayHaveUnit q) => InclUnits -> [q] -> [ListTuple]
descPairs :: forall q.
(Quantity q, MayHaveUnit q) =>
InclUnits -> [q] -> [ListTuple]
descPairs InclUnits
IgnoreUnits = forall a b. (a -> b) -> [a] -> [b]
map (\q
x -> (Symbol -> Sentence
P forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb q
x, Sentence -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase q
x, forall a. Maybe a
Nothing))
descPairs InclUnits
IncludeUnits =
  forall a b. (a -> b) -> [a] -> [b]
map (\q
x -> (Symbol -> Sentence
P forall a b. (a -> b) -> a -> b
$ forall q. HasSymbol q => q -> Symbol
eqSymb q
x, Sentence -> ItemType
Flat forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => n -> Sentence
phrase q
x Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall u. MayHaveUnit u => u -> Sentence
toSentenceUnitless q
x), forall a. Maybe a
Nothing))
  -- FIXME: Need a Units map for looking up units from variables

-- | Defines 'Field's as 'String's.
instance Show Field where
  show :: Field -> Identifier
show Field
Label             = Identifier
"Label"
  show Field
Symbol            = Identifier
"Symbol"
  show Field
Units             = Identifier
"Units"
  show Field
RefBy             = Identifier
"RefBy"
  show Field
Source            = Identifier
"Source"
  show Field
Input             = Identifier
"Input"
  show Field
Output            = Identifier
"Output"
  show Field
InConstraints     = Identifier
"Input Constraints"
  show Field
OutConstraints    = Identifier
"Output Constraints"
  show Field
DefiningEquation  = Identifier
"Equation"
  show (Description Verbosity
_ InclUnits
_) = Identifier
"Description"
  show Field
Notes             = Identifier
"Notes"