{-# 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(..), TraceViewCat,
  -- * Constructors
  ddefn, derivation, gdefn,
  instanceModel, tmodel,
  -- * Helpers
  helperRefs, helpToRefField) where

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

-- rest of Drasil
import Drasil.Database (ChunkDB, UID, HasUID(..), find)
import Drasil.System (System, systemdb, refbyLookup)
import Language.Drasil
import Theory.Drasil (DataDefinition, GenDefn, InstanceModel,
  TheoryModel, HasInputs(inputs), HasOutput(output, out_constraints), qdFromDD,
  Derivation(Derivation), MayHaveDerivation(derivations))

-- local
import Drasil.GetChunks (vars)
import Drasil.Document.Contents (unlbldExpr)
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

-- * Types

-- | Helper type that takes a set of 'UID's and a 'ChunkDB'.
type TraceViewCat = [UID] -> System -> [UID]

-- | 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 -> System -> TheoryModel -> LabelledContent
tmodel :: Fields -> System -> TheoryModel -> LabelledContent
tmodel Fields
fs System
m TheoryModel
t = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Theory ((Field -> [(Identifier, [Contents])] -> [(Identifier, [Contents])])
-> [(Identifier, [Contents])]
-> Fields
-> [(Identifier, [Contents])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TheoryModel
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkTMField TheoryModel
t System
m) [] Fields
fs)) (TheoryModel -> Reference
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 -> System -> DataDefinition -> LabelledContent
ddefn :: Fields -> System -> DataDefinition -> LabelledContent
ddefn Fields
fs System
m DataDefinition
d = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Data ((Field -> [(Identifier, [Contents])] -> [(Identifier, [Contents])])
-> [(Identifier, [Contents])]
-> Fields
-> [(Identifier, [Contents])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DataDefinition
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkDDField DataDefinition
d System
m) [] Fields
fs)) (DataDefinition -> Reference
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 -> System -> GenDefn -> LabelledContent
gdefn :: Fields -> System -> GenDefn -> LabelledContent
gdefn Fields
fs System
m GenDefn
g = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
General ((Field -> [(Identifier, [Contents])] -> [(Identifier, [Contents])])
-> [(Identifier, [Contents])]
-> Fields
-> [(Identifier, [Contents])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GenDefn
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkGDField GenDefn
g System
m) [] Fields
fs)) (GenDefn -> Reference
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 -> System -> InstanceModel -> LabelledContent
instanceModel :: Fields -> System -> InstanceModel -> LabelledContent
instanceModel Fields
fs System
m InstanceModel
i = RawContent -> Reference -> LabelledContent
mkRawLC (DType -> [(Identifier, [Contents])] -> RawContent
Defini DType
Instance ((Field -> [(Identifier, [Contents])] -> [(Identifier, [Contents])])
-> [(Identifier, [Contents])]
-> Fields
-> [(Identifier, [Contents])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (InstanceModel
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkIMField InstanceModel
i System
m) [] Fields
fs)) (InstanceModel -> Reference
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 = (Derivation -> Contents) -> Maybe Derivation -> Maybe Contents
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(Derivation Sentence
h [Sentence]
d) -> LabelledContent -> Contents
LlC (LabelledContent -> Contents) -> LabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ RawContent -> Reference -> LabelledContent
mkRawLC (Sentence -> [RawContent] -> RawContent
DerivBlock Sentence
h ([RawContent] -> RawContent) -> [RawContent] -> RawContent
forall a b. (a -> b) -> a -> b
$ (Sentence -> RawContent) -> [Sentence] -> [RawContent]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> RawContent
makeDerivCons [Sentence]
d) (c -> Reference
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref c
c)) (Maybe Derivation -> Maybe Contents)
-> Maybe Derivation -> Maybe Contents
forall a b. (a -> b) -> a -> b
$
  c
c c
-> Getting (Maybe Derivation) c (Maybe Derivation)
-> Maybe Derivation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Derivation) c (Maybe Derivation)
forall c. MayHaveDerivation c => Lens' c (Maybe Derivation)
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

-- | Create the fields for a model from a relation concept (used by 'tmodel').
mkTMField :: TheoryModel -> System -> Field -> ModRow -> ModRow
mkTMField :: TheoryModel
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkTMField TheoryModel
t System
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs  = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ TheoryModel -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart TheoryModel
t]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t System
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, NonEmpty Contents -> [Contents]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Contents -> [Contents])
-> NonEmpty Contents -> [Contents]
forall a b. (a -> b) -> a -> b
$ ModelExpr -> Contents
unlbldExpr (ModelExpr -> Contents) -> NonEmpty ModelExpr -> NonEmpty Contents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TheoryModel -> NonEmpty ModelExpr
forall c. Express c => c -> NonEmpty ModelExpr
mexpress TheoryModel
t) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t System
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Contents] -> [Contents]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Contents] -> [Contents]) -> [Contents] -> [Contents]
forall a b. (a -> b) -> a -> b
$
  (ModelExpr -> [Contents] -> [Contents])
-> [Contents] -> NonEmpty ModelExpr -> [Contents]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\ModelExpr
x -> Verbosity
-> InclUnits -> ModelExpr -> System -> [Contents] -> [Contents]
buildDescription Verbosity
v InclUnits
u ModelExpr
x System
m) [Contents]
forall a. Monoid a => a
mempty (NonEmpty ModelExpr -> [Contents])
-> NonEmpty ModelExpr -> [Contents]
forall a b. (a -> b) -> a -> b
$ TheoryModel -> NonEmpty ModelExpr
forall c. Express c => c -> NonEmpty ModelExpr
mexpress TheoryModel
t) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t System
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ TheoryModel -> System -> Sentence
forall t. HasUID t => t -> System -> Sentence
helperRefs TheoryModel
t System
m]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkTMField TheoryModel
t System
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources ([DecRef] -> [Contents]) -> [DecRef] -> [Contents]
forall a b. (a -> b) -> a -> b
$ TheoryModel
t TheoryModel -> Getting [DecRef] TheoryModel [DecRef] -> [DecRef]
forall s a. s -> Getting a s a -> a
^. Getting [DecRef] TheoryModel [DecRef]
forall c. HasDecRef c => Lens' c [DecRef]
Lens' TheoryModel [DecRef]
getDecRefs) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkTMField TheoryModel
t System
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs =
  [(Identifier, [Contents])]
-> ([Sentence] -> [(Identifier, [Contents])])
-> [Sentence]
-> [(Identifier, [Contents])]
forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, (Sentence -> Contents) -> [Sentence] -> [Contents]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (TheoryModel
t TheoryModel
-> Getting [Sentence] TheoryModel [Sentence] -> [Sentence]
forall s a. s -> Getting a s a -> a
^. Getting [Sentence] TheoryModel [Sentence]
forall c. HasAdditionalNotes c => Lens' c [Sentence]
Lens' TheoryModel [Sentence]
getNotes)
mkTMField TheoryModel
_ System
_ Field
l [(Identifier, [Contents])]
_ = Identifier -> [(Identifier, [Contents])]
forall a. HasCallStack => Identifier -> a
error (Identifier -> [(Identifier, [Contents])])
-> Identifier -> [(Identifier, [Contents])]
forall a b. (a -> b) -> a -> b
$ Identifier
"Label " Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
" not supported " Identifier -> Identifier -> Identifier
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 -> System -> Sentence
helperRefs :: forall t. HasUID t => t -> System -> Sentence
helperRefs t
t System
s = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ([Sentence] -> Sentence) -> [Sentence] -> Sentence
forall a b. (a -> b) -> a -> b
$ (UID -> Sentence) -> [UID] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (UID -> ChunkDB -> Sentence
`helpToRefField` (System
s System -> Getting ChunkDB System ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB System ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb)) ([UID] -> [Sentence]) -> [UID] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ [UID] -> [UID]
forall a. Eq a => [a] -> [a]
nub ([UID] -> [UID]) -> [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$
  UID -> System -> [UID]
refbyLookup (t
t t -> Getting UID t UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID t UID
forall c. HasUID c => Getter c UID
Getter t UID
uid) System
s

-- | Creates a reference as a 'Sentence' by finding if the 'UID' is in one of
-- the possible data sets contained in the 'System' database.
helpToRefField :: UID -> ChunkDB -> Sentence
helpToRefField :: UID -> ChunkDB -> Sentence
helpToRefField UID
trg ChunkDB
db
  | (Just DataDefinition
c) <- UID -> ChunkDB -> Maybe DataDefinition
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe DataDefinition  = DataDefinition -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS DataDefinition
c
  | (Just InstanceModel
c) <- UID -> ChunkDB -> Maybe InstanceModel
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe InstanceModel   = InstanceModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
c
  | (Just GenDefn
c) <- UID -> ChunkDB -> Maybe GenDefn
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe GenDefn         = GenDefn -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS GenDefn
c
  | (Just TheoryModel
c) <- UID -> ChunkDB -> Maybe TheoryModel
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe TheoryModel     = TheoryModel -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
c
  | (Just ConceptInstance
c) <- UID -> ChunkDB -> Maybe ConceptInstance
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe ConceptInstance = ConceptInstance -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
c
  | (Just Citation
_) <- UID -> ChunkDB -> Maybe Citation
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
trg ChunkDB
db :: Maybe Citation        = Sentence
EmptyS
  | Bool
otherwise = Identifier -> Sentence
forall a. HasCallStack => Identifier -> a
error (Identifier -> Sentence) -> Identifier -> Sentence
forall a b. (a -> b) -> a -> b
$ UID -> Identifier
forall a. Show a => a -> Identifier
show UID
trg Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
"Caught."

-- | 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 (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ Identifier -> Sentence
S Identifier
"--"]
helperSources [DecRef]
rs  = [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ([Sentence] -> Sentence) -> [Sentence] -> Sentence
forall a b. (a -> b) -> a -> b
$ (DecRef -> Sentence) -> [DecRef] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (\DecRef
r -> UID -> Sentence -> RefInfo -> Sentence
Ref (DecRef
r DecRef -> Getting UID DecRef UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID DecRef UID
forall c. HasUID c => Getter c UID
Getter DecRef UID
uid) Sentence
EmptyS (RefInfo -> Sentence) -> RefInfo -> Sentence
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 -> System -> Field -> ModRow -> ModRow
mkDDField :: DataDefinition
-> System
-> Field
-> [(Identifier, [Contents])]
-> [(Identifier, [Contents])]
mkDDField DataDefinition
d System
_ l :: Field
l@Field
Label [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ DataDefinition -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart DataDefinition
d]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d System
_ l :: Field
l@Field
Symbol [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents)
-> (Symbol -> Sentence) -> Symbol -> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Sentence
P (Symbol -> Contents) -> Symbol -> Contents
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb (DefinedQuantityDict -> Symbol) -> DefinedQuantityDict -> Symbol
forall a b. (a -> b) -> a -> b
$ DataDefinition
d DataDefinition
-> Getting DefinedQuantityDict DataDefinition DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict DataDefinition DefinedQuantityDict
forall d. DefinesQuantity d => Getter d DefinedQuantityDict
Getter DataDefinition DefinedQuantityDict
defLhs]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d System
_ l :: Field
l@Field
Units [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Sentence
forall u. MayHaveUnit u => u -> Sentence
toSentenceUnitless (DefinedQuantityDict -> Sentence)
-> DefinedQuantityDict -> Sentence
forall a b. (a -> b) -> a -> b
$ DataDefinition
d DataDefinition
-> Getting DefinedQuantityDict DataDefinition DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict DataDefinition DefinedQuantityDict
forall d. DefinesQuantity d => Getter d DefinedQuantityDict
Getter DataDefinition DefinedQuantityDict
defLhs]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d System
_ l :: Field
l@Field
DefiningEquation [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, NonEmpty Contents -> [Contents]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Contents -> [Contents])
-> NonEmpty Contents -> [Contents]
forall a b. (a -> b) -> a -> b
$ ModelExpr -> Contents
unlbldExpr (ModelExpr -> Contents) -> NonEmpty ModelExpr -> NonEmpty Contents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDefinition -> NonEmpty ModelExpr
forall c. Express c => c -> NonEmpty ModelExpr
mexpress DataDefinition
d) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d System
m l :: Field
l@(Description Verbosity
v InclUnits
u) [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, Verbosity -> InclUnits -> DataDefinition -> System -> [Contents]
buildDDescription' Verbosity
v InclUnits
u DataDefinition
d System
m) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
t System
m l :: Field
l@Field
RefBy [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ DataDefinition -> System -> Sentence
forall t. HasUID t => t -> System -> Sentence
helperRefs DataDefinition
t System
m]) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs --FIXME: fill this in
mkDDField DataDefinition
d System
_ l :: Field
l@Field
Source [(Identifier, [Contents])]
fs = (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, [DecRef] -> [Contents]
helperSources ([DecRef] -> [Contents]) -> [DecRef] -> [Contents]
forall a b. (a -> b) -> a -> b
$ DataDefinition
d DataDefinition
-> Getting [DecRef] DataDefinition [DecRef] -> [DecRef]
forall s a. s -> Getting a s a -> a
^. Getting [DecRef] DataDefinition [DecRef]
forall c. HasDecRef c => Lens' c [DecRef]
Lens' DataDefinition [DecRef]
getDecRefs) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs
mkDDField DataDefinition
d System
_ l :: Field
l@Field
Notes [(Identifier, [Contents])]
fs = [(Identifier, [Contents])]
-> ([Sentence] -> [(Identifier, [Contents])])
-> [Sentence]
-> [(Identifier, [Contents])]
forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty [(Identifier, [Contents])]
fs (\[Sentence]
ss -> (Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l, (Sentence -> Contents) -> [Sentence] -> [Contents]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Contents
mkParagraph [Sentence]
ss) (Identifier, [Contents])
-> [(Identifier, [Contents])] -> [(Identifier, [Contents])]
forall a. a -> [a] -> [a]
: [(Identifier, [Contents])]
fs) (DataDefinition
d DataDefinition
-> Getting [Sentence] DataDefinition [Sentence] -> [Sentence]
forall s a. s -> Getting a s a -> a
^. Getting [Sentence] DataDefinition [Sentence]
forall c. HasAdditionalNotes c => Lens' c [Sentence]
Lens' DataDefinition [Sentence]
getNotes)
mkDDField DataDefinition
_ System
_ Field
l [(Identifier, [Contents])]
_ = Identifier -> [(Identifier, [Contents])]
forall a. HasCallStack => Identifier -> a
error (Identifier -> [(Identifier, [Contents])])
-> Identifier -> [(Identifier, [Contents])]
forall a b. (a -> b) -> a -> b
$ Identifier
"Label " Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Field -> Identifier
forall a. Show a => a -> Identifier
show Field
l Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
" not supported " Identifier -> Identifier -> Identifier
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 -> System -> [Contents] ->
  [Contents]
buildDescription :: Verbosity
-> InclUnits -> ModelExpr -> System -> [Contents] -> [Contents]
buildDescription Verbosity
Succinct InclUnits
_ ModelExpr
_ System
_ [Contents]
_ = []
buildDescription Verbosity
Verbose InclUnits
u ModelExpr
e System
m [Contents]
cs = (UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents)
-> ([DefinedQuantityDict] -> UnlabelledContent)
-> [DefinedQuantityDict]
-> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> ([DefinedQuantityDict] -> RawContent)
-> [DefinedQuantityDict]
-> UnlabelledContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ListType -> RawContent
Enumeration (ListType -> RawContent)
-> ([DefinedQuantityDict] -> ListType)
-> [DefinedQuantityDict]
-> RawContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListTuple] -> ListType
Definitions ([ListTuple] -> ListType)
-> ([DefinedQuantityDict] -> [ListTuple])
-> [DefinedQuantityDict]
-> ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InclUnits -> [DefinedQuantityDict] -> [ListTuple]
forall q.
(Quantity q, MayHaveUnit q) =>
InclUnits -> [q] -> [ListTuple]
descPairs InclUnits
u ([DefinedQuantityDict] -> Contents)
-> [DefinedQuantityDict] -> Contents
forall a b. (a -> b) -> a -> b
$ ModelExpr -> ChunkDB -> [DefinedQuantityDict]
vars ModelExpr
e (ChunkDB -> [DefinedQuantityDict])
-> ChunkDB -> [DefinedQuantityDict]
forall a b. (a -> b) -> a -> b
$ System
m System -> Getting ChunkDB System ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB System ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb) Contents -> [Contents] -> [Contents]
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 -> System ->
  [Contents]
buildDDescription' :: Verbosity -> InclUnits -> DataDefinition -> System -> [Contents]
buildDDescription' Verbosity
Succinct InclUnits
u DataDefinition
d System
_ = [UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents)
-> (ListType -> UnlabelledContent) -> ListType -> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> (ListType -> RawContent) -> ListType -> UnlabelledContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListType -> RawContent
Enumeration (ListType -> Contents) -> ListType -> Contents
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 System
m = [UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents)
-> (ListType -> UnlabelledContent) -> ListType -> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> (ListType -> RawContent) -> ListType -> UnlabelledContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListType -> RawContent
Enumeration (ListType -> Contents) -> ListType -> Contents
forall a b. (a -> b) -> a -> b
$ [ListTuple] -> ListType
Definitions ([ListTuple] -> ListType) -> [ListTuple] -> ListType
forall a b. (a -> b) -> a -> b
$
  InclUnits -> DataDefinition -> ListTuple
firstPair' InclUnits
u DataDefinition
d ListTuple -> [ListTuple] -> [ListTuple]
forall a. a -> [a] -> [a]
: InclUnits -> [DefinedQuantityDict] -> [ListTuple]
forall q.
(Quantity q, MayHaveUnit q) =>
InclUnits -> [q] -> [ListTuple]
descPairs InclUnits
u ((ModelExpr -> ChunkDB -> [DefinedQuantityDict])
-> ChunkDB -> ModelExpr -> [DefinedQuantityDict]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModelExpr -> ChunkDB -> [DefinedQuantityDict]
vars (System
m System -> Getting ChunkDB System ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB System ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb) (ModelExpr -> [DefinedQuantityDict])
-> ModelExpr -> [DefinedQuantityDict]
forall a b. (a -> b) -> a -> b
$
  (QDefinition Expr -> ModelExpr)
-> (QDefinition ModelExpr -> ModelExpr)
-> Either (QDefinition Expr) (QDefinition ModelExpr)
-> ModelExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Expr -> ModelExpr
forall c. Express c => c -> ModelExpr
express (Expr -> ModelExpr)
-> (QDefinition Expr -> Expr) -> QDefinition Expr -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDefinition Expr -> Getting Expr (QDefinition Expr) Expr -> Expr
forall s a. s -> Getting a s a -> a
^. Getting Expr (QDefinition Expr) Expr
forall e. Lens' (QDefinition e) e
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) (QDefinition ModelExpr
-> Getting ModelExpr (QDefinition ModelExpr) ModelExpr -> ModelExpr
forall s a. s -> Getting a s a -> a
^. Getting ModelExpr (QDefinition ModelExpr) ModelExpr
forall e. Lens' (QDefinition e) e
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr) (DataDefinition -> Either (QDefinition Expr) (QDefinition ModelExpr)
qdFromDD DataDefinition
d))]

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

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