-- | Defines the design language for SCS.
module Language.Drasil.Choices (
  Choices(..), Architecture (..), makeArchit, DataInfo(..), makeData, Maps(..),
  makeMaps, spaceToCodeType, Constraints(..), makeConstraints, ODE(..), makeODE,
  DocConfig(..), makeDocConfig, LogConfig(..), makeLogConfig, OptionalFeatures(..),
  makeOptFeats, ExtLib(..), Modularity(..), InputModule(..), inputModule, Structure(..),
  ConstantStructure(..), ConstantRepr(..), ConceptMatchMap, MatchedConceptMap,
  CodeConcept(..), matchConcepts, SpaceMatch, matchSpaces, ImplementationType(..),
  ConstraintBehaviour(..), Comments(..), Verbosity(..), Visibility(..),
  Logging(..), AuxFile(..), getSampleData, hasSampleInput, defaultChoices,
  choicesSent, showChs) where

import Language.Drasil hiding (None, Var)
import Language.Drasil.Code.Code (spaceToCodeType)
import Language.Drasil.Code.Lang (Lang(..))
import Language.Drasil.Data.ODEInfo (ODEInfo)
import Language.Drasil.Data.ODELibPckg (ODELibPckg)

import GOOL.Drasil (CodeType)

import Control.Lens ((^.))
import Data.Map (Map, fromList)

-- | The instruction indicates how the generated program should be written down.
-- Full details of Choices documentation https://github.com/JacquesCarette/Drasil/wiki/The-Code-Generator
data Choices = Choices {
  -- | Target languages.
  -- Choosing multiple means program will be generated in multiple languages.
  Choices -> [Lang]
lang :: [Lang],
  -- | Architecture of the program, include modularity and implementation type
  Choices -> Architecture
architecture :: Architecture,
  -- | Data structure and represent
  Choices -> DataInfo
dataInfo :: DataInfo,
  -- | Maps for 'Drasil concepts' to 'code concepts' or 'Space' to a 'CodeType
  Choices -> Maps
maps :: Maps,
  -- | Setting for Softifacts that can be added to the program or left it out
  Choices -> OptionalFeatures
optFeats :: OptionalFeatures,
  -- | Constraint violation behaviour. Exception or Warning.
  Choices -> Constraints
srsConstraints :: Constraints,
  -- | List of external libraries what to utilize
  Choices -> [ExtLib]
extLibs :: [ExtLib],
  -- | Number of folders to go up in order to obtain the image
  Choices -> Int
folderVal :: Int
}

-- | Renders program choices as a 'Sentence'.
class RenderChoices a where
    showChs :: a -> Sentence
    showChsList :: [a] -> Sentence
    showChsList [] = String -> Sentence
S String
"None"
    showChsList [a]
lst = [Sentence] -> Sentence
foldlSent_ (forall a b. (a -> b) -> [a] -> [b]
map forall a. RenderChoices a => a -> Sentence
showChs [a]
lst)

-- | Architecture of a program
data Architecture = Archt {
  -- | How the program should be modularized.
  Architecture -> Modularity
modularity :: Modularity,
  -- | Implementation type, program or library.
  Architecture -> ImplementationType
impType :: ImplementationType
}
-- | Constructor to create a Architecture
makeArchit :: Modularity -> ImplementationType -> Architecture
makeArchit :: Modularity -> ImplementationType -> Architecture
makeArchit = Modularity -> ImplementationType -> Architecture
Archt

-- | Modularity of a program.
data Modularity = Modular InputModule -- ^ Different modules. For controller,
                                      -- input, calculations, output.
                | Unmodular -- ^ All generated code is in one module/file.

-- | Renders the modularity of a program.
instance RenderChoices Modularity where
  showChs :: Modularity -> Sentence
showChs Modularity
Unmodular = String -> Sentence
S String
"Unmodular"
  showChs (Modular InputModule
Combined) = String -> Sentence
S String
"Modular Combined"
  showChs (Modular InputModule
Separated)= String -> Sentence
S String
"Modular Separated"

-- | Options for input modules.
data InputModule = Combined -- ^ Input-related functions combined in one module.
                 | Separated -- ^ Input-related functions each in own module.

-- | Determines whether there is a 'Combined' input module or many 'Separated' input
-- modules, based on a 'Choices' structure. An 'Unmodular' design implicitly means
-- that input modules are 'Combined'.
inputModule :: Choices -> InputModule
inputModule :: Choices -> InputModule
inputModule Choices
c = Modularity -> InputModule
inputModule' forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
c
  where inputModule' :: Modularity -> InputModule
inputModule' Modularity
Unmodular = InputModule
Combined
        inputModule' (Modular InputModule
im) = InputModule
im

-- | Program implementation options.
data ImplementationType = Library -- ^ Generated code does not include Controller.
                        | Program -- ^ Generated code includes Controller.

-- | Renders options for program implementation.
instance RenderChoices ImplementationType where
  showChs :: ImplementationType -> Sentence
showChs ImplementationType
Library = String -> Sentence
S String
"Library"
  showChs ImplementationType
Program = String -> Sentence
S String
"Program"

-- | Data of a program - how information should be encoded.
data DataInfo = DataInfo {
  -- | Structure of inputs (bundled or not).
  DataInfo -> Structure
inputStructure :: Structure,
  -- | Structure of constants (inlined or bundled or not, or stored with inputs).
  DataInfo -> ConstantStructure
constStructure :: ConstantStructure,
  -- | Representation of constants (as variables or as constants).
  DataInfo -> ConstantRepr
constRepr :: ConstantRepr
}
-- | Constructor to create a DataInfo
makeData :: Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData :: Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
DataInfo

-- | Variable structure options.
data Structure = Unbundled -- ^ Individual variables
               | Bundled -- ^ Variables bundled in a class

-- | Renders the structure of variables in a program.
instance RenderChoices Structure where
  showChs :: Structure -> Sentence
showChs Structure
Unbundled = String -> Sentence
S String
"Unbundled"
  showChs Structure
Bundled = String -> Sentence
S String
"Bundled"

-- | Constants options.
data ConstantStructure = Inline -- ^ Inline values for constants.
                       | WithInputs -- ^ Store constants with inputs.
                       | Store Structure -- ^ Store constants separately from
                                         -- inputs, whether bundled or unbundled.

-- | Renders the structure of constants in a program.
instance RenderChoices ConstantStructure where
  showChs :: ConstantStructure -> Sentence
showChs ConstantStructure
Inline = String -> Sentence
S String
"Inline"
  showChs ConstantStructure
WithInputs = String -> Sentence
S String
"WithInputs"
  showChs (Store Structure
Unbundled) = String -> Sentence
S String
"Store Unbundled"
  showChs (Store Structure
Bundled) = String -> Sentence
S String
"Store Bundled"

-- | Options for representing constants in a program.
data ConstantRepr = Var -- ^ Constants represented as regular variables.
                  | Const -- ^ Use target language's mechanism for defining constants.

-- | Renders the representation of constants in a program.
instance RenderChoices ConstantRepr where
  showChs :: ConstantRepr -> Sentence
showChs ConstantRepr
Var = String -> Sentence
S String
"Var"
  showChs ConstantRepr
Const = String -> Sentence
S String
"Const"

-- | Maps for Concepts and Space
data Maps = Maps {
  -- | Map of 'UID's for Drasil concepts to code concepts.
  -- Matching a 'UID' to a code concept means the code concept should be used
  -- instead of the chunk associated with the 'UID'.
  Maps -> ConceptMatchMap
conceptMatch :: ConceptMatchMap,
  -- | Map of 'Space's to 'CodeType's
  -- Matching a 'Space' to a 'CodeType' means values of the 'Space' should have that
  -- 'CodeType' in the generated code.
  Maps -> SpaceMatch
spaceMatch :: SpaceMatch
}
-- | Constructor to create a Maps
makeMaps :: ConceptMatchMap -> SpaceMatch -> Maps
makeMaps :: ConceptMatchMap -> SpaceMatch -> Maps
makeMaps = ConceptMatchMap -> SpaceMatch -> Maps
Maps

-- | Specifies matches between chunks and 'CodeConcept's, meaning the target
-- language's pre-existing definition of the concept should be used instead of
-- defining a new variable for the concept in the generated code.
-- ['CodeConcept'] is preferentially-ordered, generator concretizes a
-- 'ConceptMatchMap' to a 'MatchedConceptMap' by checking user's other choices.
type ConceptMatchMap = Map UID [CodeConcept]
-- | Concrete version of ConceptMatchMap dependent on user choices.
type MatchedConceptMap = Map UID CodeConcept

-- Currently we only support one code concept, more will be added later
-- | Code concepts. For now, just pi.
data CodeConcept = Pi deriving CodeConcept -> CodeConcept -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeConcept -> CodeConcept -> Bool
$c/= :: CodeConcept -> CodeConcept -> Bool
== :: CodeConcept -> CodeConcept -> Bool
$c== :: CodeConcept -> CodeConcept -> Bool
Eq

-- | Renders 'CodeConcept's.
instance RenderChoices CodeConcept where
  showChs :: CodeConcept -> Sentence
showChs CodeConcept
Pi = String -> Sentence
S String
"Pi"

-- | Builds a 'ConceptMatchMap' from an association list of chunks and 'CodeConcepts'.
matchConcepts :: (HasUID c) => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts :: forall c. HasUID c => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(c
cnc,[CodeConcept]
cdc) -> (c
cnc forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid, [CodeConcept]
cdc))

-- | Specifies which 'CodeType' should be used to represent each mathematical
-- 'Space'. ['CodeType'] is preferentially-ordered, first 'CodeType' that does not
-- conflict with other choices will be selected.
type SpaceMatch = Space -> [CodeType]

-- | Updates a 'SpaceMatch' by matching the given 'Space' with the given ['CodeType'].
matchSpace :: Space -> [CodeType] -> SpaceMatch -> SpaceMatch
matchSpace :: Space -> [CodeType] -> SpaceMatch -> SpaceMatch
matchSpace Space
_ [] SpaceMatch
_ = forall a. HasCallStack => String -> a
error String
"Must match each Space to at least one CodeType"
matchSpace Space
s [CodeType]
ts SpaceMatch
sm = \Space
sp -> if Space
sp forall a. Eq a => a -> a -> Bool
== Space
s then [CodeType]
ts else SpaceMatch
sm Space
sp

-- | Builds a 'SpaceMatch' from an association list of 'Spaces' and 'CodeTypes'.
matchSpaces :: [(Space, [CodeType])] -> SpaceMatch
matchSpaces :: [(Space, [CodeType])] -> SpaceMatch
matchSpaces [(Space, [CodeType])]
spMtchs = [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' [(Space, [CodeType])]
spMtchs SpaceMatch
spaceToCodeType
  where matchSpaces' :: [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' ((Space
s,[CodeType]
ct):[(Space, [CodeType])]
sms) SpaceMatch
sm = [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' [(Space, [CodeType])]
sms forall a b. (a -> b) -> a -> b
$ Space -> [CodeType] -> SpaceMatch -> SpaceMatch
matchSpace Space
s [CodeType]
ct SpaceMatch
sm
        matchSpaces' [] SpaceMatch
sm = SpaceMatch
sm

-- Optional Features can be added to the program or left it out
data OptionalFeatures = OptFeats{
  OptionalFeatures -> DocConfig
docConfig :: DocConfig,
  OptionalFeatures -> LogConfig
logConfig :: LogConfig,
  -- | Turns generation of different auxiliary (non-source-code) files on or off.
  OptionalFeatures -> [AuxFile]
auxFiles :: [AuxFile]
}
-- | Constructor to create a OptionalFeatures
makeOptFeats :: DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats :: DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats = DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
OptFeats

-- | Configuration for Doxygen documentation
data DocConfig = DocConfig {
  -- | Turns Doxygen comments for different code structures on or off.
  DocConfig -> [Comments]
comments :: [Comments],
  -- | Standard output from running Doxygen: verbose or quiet?
  DocConfig -> Verbosity
doxVerbosity :: Verbosity,
  -- | Turns date field on or off in the generated module-level Doxygen comments.
  DocConfig -> Visibility
dates :: Visibility
}
-- | Constructor to create a DocConfig
makeDocConfig :: [Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig :: [Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig = [Comments] -> Verbosity -> Visibility -> DocConfig
DocConfig

-- | Comment implementation options.
data Comments = CommentFunc -- ^ Function/method-level comments.
              | CommentClass -- ^ Class-level comments.
              | CommentMod -- ^ File/Module-level comments.
              deriving Comments -> Comments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comments -> Comments -> Bool
$c/= :: Comments -> Comments -> Bool
== :: Comments -> Comments -> Bool
$c== :: Comments -> Comments -> Bool
Eq

-- | Renders options for implementation of comments.
instance RenderChoices Comments where
  showChs :: Comments -> Sentence
showChs Comments
CommentFunc = String -> Sentence
S String
"CommentFunc"
  showChs Comments
CommentClass = String -> Sentence
S String
"CommentClass"
  showChs Comments
CommentMod = String -> Sentence
S String
"CommentMod"

-- | Doxygen file verbosity options.
data Verbosity = Verbose | Quiet

-- | Renders options for doxygen verbosity.
instance RenderChoices Verbosity where
  showChs :: Verbosity -> Sentence
showChs Verbosity
Verbose = String -> Sentence
S String
"Verbose"
  showChs Verbosity
Quiet = String -> Sentence
S String
"Quiet"

-- | Doxygen date-field visibility options.
data Visibility = Show
                | Hide

-- | Renders options for doxygen date-field visibility.
instance RenderChoices Visibility where
  showChs :: Visibility -> Sentence
showChs Visibility
Show = String -> Sentence
S String
"Show"
  showChs Visibility
Hide = String -> Sentence
S String
"Hide"

-- | Log Configuration
data LogConfig = LogConfig {
  -- | Turns different forms of logging on or off.
  LogConfig -> [Logging]
logging :: [Logging],
  -- | Name of log file.
  LogConfig -> String
logFile :: FilePath
}
-- | Constructor to create a LogConfig
makeLogConfig :: [Logging] -> FilePath -> LogConfig
makeLogConfig :: [Logging] -> String -> LogConfig
makeLogConfig = [Logging] -> String -> LogConfig
LogConfig

-- | Logging options for function calls and variable assignments.
-- Eq instances required for Logging and Comments because generator needs to
-- check membership of these elements in lists
data Logging = LogFunc -- ^ Log messages generated for function calls.
             | LogVar -- ^ Log messages generated for variable assignments.
             deriving Logging -> Logging -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Logging -> Logging -> Bool
$c/= :: Logging -> Logging -> Bool
== :: Logging -> Logging -> Bool
$c== :: Logging -> Logging -> Bool
Eq

-- | Renders options for program logging.
instance RenderChoices Logging where
  showChs :: Logging -> Sentence
showChs Logging
LogFunc = String -> Sentence
S String
"LogFunc"
  showChs Logging
LogVar = String -> Sentence
S String
"LogVar"

-- | Currently we only support two kind of auxiliary files: sample input file, readme.
-- To generate a sample input file compatible with the generated program,
-- 'FilePath' is the path to the user-provided file containing a sample set of input data.
data AuxFile = SampleInput FilePath
             | ReadME
             deriving AuxFile -> AuxFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuxFile -> AuxFile -> Bool
$c/= :: AuxFile -> AuxFile -> Bool
== :: AuxFile -> AuxFile -> Bool
$c== :: AuxFile -> AuxFile -> Bool
Eq

-- | Renders options for auxiliary file generation.
instance RenderChoices AuxFile where
  showChs :: AuxFile -> Sentence
showChs (SampleInput String
fp) = String -> Sentence
S String
"SampleInput" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
fp
  showChs AuxFile
ReadME = String -> Sentence
S String
"ReadME"

-- | Gets the file path to a sample input data set from a 'Choices' structure, if
-- the user chose to generate a sample input file.
getSampleData :: Choices -> Maybe FilePath
getSampleData :: Choices -> Maybe String
getSampleData Choices
chs = [AuxFile] -> Maybe String
getSampleData' (OptionalFeatures -> [AuxFile]
auxFiles forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs)
  where getSampleData' :: [AuxFile] -> Maybe String
getSampleData' [] = forall a. Maybe a
Nothing
        getSampleData' (SampleInput String
fp:[AuxFile]
_) = forall a. a -> Maybe a
Just String
fp
        getSampleData' (AuxFile
_:[AuxFile]
xs) = [AuxFile] -> Maybe String
getSampleData' [AuxFile]
xs

-- | Predicate that returns true if the list of 'AuxFile's includes a 'SampleInput'.
hasSampleInput :: [AuxFile] -> Bool
hasSampleInput :: [AuxFile] -> Bool
hasSampleInput [] = Bool
False
hasSampleInput (SampleInput String
_:[AuxFile]
_) = Bool
True
hasSampleInput (AuxFile
_:[AuxFile]
xs) = [AuxFile] -> Bool
hasSampleInput [AuxFile]
xs

-- | SRS Constraints
data Constraints = Constraints{
  Constraints -> ConstraintBehaviour
onSfwrConstraint :: ConstraintBehaviour,
  Constraints -> ConstraintBehaviour
onPhysConstraint :: ConstraintBehaviour
}
-- | Constructor to create a Constraints
makeConstraints :: ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints :: ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints = ConstraintBehaviour -> ConstraintBehaviour -> Constraints
Constraints

-- | Constraint behaviour options within program.
data ConstraintBehaviour = Warning -- ^ Print warning when constraint violated.
                         | Exception -- ^ Throw exception when constraint violated.

-- | Renders options for program implementation.
instance RenderChoices ConstraintBehaviour where
  showChs :: ConstraintBehaviour -> Sentence
showChs ConstraintBehaviour
Warning = String -> Sentence
S String
"Warning"
  showChs ConstraintBehaviour
Exception = String -> Sentence
S String
"Exception"

-- | External Library Options
newtype ExtLib = Math ODE

-- | All Information needed to solve an ODE
data ODE = ODE{
  -- FIXME: ODEInfos should be automatically built from Instance models when
  -- needed, but we can't do that yet so I'm passing it through Choices instead.
  -- This choice should really just be for an ODEMethod
  -- | ODE information.
  ODE -> [ODEInfo]
odeInfo :: [ODEInfo],
  -- | Preferentially-ordered list ODE libraries to try.
  ODE -> [ODELibPckg]
odeLib :: [ODELibPckg]
}
-- | Constructor to create an ODE
makeODE :: [ODEInfo] -> [ODELibPckg] -> ODE
makeODE :: [ODEInfo] -> [ODELibPckg] -> ODE
makeODE = [ODEInfo] -> [ODELibPckg] -> ODE
ODE

-- | Default choices to be used as the base from which design specifications
-- can be built.
defaultChoices :: Choices
defaultChoices :: Choices
defaultChoices = Choices {
  lang :: [Lang]
lang = [Lang
Python],
  architecture :: Architecture
architecture = Modularity -> ImplementationType -> Architecture
makeArchit (InputModule -> Modularity
Modular InputModule
Combined) ImplementationType
Program,
  dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Bundled ConstantStructure
Inline ConstantRepr
Const,
  maps :: Maps
maps = ConceptMatchMap -> SpaceMatch -> Maps
makeMaps
    (forall c. HasUID c => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts ([] :: [(SimpleQDef, [CodeConcept])]))
    SpaceMatch
spaceToCodeType,
  optFeats :: OptionalFeatures
optFeats = DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats
    ([Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig [] Verbosity
Verbose Visibility
Hide)
    ([Logging] -> String -> LogConfig
makeLogConfig [] String
"log.txt")
    [AuxFile
ReadME],
  srsConstraints :: Constraints
srsConstraints = ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints ConstraintBehaviour
Exception ConstraintBehaviour
Warning,
  extLibs :: [ExtLib]
extLibs = [],
  folderVal :: Int
folderVal = Int
4
}

-- | Renders 'Choices' as 'Sentence's.
choicesSent :: Choices -> [Sentence]
choicesSent :: Choices -> [Sentence]
choicesSent Choices
chs = forall a b. (a -> b) -> [a] -> [b]
map (Sentence, Sentence) -> Sentence
chsFieldSent [
    (String -> Sentence
S String
"Languages",                     [Sentence] -> Sentence
foldlSent_ forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Sentence
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Choices -> [Lang]
lang Choices
chs),
    (String -> Sentence
S String
"Modularity",                    forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs),
    (String -> Sentence
S String
"Input Structure",               forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs),
    (String -> Sentence
S String
"Constant Structure",            forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantStructure
constStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs),
    (String -> Sentence
S String
"Constant Representation",       forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantRepr
constRepr forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs),
    (String -> Sentence
S String
"Implementation Type",           forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ Architecture -> ImplementationType
impType forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs),
    (String -> Sentence
S String
"Software Constraint Behaviour", forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ Constraints -> ConstraintBehaviour
onSfwrConstraint forall a b. (a -> b) -> a -> b
$ Choices -> Constraints
srsConstraints Choices
chs),
    (String -> Sentence
S String
"Physical Constraint Behaviour", forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ Constraints -> ConstraintBehaviour
onPhysConstraint forall a b. (a -> b) -> a -> b
$ Choices -> Constraints
srsConstraints Choices
chs),
    (String -> Sentence
S String
"Comments",                      forall a. RenderChoices a => [a] -> Sentence
showChsList forall a b. (a -> b) -> a -> b
$ DocConfig -> [Comments]
comments forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> DocConfig
docConfig forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs),
    (String -> Sentence
S String
"Dox Verbosity",                 forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ DocConfig -> Verbosity
doxVerbosity forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> DocConfig
docConfig forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs),
    (String -> Sentence
S String
"Dates",                         forall a. RenderChoices a => a -> Sentence
showChs forall a b. (a -> b) -> a -> b
$ DocConfig -> Visibility
dates forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> DocConfig
docConfig forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs),
    (String -> Sentence
S String
"Log File Name",                 String -> Sentence
S forall a b. (a -> b) -> a -> b
$ LogConfig -> String
logFile forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> LogConfig
logConfig forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs),
    (String -> Sentence
S String
"Logging",                       forall a. RenderChoices a => [a] -> Sentence
showChsList forall a b. (a -> b) -> a -> b
$ LogConfig -> [Logging]
logging forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> LogConfig
logConfig forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs),
    (String -> Sentence
S String
"Auxiliary Files",               forall a. RenderChoices a => [a] -> Sentence
showChsList forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> [AuxFile]
auxFiles forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs)
  ]

-- | Helper to combine pairs of 'Sentence's for rendering 'Choices'.
chsFieldSent :: (Sentence, Sentence) -> Sentence
chsFieldSent :: (Sentence, Sentence) -> Sentence
chsFieldSent (Sentence
rec, Sentence
chc) = Sentence
rec Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"selected as" Sentence -> Sentence -> Sentence
+:+. Sentence
chc