-- | 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)
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)

-- 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]
}

-- | Renders program choices as a 'Sentence'.
class RenderChoices a where
    showChs :: a -> Sentence
    showChsList :: [a] -> Sentence
    showChsList lst :: [a]
lst = [Sentence] -> Sentence
foldlSent_ ((a -> Sentence) -> [a] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map a -> Sentence
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 Unmodular = String -> Sentence
S "Unmodular"
  showChs (Modular Combined) = String -> Sentence
S "Modular Combined"
  showChs (Modular Separated)= String -> Sentence
S "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 c :: Choices
c = Modularity -> InputModule
inputModule' (Modularity -> InputModule) -> Modularity -> InputModule
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
c
  where inputModule' :: Modularity -> InputModule
inputModule' Unmodular = InputModule
Combined
        inputModule' (Modular im :: 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 Library = String -> Sentence
S "Library"
  showChs Program = String -> Sentence
S "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 Unbundled = String -> Sentence
S "Unbundled"
  showChs Bundled = String -> Sentence
S "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 Inline = String -> Sentence
S "Inline"
  showChs WithInputs = String -> Sentence
S "WithInputs"
  showChs (Store Unbundled) = String -> Sentence
S "Store Unbundled"
  showChs (Store Bundled) = String -> Sentence
S "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 Var = String -> Sentence
S "Var"
  showChs Const = String -> Sentence
S "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
(CodeConcept -> CodeConcept -> Bool)
-> (CodeConcept -> CodeConcept -> Bool) -> Eq CodeConcept
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 Pi = String -> Sentence
S "Pi"

-- | Builds a 'ConceptMatchMap' from an association list of chunks and 'CodeConcepts'.
matchConcepts :: (HasUID c) => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts :: [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts = [(UID, [CodeConcept])] -> ConceptMatchMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(UID, [CodeConcept])] -> ConceptMatchMap)
-> ([(c, [CodeConcept])] -> [(UID, [CodeConcept])])
-> [(c, [CodeConcept])]
-> ConceptMatchMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, [CodeConcept]) -> (UID, [CodeConcept]))
-> [(c, [CodeConcept])] -> [(UID, [CodeConcept])]
forall a b. (a -> b) -> [a] -> [b]
map (\(cnc :: c
cnc,cdc :: [CodeConcept]
cdc) -> (c
cnc c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
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 _ [] _ = String -> SpaceMatch
forall a. HasCallStack => String -> a
error "Must match each Space to at least one CodeType"
matchSpace s :: Space
s ts :: [CodeType]
ts sm :: SpaceMatch
sm = \sp :: Space
sp -> if Space
sp Space -> Space -> Bool
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 spMtchs :: [(Space, [CodeType])]
spMtchs = [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' [(Space, [CodeType])]
spMtchs SpaceMatch
spaceToCodeType
  where matchSpaces' :: [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' ((s :: Space
s,ct :: [CodeType]
ct):sms :: [(Space, [CodeType])]
sms) sm :: SpaceMatch
sm = [(Space, [CodeType])] -> SpaceMatch -> SpaceMatch
matchSpaces' [(Space, [CodeType])]
sms (SpaceMatch -> SpaceMatch) -> SpaceMatch -> SpaceMatch
forall a b. (a -> b) -> a -> b
$ Space -> [CodeType] -> SpaceMatch -> SpaceMatch
matchSpace Space
s [CodeType]
ct SpaceMatch
sm
        matchSpaces' [] sm :: 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
(Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool) -> Eq Comments
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 CommentFunc = String -> Sentence
S "CommentFunc"
  showChs CommentClass = String -> Sentence
S "CommentClass"
  showChs CommentMod = String -> Sentence
S "CommentMod"

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

-- | Renders options for doxygen verbosity.
instance RenderChoices Verbosity where
  showChs :: Verbosity -> Sentence
showChs Verbose = String -> Sentence
S "Verbose"
  showChs Quiet = String -> Sentence
S "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 Show = String -> Sentence
S "Show"
  showChs Hide = String -> Sentence
S "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
(Logging -> Logging -> Bool)
-> (Logging -> Logging -> Bool) -> Eq Logging
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 LogFunc = String -> Sentence
S "LogFunc"
  showChs LogVar = String -> Sentence
S "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
(AuxFile -> AuxFile -> Bool)
-> (AuxFile -> AuxFile -> Bool) -> Eq AuxFile
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 fp :: String
fp) = String -> Sentence
S "SampleInput" Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
fp
  showChs ReadME = String -> Sentence
S "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 chs :: Choices
chs = [AuxFile] -> Maybe String
getSampleData' (OptionalFeatures -> [AuxFile]
auxFiles (OptionalFeatures -> [AuxFile]) -> OptionalFeatures -> [AuxFile]
forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs)
  where getSampleData' :: [AuxFile] -> Maybe String
getSampleData' [] = Maybe String
forall a. Maybe a
Nothing
        getSampleData' (SampleInput fp :: String
fp:_) = String -> Maybe String
forall a. a -> Maybe a
Just String
fp
        getSampleData' (_:xs :: [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 _:_) = Bool
True
hasSampleInput (_:xs :: [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 Warning = String -> Sentence
S "Warning"
  showChs Exception = String -> Sentence
S "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]
-> Architecture
-> DataInfo
-> Maps
-> OptionalFeatures
-> Constraints
-> [ExtLib]
-> Choices
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 
    ([(SimpleQDef, [CodeConcept])] -> ConceptMatchMap
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 [] "log.txt") 
    [AuxFile
ReadME],
  srsConstraints :: Constraints
srsConstraints = ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints ConstraintBehaviour
Exception ConstraintBehaviour
Warning,
  extLibs :: [ExtLib]
extLibs = []
}

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