From dfe64d4196ea4531e1b4543b3c7076bdad91aac7 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 2 Jan 2024 12:21:17 -0500 Subject: [PATCH 1/9] Add language extensions to grammar - Add space between .. math:: and content in template - Add disable extension - Match descriptions with GHC manual - Satisfy fourmolu (somewhat) --- Cabal-described/src/Distribution/Described.hs | 49 +- .../src/Language/Haskell/Extension.hs | 455 ++++++++++++++++++ buildinfo-reference-generator/src/Main.hs | 27 +- buildinfo-reference-generator/template.zinza | 6 + 4 files changed, 534 insertions(+), 3 deletions(-) diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs index 717fd6a5c7a..1916d37e439 100644 --- a/Cabal-described/src/Distribution/Described.hs +++ b/Cabal-described/src/Distribution/Described.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} module Distribution.Described ( Described (..), describeDoc, @@ -20,6 +22,10 @@ module Distribution.Described ( reSpacedComma, reHsString, reUnqualComponent, + -- * Language Extensions + reKnownExtension, + reDisableExtension, + reXs, -- * describeFlagAssignmentNonEmpty, -- * Lists @@ -102,7 +108,7 @@ import Distribution.Types.UnqualComponentName (UnqualComponentName) import Distribution.Utils.Path (SymbolicPath, RelativePath) import Distribution.Verbosity (Verbosity) import Distribution.Version (Version, VersionRange) -import Language.Haskell.Extension (Extension, Language, knownLanguages) +import Language.Haskell.Extension -- | Class describing the pretty/parsec format of a. class (Pretty a, Parsec a) => Described a where @@ -181,6 +187,42 @@ reComma = reChar ',' reSpacedComma :: GrammarRegex a reSpacedComma = RESpaces <> reComma <> RESpaces +------------------------------------------------------------------------------- +-- Language extensions +------------------------------------------------------------------------------- + +reXs :: [KnownExtension] -> GrammarRegex a +reXs xs = REUnion (fromString . prettyShow <$> xs) + +reKnownExtension :: GrammarRegex a +reKnownExtension = REUnion + [ RENamed "interactive-extension" $ reXs xGroupInteractive + , RENamed "phase-extension" $ reXs xGroupPhase + , RENamed "syntax-extension" $ reXs xGroupSyntax + , RENamed "import-export-extension" $ reXs xGroupImportExport + , RENamed "type-extension" $ reXs xGroupTypes + , RENamed "record-extension" $ reXs xGroupRecords + , RENamed "deriving-extension" $ reXs xGroupDeriving + , RENamed "pattern-extension" $ reXs xGroupPatterns + , RENamed "classes-instances-extension" $ reXs xGroupClassesInstances + , RENamed "literals-extension" $ reXs xGroupLiterals + , RENamed "constraint-extension" $ reXs xGroupConstraints + , RENamed "type-signature-extension" $ reXs xGroupTypeSignatures + , RENamed "binding-generalisation-extension" $ reXs xGroupBindingsGeneralisation + , RENamed "template-haskell-extension" $ reXs xGroupTemplates + , RENamed "bang-strict-extension" $ reXs xGroupBangStrict + , RENamed "parallel-concurrent-extension" $ reXs xGroupParallelConcurrent + , RENamed "unboxed-primitive-extension" $ reXs xGroupUnboxedPrimitive + , RENamed "foreign-extension" $ reXs xGroupForeign + , RENamed "safe-extension" $ reXs xGroupSafe + , RENamed "miscellaneous-extension" $ reXs xGroupMiscellaneous + , RENamed "bugs-extension" $ reXs xGroupBugs + , RENamed "ungrouped-extension" $ reXs xUngrouped + ] + +reDisableExtension :: GrammarRegex a +reDisableExtension = REUnion ["No" <> RENamed "enable-extension" reKnownExtension] + ------------------------------------------------------------------------------- -- Character sets ------------------------------------------------------------------------------- @@ -401,7 +443,10 @@ instance Described ExposedModule where describe _ = RETodo instance Described Extension where - describe _ = RETodo + describe _ = REUnion + [ RENamed "enable-extension" reKnownExtension + , RENamed "disable-extension" reDisableExtension + ] instance Described FlagAssignment where describe _ = REMunch RESpaces1 $ diff --git a/Cabal-syntax/src/Language/Haskell/Extension.hs b/Cabal-syntax/src/Language/Haskell/Extension.hs index 13796c80666..f5586e5fdc0 100644 --- a/Cabal-syntax/src/Language/Haskell/Extension.hs +++ b/Cabal-syntax/src/Language/Haskell/Extension.hs @@ -22,11 +22,36 @@ module Language.Haskell.Extension , deprecatedExtensions , classifyExtension , knownExtensions + + -- * Extension groups + , xGroupInteractive + , xGroupPhase + , xGroupSyntax + , xGroupImportExport + , xGroupTypes + , xGroupRecords + , xGroupDeriving + , xGroupPatterns + , xGroupClassesInstances + , xGroupLiterals + , xGroupConstraints + , xGroupTypeSignatures + , xGroupBindingsGeneralisation + , xGroupTemplates + , xGroupBangStrict + , xGroupParallelConcurrent + , xGroupUnboxedPrimitive + , xGroupForeign + , xGroupSafe + , xGroupMiscellaneous + , xGroupBugs + , xUngrouped ) where import Distribution.Compat.Prelude import Data.Array (Array, Ix (inRange), accumArray, bounds, (!)) +import Data.List ((\\)) import Distribution.Parsec import Distribution.Pretty @@ -626,3 +651,433 @@ knownExtensionTable = knownExtensions :: [KnownExtension] knownExtensions = [minBound .. maxBound] + +-- The comments in the xGroup* lists are taken from the GHC User's Guide. Stop +-- the formatter from rearranging them with: +{- FOURMOLU_DISABLE -} +xGroupInteractive :: [KnownExtension] +xGroupInteractive = + [ + -- Type defaulting in GHCi + ExtendedDefaultRules + ] + +xGroupPhase :: [KnownExtension] +xGroupPhase = [CPP] + +xGroupSyntax :: [KnownExtension] +xGroupSyntax = + [ + -- Unicode syntax + UnicodeSyntax + + -- The magic hash + , MagicHash + + -- The recursive do-notation + , RecursiveDo + + -- Applicative do-notation + , ApplicativeDo + + -- Qualified do-notation + , QualifiedDo + + -- Parallel List Comprehensions + , ParallelListComp + + -- Generalized (SQL-like) List comprehensions + , TransformListComp + + -- Monad comprehensions + , MonadComprehensions + + -- Overloaded lists + , OverloadedLists + + -- Rebindable syntax and the implicit Prelude import + , ImplicitPrelude + , RebindableSyntax -- implies NoImplicitPrelude + + -- Postfix operators + , PostfixOperators + + -- Tuple sections + , TupleSections + + -- Lambda-case + , LambdaCase + + -- Empty case + , EmptyCase + + -- Multi-way if-expressions + , MultiWayIf + + -- Arrow notation + , Arrows + + -- Lexical negation + , LexicalNegation + + -- More liberal syntax for function arguments + , BlockArguments + ] + +xGroupImportExport :: [KnownExtension] +xGroupImportExport = + [ + -- Package-qualified imports + PackageImports + + -- Explicit namespaces in import/export + , ExplicitNamespaces + + -- Writing qualified in postpositive position + , ImportQualifiedPost + ] + +xGroupTypes :: [KnownExtension] +xGroupTypes = + [ + -- Data types with no constructors + EmptyDataDecls + + -- Data type contexts + , DatatypeContexts -- deprecated + + -- Type operators + , TypeOperators + + -- Liberalised type synonyms + , LiberalTypeSynonyms -- implies ExplicitForAll + + -- Existentially quantified data constructors + , ExistentialQuantification -- implies ExplicitForAll + + -- Declaring data types with explicit constructor signatures + , GADTSyntax -- implied by GADTs + + -- Generalised algebraic data types (GADTs) + , GADTs -- implies MonoLocalBinds, GADTSyntax + + -- Type families + , TypeFamilies -- implies MonoLocalBinds, KindSignatures, ExplicitNamespaces + + -- Injective type families + , TypeFamilyDependencies -- implies TypeFamilies + + -- Datatype promotion + , DataKinds + + -- Type-level data declarations + , TypeData + + -- Kind polymorphism + , TypeInType -- implies PolyKinds, DataKinds, KindSignatures + , PolyKinds -- implies KindSignatures + , CUSKs -- legacy feature replaced by StandaloneKindSignatures + , StandaloneKindSignatures -- implies NoCUSKs + , StarIsType + + -- Visible type application + , TypeApplications + + -- Type abstractions + , TypeAbstractions + + -- Required type arguments + , RequiredTypeArguments + + -- Arbitrary-rank polymorphism + , RankNTypes -- implies ExplicitForAll + , Rank2Types -- deprecated alias of RankNTypes + + -- Subsumption + , DeepSubsumption + + -- Impredicative polymorphism + , ImpredicativeTypes -- implies RankNTypes + + -- Linear types + , LinearTypes -- implies MonoLocalBinds + + -- Role annotations + , RoleAnnotations + ] + +xGroupRecords :: [KnownExtension] +xGroupRecords = + [ + -- Traditional record syntax + TraditionalRecordSyntax + + -- Record field disambiguation + , DisambiguateRecordFields + + -- Duplicate record fields + , DuplicateRecordFields + + -- Field selectors + , FieldSelectors + + -- Record puns + , NamedFieldPuns + + -- Record wildcards + , RecordWildCards + + -- Overloaded record dot + , OverloadedRecordDot + + -- Overloaded record update + , OverloadedRecordUpdate + ] + +xGroupDeriving :: [KnownExtension] +xGroupDeriving = + [ EmptyDataDeriving, StandaloneDeriving + , DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveDataTypeable, DeriveLift + , GeneralizedNewtypeDeriving, GeneralisedNewtypeDeriving + , DeriveAnyClass + , DerivingStrategies + , DerivingVia + ] + +xGroupPatterns :: [KnownExtension] +xGroupPatterns = + [ + -- Pattern guards + PatternGuards + + -- View patterns + , ViewPatterns + + -- n+k patterns + , NPlusKPatterns + + -- Pattern synonyms + , PatternSynonyms + ] + +xGroupClassesInstances :: [KnownExtension] +xGroupClassesInstances = + [ + -- Multi-parameter type classes + MultiParamTypeClasses -- implies ConstrainedClassMethods, implied by FunctionalDependencies + + -- Undecidable (or recursive) superclasses + , UndecidableSuperClasses + + -- Constrained class method types + , ConstrainedClassMethods -- implied by MultiParamTypeClasses + + -- Default method signatures + , DefaultSignatures + + -- Nullary type classes + , NullaryTypeClasses -- deprecated, replaced by MultiParamTypeClasses + + -- Functional dependencies + , FunctionalDependencies -- implies MultiParamTypeClasses + + --Relaxed rules for the instance head + , TypeSynonymInstances -- implied by FlexibleInstances + , FlexibleInstances -- implies TypeSynonymInstances + + -- Undecided instances and loopy superclasses + , UndecidableInstances + + -- Overlapping instances + , OverlappingInstances -- deprecated + , IncoherentInstances -- deprecated + + -- Instance signatures: type signatures in instance declarations + , InstanceSigs + ] + +xGroupLiterals :: [KnownExtension] +xGroupLiterals = + [ + -- Negative literals + NegativeLiterals + + -- Bindary integer literals + , BinaryLiterals + + -- Hexadecimal floating point literals + , HexFloatLiterals + + -- Fractional looking integer literals + , NumDecimals + + -- Sized primitive literal syntax + , ExtendedLiterals + + -- Numeric underscores + , NumericUnderscores + + -- Overloaded string literals + , OverloadedStrings + + -- Overloaded labels + , OverloadedLabels + ] + +xGroupConstraints :: [KnownExtension] +xGroupConstraints = + [ + -- Loosening restrictions on class contexts + FlexibleContexts + + -- The Constraint kind + , ConstraintKinds + + -- Quantified constraints + , QuantifiedConstraints -- implies ExplicitForAll + ] + +xGroupTypeSignatures :: [KnownExtension] +xGroupTypeSignatures = + [ + -- Explicit universal quantification (forall) + ExplicitForAll + + -- Ambiguous types and the ambiguity check + , AllowAmbiguousTypes + + -- Explicitly-kinded quantification + , KindSignatures -- implied by TypeFamilies, PolyKinds + + -- Lexically scoped type variables + , ScopedTypeVariables -- implies ExplicitForAll + + -- Implicit parameters + , ImplicitParams + + -- Partial Type Signatures + , PartialTypeSignatures + + -- Named Wildcards + , NamedWildCards + ] + +xGroupBindingsGeneralisation :: [KnownExtension] +xGroupBindingsGeneralisation = + [ + -- Switching off the monomorphism restriction + MonomorphismRestriction + + -- Let-generalisation + , MonoLocalBinds -- implied by TypeFamilies, GADTs + ] + +xGroupTemplates :: [KnownExtension] +xGroupTemplates = + [ + -- Template Haskell + TemplateHaskell -- implies TemplateHaskellQuotes + , TemplateHaskellQuotes + + -- Template Haskell Quasi-quotation + , QuasiQuotes + ] + +xGroupBangStrict :: [KnownExtension] +xGroupBangStrict = + [ + -- Bang patterns + BangPatterns + + -- Strict-by-default data types + , StrictData + + -- Strict-by-default pattern bindings + , Strict -- implies StrictData + ] + +-- | Concurrent Haskell is enabled by default +xGroupParallelConcurrent :: [KnownExtension] +xGroupParallelConcurrent = + [ + -- Static pointers + StaticPointers + ] + +xGroupUnboxedPrimitive :: [KnownExtension] +xGroupUnboxedPrimitive = + [ + -- Unboxed tuples + UnboxedTuples -- implies UnboxedSums + + -- Unboxed sums + , UnboxedSums -- implied by UnboxedTuples + + -- Unlifted Newtypes + , UnliftedNewtypes + + -- Unlifted Datatypes + , UnliftedDatatypes -- implies DataKinds, StandaloneKindSignatures + ] + +xGroupForeign :: [KnownExtension] +xGroupForeign = + [ + -- Foreign function interface (FFI) + ForeignFunctionInterface + + -- Unlifted FFI Types + , UnliftedFFITypes + + -- Primitive imports + , GHCForeignImportPrim + + -- Interruptible foreign calls + , InterruptibleFFI + + -- The CAPI calling convention + , CApiFFI + ] + +xGroupSafe :: [KnownExtension] +xGroupSafe = [Safe, Trustworthy, Unsafe] + +xGroupMiscellaneous :: [KnownExtension] +xGroupMiscellaneous = + [ + -- Deriving representations + DeriveGeneric + ] + +xGroupBugs :: [KnownExtension] +xGroupBugs = + [ + -- Context-free syntax + NondecreasingIndentation + ] + +-- | Extensions that are not in other groups, likley undocumented. +xUngrouped :: [KnownExtension] +xUngrouped = + (((((((((((((((((((((knownExtensions + \\ xGroupInteractive) + \\ xGroupPhase) + \\ xGroupSyntax) + \\ xGroupImportExport) + \\ xGroupTypes) + \\ xGroupRecords) + \\ xGroupDeriving) + \\ xGroupPatterns) + \\ xGroupClassesInstances) + \\ xGroupLiterals) + \\ xGroupConstraints) + \\ xGroupTypeSignatures) + \\ xGroupBindingsGeneralisation) + \\ xGroupTemplates) + \\ xGroupBangStrict) + \\ xGroupParallelConcurrent) + \\ xGroupUnboxedPrimitive) + \\ xGroupForeign) + \\ xGroupSafe) + \\ xGroupMiscellaneous) + \\ xGroupBugs) diff --git a/buildinfo-reference-generator/src/Main.hs b/buildinfo-reference-generator/src/Main.hs index 309d711b55e..7d2b6654727 100644 --- a/buildinfo-reference-generator/src/Main.hs +++ b/buildinfo-reference-generator/src/Main.hs @@ -31,6 +31,7 @@ import Distribution.Utils.GrammarRegex import Distribution.ModuleName (ModuleName) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange) +import Language.Haskell.Extension ------------------------------------------------------------------------------- -- Main @@ -48,7 +49,31 @@ main = do , zPackageDescriptionFields = fromReference packageDescriptionFieldGrammar , zTestSuiteFields = fromReference $ testSuiteFieldGrammar // buildInfoFieldGrammar , zProductions = - [ zproduction "hs-string" reHsString + [ zproduction "interactive-extension" (reXs xGroupInteractive) "Language Extensions related to GHC interactive." + , zproduction "phase-extension" (reXs xGroupPhase) "Language Extensions related to a particular GHC phase." + , zproduction "syntax-extension" (reXs xGroupSyntax) "Syntax Language Extensions." + , zproduction "import-export-extension" (reXs xGroupImportExport) "Import and Export Language Extensions." + , zproduction "type-extension" (reXs xGroupTypes) "Language Extensions for Types." + , zproduction "record-extension" (reXs xGroupRecords) "Record Language Extensions." + , zproduction "deriving-extension" (reXs xGroupDeriving) "Language Extensions for deriving mechanisms." + , zproduction "pattern-extension" (reXs xGroupPatterns) "Patterns Language Extensions." + , zproduction "classes-instances-extension" (reXs xGroupClassesInstances) "Language Extensions for class and instance declarations." + , zproduction "literal-extension" (reXs xGroupLiterals) "Literals Language Extensions." + , zproduction "constraint-extension" (reXs xGroupConstraints) "Constraint Language Extensions." + , zproduction "type-signature-extension" (reXs xGroupTypeSignatures) "Type Signature Language Extensions." + , zproduction "binding-generalisation-extension" (reXs xGroupBindingsGeneralisation) "Language Extensions for bindings and generalisation " + , zproduction "template-haskell-extension" (reXs xGroupTemplates) "Template Haskell Language Extensions." + , zproduction "bang-strict-extension" (reXs xGroupBangStrict) "Bang pattern and Strict Haskell Language Extensions." + , zproduction "parallel-concurrent-extension" (reXs xGroupParallelConcurrent) "Parallel and Concurrent Language Extensions." + , zproduction "unboxed-primitive-extension" (reXs xGroupUnboxedPrimitive) "Unboxed types and Primitive operations Language Extensions." + , zproduction "foreign-extension" (reXs xGroupForeign) "Foreign function interface (FFI) Language Extensions." + , zproduction "safe-extension" (reXs xGroupSafe) "Safe Haskell Language Extensions." + , zproduction "miscellaneous-extension" (reXs xGroupMiscellaneous) "Miscellaneous Language Extensions." + , zproduction "bugs-extension" (reXs xGroupBugs) "Language Extensions related to GHC bugs and infelicities." + , zproduction "ungrouped-extension" (reXs xUngrouped) "Language Extensions not belonging to other extension groups, includes undocumented extensions." + , zproduction "enable-extension" reKnownExtension "GHC Language Extensions, some of these may be on by default." + , zproduction "disable-extension" reDisableExtension "Disable a GHC Language Extension." + , zproduction "hs-string" reHsString "String as in Haskell; it's recommended to avoid using Haskell-specific escapes." , zproduction "unqual-name" reUnqualComponent $ unwords [ "Unqualified component names are used for package names, component names etc. but not flag names." diff --git a/buildinfo-reference-generator/template.zinza b/buildinfo-reference-generator/template.zinza index 8f05a416a8f..8ae6cffb52c 100644 --- a/buildinfo-reference-generator/template.zinza +++ b/buildinfo-reference-generator/template.zinza @@ -108,6 +108,7 @@ Comma separated Note, the comma cannot exist alone. .. math:: + \mathrm{commalist}(\mathit{element}) = {{commaList}} @@ -119,6 +120,7 @@ Optional comma separated an example field is :pkg-field:`default-extensions`. .. math:: + \mathrm{optcommalist}(\mathit{element}) = {{optCommaList}} @@ -132,6 +134,7 @@ In the syntax definitions below the following non-terminal symbols are used: {{ production.description }} .. math:: + {{ production.syntax }} {% endfor %} @@ -163,6 +166,7 @@ Build info fields {% if notNull field.syntax %} .. math:: + {{field.syntax}} {% endif %} @@ -195,6 +199,7 @@ Package description fields {% if notNull field.syntax %} .. math:: + {{field.syntax}} {% endif %} @@ -227,6 +232,7 @@ Test-suite fields {% if notNull field.syntax %} .. math:: + {{field.syntax}} {% endif %} From 8009070fff7313470fbc62c8aa19a271e1264423 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 2 Jan 2024 13:55:57 -0500 Subject: [PATCH 2/9] Use MathJax 3's SVG renderer --- doc/conf.py | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/doc/conf.py b/doc/conf.py index 6f70381427d..25918eb50bd 100644 --- a/doc/conf.py +++ b/doc/conf.py @@ -72,7 +72,8 @@ html_title = "Cabal {} User's Guide".format(release) html_short_title = "Cabal %s User's Guide" % release html_logo = 'images/Cabal-dark.png' -html_static_path = ['images'] +html_static_path = ['_static', 'images'] +html_css_files = ['css/custom.css'] # Convert quotes and dashes to typographically correct entities html_use_smartypants = True html_show_copyright = True @@ -102,8 +103,20 @@ # Output file base name for HTML help builder. htmlhelp_basename = 'CabalUsersGuide' -# MathJax to use HTML rendering by default (makes the text selectable, see #8453) -mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS_CHTML' +# The SVG renders clearer and quicker than the HTML (with version 3 of MathJax). +# It is not selectable immediately (with either version 3 renderer unlike with +# version 2's HTML renderer), but can be selected through the context menu, see +# #8453. +mathjax_path = 'https://cdn.jsdelivr.net/npm/mathjax@3.0.1/es5/tex-mml-svg.js' +mathjax3_config = { + 'tex': { + # Avoid a false positive infinite loop detection by increasing the buffer size. + 'maxBuffer': 1024 * 1024 + }, + 'svg': { + 'displayAlign': 'left', + } + } # -- Options for LaTeX output --------------------------------------------- From 9dfd9f263c17d734cb76ef6489acd836a75d78c4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 2 Jan 2024 13:40:06 -0500 Subject: [PATCH 3/9] Add custom CSS for docs --- doc/_static/css/custom.css | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 doc/_static/css/custom.css diff --git a/doc/_static/css/custom.css b/doc/_static/css/custom.css new file mode 100644 index 00000000000..23da06bc7c4 --- /dev/null +++ b/doc/_static/css/custom.css @@ -0,0 +1,13 @@ +mjx-container[jax="SVG"] { + color: #55a5d9; +} + +/* +TODO: Avoid overflow of mixin in field syntax reference with the TeX expression: + \mathrm{commalist}\left(\mathop{\mathit{package\text{-}name}}{\left(\mathop{\mathord{``}\mathtt{\text{:}}\mathord{"}}\mathop{\mathit{library\text{-}name}}\right)}^?{\left(\bullet\left\{ \mid\mathop{\mathord{``}\mathtt{hiding}\mathord{"}}\circ\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ{\mathop{\mathit{module\text{-}name}}}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ{\left(\mathop{\mathit{module\text{-}name}}{\left(\bullet\mathop{\mathord{``}\mathtt{as}\mathord{"}}\bullet\mathop{\mathit{module\text{-}name}}\right)}^?\right)}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}} \right\}{\left(\circ\mathop{\mathord{``}\mathtt{requires}\mathord{"}}\bullet\left\{ \mid\mathop{\mathord{``}\mathtt{hiding}\mathord{"}}\circ\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ{\mathop{\mathit{module\text{-}name}}}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ{\left(\mathop{\mathit{module\text{-}name}}{\left(\bullet\mathop{\mathord{``}\mathtt{as}\mathord{"}}\bullet\mathop{\mathit{module\text{-}name}}\right)}^?\right)}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}} \right\}\right)}^?\right)}^?\right) +To alleviate this problem and to aid readability on desktops, use the whole width of the screen for the documentation. +SEE: https://stackoverflow.com/questions/23211695/modifying-content-width-of-the-sphinx-theme-read-the-docs +*/ +.wy-nav-content { + max-width: none; +} \ No newline at end of file From 760a2f8b53fac5d0b2cff02b4dbb4b768b2e3e56 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 2 Jan 2024 15:54:33 -0500 Subject: [PATCH 4/9] Move extension groups to Cabal-described --- Cabal-described/Cabal-described.cabal | 1 + Cabal-described/src/Distribution/Described.hs | 50 +- .../src/Distribution/Described/Extension.hs | 504 ++++++++++++++++++ .../src/Language/Haskell/Extension.hs | 455 ---------------- buildinfo-reference-generator/src/Main.hs | 2 +- 5 files changed, 507 insertions(+), 505 deletions(-) create mode 100644 Cabal-described/src/Distribution/Described/Extension.hs diff --git a/Cabal-described/Cabal-described.cabal b/Cabal-described/Cabal-described.cabal index 86b516d94ef..6ad857ead69 100644 --- a/Cabal-described/Cabal-described.cabal +++ b/Cabal-described/Cabal-described.cabal @@ -23,5 +23,6 @@ library exposed-modules: Distribution.Described + Distribution.Described.Extension Distribution.Utils.CharSet Distribution.Utils.GrammarRegex diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs index 1916d37e439..d15f93ade79 100644 --- a/Cabal-described/src/Distribution/Described.hs +++ b/Cabal-described/src/Distribution/Described.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} module Distribution.Described ( Described (..), describeDoc, @@ -22,10 +20,6 @@ module Distribution.Described ( reSpacedComma, reHsString, reUnqualComponent, - -- * Language Extensions - reKnownExtension, - reDisableExtension, - reXs, -- * describeFlagAssignmentNonEmpty, -- * Lists @@ -108,7 +102,7 @@ import Distribution.Types.UnqualComponentName (UnqualComponentName) import Distribution.Utils.Path (SymbolicPath, RelativePath) import Distribution.Verbosity (Verbosity) import Distribution.Version (Version, VersionRange) -import Language.Haskell.Extension +import Language.Haskell.Extension (Extension, Language, knownLanguages) -- | Class describing the pretty/parsec format of a. class (Pretty a, Parsec a) => Described a where @@ -187,42 +181,6 @@ reComma = reChar ',' reSpacedComma :: GrammarRegex a reSpacedComma = RESpaces <> reComma <> RESpaces -------------------------------------------------------------------------------- --- Language extensions -------------------------------------------------------------------------------- - -reXs :: [KnownExtension] -> GrammarRegex a -reXs xs = REUnion (fromString . prettyShow <$> xs) - -reKnownExtension :: GrammarRegex a -reKnownExtension = REUnion - [ RENamed "interactive-extension" $ reXs xGroupInteractive - , RENamed "phase-extension" $ reXs xGroupPhase - , RENamed "syntax-extension" $ reXs xGroupSyntax - , RENamed "import-export-extension" $ reXs xGroupImportExport - , RENamed "type-extension" $ reXs xGroupTypes - , RENamed "record-extension" $ reXs xGroupRecords - , RENamed "deriving-extension" $ reXs xGroupDeriving - , RENamed "pattern-extension" $ reXs xGroupPatterns - , RENamed "classes-instances-extension" $ reXs xGroupClassesInstances - , RENamed "literals-extension" $ reXs xGroupLiterals - , RENamed "constraint-extension" $ reXs xGroupConstraints - , RENamed "type-signature-extension" $ reXs xGroupTypeSignatures - , RENamed "binding-generalisation-extension" $ reXs xGroupBindingsGeneralisation - , RENamed "template-haskell-extension" $ reXs xGroupTemplates - , RENamed "bang-strict-extension" $ reXs xGroupBangStrict - , RENamed "parallel-concurrent-extension" $ reXs xGroupParallelConcurrent - , RENamed "unboxed-primitive-extension" $ reXs xGroupUnboxedPrimitive - , RENamed "foreign-extension" $ reXs xGroupForeign - , RENamed "safe-extension" $ reXs xGroupSafe - , RENamed "miscellaneous-extension" $ reXs xGroupMiscellaneous - , RENamed "bugs-extension" $ reXs xGroupBugs - , RENamed "ungrouped-extension" $ reXs xUngrouped - ] - -reDisableExtension :: GrammarRegex a -reDisableExtension = REUnion ["No" <> RENamed "enable-extension" reKnownExtension] - ------------------------------------------------------------------------------- -- Character sets ------------------------------------------------------------------------------- @@ -442,12 +400,6 @@ instance Described ExeDependency where instance Described ExposedModule where describe _ = RETodo -instance Described Extension where - describe _ = REUnion - [ RENamed "enable-extension" reKnownExtension - , RENamed "disable-extension" reDisableExtension - ] - instance Described FlagAssignment where describe _ = REMunch RESpaces1 $ REUnion [fromString "+", fromString "-"] <> describe (Proxy :: Proxy FlagName) diff --git a/Cabal-described/src/Distribution/Described/Extension.hs b/Cabal-described/src/Distribution/Described/Extension.hs new file mode 100644 index 00000000000..623e091ada8 --- /dev/null +++ b/Cabal-described/src/Distribution/Described/Extension.hs @@ -0,0 +1,504 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Distribution.Described.Extension + ( reKnownExtension + , reDisableExtension + , reXs + -- * Extension groups + , xGroupInteractive + , xGroupPhase + , xGroupSyntax + , xGroupImportExport + , xGroupTypes + , xGroupRecords + , xGroupDeriving + , xGroupPatterns + , xGroupClassesInstances + , xGroupLiterals + , xGroupConstraints + , xGroupTypeSignatures + , xGroupBindingsGeneralisation + , xGroupTemplates + , xGroupBangStrict + , xGroupParallelConcurrent + , xGroupUnboxedPrimitive + , xGroupForeign + , xGroupSafe + , xGroupMiscellaneous + , xGroupBugs + , xUngrouped + ) where + +import Data.List ((\\)) +import Data.String (IsString (..)) +import Distribution.Pretty (prettyShow) +import Distribution.Described +import Language.Haskell.Extension + +instance Described Extension where + describe _ = REUnion + [ RENamed "enable-extension" reKnownExtension + , RENamed "disable-extension" reDisableExtension + ] + +reXs :: [KnownExtension] -> GrammarRegex a +reXs xs = REUnion (fromString . prettyShow <$> xs) + +reKnownExtension :: GrammarRegex a +reKnownExtension = REUnion + [ RENamed "interactive-extension" $ reXs xGroupInteractive + , RENamed "phase-extension" $ reXs xGroupPhase + , RENamed "syntax-extension" $ reXs xGroupSyntax + , RENamed "import-export-extension" $ reXs xGroupImportExport + , RENamed "type-extension" $ reXs xGroupTypes + , RENamed "record-extension" $ reXs xGroupRecords + , RENamed "deriving-extension" $ reXs xGroupDeriving + , RENamed "pattern-extension" $ reXs xGroupPatterns + , RENamed "classes-instances-extension" $ reXs xGroupClassesInstances + , RENamed "literals-extension" $ reXs xGroupLiterals + , RENamed "constraint-extension" $ reXs xGroupConstraints + , RENamed "type-signature-extension" $ reXs xGroupTypeSignatures + , RENamed "binding-generalisation-extension" $ reXs xGroupBindingsGeneralisation + , RENamed "template-haskell-extension" $ reXs xGroupTemplates + , RENamed "bang-strict-extension" $ reXs xGroupBangStrict + , RENamed "parallel-concurrent-extension" $ reXs xGroupParallelConcurrent + , RENamed "unboxed-primitive-extension" $ reXs xGroupUnboxedPrimitive + , RENamed "foreign-extension" $ reXs xGroupForeign + , RENamed "safe-extension" $ reXs xGroupSafe + , RENamed "miscellaneous-extension" $ reXs xGroupMiscellaneous + , RENamed "bugs-extension" $ reXs xGroupBugs + , RENamed "ungrouped-extension" $ reXs xUngrouped + ] + +reDisableExtension :: GrammarRegex a +reDisableExtension = REUnion ["No" <> RENamed "enable-extension" reKnownExtension] + +-- The comments in the xGroup* lists are taken from the GHC User's Guide. Stop +-- the formatter from rearranging them with: +{- FOURMOLU_DISABLE -} +xGroupInteractive :: [KnownExtension] +xGroupInteractive = + [ + -- Type defaulting in GHCi + ExtendedDefaultRules + ] + +xGroupPhase :: [KnownExtension] +xGroupPhase = [CPP] + +xGroupSyntax :: [KnownExtension] +xGroupSyntax = + [ + -- Unicode syntax + UnicodeSyntax + + -- The magic hash + , MagicHash + + -- The recursive do-notation + , RecursiveDo + + -- Applicative do-notation + , ApplicativeDo + + -- Qualified do-notation + , QualifiedDo + + -- Parallel List Comprehensions + , ParallelListComp + + -- Generalized (SQL-like) List comprehensions + , TransformListComp + + -- Monad comprehensions + , MonadComprehensions + + -- Overloaded lists + , OverloadedLists + + -- Rebindable syntax and the implicit Prelude import + , ImplicitPrelude + , RebindableSyntax -- implies NoImplicitPrelude + + -- Postfix operators + , PostfixOperators + + -- Tuple sections + , TupleSections + + -- Lambda-case + , LambdaCase + + -- Empty case + , EmptyCase + + -- Multi-way if-expressions + , MultiWayIf + + -- Arrow notation + , Arrows + + -- Lexical negation + , LexicalNegation + + -- More liberal syntax for function arguments + , BlockArguments + ] + +xGroupImportExport :: [KnownExtension] +xGroupImportExport = + [ + -- Package-qualified imports + PackageImports + + -- Explicit namespaces in import/export + , ExplicitNamespaces + + -- Writing qualified in postpositive position + , ImportQualifiedPost + ] + +xGroupTypes :: [KnownExtension] +xGroupTypes = + [ + -- Data types with no constructors + EmptyDataDecls + + -- Data type contexts + , DatatypeContexts -- deprecated + + -- Type operators + , TypeOperators + + -- Liberalised type synonyms + , LiberalTypeSynonyms -- implies ExplicitForAll + + -- Existentially quantified data constructors + , ExistentialQuantification -- implies ExplicitForAll + + -- Declaring data types with explicit constructor signatures + , GADTSyntax -- implied by GADTs + + -- Generalised algebraic data types (GADTs) + , GADTs -- implies MonoLocalBinds, GADTSyntax + + -- Type families + , TypeFamilies -- implies MonoLocalBinds, KindSignatures, ExplicitNamespaces + + -- Injective type families + , TypeFamilyDependencies -- implies TypeFamilies + + -- Datatype promotion + , DataKinds + + -- Type-level data declarations + , TypeData + + -- Kind polymorphism + , TypeInType -- implies PolyKinds, DataKinds, KindSignatures + , PolyKinds -- implies KindSignatures + , CUSKs -- legacy feature replaced by StandaloneKindSignatures + , StandaloneKindSignatures -- implies NoCUSKs + , StarIsType + + -- Visible type application + , TypeApplications + + -- Type abstractions + , TypeAbstractions + + -- Required type arguments + , RequiredTypeArguments + + -- Arbitrary-rank polymorphism + , RankNTypes -- implies ExplicitForAll + , Rank2Types -- deprecated alias of RankNTypes + + -- Subsumption + , DeepSubsumption + + -- Impredicative polymorphism + , ImpredicativeTypes -- implies RankNTypes + + -- Linear types + , LinearTypes -- implies MonoLocalBinds + + -- Role annotations + , RoleAnnotations + ] + +xGroupRecords :: [KnownExtension] +xGroupRecords = + [ + -- Traditional record syntax + TraditionalRecordSyntax + + -- Record field disambiguation + , DisambiguateRecordFields + + -- Duplicate record fields + , DuplicateRecordFields + + -- Field selectors + , FieldSelectors + + -- Record puns + , NamedFieldPuns + + -- Record wildcards + , RecordWildCards + + -- Overloaded record dot + , OverloadedRecordDot + + -- Overloaded record update + , OverloadedRecordUpdate + ] + +xGroupDeriving :: [KnownExtension] +xGroupDeriving = + [ EmptyDataDeriving, StandaloneDeriving + , DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveDataTypeable, DeriveLift + , GeneralizedNewtypeDeriving, GeneralisedNewtypeDeriving + , DeriveAnyClass + , DerivingStrategies + , DerivingVia + ] + +xGroupPatterns :: [KnownExtension] +xGroupPatterns = + [ + -- Pattern guards + PatternGuards + + -- View patterns + , ViewPatterns + + -- n+k patterns + , NPlusKPatterns + + -- Pattern synonyms + , PatternSynonyms + ] + +xGroupClassesInstances :: [KnownExtension] +xGroupClassesInstances = + [ + -- Multi-parameter type classes + MultiParamTypeClasses -- implies ConstrainedClassMethods, implied by FunctionalDependencies + + -- Undecidable (or recursive) superclasses + , UndecidableSuperClasses + + -- Constrained class method types + , ConstrainedClassMethods -- implied by MultiParamTypeClasses + + -- Default method signatures + , DefaultSignatures + + -- Nullary type classes + , NullaryTypeClasses -- deprecated, replaced by MultiParamTypeClasses + + -- Functional dependencies + , FunctionalDependencies -- implies MultiParamTypeClasses + + --Relaxed rules for the instance head + , TypeSynonymInstances -- implied by FlexibleInstances + , FlexibleInstances -- implies TypeSynonymInstances + + -- Undecided instances and loopy superclasses + , UndecidableInstances + + -- Overlapping instances + , OverlappingInstances -- deprecated + , IncoherentInstances -- deprecated + + -- Instance signatures: type signatures in instance declarations + , InstanceSigs + ] + +xGroupLiterals :: [KnownExtension] +xGroupLiterals = + [ + -- Negative literals + NegativeLiterals + + -- Bindary integer literals + , BinaryLiterals + + -- Hexadecimal floating point literals + , HexFloatLiterals + + -- Fractional looking integer literals + , NumDecimals + + -- Sized primitive literal syntax + , ExtendedLiterals + + -- Numeric underscores + , NumericUnderscores + + -- Overloaded string literals + , OverloadedStrings + + -- Overloaded labels + , OverloadedLabels + ] + +xGroupConstraints :: [KnownExtension] +xGroupConstraints = + [ + -- Loosening restrictions on class contexts + FlexibleContexts + + -- The Constraint kind + , ConstraintKinds + + -- Quantified constraints + , QuantifiedConstraints -- implies ExplicitForAll + ] + +xGroupTypeSignatures :: [KnownExtension] +xGroupTypeSignatures = + [ + -- Explicit universal quantification (forall) + ExplicitForAll + + -- Ambiguous types and the ambiguity check + , AllowAmbiguousTypes + + -- Explicitly-kinded quantification + , KindSignatures -- implied by TypeFamilies, PolyKinds + + -- Lexically scoped type variables + , ScopedTypeVariables -- implies ExplicitForAll + + -- Implicit parameters + , ImplicitParams + + -- Partial Type Signatures + , PartialTypeSignatures + + -- Named Wildcards + , NamedWildCards + ] + +xGroupBindingsGeneralisation :: [KnownExtension] +xGroupBindingsGeneralisation = + [ + -- Switching off the monomorphism restriction + MonomorphismRestriction + + -- Let-generalisation + , MonoLocalBinds -- implied by TypeFamilies, GADTs + ] + +xGroupTemplates :: [KnownExtension] +xGroupTemplates = + [ + -- Template Haskell + TemplateHaskell -- implies TemplateHaskellQuotes + , TemplateHaskellQuotes + + -- Template Haskell Quasi-quotation + , QuasiQuotes + ] + +xGroupBangStrict :: [KnownExtension] +xGroupBangStrict = + [ + -- Bang patterns + BangPatterns + + -- Strict-by-default data types + , StrictData + + -- Strict-by-default pattern bindings + , Strict -- implies StrictData + ] + +-- | Concurrent Haskell is enabled by default +xGroupParallelConcurrent :: [KnownExtension] +xGroupParallelConcurrent = + [ + -- Static pointers + StaticPointers + ] + +xGroupUnboxedPrimitive :: [KnownExtension] +xGroupUnboxedPrimitive = + [ + -- Unboxed tuples + UnboxedTuples -- implies UnboxedSums + + -- Unboxed sums + , UnboxedSums -- implied by UnboxedTuples + + -- Unlifted Newtypes + , UnliftedNewtypes + + -- Unlifted Datatypes + , UnliftedDatatypes -- implies DataKinds, StandaloneKindSignatures + ] + +xGroupForeign :: [KnownExtension] +xGroupForeign = + [ + -- Foreign function interface (FFI) + ForeignFunctionInterface + + -- Unlifted FFI Types + , UnliftedFFITypes + + -- Primitive imports + , GHCForeignImportPrim + + -- Interruptible foreign calls + , InterruptibleFFI + + -- The CAPI calling convention + , CApiFFI + ] + +xGroupSafe :: [KnownExtension] +xGroupSafe = [Safe, Trustworthy, Unsafe] + +xGroupMiscellaneous :: [KnownExtension] +xGroupMiscellaneous = + [ + -- Deriving representations + DeriveGeneric + ] + +xGroupBugs :: [KnownExtension] +xGroupBugs = + [ + -- Context-free syntax + NondecreasingIndentation + ] + +-- | Extensions that are not in other groups, likley undocumented. +xUngrouped :: [KnownExtension] +xUngrouped = + (((((((((((((((((((((knownExtensions + \\ xGroupInteractive) + \\ xGroupPhase) + \\ xGroupSyntax) + \\ xGroupImportExport) + \\ xGroupTypes) + \\ xGroupRecords) + \\ xGroupDeriving) + \\ xGroupPatterns) + \\ xGroupClassesInstances) + \\ xGroupLiterals) + \\ xGroupConstraints) + \\ xGroupTypeSignatures) + \\ xGroupBindingsGeneralisation) + \\ xGroupTemplates) + \\ xGroupBangStrict) + \\ xGroupParallelConcurrent) + \\ xGroupUnboxedPrimitive) + \\ xGroupForeign) + \\ xGroupSafe) + \\ xGroupMiscellaneous) + \\ xGroupBugs) \ No newline at end of file diff --git a/Cabal-syntax/src/Language/Haskell/Extension.hs b/Cabal-syntax/src/Language/Haskell/Extension.hs index f5586e5fdc0..13796c80666 100644 --- a/Cabal-syntax/src/Language/Haskell/Extension.hs +++ b/Cabal-syntax/src/Language/Haskell/Extension.hs @@ -22,36 +22,11 @@ module Language.Haskell.Extension , deprecatedExtensions , classifyExtension , knownExtensions - - -- * Extension groups - , xGroupInteractive - , xGroupPhase - , xGroupSyntax - , xGroupImportExport - , xGroupTypes - , xGroupRecords - , xGroupDeriving - , xGroupPatterns - , xGroupClassesInstances - , xGroupLiterals - , xGroupConstraints - , xGroupTypeSignatures - , xGroupBindingsGeneralisation - , xGroupTemplates - , xGroupBangStrict - , xGroupParallelConcurrent - , xGroupUnboxedPrimitive - , xGroupForeign - , xGroupSafe - , xGroupMiscellaneous - , xGroupBugs - , xUngrouped ) where import Distribution.Compat.Prelude import Data.Array (Array, Ix (inRange), accumArray, bounds, (!)) -import Data.List ((\\)) import Distribution.Parsec import Distribution.Pretty @@ -651,433 +626,3 @@ knownExtensionTable = knownExtensions :: [KnownExtension] knownExtensions = [minBound .. maxBound] - --- The comments in the xGroup* lists are taken from the GHC User's Guide. Stop --- the formatter from rearranging them with: -{- FOURMOLU_DISABLE -} -xGroupInteractive :: [KnownExtension] -xGroupInteractive = - [ - -- Type defaulting in GHCi - ExtendedDefaultRules - ] - -xGroupPhase :: [KnownExtension] -xGroupPhase = [CPP] - -xGroupSyntax :: [KnownExtension] -xGroupSyntax = - [ - -- Unicode syntax - UnicodeSyntax - - -- The magic hash - , MagicHash - - -- The recursive do-notation - , RecursiveDo - - -- Applicative do-notation - , ApplicativeDo - - -- Qualified do-notation - , QualifiedDo - - -- Parallel List Comprehensions - , ParallelListComp - - -- Generalized (SQL-like) List comprehensions - , TransformListComp - - -- Monad comprehensions - , MonadComprehensions - - -- Overloaded lists - , OverloadedLists - - -- Rebindable syntax and the implicit Prelude import - , ImplicitPrelude - , RebindableSyntax -- implies NoImplicitPrelude - - -- Postfix operators - , PostfixOperators - - -- Tuple sections - , TupleSections - - -- Lambda-case - , LambdaCase - - -- Empty case - , EmptyCase - - -- Multi-way if-expressions - , MultiWayIf - - -- Arrow notation - , Arrows - - -- Lexical negation - , LexicalNegation - - -- More liberal syntax for function arguments - , BlockArguments - ] - -xGroupImportExport :: [KnownExtension] -xGroupImportExport = - [ - -- Package-qualified imports - PackageImports - - -- Explicit namespaces in import/export - , ExplicitNamespaces - - -- Writing qualified in postpositive position - , ImportQualifiedPost - ] - -xGroupTypes :: [KnownExtension] -xGroupTypes = - [ - -- Data types with no constructors - EmptyDataDecls - - -- Data type contexts - , DatatypeContexts -- deprecated - - -- Type operators - , TypeOperators - - -- Liberalised type synonyms - , LiberalTypeSynonyms -- implies ExplicitForAll - - -- Existentially quantified data constructors - , ExistentialQuantification -- implies ExplicitForAll - - -- Declaring data types with explicit constructor signatures - , GADTSyntax -- implied by GADTs - - -- Generalised algebraic data types (GADTs) - , GADTs -- implies MonoLocalBinds, GADTSyntax - - -- Type families - , TypeFamilies -- implies MonoLocalBinds, KindSignatures, ExplicitNamespaces - - -- Injective type families - , TypeFamilyDependencies -- implies TypeFamilies - - -- Datatype promotion - , DataKinds - - -- Type-level data declarations - , TypeData - - -- Kind polymorphism - , TypeInType -- implies PolyKinds, DataKinds, KindSignatures - , PolyKinds -- implies KindSignatures - , CUSKs -- legacy feature replaced by StandaloneKindSignatures - , StandaloneKindSignatures -- implies NoCUSKs - , StarIsType - - -- Visible type application - , TypeApplications - - -- Type abstractions - , TypeAbstractions - - -- Required type arguments - , RequiredTypeArguments - - -- Arbitrary-rank polymorphism - , RankNTypes -- implies ExplicitForAll - , Rank2Types -- deprecated alias of RankNTypes - - -- Subsumption - , DeepSubsumption - - -- Impredicative polymorphism - , ImpredicativeTypes -- implies RankNTypes - - -- Linear types - , LinearTypes -- implies MonoLocalBinds - - -- Role annotations - , RoleAnnotations - ] - -xGroupRecords :: [KnownExtension] -xGroupRecords = - [ - -- Traditional record syntax - TraditionalRecordSyntax - - -- Record field disambiguation - , DisambiguateRecordFields - - -- Duplicate record fields - , DuplicateRecordFields - - -- Field selectors - , FieldSelectors - - -- Record puns - , NamedFieldPuns - - -- Record wildcards - , RecordWildCards - - -- Overloaded record dot - , OverloadedRecordDot - - -- Overloaded record update - , OverloadedRecordUpdate - ] - -xGroupDeriving :: [KnownExtension] -xGroupDeriving = - [ EmptyDataDeriving, StandaloneDeriving - , DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveDataTypeable, DeriveLift - , GeneralizedNewtypeDeriving, GeneralisedNewtypeDeriving - , DeriveAnyClass - , DerivingStrategies - , DerivingVia - ] - -xGroupPatterns :: [KnownExtension] -xGroupPatterns = - [ - -- Pattern guards - PatternGuards - - -- View patterns - , ViewPatterns - - -- n+k patterns - , NPlusKPatterns - - -- Pattern synonyms - , PatternSynonyms - ] - -xGroupClassesInstances :: [KnownExtension] -xGroupClassesInstances = - [ - -- Multi-parameter type classes - MultiParamTypeClasses -- implies ConstrainedClassMethods, implied by FunctionalDependencies - - -- Undecidable (or recursive) superclasses - , UndecidableSuperClasses - - -- Constrained class method types - , ConstrainedClassMethods -- implied by MultiParamTypeClasses - - -- Default method signatures - , DefaultSignatures - - -- Nullary type classes - , NullaryTypeClasses -- deprecated, replaced by MultiParamTypeClasses - - -- Functional dependencies - , FunctionalDependencies -- implies MultiParamTypeClasses - - --Relaxed rules for the instance head - , TypeSynonymInstances -- implied by FlexibleInstances - , FlexibleInstances -- implies TypeSynonymInstances - - -- Undecided instances and loopy superclasses - , UndecidableInstances - - -- Overlapping instances - , OverlappingInstances -- deprecated - , IncoherentInstances -- deprecated - - -- Instance signatures: type signatures in instance declarations - , InstanceSigs - ] - -xGroupLiterals :: [KnownExtension] -xGroupLiterals = - [ - -- Negative literals - NegativeLiterals - - -- Bindary integer literals - , BinaryLiterals - - -- Hexadecimal floating point literals - , HexFloatLiterals - - -- Fractional looking integer literals - , NumDecimals - - -- Sized primitive literal syntax - , ExtendedLiterals - - -- Numeric underscores - , NumericUnderscores - - -- Overloaded string literals - , OverloadedStrings - - -- Overloaded labels - , OverloadedLabels - ] - -xGroupConstraints :: [KnownExtension] -xGroupConstraints = - [ - -- Loosening restrictions on class contexts - FlexibleContexts - - -- The Constraint kind - , ConstraintKinds - - -- Quantified constraints - , QuantifiedConstraints -- implies ExplicitForAll - ] - -xGroupTypeSignatures :: [KnownExtension] -xGroupTypeSignatures = - [ - -- Explicit universal quantification (forall) - ExplicitForAll - - -- Ambiguous types and the ambiguity check - , AllowAmbiguousTypes - - -- Explicitly-kinded quantification - , KindSignatures -- implied by TypeFamilies, PolyKinds - - -- Lexically scoped type variables - , ScopedTypeVariables -- implies ExplicitForAll - - -- Implicit parameters - , ImplicitParams - - -- Partial Type Signatures - , PartialTypeSignatures - - -- Named Wildcards - , NamedWildCards - ] - -xGroupBindingsGeneralisation :: [KnownExtension] -xGroupBindingsGeneralisation = - [ - -- Switching off the monomorphism restriction - MonomorphismRestriction - - -- Let-generalisation - , MonoLocalBinds -- implied by TypeFamilies, GADTs - ] - -xGroupTemplates :: [KnownExtension] -xGroupTemplates = - [ - -- Template Haskell - TemplateHaskell -- implies TemplateHaskellQuotes - , TemplateHaskellQuotes - - -- Template Haskell Quasi-quotation - , QuasiQuotes - ] - -xGroupBangStrict :: [KnownExtension] -xGroupBangStrict = - [ - -- Bang patterns - BangPatterns - - -- Strict-by-default data types - , StrictData - - -- Strict-by-default pattern bindings - , Strict -- implies StrictData - ] - --- | Concurrent Haskell is enabled by default -xGroupParallelConcurrent :: [KnownExtension] -xGroupParallelConcurrent = - [ - -- Static pointers - StaticPointers - ] - -xGroupUnboxedPrimitive :: [KnownExtension] -xGroupUnboxedPrimitive = - [ - -- Unboxed tuples - UnboxedTuples -- implies UnboxedSums - - -- Unboxed sums - , UnboxedSums -- implied by UnboxedTuples - - -- Unlifted Newtypes - , UnliftedNewtypes - - -- Unlifted Datatypes - , UnliftedDatatypes -- implies DataKinds, StandaloneKindSignatures - ] - -xGroupForeign :: [KnownExtension] -xGroupForeign = - [ - -- Foreign function interface (FFI) - ForeignFunctionInterface - - -- Unlifted FFI Types - , UnliftedFFITypes - - -- Primitive imports - , GHCForeignImportPrim - - -- Interruptible foreign calls - , InterruptibleFFI - - -- The CAPI calling convention - , CApiFFI - ] - -xGroupSafe :: [KnownExtension] -xGroupSafe = [Safe, Trustworthy, Unsafe] - -xGroupMiscellaneous :: [KnownExtension] -xGroupMiscellaneous = - [ - -- Deriving representations - DeriveGeneric - ] - -xGroupBugs :: [KnownExtension] -xGroupBugs = - [ - -- Context-free syntax - NondecreasingIndentation - ] - --- | Extensions that are not in other groups, likley undocumented. -xUngrouped :: [KnownExtension] -xUngrouped = - (((((((((((((((((((((knownExtensions - \\ xGroupInteractive) - \\ xGroupPhase) - \\ xGroupSyntax) - \\ xGroupImportExport) - \\ xGroupTypes) - \\ xGroupRecords) - \\ xGroupDeriving) - \\ xGroupPatterns) - \\ xGroupClassesInstances) - \\ xGroupLiterals) - \\ xGroupConstraints) - \\ xGroupTypeSignatures) - \\ xGroupBindingsGeneralisation) - \\ xGroupTemplates) - \\ xGroupBangStrict) - \\ xGroupParallelConcurrent) - \\ xGroupUnboxedPrimitive) - \\ xGroupForeign) - \\ xGroupSafe) - \\ xGroupMiscellaneous) - \\ xGroupBugs) diff --git a/buildinfo-reference-generator/src/Main.hs b/buildinfo-reference-generator/src/Main.hs index 7d2b6654727..dd0f01c8883 100644 --- a/buildinfo-reference-generator/src/Main.hs +++ b/buildinfo-reference-generator/src/Main.hs @@ -26,12 +26,12 @@ import qualified Text.PrettyPrint as PP import qualified Zinza as Z import Distribution.Described +import Distribution.Described.Extension import Distribution.Utils.GrammarRegex import Distribution.ModuleName (ModuleName) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange) -import Language.Haskell.Extension ------------------------------------------------------------------------------- -- Main From 68031f30d9af7e89de767e152458a6a175e2cb59 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 4 Jan 2024 15:31:12 -0500 Subject: [PATCH 5/9] Link to GHC syntax from Cabal Package syntax - Split and rename the syntax - Remove most GHC grammar except language - Remove test-suite fields from GHC syntax - Remove package description fields from GHC syntax - Remove build info fields from GHC syntax - Get rid of hs-string, put disable-extension first - Remove everything but language extensions - Combine recipes with doc/%-syntax.rst pattern rules - Make syntax its own section - Partition build info fields - Add lib to Cabal-syntax-docs - Add GHC build info fields to ghc-syntax - Show ghc-syntax as a list of links - Update make recipe for build info and user guide --- .../src/Distribution/Described/Extension.hs | 6 +- Cabal-syntax-docs/Cabal-syntax-docs.cabal | 44 +++ Cabal-syntax-docs/cabal-package/Main.hs | 84 +++++ .../cabal-package}/template.zinza | 24 +- Cabal-syntax-docs/ghc/Main.hs | 106 +++++++ Cabal-syntax-docs/ghc/template.zinza | 63 ++++ .../src/Cabal/Syntax/Docs/ZFields.hs | 203 ++++++++++++ Makefile | 19 +- .../buildinfo-reference-generator.cabal | 16 - buildinfo-reference-generator/src/Main.hs | 299 ------------------ cabal.project.docs | 10 + ...reference.rst => cabal-package-syntax.rst} | 24 +- doc/ghc-syntax.rst | 292 +++++++++++++++++ doc/index.rst | 9 +- 14 files changed, 868 insertions(+), 331 deletions(-) create mode 100644 Cabal-syntax-docs/Cabal-syntax-docs.cabal create mode 100644 Cabal-syntax-docs/cabal-package/Main.hs rename {buildinfo-reference-generator => Cabal-syntax-docs/cabal-package}/template.zinza (91%) create mode 100644 Cabal-syntax-docs/ghc/Main.hs create mode 100644 Cabal-syntax-docs/ghc/template.zinza create mode 100644 Cabal-syntax-docs/src/Cabal/Syntax/Docs/ZFields.hs delete mode 100644 buildinfo-reference-generator/buildinfo-reference-generator.cabal delete mode 100644 buildinfo-reference-generator/src/Main.hs create mode 100644 cabal.project.docs rename doc/{buildinfo-fields-reference.rst => cabal-package-syntax.rst} (97%) create mode 100644 doc/ghc-syntax.rst diff --git a/Cabal-described/src/Distribution/Described/Extension.hs b/Cabal-described/src/Distribution/Described/Extension.hs index 623e091ada8..4c5c81e46ae 100644 --- a/Cabal-described/src/Distribution/Described/Extension.hs +++ b/Cabal-described/src/Distribution/Described/Extension.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} module Distribution.Described.Extension - ( reKnownExtension + ( reEnableExtension + , reKnownExtension , reDisableExtension , reXs -- * Extension groups @@ -44,6 +45,9 @@ instance Described Extension where reXs :: [KnownExtension] -> GrammarRegex a reXs xs = REUnion (fromString . prettyShow <$> xs) +reEnableExtension :: GrammarRegex a +reEnableExtension = "enable-extension" + reKnownExtension :: GrammarRegex a reKnownExtension = REUnion [ RENamed "interactive-extension" $ reXs xGroupInteractive diff --git a/Cabal-syntax-docs/Cabal-syntax-docs.cabal b/Cabal-syntax-docs/Cabal-syntax-docs.cabal new file mode 100644 index 00000000000..1b4578c66de --- /dev/null +++ b/Cabal-syntax-docs/Cabal-syntax-docs.cabal @@ -0,0 +1,44 @@ +cabal-version: 2.2 +name: Cabal-syntax-docs +version: 0 + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + build-depends: + , base >=4.11 && <4.20 + , Cabal + , Cabal-described + , containers + , pretty + , zinza ^>=0.2 + exposed-modules: Cabal.Syntax.Docs.ZFields + +executable gen-cabal-package-syntax-docs + default-language: Haskell2010 + hs-source-dirs: cabal-package + ghc-options: -Wall + main-is: Main.hs + build-depends: + , base >=4.11 && <4.20 + , Cabal + , Cabal-described + , Cabal-syntax-docs + , containers + , pretty + , zinza ^>=0.2 + +executable gen-ghc-syntax-docs + default-language: Haskell2010 + hs-source-dirs: ghc + ghc-options: -Wall + main-is: Main.hs + build-depends: + , base >=4.11 && <4.20 + , Cabal + , Cabal-described + , Cabal-syntax-docs + , containers + , pretty + , zinza ^>=0.2 diff --git a/Cabal-syntax-docs/cabal-package/Main.hs b/Cabal-syntax-docs/cabal-package/Main.hs new file mode 100644 index 00000000000..c8b2dea4226 --- /dev/null +++ b/Cabal-syntax-docs/cabal-package/Main.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +module Main (main) where + +import Data.List (partition) +import Data.Proxy (Proxy (..)) +import GHC.Generics (Generic) +import System.Environment (getArgs) +import System.Exit (exitFailure) + +import Distribution.PackageDescription.FieldGrammar (buildInfoFieldGrammar, packageDescriptionFieldGrammar, testSuiteFieldGrammar) + +import qualified Zinza as Z + +import Distribution.Described +import Distribution.Described.Extension () +import Distribution.Utils.GrammarRegex + +import Distribution.ModuleName (ModuleName) +import Distribution.Types.Version (Version) +import Distribution.Types.VersionRange (VersionRange) +import Cabal.Syntax.Docs.ZFields + +main :: IO () +main = do + args <- getArgs + case args of + [tmpl] -> do + let (biGhc, biCabal) = partition isGhcBuildInfo $ fromReference buildInfoFieldGrammar + run <- Z.parseAndCompileTemplateIO tmpl + contents <- run $ Z + { zGhcBuildInfoFields = biGhc + , zCabalBuildInfoFields = biCabal + , zPackageDescriptionFields = fromReference packageDescriptionFieldGrammar + , zTestSuiteFields = fromReference $ testSuiteFieldGrammar // buildInfoFieldGrammar + , zProductions = + [ zproduction "hs-string" reHsString + "String as in Haskell; it's recommended to avoid using Haskell-specific escapes." + , zproduction "unqual-name" reUnqualComponent $ unwords + [ "Unqualified component names are used for package names, component names etc. but not flag names." + , "Unqualified component name consist of components separated by dash, each component is non-empty alphanumeric string, with at least one alphabetic character." + , "In other words, component may not look like a number." + ] + + , zproduction "module-name" (describe (Proxy :: Proxy ModuleName)) + "Haskell module name as recognized by Cabal parser." + , zproduction "version" (describe (Proxy :: Proxy Version)) + "Version is to first approximation numbers separated by dots, where leading zero is not allowed and each version digit is consists at most of nine characters." + , zproduction "version-range" (describe (Proxy :: Proxy VersionRange)) + "Version range syntax is recursive. Also note the set syntax added in ``cabal-version: 3.0``, set cannot be empty." + ] + , zSpaceList = show $ regexDoc $ + REMunch RESpaces1 (RENamed "element" RETodo) + , zCommaList = show $ regexDoc $ + expandedCommaList (RENamed "element" RETodo) + , zOptCommaList = show $ regexDoc $ + expandedOptCommaList (RENamed "element" RETodo) + + , zNull = null + , zNotNull = not . null + } + + putStrLn contents + _ -> do + putStrLn "Usage: generator " + exitFailure + +data Z = Z + { zGhcBuildInfoFields :: [ZField] + , zCabalBuildInfoFields :: [ZField] + , zPackageDescriptionFields :: [ZField] + , zTestSuiteFields :: [ZField] + , zProductions :: [ZProduction] + , zSpaceList :: String + , zCommaList :: String + , zOptCommaList :: String + , zNull :: String -> Bool + , zNotNull :: String -> Bool + } + deriving (Generic) + +instance Z.Zinza Z where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP + fromValue = Z.genericFromValueSFP diff --git a/buildinfo-reference-generator/template.zinza b/Cabal-syntax-docs/cabal-package/template.zinza similarity index 91% rename from buildinfo-reference-generator/template.zinza rename to Cabal-syntax-docs/cabal-package/template.zinza index 8ae6cffb52c..d2e7371df53 100644 --- a/buildinfo-reference-generator/template.zinza +++ b/Cabal-syntax-docs/cabal-package/template.zinza @@ -1,10 +1,24 @@ -.. _buildinfo-field-reference: +.. _cabal-package-syntax: -Field Syntax Reference -====================== +Cabal Package Syntax +==================== + +GHC syntax +---------- + +Some elements of cabal package syntax are controlled by GHC. As such these are +effectively strings passed on to GHC and that may be as far as Cabal will check +their syntax. See the :ref:`ghc-syntax` for these elements of GHC syntax +embedded within cabal package descriptions. + +- :ref:`ghc-enable-extension` +- :ref:`ghc-disable-extension` +{% for field in ghcBuildInfoFields %} +- :ref:`{{field.name}}` +{% endfor %} Notation ---------------- +-------- Field syntax is described as they are in the latest cabal file format version. @@ -142,7 +156,7 @@ In the syntax definitions below the following non-terminal symbols are used: Build info fields ----------------- -{% for field in buildInfoFields %} +{% for field in cabalBuildInfoFields %} {{ field.name }} * {{field.format}} {% if notNull field.default %} diff --git a/Cabal-syntax-docs/ghc/Main.hs b/Cabal-syntax-docs/ghc/Main.hs new file mode 100644 index 00000000000..a14173bdc4d --- /dev/null +++ b/Cabal-syntax-docs/ghc/Main.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE DeriveGeneric #-} +module Main (main) where + +import GHC.Generics (Generic) +import System.Environment (getArgs) +import System.Exit (exitFailure) + +import Distribution.PackageDescription.FieldGrammar (buildInfoFieldGrammar) + +import qualified Zinza as Z + +import Distribution.Described +import Distribution.Described.Extension +import Distribution.Utils.GrammarRegex +import Cabal.Syntax.Docs.ZFields + +main :: IO () +main = do + args <- getArgs + case args of + [tmpl] -> do + let biGhc = filter isGhcBuildInfo $ fromReference buildInfoFieldGrammar + run <- Z.parseAndCompileTemplateIO tmpl + contents <- run $ Z + { zGhcBuildInfoFields = biGhc + , zProductions = + [ zproduction "disable-extension" reDisableExtension + "Disable a language extension by prepending the extension with \"No\"." + , zproduction "enable-extension" reKnownExtension + "All GHC language extensions known to cabal. There may be more and some of these may be on by default." + , zproduction "interactive-extension" (reXs xGroupInteractive) + "Language Extensions related to GHC interactive." + , zproduction "phase-extension" (reXs xGroupPhase) + "Language Extensions related to a particular GHC phase." + , zproduction "syntax-extension" (reXs xGroupSyntax) + "Syntax Language Extensions." + , zproduction "import-export-extension" (reXs xGroupImportExport) + "Import and Export Language Extensions." + , zproduction "type-extension" (reXs xGroupTypes) + "Language Extensions for Types." + , zproduction "record-extension" (reXs xGroupRecords) + "Record Language Extensions." + , zproduction "deriving-extension" (reXs xGroupDeriving) + "Language Extensions for deriving mechanisms." + , zproduction "pattern-extension" (reXs xGroupPatterns) + "Patterns Language Extensions." + , zproduction "classes-instances-extension" (reXs xGroupClassesInstances) + "Language Extensions for class and instance declarations." + , zproduction "literal-extension" (reXs xGroupLiterals) + "Literals Language Extensions." + , zproduction "constraint-extension" (reXs xGroupConstraints) + "Constraint Language Extensions." + , zproduction "type-signature-extension" (reXs xGroupTypeSignatures) + "Type Signature Language Extensions." + , zproduction "binding-generalisation-extension" (reXs xGroupBindingsGeneralisation) + "Language Extensions for bindings and generalisation " + , zproduction "template-haskell-extension" (reXs xGroupTemplates) + "Template Haskell Language Extensions." + , zproduction "bang-strict-extension" (reXs xGroupBangStrict) + "Bang pattern and Strict Haskell Language Extensions." + , zproduction "parallel-concurrent-extension" (reXs xGroupParallelConcurrent) + "Parallel and Concurrent Language Extensions." + , zproduction "unboxed-primitive-extension" (reXs xGroupUnboxedPrimitive) + "Unboxed types and Primitive operations Language Extensions." + , zproduction "foreign-extension" (reXs xGroupForeign) + "Foreign function interface (FFI) Language Extensions." + , zproduction "safe-extension" (reXs xGroupSafe) + "Safe Haskell Language Extensions." + , zproduction "miscellaneous-extension" (reXs xGroupMiscellaneous) + "Miscellaneous Language Extensions." + , zproduction "bugs-extension" (reXs xGroupBugs) + "Language Extensions related to GHC bugs and infelicities." + , zproduction "ungrouped-extension" (reXs xUngrouped) + "Language Extensions not belonging to other extension groups, includes undocumented extensions." + ] + , zSpaceList = show $ regexDoc $ + REMunch RESpaces1 (RENamed "element" RETodo) + , zCommaList = show $ regexDoc $ + expandedCommaList (RENamed "element" RETodo) + , zOptCommaList = show $ regexDoc $ + expandedOptCommaList (RENamed "element" RETodo) + + , zNull = null + , zNotNull = not . null + } + + putStrLn contents + _ -> do + putStrLn "Usage: generator " + exitFailure + +data Z = Z + { zGhcBuildInfoFields :: [ZField] + , zProductions :: [ZProduction] + , zSpaceList :: String + , zCommaList :: String + , zOptCommaList :: String + , zNull :: String -> Bool + , zNotNull :: String -> Bool + } + deriving (Generic) + +instance Z.Zinza Z where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP + fromValue = Z.genericFromValueSFP \ No newline at end of file diff --git a/Cabal-syntax-docs/ghc/template.zinza b/Cabal-syntax-docs/ghc/template.zinza new file mode 100644 index 00000000000..0272d5d99a3 --- /dev/null +++ b/Cabal-syntax-docs/ghc/template.zinza @@ -0,0 +1,63 @@ +.. _ghc-syntax: + +GHC Syntax Reference +==================== + +Language Extensions +------------------- + +The many GHC language extensions are divided into groups of extensions +corresponding to subsections of the GHC users' guide on language extensions. +Those of the :ref:`ungrouped-extension ` group are +undocumented in the GHC users' guide. + +{% for production in productions %} +.. _ghc-{{ production.name }}: + +{{ production.name }} + {{ production.description }} + + .. math:: + + {{ production.syntax }} + +{% endfor %} + +GHC build info fields +--------------------- + +These are cabal package build info fields that are more related to GHC, the +Haskell compiler, than they are to Cabal. + +{% for field in ghcBuildInfoFields %} +.. _ghc-{{ field.name }}: + +{{ field.name }} + * {{field.format}} +{% if notNull field.default %} + * Default: ``{{field.default}}`` +{% endif %} +{% if notNull field.availableSince %} + * Available since ``cabal-version: {{field.availableSince}}``. +{% endif %} +{% if notNull field.deprecatedSince.fst %} + * Deprecated since ``cabal-version: {{field.deprecatedSince.fst}}``: {{field.deprecatedSince.snd}} +{% endif %} +{% if notNull field.removedIn.fst %} + * Removed in ``cabal-version: {{field.removedIn.fst}}``: {{field.removedIn.snd}} +{% endif %} +{# We show documentation link only for non deprecated fields #} +{% if null field.deprecatedSince.fst %} +{% if null field.removedIn.fst %} + * Documentation of :pkg-field:`library:{{field.name}}` +{% endif %} +{% endif %} +{% if notNull field.syntax %} + + .. math:: + + {{field.syntax}} +{% endif %} + +{% endfor %} + diff --git a/Cabal-syntax-docs/src/Cabal/Syntax/Docs/ZFields.hs b/Cabal-syntax-docs/src/Cabal/Syntax/Docs/ZFields.hs new file mode 100644 index 00000000000..de2ca86e50c --- /dev/null +++ b/Cabal-syntax-docs/src/Cabal/Syntax/Docs/ZFields.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Cabal.Syntax.Docs.ZFields where + +import Data.Map.Strict (Map) + +import Data.Bifunctor (first) +import Data.Void (Void) +import Distribution.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) +import Distribution.Compat.Newtype (pack') +import Distribution.FieldGrammar.Class (FieldGrammar (..)) +import Distribution.Fields.Field (FieldName) +import Distribution.Pretty (pretty) +import Distribution.Simple.Utils (fromUTF8BS) +import GHC.Generics (Generic) + +import qualified Data.Map.Strict as Map +import qualified Text.PrettyPrint as PP + +import qualified Zinza as Z + +import Distribution.Described +import Distribution.Described.Extension () +import Distribution.Utils.GrammarRegex + +ghcBuildInfoFields :: [String] +ghcBuildInfoFields = ["default-language", "other-languages", "default-extensions", "other-extensions", "extensions"] + +isGhcBuildInfo :: ZField -> Bool +isGhcBuildInfo = (`elem` ghcBuildInfoFields) . zfieldName + +zproduction :: String -> GrammarRegex Void -> String -> ZProduction +zproduction name re desc = ZProduction + { zprodName = name + , zprodSyntax = show (regexDoc re') + , zprodDescription = desc + } + where + re' = case re of + RENamed _ r -> r + _ -> re + +-- also in UnitTests.Distribution.Described +expandedCommaList :: GrammarRegex a -> GrammarRegex a +expandedCommaList = REUnion . expandedCommaList' + +expandedCommaList' :: GrammarRegex a -> [GrammarRegex a] +expandedCommaList' r = + [ REMunch reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + +expandedOptCommaList :: GrammarRegex a -> GrammarRegex a +expandedOptCommaList r = REUnion $ reSpacedList r : expandedCommaList' r + +data ZField = ZField + { zfieldName :: String + , zfieldAvailableSince :: String + , zfieldDeprecatedSince :: (String, String) + , zfieldRemovedIn :: (String, String) + , zfieldFormat :: String + , zfieldDefault :: String + , zfieldSyntax :: String + } + deriving (Generic) + +instance Z.Zinza ZField where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP + fromValue = Z.genericFromValueSFP + +data ZProduction = ZProduction + { zprodName :: String + , zprodSyntax :: String + , zprodDescription :: String + } + deriving (Generic) + +instance Z.Zinza ZProduction where + toType = Z.genericToTypeSFP + toValue = Z.genericToValueSFP + fromValue = Z.genericFromValueSFP + +------------------------------------------------------------------------------- +-- From reference +------------------------------------------------------------------------------- + +-- TODO: produce ZField +fromReference :: Reference a a -> [ZField] +fromReference (Reference m) = + [ ZField + { zfieldName = fromUTF8BS n + , zfieldAvailableSince = maybe "" showCabalSpecVersion (fdAvailableSince desc) + , zfieldDeprecatedSince = maybe ("", "") (first showCabalSpecVersion) (fdDeprecatedSince desc) + , zfieldRemovedIn = maybe ("", "") (first showCabalSpecVersion) (fdRemovedIn desc) + , zfieldFormat = fmt + , zfieldDefault = def + , zfieldSyntax = syntax + } + | (n, desc) <- Map.toList m + , let (fmt, def, syntax) = fromFieldDesc' (fdDescription desc) + ] + +fromFieldDesc' :: FieldDesc' -> (String, String, String) +fromFieldDesc' (MonoidalFieldAla s) = ("Monoidal field", "", show s) +fromFieldDesc' (BooleanFieldDesc def) = ("Boolean field", show def, show $ describeDoc ([] :: [Bool])) +fromFieldDesc' (OptionalFieldAla s) = ("Optional field", "", show s) +fromFieldDesc' (OptionalFieldDefAla s def) = ("Optional field", show def, show s) +fromFieldDesc' FreeTextField = ("Free text field", "", "") +fromFieldDesc' (UniqueField s) = ("Required field", "", show s) + +------------------------------------------------------------------------------- +-- Reference +------------------------------------------------------------------------------- + +newtype Reference a b = Reference (Map FieldName FieldDesc) + deriving (Functor) + +referenceAvailableSince :: CabalSpecVersion -> Reference a b -> Reference a b +referenceAvailableSince v (Reference m) = + Reference (fmap (fieldDescAvailableSince v) m) + +referenceRemovedIn :: CabalSpecVersion -> String -> Reference a b -> Reference a b +referenceRemovedIn v desc (Reference m) = + Reference (fmap (fieldDescRemovedIn v desc) m) + +referenceDeprecatedSince :: CabalSpecVersion -> String -> Reference a b -> Reference a b +referenceDeprecatedSince v desc (Reference m) = + Reference (fmap (fieldDescDeprecatedSince v desc) m) + +(//) :: Reference a b -> Reference c d -> Reference a b +Reference ab // Reference cd = Reference $ Map.difference ab cd + +fieldDescAvailableSince :: CabalSpecVersion -> FieldDesc -> FieldDesc +fieldDescAvailableSince v d = d { fdAvailableSince = Just v } + +fieldDescRemovedIn :: CabalSpecVersion -> String -> FieldDesc -> FieldDesc +fieldDescRemovedIn v desc d = d { fdRemovedIn = Just (v, desc) } + +fieldDescDeprecatedSince :: CabalSpecVersion -> String -> FieldDesc -> FieldDesc +fieldDescDeprecatedSince v desc d = d { fdDeprecatedSince = Just (v, desc) } + +data FieldDesc = FieldDesc + { fdAvailableSince :: Maybe CabalSpecVersion + , fdRemovedIn :: Maybe (CabalSpecVersion, String) + , fdDeprecatedSince :: Maybe (CabalSpecVersion, String) + , fdDescription :: FieldDesc' + } + deriving Show + +reference :: FieldName -> FieldDesc' -> Reference a b +reference fn d = Reference $ Map.singleton fn $ FieldDesc Nothing Nothing Nothing d + +data FieldDesc' + = BooleanFieldDesc Bool + | UniqueField PP.Doc -- ^ not used in BuildInfo + | FreeTextField -- ^ not user in BuildInfo + | OptionalFieldAla PP.Doc + | OptionalFieldDefAla PP.Doc PP.Doc + | MonoidalFieldAla PP.Doc + deriving Show + +instance Applicative (Reference a) where + pure _ = Reference Map.empty + Reference f <*> Reference x = Reference (Map.union f x) + +instance FieldGrammar Described Reference where + blurFieldGrammar _ (Reference xs) = Reference xs + + uniqueFieldAla fn pack _l = + reference fn $ UniqueField (describeDoc pack) + + booleanFieldDef fn _l def = + reference fn $ BooleanFieldDesc def + + optionalFieldAla fn pack _l = + reference fn $ OptionalFieldAla (describeDoc pack) + + optionalFieldDefAla fn pack _l def = + reference fn $ OptionalFieldDefAla + (describeDoc pack) + (pretty $ pack' pack def) + + freeTextField fn _l = reference fn FreeTextField + + freeTextFieldDef fn _l = reference fn FreeTextField + freeTextFieldDefST fn _l = reference fn FreeTextField + + monoidalFieldAla fn pack _l = + reference fn (MonoidalFieldAla (describeDoc pack)) + + prefixedFields _pfx _l = Reference Map.empty + + knownField _fn = Reference Map.empty -- TODO + + -- hidden fields are hidden from the reference. + hiddenField _ = Reference Map.empty + + deprecatedSince = referenceDeprecatedSince + removedIn = referenceRemovedIn + availableSince v _ r = referenceAvailableSince v r \ No newline at end of file diff --git a/Makefile b/Makefile index 835c73b8ff9..777aa496a3e 100644 --- a/Makefile +++ b/Makefile @@ -79,13 +79,22 @@ $(TEMPLATE_PATHS) : templates/Paths_pkg.template.hs cabal-dev-scripts/src/GenPat # generated docs # Use cabal build before cabal run to avoid output of the build on stdout when running -doc/buildinfo-fields-reference.rst : \ +doc/cabal-package-syntax.rst : \ $(wildcard Cabal-syntax/src/*/*.hs Cabal-syntax/src/*/*/*.hs Cabal-syntax/src/*/*/*/*.hs) \ $(wildcard Cabal-described/src/Distribution/Described.hs Cabal-described/src/Distribution/Utils/*.hs) \ - buildinfo-reference-generator/src/Main.hs \ - buildinfo-reference-generator/template.zinza - cabal build buildinfo-reference-generator - cabal run buildinfo-reference-generator buildinfo-reference-generator/template.zinza | tee $@ + Cabal-syntax-docs/cabal-package/Main.hs \ + Cabal-syntax-docs/cabal-package/template.zinza + cabal build --project-file=cabal.project.docs gen-cabal-package-syntax-docs + cabal run --project-file=cabal.project.docs gen-cabal-package-syntax-docs Cabal-syntax-docs/cabal-package/template.zinza | tee $@ + git diff --exit-code $@ + +doc/ghc-syntax.rst : \ + $(wildcard Cabal-syntax/src/*/*.hs Cabal-syntax/src/*/*/*.hs Cabal-syntax/src/*/*/*/*.hs) \ + $(wildcard Cabal-described/src/Distribution/Described.hs Cabal-described/src/Distribution/Utils/*.hs) \ + Cabal-syntax-docs/ghc/Main.hs \ + Cabal-syntax-docs/ghc/template.zinza + cabal build --project-file=cabal.project.docs gen-ghc-syntax-docs + cabal run --project-file=cabal.project.docs gen-ghc-syntax-docs Cabal-syntax-docs/ghc/template.zinza | tee $@ git diff --exit-code $@ .PHONY: analyse-imports diff --git a/buildinfo-reference-generator/buildinfo-reference-generator.cabal b/buildinfo-reference-generator/buildinfo-reference-generator.cabal deleted file mode 100644 index 47068ee33b1..00000000000 --- a/buildinfo-reference-generator/buildinfo-reference-generator.cabal +++ /dev/null @@ -1,16 +0,0 @@ -cabal-version: 2.2 -name: buildinfo-reference-generator -version: 0 - -executable buildinfo-reference-generator - default-language: Haskell2010 - hs-source-dirs: src - ghc-options: -Wall - main-is: Main.hs - build-depends: - , base >=4.11 && <4.21 - , Cabal - , Cabal-described - , containers - , pretty - , zinza ^>=0.2 diff --git a/buildinfo-reference-generator/src/Main.hs b/buildinfo-reference-generator/src/Main.hs deleted file mode 100644 index dd0f01c8883..00000000000 --- a/buildinfo-reference-generator/src/Main.hs +++ /dev/null @@ -1,299 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -module Main (main) where - -import Data.Map.Strict (Map) - -import Data.Bifunctor (first) -import Data.Proxy (Proxy (..)) -import Data.Void (Void) -import Distribution.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) -import Distribution.Compat.Newtype (pack') -import Distribution.FieldGrammar.Class (FieldGrammar (..)) -import Distribution.Fields.Field (FieldName) -import Distribution.Pretty (pretty) -import Distribution.Simple.Utils (fromUTF8BS) -import GHC.Generics (Generic) -import System.Environment (getArgs) -import System.Exit (exitFailure) - -import Distribution.PackageDescription.FieldGrammar (buildInfoFieldGrammar, packageDescriptionFieldGrammar, testSuiteFieldGrammar) - -import qualified Data.Map.Strict as Map -import qualified Text.PrettyPrint as PP - -import qualified Zinza as Z - -import Distribution.Described -import Distribution.Described.Extension -import Distribution.Utils.GrammarRegex - -import Distribution.ModuleName (ModuleName) -import Distribution.Types.Version (Version) -import Distribution.Types.VersionRange (VersionRange) - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- - -main :: IO () -main = do - args <- getArgs - case args of - [tmpl] -> do - -- TODO: getArgs - run <- Z.parseAndCompileTemplateIO tmpl - contents <- run $ Z - { zBuildInfoFields = fromReference buildInfoFieldGrammar - , zPackageDescriptionFields = fromReference packageDescriptionFieldGrammar - , zTestSuiteFields = fromReference $ testSuiteFieldGrammar // buildInfoFieldGrammar - , zProductions = - [ zproduction "interactive-extension" (reXs xGroupInteractive) "Language Extensions related to GHC interactive." - , zproduction "phase-extension" (reXs xGroupPhase) "Language Extensions related to a particular GHC phase." - , zproduction "syntax-extension" (reXs xGroupSyntax) "Syntax Language Extensions." - , zproduction "import-export-extension" (reXs xGroupImportExport) "Import and Export Language Extensions." - , zproduction "type-extension" (reXs xGroupTypes) "Language Extensions for Types." - , zproduction "record-extension" (reXs xGroupRecords) "Record Language Extensions." - , zproduction "deriving-extension" (reXs xGroupDeriving) "Language Extensions for deriving mechanisms." - , zproduction "pattern-extension" (reXs xGroupPatterns) "Patterns Language Extensions." - , zproduction "classes-instances-extension" (reXs xGroupClassesInstances) "Language Extensions for class and instance declarations." - , zproduction "literal-extension" (reXs xGroupLiterals) "Literals Language Extensions." - , zproduction "constraint-extension" (reXs xGroupConstraints) "Constraint Language Extensions." - , zproduction "type-signature-extension" (reXs xGroupTypeSignatures) "Type Signature Language Extensions." - , zproduction "binding-generalisation-extension" (reXs xGroupBindingsGeneralisation) "Language Extensions for bindings and generalisation " - , zproduction "template-haskell-extension" (reXs xGroupTemplates) "Template Haskell Language Extensions." - , zproduction "bang-strict-extension" (reXs xGroupBangStrict) "Bang pattern and Strict Haskell Language Extensions." - , zproduction "parallel-concurrent-extension" (reXs xGroupParallelConcurrent) "Parallel and Concurrent Language Extensions." - , zproduction "unboxed-primitive-extension" (reXs xGroupUnboxedPrimitive) "Unboxed types and Primitive operations Language Extensions." - , zproduction "foreign-extension" (reXs xGroupForeign) "Foreign function interface (FFI) Language Extensions." - , zproduction "safe-extension" (reXs xGroupSafe) "Safe Haskell Language Extensions." - , zproduction "miscellaneous-extension" (reXs xGroupMiscellaneous) "Miscellaneous Language Extensions." - , zproduction "bugs-extension" (reXs xGroupBugs) "Language Extensions related to GHC bugs and infelicities." - , zproduction "ungrouped-extension" (reXs xUngrouped) "Language Extensions not belonging to other extension groups, includes undocumented extensions." - , zproduction "enable-extension" reKnownExtension "GHC Language Extensions, some of these may be on by default." - , zproduction "disable-extension" reDisableExtension "Disable a GHC Language Extension." - , zproduction "hs-string" reHsString - "String as in Haskell; it's recommended to avoid using Haskell-specific escapes." - , zproduction "unqual-name" reUnqualComponent $ unwords - [ "Unqualified component names are used for package names, component names etc. but not flag names." - , "Unqualified component name consist of components separated by dash, each component is non-empty alphanumeric string, with at least one alphabetic character." - , "In other words, component may not look like a number." - ] - - , zproduction "module-name" (describe (Proxy :: Proxy ModuleName)) - "Haskell module name as recognized by Cabal parser." - , zproduction "version" (describe (Proxy :: Proxy Version)) - "Version is to first approximation numbers separated by dots, where leading zero is not allowed and each version digit is consists at most of nine characters." - , zproduction "version-range" (describe (Proxy :: Proxy VersionRange)) - "Version range syntax is recursive. Also note the set syntax added in ``cabal-version: 3.0``, set cannot be empty." - ] - , zSpaceList = show $ regexDoc $ - REMunch RESpaces1 (RENamed "element" RETodo) - , zCommaList = show $ regexDoc $ - expandedCommaList (RENamed "element" RETodo) - , zOptCommaList = show $ regexDoc $ - expandedOptCommaList (RENamed "element" RETodo) - - , zNull = null - , zNotNull = not . null - } - - putStrLn contents - _ -> do - putStrLn "Usage: generator " - exitFailure - -zproduction :: String -> GrammarRegex Void -> String -> ZProduction -zproduction name re desc = ZProduction - { zprodName = name - , zprodSyntax = show (regexDoc re') - , zprodDescription = desc - } - where - re' = case re of - RENamed _ r -> r - _ -> re - --- also in UnitTests.Distribution.Described -expandedCommaList :: GrammarRegex a -> GrammarRegex a -expandedCommaList = REUnion . expandedCommaList' - -expandedCommaList' :: GrammarRegex a -> [GrammarRegex a] -expandedCommaList' r = - [ REMunch reSpacedComma r - , reComma <> RESpaces <> REMunch1 reSpacedComma r - , REMunch1 reSpacedComma r <> RESpaces <> reComma - ] - -expandedOptCommaList :: GrammarRegex a -> GrammarRegex a -expandedOptCommaList r = REUnion $ reSpacedList r : expandedCommaList' r - -------------------------------------------------------------------------------- --- Template Inputs -------------------------------------------------------------------------------- - -data Z = Z - { zBuildInfoFields :: [ZField] - , zPackageDescriptionFields :: [ZField] - , zTestSuiteFields :: [ZField] - , zProductions :: [ZProduction] - , zSpaceList :: String - , zCommaList :: String - , zOptCommaList :: String - , zNull :: String -> Bool - , zNotNull :: String -> Bool - } - deriving (Generic) - -data ZField = ZField - { zfieldName :: String - , zfieldAvailableSince :: String - , zfieldDeprecatedSince :: (String, String) - , zfieldRemovedIn :: (String, String) - , zfieldFormat :: String - , zfieldDefault :: String - , zfieldSyntax :: String - } - deriving (Generic) - -data ZProduction = ZProduction - { zprodName :: String - , zprodSyntax :: String - , zprodDescription :: String - } - deriving (Generic) - -instance Z.Zinza Z where - toType = Z.genericToTypeSFP - toValue = Z.genericToValueSFP - fromValue = Z.genericFromValueSFP - -instance Z.Zinza ZField where - toType = Z.genericToTypeSFP - toValue = Z.genericToValueSFP - fromValue = Z.genericFromValueSFP - -instance Z.Zinza ZProduction where - toType = Z.genericToTypeSFP - toValue = Z.genericToValueSFP - fromValue = Z.genericFromValueSFP - -------------------------------------------------------------------------------- --- From reference -------------------------------------------------------------------------------- - --- TODO: produce ZField -fromReference :: Reference a a -> [ZField] -fromReference (Reference m) = - [ ZField - { zfieldName = fromUTF8BS n - , zfieldAvailableSince = maybe "" showCabalSpecVersion (fdAvailableSince desc) - , zfieldDeprecatedSince = maybe ("", "") (first showCabalSpecVersion) (fdDeprecatedSince desc) - , zfieldRemovedIn = maybe ("", "") (first showCabalSpecVersion) (fdRemovedIn desc) - , zfieldFormat = fmt - , zfieldDefault = def - , zfieldSyntax = syntax - } - | (n, desc) <- Map.toList m - , let (fmt, def, syntax) = fromFieldDesc' (fdDescription desc) - ] - -fromFieldDesc' :: FieldDesc' -> (String, String, String) -fromFieldDesc' (MonoidalFieldAla s) = ("Monoidal field", "", show s) -fromFieldDesc' (BooleanFieldDesc def) = ("Boolean field", show def, show $ describeDoc ([] :: [Bool])) -fromFieldDesc' (OptionalFieldAla s) = ("Optional field", "", show s) -fromFieldDesc' (OptionalFieldDefAla s def) = ("Optional field", show def, show s) -fromFieldDesc' FreeTextField = ("Free text field", "", "") -fromFieldDesc' (UniqueField s) = ("Required field", "", show s) - -------------------------------------------------------------------------------- --- Reference -------------------------------------------------------------------------------- - -newtype Reference a b = Reference (Map FieldName FieldDesc) - deriving (Functor) - -referenceAvailableSince :: CabalSpecVersion -> Reference a b -> Reference a b -referenceAvailableSince v (Reference m) = - Reference (fmap (fieldDescAvailableSince v) m) - -referenceRemovedIn :: CabalSpecVersion -> String -> Reference a b -> Reference a b -referenceRemovedIn v desc (Reference m) = - Reference (fmap (fieldDescRemovedIn v desc) m) - -referenceDeprecatedSince :: CabalSpecVersion -> String -> Reference a b -> Reference a b -referenceDeprecatedSince v desc (Reference m) = - Reference (fmap (fieldDescDeprecatedSince v desc) m) - -(//) :: Reference a b -> Reference c d -> Reference a b -Reference ab // Reference cd = Reference $ Map.difference ab cd - -fieldDescAvailableSince :: CabalSpecVersion -> FieldDesc -> FieldDesc -fieldDescAvailableSince v d = d { fdAvailableSince = Just v } - -fieldDescRemovedIn :: CabalSpecVersion -> String -> FieldDesc -> FieldDesc -fieldDescRemovedIn v desc d = d { fdRemovedIn = Just (v, desc) } - -fieldDescDeprecatedSince :: CabalSpecVersion -> String -> FieldDesc -> FieldDesc -fieldDescDeprecatedSince v desc d = d { fdDeprecatedSince = Just (v, desc) } - -data FieldDesc = FieldDesc - { fdAvailableSince :: Maybe CabalSpecVersion - , fdRemovedIn :: Maybe (CabalSpecVersion, String) - , fdDeprecatedSince :: Maybe (CabalSpecVersion, String) - , fdDescription :: FieldDesc' - } - deriving Show - -reference :: FieldName -> FieldDesc' -> Reference a b -reference fn d = Reference $ Map.singleton fn $ FieldDesc Nothing Nothing Nothing d - -data FieldDesc' - = BooleanFieldDesc Bool - | UniqueField PP.Doc -- ^ not used in BuildInfo - | FreeTextField -- ^ not user in BuildInfo - | OptionalFieldAla PP.Doc - | OptionalFieldDefAla PP.Doc PP.Doc - | MonoidalFieldAla PP.Doc - deriving Show - -instance Applicative (Reference a) where - pure _ = Reference Map.empty - Reference f <*> Reference x = Reference (Map.union f x) - -instance FieldGrammar Described Reference where - blurFieldGrammar _ (Reference xs) = Reference xs - - uniqueFieldAla fn pack _l = - reference fn $ UniqueField (describeDoc pack) - - booleanFieldDef fn _l def = - reference fn $ BooleanFieldDesc def - - optionalFieldAla fn pack _l = - reference fn $ OptionalFieldAla (describeDoc pack) - - optionalFieldDefAla fn pack _l def = - reference fn $ OptionalFieldDefAla - (describeDoc pack) - (pretty $ pack' pack def) - - freeTextField fn _l = reference fn FreeTextField - - freeTextFieldDef fn _l = reference fn FreeTextField - freeTextFieldDefST fn _l = reference fn FreeTextField - - monoidalFieldAla fn pack _l = - reference fn (MonoidalFieldAla (describeDoc pack)) - - prefixedFields _pfx _l = Reference Map.empty - - knownField _fn = Reference Map.empty -- TODO - - -- hidden fields are hidden from the reference. - hiddenField _ = Reference Map.empty - - deprecatedSince = referenceDeprecatedSince - removedIn = referenceRemovedIn - availableSince v _ r = referenceAvailableSince v r diff --git a/cabal.project.docs b/cabal.project.docs new file mode 100644 index 00000000000..d59cf4a3f16 --- /dev/null +++ b/cabal.project.docs @@ -0,0 +1,10 @@ +packages: Cabal-syntax +packages: Cabal +packages: Cabal-described +packages: Cabal-syntax-docs +tests: False +optimization: False + +-- avoiding extra dependencies +constraints: rere -rere-cfg +constraints: these -assoc diff --git a/doc/buildinfo-fields-reference.rst b/doc/cabal-package-syntax.rst similarity index 97% rename from doc/buildinfo-fields-reference.rst rename to doc/cabal-package-syntax.rst index a289292945a..e3e9a30ba88 100644 --- a/doc/buildinfo-fields-reference.rst +++ b/doc/cabal-package-syntax.rst @@ -1,10 +1,26 @@ -.. _buildinfo-field-reference: +.. _cabal-package-syntax: -Field Syntax Reference -====================== +Cabal Package Syntax +==================== + +GHC syntax +---------- + +Some elements of cabal package syntax are controlled by GHC. As such these are +effectively strings passed on to GHC and that may be as far as Cabal will check +their syntax. See the :ref:`ghc-syntax` for these elements of GHC syntax +embedded within cabal package descriptions. + +- :ref:`ghc-enable-extension` +- :ref:`ghc-disable-extension` +- :ref:`default-extensions` +- :ref:`default-language` +- :ref:`extensions` +- :ref:`other-extensions` +- :ref:`other-languages` Notation ---------------- +-------- Field syntax is described as they are in the latest cabal file format version. diff --git a/doc/ghc-syntax.rst b/doc/ghc-syntax.rst new file mode 100644 index 00000000000..3e5601e1e39 --- /dev/null +++ b/doc/ghc-syntax.rst @@ -0,0 +1,292 @@ +.. _ghc-syntax: + +GHC Syntax Reference +==================== + +Language Extensions +------------------- + +The many GHC language extensions are divided into groups of extensions +corresponding to subsections of the GHC users' guide on language extensions. +Those of the :ref:`ungrouped-extension ` group are +undocumented in the GHC users' guide. + +.. _ghc-disable-extension: + +disable-extension + Disable a language extension by prepending the extension with "No". + + .. math:: + + \mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}extension}} + +.. _ghc-enable-extension: + +enable-extension + All GHC language extensions known to cabal. There may be more and some of these may be on by default. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathit{interactive\text{-}extension}}\\\mathop{\mathit{phase\text{-}extension}}\\\mathop{\mathit{syntax\text{-}extension}}\\\mathop{\mathit{import\text{-}export\text{-}extension}}\\\mathop{\mathit{type\text{-}extension}}\\\mathop{\mathit{record\text{-}extension}}\\\mathop{\mathit{deriving\text{-}extension}}\\\mathop{\mathit{pattern\text{-}extension}}\\\mathop{\mathit{classes\text{-}instances\text{-}extension}}\\\mathop{\mathit{literals\text{-}extension}}\\\mathop{\mathit{constraint\text{-}extension}}\\\mathop{\mathit{type\text{-}signature\text{-}extension}}\\\mathop{\mathit{binding\text{-}generalisation\text{-}extension}}\\\mathop{\mathit{template\text{-}haskell\text{-}extension}}\\\mathop{\mathit{bang\text{-}strict\text{-}extension}}\\\mathop{\mathit{parallel\text{-}concurrent\text{-}extension}}\\\mathop{\mathit{unboxed\text{-}primitive\text{-}extension}}\\\mathop{\mathit{foreign\text{-}extension}}\\\mathop{\mathit{safe\text{-}extension}}\\\mathop{\mathit{miscellaneous\text{-}extension}}\\\mathop{\mathit{bugs\text{-}extension}}\\\mathop{\mathit{ungrouped\text{-}extension}}\end{gathered} \right\} + +.. _ghc-interactive-extension: + +interactive-extension + Language Extensions related to GHC interactive. + + .. math:: + + \mathop{\mathord{``}\mathtt{ExtendedDefaultRules}\mathord{"}} + +.. _ghc-phase-extension: + +phase-extension + Language Extensions related to a particular GHC phase. + + .. math:: + + \mathop{\mathord{``}\mathtt{CPP}\mathord{"}} + +.. _ghc-syntax-extension: + +syntax-extension + Syntax Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{UnicodeSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MagicHash}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RecursiveDo}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ApplicativeDo}\mathord{"}}\\\mathop{\mathord{``}\mathtt{QualifiedDo}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ParallelListComp}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TransformListComp}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonadComprehensions}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverloadedLists}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ImplicitPrelude}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RebindableSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PostfixOperators}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TupleSections}\mathord{"}}\\\mathop{\mathord{``}\mathtt{LambdaCase}\mathord{"}}\\\mathop{\mathord{``}\mathtt{EmptyCase}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MultiWayIf}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Arrows}\mathord{"}}\\\mathop{\mathord{``}\mathtt{LexicalNegation}\mathord{"}}\\\mathop{\mathord{``}\mathtt{BlockArguments}\mathord{"}}\end{gathered} \right\} + +.. _ghc-import-export-extension: + +import-export-extension + Import and Export Language Extensions. + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{PackageImports}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{ExplicitNamespaces}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{ImportQualifiedPost}\mathord{"}} \right\} + +.. _ghc-type-extension: + +type-extension + Language Extensions for Types. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{EmptyDataDecls}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DatatypeContexts}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeOperators}\mathord{"}}\\\mathop{\mathord{``}\mathtt{LiberalTypeSynonyms}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ExistentialQuantification}\mathord{"}}\\\mathop{\mathord{``}\mathtt{GADTSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{GADTs}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeFamilies}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeFamilyDependencies}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DataKinds}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeData}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeInType}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PolyKinds}\mathord{"}}\\\mathop{\mathord{``}\mathtt{CUSKs}\mathord{"}}\\\mathop{\mathord{``}\mathtt{StandaloneKindSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{StarIsType}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeApplications}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeAbstractions}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RequiredTypeArguments}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RankNTypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Rank2Types}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeepSubsumption}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ImpredicativeTypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{LinearTypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RoleAnnotations}\mathord{"}}\end{gathered} \right\} + +.. _ghc-record-extension: + +record-extension + Record Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{TraditionalRecordSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DisambiguateRecordFields}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DuplicateRecordFields}\mathord{"}}\\\mathop{\mathord{``}\mathtt{FieldSelectors}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NamedFieldPuns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RecordWildCards}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverloadedRecordDot}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverloadedRecordUpdate}\mathord{"}}\end{gathered} \right\} + +.. _ghc-deriving-extension: + +deriving-extension + Language Extensions for deriving mechanisms. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{EmptyDataDeriving}\mathord{"}}\\\mathop{\mathord{``}\mathtt{StandaloneDeriving}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveFoldable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveFunctor}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveTraversable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveDataTypeable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveLift}\mathord{"}}\\\mathop{\mathord{``}\mathtt{GeneralizedNewtypeDeriving}\mathord{"}}\\\mathop{\mathord{``}\mathtt{GeneralisedNewtypeDeriving}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DeriveAnyClass}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DerivingStrategies}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DerivingVia}\mathord{"}}\end{gathered} \right\} + +.. _ghc-pattern-extension: + +pattern-extension + Patterns Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{PatternGuards}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ViewPatterns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NPlusKPatterns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PatternSynonyms}\mathord{"}}\end{gathered} \right\} + +.. _ghc-classes-instances-extension: + +classes-instances-extension + Language Extensions for class and instance declarations. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{MultiParamTypeClasses}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UndecidableSuperClasses}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ConstrainedClassMethods}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DefaultSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NullaryTypeClasses}\mathord{"}}\\\mathop{\mathord{``}\mathtt{FunctionalDependencies}\mathord{"}}\\\mathop{\mathord{``}\mathtt{TypeSynonymInstances}\mathord{"}}\\\mathop{\mathord{``}\mathtt{FlexibleInstances}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UndecidableInstances}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverlappingInstances}\mathord{"}}\\\mathop{\mathord{``}\mathtt{IncoherentInstances}\mathord{"}}\\\mathop{\mathord{``}\mathtt{InstanceSigs}\mathord{"}}\end{gathered} \right\} + +.. _ghc-literal-extension: + +literal-extension + Literals Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{NegativeLiterals}\mathord{"}}\\\mathop{\mathord{``}\mathtt{BinaryLiterals}\mathord{"}}\\\mathop{\mathord{``}\mathtt{HexFloatLiterals}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NumDecimals}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ExtendedLiterals}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NumericUnderscores}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverloadedStrings}\mathord{"}}\\\mathop{\mathord{``}\mathtt{OverloadedLabels}\mathord{"}}\end{gathered} \right\} + +.. _ghc-constraint-extension: + +constraint-extension + Constraint Language Extensions. + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{FlexibleContexts}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{ConstraintKinds}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{QuantifiedConstraints}\mathord{"}} \right\} + +.. _ghc-type-signature-extension: + +type-signature-extension + Type Signature Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{ExplicitForAll}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AllowAmbiguousTypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{KindSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ScopedTypeVariables}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ImplicitParams}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PartialTypeSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NamedWildCards}\mathord{"}}\end{gathered} \right\} + +.. _ghc-binding-generalisation-extension: + +binding-generalisation-extension + Language Extensions for bindings and generalisation + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{MonomorphismRestriction}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{MonoLocalBinds}\mathord{"}} \right\} + +.. _ghc-template-haskell-extension: + +template-haskell-extension + Template Haskell Language Extensions. + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{TemplateHaskell}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{TemplateHaskellQuotes}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{QuasiQuotes}\mathord{"}} \right\} + +.. _ghc-bang-strict-extension: + +bang-strict-extension + Bang pattern and Strict Haskell Language Extensions. + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{BangPatterns}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{StrictData}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Strict}\mathord{"}} \right\} + +.. _ghc-parallel-concurrent-extension: + +parallel-concurrent-extension + Parallel and Concurrent Language Extensions. + + .. math:: + + \mathop{\mathord{``}\mathtt{StaticPointers}\mathord{"}} + +.. _ghc-unboxed-primitive-extension: + +unboxed-primitive-extension + Unboxed types and Primitive operations Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{UnboxedTuples}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UnboxedSums}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UnliftedNewtypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UnliftedDatatypes}\mathord{"}}\end{gathered} \right\} + +.. _ghc-foreign-extension: + +foreign-extension + Foreign function interface (FFI) Language Extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{ForeignFunctionInterface}\mathord{"}}\\\mathop{\mathord{``}\mathtt{UnliftedFFITypes}\mathord{"}}\\\mathop{\mathord{``}\mathtt{GHCForeignImportPrim}\mathord{"}}\\\mathop{\mathord{``}\mathtt{InterruptibleFFI}\mathord{"}}\\\mathop{\mathord{``}\mathtt{CApiFFI}\mathord{"}}\end{gathered} \right\} + +.. _ghc-safe-extension: + +safe-extension + Safe Haskell Language Extensions. + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{Safe}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Trustworthy}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Unsafe}\mathord{"}} \right\} + +.. _ghc-miscellaneous-extension: + +miscellaneous-extension + Miscellaneous Language Extensions. + + .. math:: + + \mathop{\mathord{``}\mathtt{DeriveGeneric}\mathord{"}} + +.. _ghc-bugs-extension: + +bugs-extension + Language Extensions related to GHC bugs and infelicities. + + .. math:: + + \mathop{\mathord{``}\mathtt{NondecreasingIndentation}\mathord{"}} + +.. _ghc-ungrouped-extension: + +ungrouped-extension + Language Extensions not belonging to other extension groups, includes undocumented extensions. + + .. math:: + + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{DoRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PolymorphicComponents}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PatternSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Generics}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ExtensibleRecords}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RestrictedTypeSynonyms}\mathord{"}}\\\mathop{\mathord{``}\mathtt{HereDocuments}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RecordPuns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonoPatBinds}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedPolyRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NewQualifiedOperators}\mathord{"}}\\\mathop{\mathord{``}\mathtt{XmlSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RegularPatterns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DoAndIfThenElse}\mathord{"}}\\\mathop{\mathord{``}\mathtt{SafeImports}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ParallelArrays}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AutoDeriveTypeable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{JavaScriptFFI}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonadFailDesugaring}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRule}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRuleTransitional}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedLayout}\mathord{"}}\end{gathered} \right\} + + +GHC build info fields +--------------------- + +These are cabal package build info fields that are more related to GHC, the +Haskell compiler, than they are to Cabal. + +.. _ghc-default-extensions: + +default-extensions + * Monoidal field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:default-extensions` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-default-language: + +default-language + * Optional field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:default-language` + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} + +.. _ghc-extensions: + +extensions + * Monoidal field + * Deprecated since ``cabal-version: 1.12``: Please use 'default-extensions' or 'other-extensions' fields. + * Removed in ``cabal-version: 3.0``: Please use 'default-extensions' or 'other-extensions' fields. + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-other-extensions: + +other-extensions + * Monoidal field + * Documentation of :pkg-field:`library:other-extensions` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-other-languages: + +other-languages + * Monoidal field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:other-languages` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} + + + diff --git a/doc/index.rst b/doc/index.rst index 0b5407e8580..d3e86f23320 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -32,7 +32,6 @@ Welcome to the Cabal User Guide external-commands setup-commands file-format-changelog - buildinfo-fields-reference .. toctree:: :caption: Cabal Explanation @@ -42,3 +41,11 @@ Welcome to the Cabal User Guide cabal-context package-concepts cabal-interface-stability + +.. toctree:: + :caption: Syntax Reference + :numbered: + :maxdepth: 2 + + cabal-package-syntax + ghc-syntax From eb07c4794209f8b5fb1e2016038d2a1a56ec2ffa Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 6 Jan 2024 08:14:36 -0500 Subject: [PATCH 6/9] Don't mention GHC, just language --- .../cabal-package/template.zinza | 10 ++++------ Cabal-syntax-docs/ghc/template.zinza | 19 +++++++------------ doc/cabal-package-syntax.rst | 10 ++++------ doc/ghc-syntax.rst | 19 +++++++------------ 4 files changed, 22 insertions(+), 36 deletions(-) diff --git a/Cabal-syntax-docs/cabal-package/template.zinza b/Cabal-syntax-docs/cabal-package/template.zinza index d2e7371df53..86c9d14dfe2 100644 --- a/Cabal-syntax-docs/cabal-package/template.zinza +++ b/Cabal-syntax-docs/cabal-package/template.zinza @@ -3,13 +3,11 @@ Cabal Package Syntax ==================== -GHC syntax ----------- +Lanugage Extensions +------------------- -Some elements of cabal package syntax are controlled by GHC. As such these are -effectively strings passed on to GHC and that may be as far as Cabal will check -their syntax. See the :ref:`ghc-syntax` for these elements of GHC syntax -embedded within cabal package descriptions. +For control of the default language and language extensions for the whole +package, see :ref:`ghc-syntax`. - :ref:`ghc-enable-extension` - :ref:`ghc-disable-extension` diff --git a/Cabal-syntax-docs/ghc/template.zinza b/Cabal-syntax-docs/ghc/template.zinza index 0272d5d99a3..6dd4e825e57 100644 --- a/Cabal-syntax-docs/ghc/template.zinza +++ b/Cabal-syntax-docs/ghc/template.zinza @@ -1,15 +1,11 @@ .. _ghc-syntax: -GHC Syntax Reference -==================== - Language Extensions -------------------- +=================== -The many GHC language extensions are divided into groups of extensions -corresponding to subsections of the GHC users' guide on language extensions. -Those of the :ref:`ungrouped-extension ` group are -undocumented in the GHC users' guide. +Language extensions groups shown here correspond to subsections of the GHC +users' guide on language extensions. Those of the :ref:`ungrouped-extension +` group are undocumented in the GHC users' guide. {% for production in productions %} .. _ghc-{{ production.name }}: @@ -23,11 +19,10 @@ undocumented in the GHC users' guide. {% endfor %} -GHC build info fields ---------------------- +Package language fields +----------------------- -These are cabal package build info fields that are more related to GHC, the -Haskell compiler, than they are to Cabal. +These are cabal package build info fields that control language. {% for field in ghcBuildInfoFields %} .. _ghc-{{ field.name }}: diff --git a/doc/cabal-package-syntax.rst b/doc/cabal-package-syntax.rst index e3e9a30ba88..ca646f2f1c0 100644 --- a/doc/cabal-package-syntax.rst +++ b/doc/cabal-package-syntax.rst @@ -3,13 +3,11 @@ Cabal Package Syntax ==================== -GHC syntax ----------- +Lanugage Extensions +------------------- -Some elements of cabal package syntax are controlled by GHC. As such these are -effectively strings passed on to GHC and that may be as far as Cabal will check -their syntax. See the :ref:`ghc-syntax` for these elements of GHC syntax -embedded within cabal package descriptions. +For control of the default language and language extensions for the whole +package, see :ref:`ghc-syntax`. - :ref:`ghc-enable-extension` - :ref:`ghc-disable-extension` diff --git a/doc/ghc-syntax.rst b/doc/ghc-syntax.rst index 3e5601e1e39..9ca39cc349e 100644 --- a/doc/ghc-syntax.rst +++ b/doc/ghc-syntax.rst @@ -1,15 +1,11 @@ .. _ghc-syntax: -GHC Syntax Reference -==================== - Language Extensions -------------------- +=================== -The many GHC language extensions are divided into groups of extensions -corresponding to subsections of the GHC users' guide on language extensions. -Those of the :ref:`ungrouped-extension ` group are -undocumented in the GHC users' guide. +Language extensions groups shown here correspond to subsections of the GHC +users' guide on language extensions. Those of the :ref:`ungrouped-extension +` group are undocumented in the GHC users' guide. .. _ghc-disable-extension: @@ -228,11 +224,10 @@ ungrouped-extension \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{DoRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PolymorphicComponents}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PatternSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Generics}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ExtensibleRecords}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RestrictedTypeSynonyms}\mathord{"}}\\\mathop{\mathord{``}\mathtt{HereDocuments}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RecordPuns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonoPatBinds}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedPolyRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NewQualifiedOperators}\mathord{"}}\\\mathop{\mathord{``}\mathtt{XmlSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RegularPatterns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DoAndIfThenElse}\mathord{"}}\\\mathop{\mathord{``}\mathtt{SafeImports}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ParallelArrays}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AutoDeriveTypeable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{JavaScriptFFI}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonadFailDesugaring}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRule}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRuleTransitional}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedLayout}\mathord{"}}\end{gathered} \right\} -GHC build info fields ---------------------- +Package language fields +----------------------- -These are cabal package build info fields that are more related to GHC, the -Haskell compiler, than they are to Cabal. +These are cabal package build info fields that control language. .. _ghc-default-extensions: From a8391fa7794a1366c32d2260f9375d9a5c3aa27f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 6 Jan 2024 08:45:19 -0500 Subject: [PATCH 7/9] Add a note and warning for language extensions --- .../cabal-package/template.zinza | 15 +- Cabal-syntax-docs/ghc/Main.hs | 2 +- Cabal-syntax-docs/ghc/template.zinza | 48 +++--- doc/cabal-package-syntax.rst | 17 +-- doc/ghc-syntax.rst | 138 ++++++++++-------- 5 files changed, 120 insertions(+), 100 deletions(-) diff --git a/Cabal-syntax-docs/cabal-package/template.zinza b/Cabal-syntax-docs/cabal-package/template.zinza index 86c9d14dfe2..7258fabc2c8 100644 --- a/Cabal-syntax-docs/cabal-package/template.zinza +++ b/Cabal-syntax-docs/cabal-package/template.zinza @@ -3,17 +3,14 @@ Cabal Package Syntax ==================== -Lanugage Extensions +Language Extensions ------------------- For control of the default language and language extensions for the whole package, see :ref:`ghc-syntax`. -- :ref:`ghc-enable-extension` -- :ref:`ghc-disable-extension` -{% for field in ghcBuildInfoFields %} -- :ref:`{{field.name}}` -{% endfor %} +- :ref:`ghc-default-language` +- :ref:`ghc-default-extensions` Notation -------- @@ -151,7 +148,7 @@ In the syntax definitions below the following non-terminal symbols are used: {% endfor %} -Build info fields +Build Info Fields ----------------- {% for field in cabalBuildInfoFields %} @@ -184,7 +181,7 @@ Build info fields {% endfor %} -Package description fields +Package Description Fields -------------------------- {% for field in packageDescriptionFields %} @@ -217,7 +214,7 @@ Package description fields {% endfor %} -Test-suite fields +Test-suite Fields ----------------- {% for field in testSuiteFields %} diff --git a/Cabal-syntax-docs/ghc/Main.hs b/Cabal-syntax-docs/ghc/Main.hs index a14173bdc4d..bc694fd3727 100644 --- a/Cabal-syntax-docs/ghc/Main.hs +++ b/Cabal-syntax-docs/ghc/Main.hs @@ -71,7 +71,7 @@ main = do , zproduction "bugs-extension" (reXs xGroupBugs) "Language Extensions related to GHC bugs and infelicities." , zproduction "ungrouped-extension" (reXs xUngrouped) - "Language Extensions not belonging to other extension groups, includes undocumented extensions." + "Language Extensions not belonging to other extension groups." ] , zSpaceList = show $ regexDoc $ REMunch RESpaces1 (RENamed "element" RETodo) diff --git a/Cabal-syntax-docs/ghc/template.zinza b/Cabal-syntax-docs/ghc/template.zinza index 6dd4e825e57..d5328dee02d 100644 --- a/Cabal-syntax-docs/ghc/template.zinza +++ b/Cabal-syntax-docs/ghc/template.zinza @@ -3,23 +3,7 @@ Language Extensions =================== -Language extensions groups shown here correspond to subsections of the GHC -users' guide on language extensions. Those of the :ref:`ungrouped-extension -` group are undocumented in the GHC users' guide. - -{% for production in productions %} -.. _ghc-{{ production.name }}: - -{{ production.name }} - {{ production.description }} - - .. math:: - - {{ production.syntax }} - -{% endfor %} - -Package language fields +Package Language Fields ----------------------- These are cabal package build info fields that control language. @@ -56,3 +40,33 @@ These are cabal package build info fields that control language. {% endfor %} +Langage Extension Groups +------------------------ + +Language extensions groups shown here correspond to subsections of the GHC +users' guide on language extensions. + +.. Note:: + + The Cabal package grammar accepts any tokens for extension fields. The + extensions specified may be anything, something which a particular Cabal + version doesn't know about and this list of "known" extensions is not part + of the ``.cabal`` file specification and shown here only as a convenience. + The GHC users' guide is the place to look these up. + +{% for production in productions %} +.. _ghc-{{ production.name }}: + +{{ production.name }} + {{ production.description }} + + .. math:: + + {{ production.syntax }} + +{% endfor %} + +.. Warning:: + + Extensions of the :ref:`ungrouped-extension ` group + are undocumented in the GHC users' guide. diff --git a/doc/cabal-package-syntax.rst b/doc/cabal-package-syntax.rst index ca646f2f1c0..7b2e0ff4452 100644 --- a/doc/cabal-package-syntax.rst +++ b/doc/cabal-package-syntax.rst @@ -3,19 +3,14 @@ Cabal Package Syntax ==================== -Lanugage Extensions +Language Extensions ------------------- For control of the default language and language extensions for the whole package, see :ref:`ghc-syntax`. -- :ref:`ghc-enable-extension` -- :ref:`ghc-disable-extension` -- :ref:`default-extensions` -- :ref:`default-language` -- :ref:`extensions` -- :ref:`other-extensions` -- :ref:`other-languages` +- :ref:`ghc-default-language` +- :ref:`ghc-default-extensions` Notation -------- @@ -172,7 +167,7 @@ version-range \mathbf{fix}\;\mathop{\mathit{version\text{-}range}}\;\mathbf{in}\;\left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{\text{=}\text{=}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{>}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{<}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{<}\text{=}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{>}\text{=}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{^}\text{>}\text{=}}\mathord{"}}\circ\mathop{\mathit{version}}\\\mathop{\mathord{``}\mathtt{\text{=}\text{=}}\mathord{"}}\circ{\left\{ \mathop{\mathord{``}\mathtt{0}\mathord{"}}\mid[\mathop{\mathord{``}\mathtt{1}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}]{[\mathop{\mathord{``}\mathtt{0}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}]}^{\in [0\ldots8]}_{} \right\}}^+_{\mathop{\mathord{``}\mathtt{\text{.}}\mathord{"}}}\mathop{\mathord{``}\mathtt{\text{.}\text{*}}\mathord{"}}\\\mathop{\mathit{version\text{-}range}}\circ\mathop{\mathord{``}\mathtt{\text{|}\text{|}}\mathord{"}}\circ\mathop{\mathit{version\text{-}range}}\\\mathop{\mathit{version\text{-}range}}\circ\mathop{\mathord{``}\mathtt{\text{&}\text{&}}\mathord{"}}\circ\mathop{\mathit{version\text{-}range}}\\\mathop{\mathord{``}\mathtt{\text{(}}\mathord{"}}\circ\mathop{\mathit{version\text{-}range}}\circ\mathop{\mathord{``}\mathtt{\text{)}}\mathord{"}}\\\mathop{\mathord{``}\mathtt{\text{=}\text{=}}\mathord{"}}\circ\mathop{\mathord{``}\mathtt{\{}\mathord{"}}\circ{\mathop{\mathit{version}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\}}\mathord{"}}\\\mathop{\mathord{``}\mathtt{\text{^}\text{>}\text{=}}\mathord{"}}\circ\mathop{\mathord{``}\mathtt{\{}\mathord{"}}\circ{\mathop{\mathit{version}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\}}\mathord{"}}\end{gathered} \right\} -Build info fields +Build Info Fields ----------------- asm-options @@ -549,7 +544,7 @@ virtual-modules \mathrm{commalist}\left({\left(\mathop{\mathit{upper}}{\left\{ \mathop{\mathit{alpha\text{-}num}}\mid[\mathop{\mathord{``}\mathtt{\text{'}}\mathord{"}}\mathop{\mathord{``}\mathtt{\text{_}}\mathord{"}}] \right\}}^\ast_{}\right)}^+_{\mathop{\mathord{``}\mathtt{\text{.}}\mathord{"}}}\right) -Package description fields +Package Description Fields -------------------------- author @@ -688,7 +683,7 @@ version {\left\{ \mathop{\mathord{``}\mathtt{0}\mathord{"}}\mid[\mathop{\mathord{``}\mathtt{1}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}]{[\mathop{\mathord{``}\mathtt{0}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}]}^{\in [0\ldots8]}_{} \right\}}^+_{\mathop{\mathord{``}\mathtt{\text{.}}\mathord{"}}} -Test-suite fields +Test-suite Fields ----------------- code-generators diff --git a/doc/ghc-syntax.rst b/doc/ghc-syntax.rst index 9ca39cc349e..439e32303f9 100644 --- a/doc/ghc-syntax.rst +++ b/doc/ghc-syntax.rst @@ -3,9 +3,79 @@ Language Extensions =================== +Package Language Fields +----------------------- + +These are cabal package build info fields that control language. + +.. _ghc-default-extensions: + +default-extensions + * Monoidal field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:default-extensions` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-default-language: + +default-language + * Optional field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:default-language` + + .. math:: + + \left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} + +.. _ghc-extensions: + +extensions + * Monoidal field + * Deprecated since ``cabal-version: 1.12``: Please use 'default-extensions' or 'other-extensions' fields. + * Removed in ``cabal-version: 3.0``: Please use 'default-extensions' or 'other-extensions' fields. + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-other-extensions: + +other-extensions + * Monoidal field + * Documentation of :pkg-field:`library:other-extensions` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + +.. _ghc-other-languages: + +other-languages + * Monoidal field + * Available since ``cabal-version: 1.10``. + * Documentation of :pkg-field:`library:other-languages` + + .. math:: + + \mathrm{optcommalist}\left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} + + +Langage Extension Groups +------------------------ + Language extensions groups shown here correspond to subsections of the GHC -users' guide on language extensions. Those of the :ref:`ungrouped-extension -` group are undocumented in the GHC users' guide. +users' guide on language extensions. + +.. Note:: + + The Cabal package grammar accepts any tokens for extension fields. The + extensions specified may be anything, something which a particular Cabal + version doesn't know about and this list of "known" extensions is not part + of the ``.cabal`` file specification and shown here only as a convenience. + The GHC users' guide is the place to look these up. .. _ghc-disable-extension: @@ -217,71 +287,15 @@ bugs-extension .. _ghc-ungrouped-extension: ungrouped-extension - Language Extensions not belonging to other extension groups, includes undocumented extensions. + Language Extensions not belonging to other extension groups. .. math:: \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{DoRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PolymorphicComponents}\mathord{"}}\\\mathop{\mathord{``}\mathtt{PatternSignatures}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Generics}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ExtensibleRecords}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RestrictedTypeSynonyms}\mathord{"}}\\\mathop{\mathord{``}\mathtt{HereDocuments}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RecordPuns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonoPatBinds}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedPolyRec}\mathord{"}}\\\mathop{\mathord{``}\mathtt{NewQualifiedOperators}\mathord{"}}\\\mathop{\mathord{``}\mathtt{XmlSyntax}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RegularPatterns}\mathord{"}}\\\mathop{\mathord{``}\mathtt{DoAndIfThenElse}\mathord{"}}\\\mathop{\mathord{``}\mathtt{SafeImports}\mathord{"}}\\\mathop{\mathord{``}\mathtt{ParallelArrays}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AutoDeriveTypeable}\mathord{"}}\\\mathop{\mathord{``}\mathtt{JavaScriptFFI}\mathord{"}}\\\mathop{\mathord{``}\mathtt{MonadFailDesugaring}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRule}\mathord{"}}\\\mathop{\mathord{``}\mathtt{AlternativeLayoutRuleTransitional}\mathord{"}}\\\mathop{\mathord{``}\mathtt{RelaxedLayout}\mathord{"}}\end{gathered} \right\} -Package language fields ------------------------ - -These are cabal package build info fields that control language. - -.. _ghc-default-extensions: - -default-extensions - * Monoidal field - * Available since ``cabal-version: 1.10``. - * Documentation of :pkg-field:`library:default-extensions` - - .. math:: - - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} - -.. _ghc-default-language: - -default-language - * Optional field - * Available since ``cabal-version: 1.10``. - * Documentation of :pkg-field:`library:default-language` - - .. math:: - - \left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} - -.. _ghc-extensions: - -extensions - * Monoidal field - * Deprecated since ``cabal-version: 1.12``: Please use 'default-extensions' or 'other-extensions' fields. - * Removed in ``cabal-version: 3.0``: Please use 'default-extensions' or 'other-extensions' fields. - - .. math:: - - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} - -.. _ghc-other-extensions: - -other-extensions - * Monoidal field - * Documentation of :pkg-field:`library:other-extensions` - - .. math:: - - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} - -.. _ghc-other-languages: - -other-languages - * Monoidal field - * Available since ``cabal-version: 1.10``. - * Documentation of :pkg-field:`library:other-languages` - - .. math:: - - \mathrm{optcommalist}\left\{ \mathop{\mathord{``}\mathtt{GHC2021}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}} \right\} - +.. Warning:: + Extensions of the :ref:`ungrouped-extension ` group + are undocumented in the GHC users' guide. From 38a937404dbd99befd6d1b0ecd8806be888c1623 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 6 Jan 2024 09:13:04 -0500 Subject: [PATCH 8/9] Add reUnknownExtension --- .../src/Distribution/Described/Extension.hs | 17 +++++++----- Cabal-syntax-docs/ghc/Main.hs | 8 +++--- doc/ghc-syntax.rst | 27 ++++++++++++------- 3 files changed, 34 insertions(+), 18 deletions(-) diff --git a/Cabal-described/src/Distribution/Described/Extension.hs b/Cabal-described/src/Distribution/Described/Extension.hs index 4c5c81e46ae..7b10652244f 100644 --- a/Cabal-described/src/Distribution/Described/Extension.hs +++ b/Cabal-described/src/Distribution/Described/Extension.hs @@ -3,6 +3,7 @@ module Distribution.Described.Extension ( reEnableExtension , reKnownExtension + , reUnknownExtension , reDisableExtension , reXs -- * Extension groups @@ -38,15 +39,22 @@ import Language.Haskell.Extension instance Described Extension where describe _ = REUnion - [ RENamed "enable-extension" reKnownExtension - , RENamed "disable-extension" reDisableExtension + [ reEnableExtension + , reDisableExtension + , reUnknownExtension ] reXs :: [KnownExtension] -> GrammarRegex a reXs xs = REUnion (fromString . prettyShow <$> xs) reEnableExtension :: GrammarRegex a -reEnableExtension = "enable-extension" +reEnableExtension = RENamed "enable-known-extension" reKnownExtension + +reDisableExtension :: GrammarRegex a +reDisableExtension = REUnion ["No" <> reEnableExtension] + +reUnknownExtension :: GrammarRegex a +reUnknownExtension = RENamed "unknown-extension" RETodo reKnownExtension :: GrammarRegex a reKnownExtension = REUnion @@ -74,9 +82,6 @@ reKnownExtension = REUnion , RENamed "ungrouped-extension" $ reXs xUngrouped ] -reDisableExtension :: GrammarRegex a -reDisableExtension = REUnion ["No" <> RENamed "enable-extension" reKnownExtension] - -- The comments in the xGroup* lists are taken from the GHC User's Guide. Stop -- the formatter from rearranging them with: {- FOURMOLU_DISABLE -} diff --git a/Cabal-syntax-docs/ghc/Main.hs b/Cabal-syntax-docs/ghc/Main.hs index bc694fd3727..ae8bc71f945 100644 --- a/Cabal-syntax-docs/ghc/Main.hs +++ b/Cabal-syntax-docs/ghc/Main.hs @@ -24,10 +24,12 @@ main = do contents <- run $ Z { zGhcBuildInfoFields = biGhc , zProductions = - [ zproduction "disable-extension" reDisableExtension + [ zproduction "disable-known-extension" reDisableExtension "Disable a language extension by prepending the extension with \"No\"." - , zproduction "enable-extension" reKnownExtension - "All GHC language extensions known to cabal. There may be more and some of these may be on by default." + , zproduction "enable-known-extension" reKnownExtension + "All \"known\" language extensions. There may be more and some of these may be on by default." + , zproduction "unknown-extension" reUnknownExtension + "Any token for any unknown extension is acceptable." , zproduction "interactive-extension" (reXs xGroupInteractive) "Language Extensions related to GHC interactive." , zproduction "phase-extension" (reXs xGroupPhase) diff --git a/doc/ghc-syntax.rst b/doc/ghc-syntax.rst index 439e32303f9..22d3d547cb1 100644 --- a/doc/ghc-syntax.rst +++ b/doc/ghc-syntax.rst @@ -17,7 +17,7 @@ default-extensions .. math:: - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathit{unknown\text{-}extension}} \right\} .. _ghc-default-language: @@ -39,7 +39,7 @@ extensions .. math:: - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathit{unknown\text{-}extension}} \right\} .. _ghc-other-extensions: @@ -49,7 +49,7 @@ other-extensions .. math:: - \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}extension}}\mid\mathop{\mathit{disable\text{-}extension}} \right\} + \mathrm{optcommalist}\left\{ \mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}known\text{-}extension}}\mid\mathop{\mathit{unknown\text{-}extension}} \right\} .. _ghc-other-languages: @@ -77,24 +77,33 @@ users' guide on language extensions. of the ``.cabal`` file specification and shown here only as a convenience. The GHC users' guide is the place to look these up. -.. _ghc-disable-extension: +.. _ghc-disable-known-extension: -disable-extension +disable-known-extension Disable a language extension by prepending the extension with "No". .. math:: - \mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}extension}} + \mathop{\mathord{``}\mathtt{No}\mathord{"}}\mathop{\mathit{enable\text{-}known\text{-}extension}} -.. _ghc-enable-extension: +.. _ghc-enable-known-extension: -enable-extension - All GHC language extensions known to cabal. There may be more and some of these may be on by default. +enable-known-extension + All "known" language extensions. There may be more and some of these may be on by default. .. math:: \left\{ \begin{gathered}\mathop{\mathit{interactive\text{-}extension}}\\\mathop{\mathit{phase\text{-}extension}}\\\mathop{\mathit{syntax\text{-}extension}}\\\mathop{\mathit{import\text{-}export\text{-}extension}}\\\mathop{\mathit{type\text{-}extension}}\\\mathop{\mathit{record\text{-}extension}}\\\mathop{\mathit{deriving\text{-}extension}}\\\mathop{\mathit{pattern\text{-}extension}}\\\mathop{\mathit{classes\text{-}instances\text{-}extension}}\\\mathop{\mathit{literals\text{-}extension}}\\\mathop{\mathit{constraint\text{-}extension}}\\\mathop{\mathit{type\text{-}signature\text{-}extension}}\\\mathop{\mathit{binding\text{-}generalisation\text{-}extension}}\\\mathop{\mathit{template\text{-}haskell\text{-}extension}}\\\mathop{\mathit{bang\text{-}strict\text{-}extension}}\\\mathop{\mathit{parallel\text{-}concurrent\text{-}extension}}\\\mathop{\mathit{unboxed\text{-}primitive\text{-}extension}}\\\mathop{\mathit{foreign\text{-}extension}}\\\mathop{\mathit{safe\text{-}extension}}\\\mathop{\mathit{miscellaneous\text{-}extension}}\\\mathop{\mathit{bugs\text{-}extension}}\\\mathop{\mathit{ungrouped\text{-}extension}}\end{gathered} \right\} +.. _ghc-unknown-extension: + +unknown-extension + Any token for any unknown extension is acceptable. + + .. math:: + + \mathsf{\color{red}{TODO}} + .. _ghc-interactive-extension: interactive-extension From 24bfa09abc8f5f77c7562965aa8e8e662b399b3f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 6 Jan 2024 09:43:46 -0500 Subject: [PATCH 9/9] Rename language-extensions.rst, add to quickjobs --- .github/workflows/quick-jobs.yml | 6 ++++-- Makefile | 2 +- doc/index.rst | 2 +- doc/{ghc-syntax.rst => language-extensions.rst} | 0 4 files changed, 6 insertions(+), 4 deletions(-) rename doc/{ghc-syntax.rst => language-extensions.rst} (100%) diff --git a/.github/workflows/quick-jobs.yml b/.github/workflows/quick-jobs.yml index 82c3fbd1244..ebe23928d43 100644 --- a/.github/workflows/quick-jobs.yml +++ b/.github/workflows/quick-jobs.yml @@ -141,8 +141,10 @@ jobs: restore-keys: linux-store-buildinfo-doc-diff - name: Build buildinfo-reference-generator run: ${{ env.cabal_build }} - - name: Are buildinfo docs up to date? - run: make doc/buildinfo-fields-reference.rst + - name: Are cabal package syntax docs up to date? + run: make doc/cabal-package-syntax.rst + - name: Are language extensions docs up to date? + run: make doc/language-extensions.rst - name: Cache dependencies uses: actions/cache/save@v4 if: always() && steps.cache.outputs.cache-hit != 'true' diff --git a/Makefile b/Makefile index 777aa496a3e..357cab7f296 100644 --- a/Makefile +++ b/Makefile @@ -88,7 +88,7 @@ doc/cabal-package-syntax.rst : \ cabal run --project-file=cabal.project.docs gen-cabal-package-syntax-docs Cabal-syntax-docs/cabal-package/template.zinza | tee $@ git diff --exit-code $@ -doc/ghc-syntax.rst : \ +doc/language-extensions.rst : \ $(wildcard Cabal-syntax/src/*/*.hs Cabal-syntax/src/*/*/*.hs Cabal-syntax/src/*/*/*/*.hs) \ $(wildcard Cabal-described/src/Distribution/Described.hs Cabal-described/src/Distribution/Utils/*.hs) \ Cabal-syntax-docs/ghc/Main.hs \ diff --git a/doc/index.rst b/doc/index.rst index d3e86f23320..b308eb7fd94 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -48,4 +48,4 @@ Welcome to the Cabal User Guide :maxdepth: 2 cabal-package-syntax - ghc-syntax + language-extensions diff --git a/doc/ghc-syntax.rst b/doc/language-extensions.rst similarity index 100% rename from doc/ghc-syntax.rst rename to doc/language-extensions.rst