From 90b14ae63d49e62b8fff4b686a47685068aacad8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 13 Feb 2020 20:00:35 +0200 Subject: [PATCH] Add buildinfo-reference-generator Note all Described instances are implemented. This is just a start. --- .../src/Test/QuickCheck/Instances/Cabal.hs | 22 + Cabal/Cabal.cabal | 19 +- Cabal/Distribution/Compat/Prelude.hs | 6 + Cabal/Distribution/FieldGrammar/Class.hs | 23 +- Cabal/Distribution/FieldGrammar/Described.hs | 135 ++++ Cabal/Distribution/ModuleName.hs | 8 +- Cabal/Distribution/Parsec/Newtypes.hs | 43 +- Cabal/Distribution/Types/AbiDependency.hs | 7 + Cabal/Distribution/Types/AbiHash.hs | 4 + Cabal/Distribution/Types/BenchmarkType.hs | 7 +- Cabal/Distribution/Types/BuildType.hs | 5 + Cabal/Distribution/Types/Dependency.hs | 49 +- Cabal/Distribution/Types/ExeDependency.hs | 7 +- Cabal/Distribution/Types/ExecutableScope.hs | 5 + Cabal/Distribution/Types/ExposedModule.hs | 4 + Cabal/Distribution/Types/ForeignLib.hs | 9 +- Cabal/Distribution/Types/ForeignLibOption.hs | 5 + Cabal/Distribution/Types/ForeignLibType.hs | 5 + .../InstalledPackageInfo/FieldGrammar.hs | 12 +- .../Distribution/Types/LegacyExeDependency.hs | 8 +- Cabal/Distribution/Types/LibraryVisibility.hs | 5 + Cabal/Distribution/Types/Mixin.hs | 4 + Cabal/Distribution/Types/ModuleReexport.hs | 4 + Cabal/Distribution/Types/MungedPackageName.hs | 4 + Cabal/Distribution/Types/PackageName.hs | 5 + .../Distribution/Types/PkgconfigDependency.hs | 6 +- Cabal/Distribution/Types/SourceRepo.hs | 4 + Cabal/Distribution/Types/TestType.hs | 7 +- Cabal/Distribution/Types/UnitId.hs | 4 + .../Distribution/Types/UnqualComponentName.hs | 4 + Cabal/Distribution/Types/Version.hs | 8 + .../Types/VersionRange/Internal.hs | 33 +- Cabal/Distribution/Utils/CharSet.hs | 230 +++++++ Cabal/Distribution/Utils/Regex.hs | 202 ++++++ Cabal/Language/Haskell/Extension.hs | 8 + Cabal/doc/buildinfo-fields-reference.rst | 650 ++++++++++++++++++ Cabal/doc/conf.py | 3 + Cabal/doc/index.rst | 1 + Cabal/tests/UnitTests.hs | 4 + .../tests/UnitTests/Distribution/Described.hs | 134 ++++ .../UnitTests/Distribution/Utils/CharSet.hs | 27 + Makefile | 7 + .../buildinfo-reference-generator.cabal | 15 + buildinfo-reference-generator/src/Main.hs | 275 ++++++++ buildinfo-reference-generator/template.zinza | 234 +++++++ cabal.project.buildinfo | 5 + 46 files changed, 2226 insertions(+), 40 deletions(-) create mode 100644 Cabal/Distribution/FieldGrammar/Described.hs create mode 100644 Cabal/Distribution/Utils/CharSet.hs create mode 100644 Cabal/Distribution/Utils/Regex.hs create mode 100644 Cabal/doc/buildinfo-fields-reference.rst create mode 100644 Cabal/tests/UnitTests/Distribution/Described.hs create mode 100644 Cabal/tests/UnitTests/Distribution/Utils/CharSet.hs create mode 100644 buildinfo-reference-generator/buildinfo-reference-generator.cabal create mode 100644 buildinfo-reference-generator/src/Main.hs create mode 100644 buildinfo-reference-generator/template.zinza create mode 100644 cabal.project.buildinfo diff --git a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs index f7a40b2d5dd..621d0a3a73c 100644 --- a/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -3,16 +3,30 @@ module Test.QuickCheck.Instances.Cabal () where import Control.Applicative (liftA2) +import Data.Char (isAlphaNum, isDigit) +import Data.List (intercalate) import Test.QuickCheck import Distribution.SPDX import Distribution.Version +import Distribution.Types.PackageName import Distribution.Types.VersionRange.Internal #if !MIN_VERSION_base(4,8,0) import Control.Applicative (pure, (<$>), (<*>)) #endif +------------------------------------------------------------------------------- +-- PackageName +------------------------------------------------------------------------------- + +instance Arbitrary PackageName where + arbitrary = mkPackageName . intercalate "-" <$> shortListOf1 2 nameComponent + where + nameComponent = shortListOf1 5 (elements packageChars) + `suchThat` (not . all isDigit) + packageChars = filter isAlphaNum ['\0'..'\127'] + ------------------------------------------------------------------------------- -- Version ------------------------------------------------------------------------------- @@ -150,3 +164,11 @@ instance Arbitrary LicenseExpression where shrink (EOr a b) = a : b : map (uncurry EOr) (shrink (a, b)) shrink _ = [] +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +shortListOf1 :: Int -> Gen a -> Gen [a] +shortListOf1 bound gen = sized $ \n -> do + k <- choose (1, 1 `max` ((n `div` 2) `min` bound)) + vectorOf k gen diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index a992a58672c..f70ae3ce5ee 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -303,6 +303,9 @@ library -- already depends on `fail` and `semigroups` transitively build-depends: fail == 4.9.*, semigroups >= 0.18.3 && < 0.20 + if !impl(ghc >= 7.10) + build-depends: void >= 0.7.3 && < 0.8 + if !impl(ghc >= 7.8) -- semigroups depends on tagged. build-depends: tagged >=0.8.6 && <0.9 @@ -481,6 +484,8 @@ library Distribution.Types.VersionInterval Distribution.Types.GivenComponent Distribution.Types.PackageVersionConstraint + Distribution.Utils.CharSet + Distribution.Utils.Regex Distribution.Utils.Generic Distribution.Utils.NubList Distribution.Utils.ShortText @@ -504,6 +509,7 @@ library Distribution.Compat.CharParsing Distribution.FieldGrammar Distribution.FieldGrammar.Class + Distribution.FieldGrammar.Described Distribution.FieldGrammar.FieldDescrs Distribution.FieldGrammar.Parsec Distribution.FieldGrammar.Pretty @@ -614,6 +620,7 @@ test-suite unit-tests UnitTests.Distribution.Compat.CreatePipe UnitTests.Distribution.Compat.Graph UnitTests.Distribution.Compat.Time + UnitTests.Distribution.Described UnitTests.Distribution.Simple.Glob UnitTests.Distribution.Simple.Program.GHC UnitTests.Distribution.Simple.Program.Internal @@ -621,6 +628,7 @@ test-suite unit-tests UnitTests.Distribution.SPDX UnitTests.Distribution.System UnitTests.Distribution.Types.GenericPackageDescription + UnitTests.Distribution.Utils.CharSet UnitTests.Distribution.Utils.Generic UnitTests.Distribution.Utils.NubList UnitTests.Distribution.Utils.ShortText @@ -644,6 +652,7 @@ test-suite unit-tests directory, filepath, integer-logarithms >= 1.0.2 && <1.1, + rere >=0.1 && <0.2, tasty >= 1.2.3 && < 1.3, tasty-hunit, tasty-quickcheck, @@ -657,6 +666,14 @@ test-suite unit-tests ghc-options: -Wall default-language: Haskell2010 + if !impl(ghc >= 7.10) + build-depends: void + + -- Cabal-quickcheck + hs-source-dirs: Cabal-quickcheck/src + other-modules: + Test.QuickCheck.Instances.Cabal + test-suite parser-tests type: exitcode-stdio-1.0 hs-source-dirs: tests @@ -677,7 +694,7 @@ test-suite parser-tests default-language: Haskell2010 if !impl(ghc >= 8.0) - build-depends: semigroups + build-depends: semigroups if impl(ghc >= 7.8) build-depends: diff --git a/Cabal/Distribution/Compat/Prelude.hs b/Cabal/Distribution/Compat/Prelude.hs index d13db626706..506737f194c 100644 --- a/Cabal/Distribution/Compat/Prelude.hs +++ b/Cabal/Distribution/Compat/Prelude.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE Trustworthy #-} #ifdef MIN_VERSION_base #define MINVER_base_411 MIN_VERSION_base(4,11,0) @@ -48,6 +49,7 @@ module Distribution.Compat.Prelude ( Set, Identity (..), Proxy (..), + Void, -- * Data.Maybe catMaybes, mapMaybe, @@ -92,6 +94,9 @@ module Distribution.Compat.Prelude ( chr, ord, toLower, toUpper, + -- * Data.Void + absurd, vacuous, + -- * Data.Word & Data.Int Word, Word8, Word16, Word32, Word64, @@ -160,6 +165,7 @@ import Data.Maybe import Data.String (IsString (..)) import Data.Int import Data.Word +import Data.Void (Void, absurd, vacuous) import Text.Read (readMaybe) import qualified Text.PrettyPrint as Disp diff --git a/Cabal/Distribution/FieldGrammar/Class.hs b/Cabal/Distribution/FieldGrammar/Class.hs index 6dda48b42ce..7a65543bef8 100644 --- a/Cabal/Distribution/FieldGrammar/Class.hs +++ b/Cabal/Distribution/FieldGrammar/Class.hs @@ -11,11 +11,10 @@ import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () -import Distribution.CabalSpecVersion (CabalSpecVersion) -import Distribution.Compat.Newtype (Newtype) +import Distribution.CabalSpecVersion (CabalSpecVersion) +import Distribution.Compat.Newtype (Newtype) +import Distribution.FieldGrammar.Described (Described) import Distribution.Fields.Field -import Distribution.Parsec (Parsec) -import Distribution.Pretty (Pretty) import Distribution.Utils.ShortText -- | 'FieldGrammar' is parametrised by @@ -33,7 +32,7 @@ class FieldGrammar g where -- | Field which should be defined, exactly once. uniqueFieldAla - :: (Parsec b, Pretty b, Newtype a b) + :: (Described b, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'Newtype' pack -> ALens' s a -- ^ lens into the field @@ -48,7 +47,7 @@ class FieldGrammar g where -- | Optional field. optionalFieldAla - :: (Parsec b, Pretty b, Newtype a b) + :: (Described b, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'pack' -> ALens' s (Maybe a) -- ^ lens into the field @@ -56,7 +55,7 @@ class FieldGrammar g where -- | Optional field with default value. optionalFieldDefAla - :: (Parsec b, Pretty b, Newtype a b, Eq a) + :: (Described b, Newtype a b, Eq a) => FieldName -- ^ field name -> (a -> b) -- ^ 'Newtype' pack -> ALens' s a -- ^ @'Lens'' s a@: lens into the field @@ -94,7 +93,7 @@ class FieldGrammar g where -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid. -- monoidalFieldAla - :: (Parsec b, Pretty b, Monoid a, Newtype a b) + :: (Described b, Monoid a, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'pack' -> ALens' s a -- ^ lens into the field @@ -135,7 +134,7 @@ class FieldGrammar g where -- | Field which can be defined at most once. uniqueField - :: (FieldGrammar g, Parsec a, Pretty a) + :: (FieldGrammar g, Described a) => FieldName -- ^ field name -> ALens' s a -- ^ lens into the field -> g s a @@ -143,7 +142,7 @@ uniqueField fn = uniqueFieldAla fn Identity -- | Field which can be defined at most once. optionalField - :: (FieldGrammar g, Parsec a, Pretty a) + :: (FieldGrammar g, Described a) => FieldName -- ^ field name -> ALens' s (Maybe a) -- ^ lens into the field -> g s (Maybe a) @@ -151,7 +150,7 @@ optionalField fn = optionalFieldAla fn Identity -- | Optional field with default value. optionalFieldDef - :: (FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a) + :: (FieldGrammar g, Functor (g s), Described a, Eq a) => FieldName -- ^ field name -> ALens' s a -- ^ @'Lens'' s a@: lens into the field -> a -- ^ default value @@ -160,7 +159,7 @@ optionalFieldDef fn = optionalFieldDefAla fn Identity -- | Field which can be define multiple times, and the results are @mappend@ed. monoidalField - :: (FieldGrammar g, Parsec a, Pretty a, Monoid a) + :: (FieldGrammar g, Described a, Monoid a) => FieldName -- ^ field name -> ALens' s a -- ^ lens into the field -> g s a diff --git a/Cabal/Distribution/FieldGrammar/Described.hs b/Cabal/Distribution/FieldGrammar/Described.hs new file mode 100644 index 00000000000..8b66ba5dc6d --- /dev/null +++ b/Cabal/Distribution/FieldGrammar/Described.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Distribution.FieldGrammar.Described ( + Described (..), + describeDoc, + -- * Regular expressions + Regex (..), + reEps, + reChar, + reChars, + reMunchCS, + reMunch1CS, + -- * Variables + reVar0, + reVar1, + -- * Special expressions + reDot, + reComma, + reSpacedComma, + reHsString, + reUnqualComponent, + -- * Lists + reSpacedList, + reCommaList, + reOptCommaList, + -- * Character Sets + csChar, + csAlphaNum, + csNotSpace, + csNotSpaceOrComma, + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Parsec (Parsec) +import Distribution.Pretty (Pretty) + +import Distribution.Utils.Regex + +import qualified Distribution.Utils.CharSet as CS +import qualified Text.PrettyPrint as PP + +-- | Class describing the pretty/parsec format of a. +class (Pretty a, Parsec a) => Described a where + -- | A pretty document of "regex" describing the field format + describe :: proxy a -> Regex void + +-- | Pretty-print description. +-- +-- >>> describeDoc ([] :: [Bool]) +-- \left\{ \mathop{\mathord{``}\mathtt{True}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{False}\mathord{"}} \right\} +-- +describeDoc :: Described a => proxy a -> PP.Doc +describeDoc p = regexDoc (describe p) + +instance Described Bool where + describe _ = REUnion ["True", "False"] + +instance Described a => Described (Identity a) where + describe _ = describe ([] :: [a]) + +------------------------------------------------------------------------------- +-- Lists +------------------------------------------------------------------------------ + +reSpacedList :: Regex a -> Regex a +reSpacedList = REMunch RESpaces1 + +reCommaList :: Regex a -> Regex a +reCommaList = RECommaList + +reOptCommaList :: Regex a -> Regex a +reOptCommaList = REOptCommaList + +------------------------------------------------------------------------------- +-- Specific grammars +------------------------------------------------------------------------------- + +reHsString :: Regex a +reHsString = RENamed "hs-string" impl where + impl = reChar '"' <> REMunch reEps (REUnion [strChar, escChar]) <> reChar '"' + strChar = RECharSet $ CS.difference CS.universe (CS.fromList "\"\\") + + escChar = REUnion + [ "\\&" + , "\\\\" + , REUnion ["\\n", RENamed "escapes" "\\n"] -- TODO + , "\\" <> RECharSet "0123456789" + , "\\o" <> RECharSet "01234567" + , "\\x" <> RECharSet "0123456789abcdefABCDEF" + , REUnion ["\\^@", RENamed "control" "\\^@"] -- TODO + , REUnion ["\\NUL", RENamed "ascii" "\\NUL"] -- TODO + ] + +reUnqualComponent :: Regex a +reUnqualComponent = RENamed "unqual-name" $ + REMunch1 (reChar '-') component + where + component + = REMunch reEps (RECharSet csAlphaNum) + -- currently the parser accepts "csAlphaNum `difference` "0123456789" + -- which is larger set than CS.alpha + -- + -- Hackage rejects non ANSI names, so it's not so relevant. + <> RECharSet CS.alpha + <> REMunch reEps (RECharSet csAlphaNum) + +reDot :: Regex a +reDot = reChar '.' + +reComma :: Regex a +reComma = reChar ',' + +reSpacedComma :: Regex a +reSpacedComma = RESpaces <> reComma <> RESpaces + +------------------------------------------------------------------------------- +-- Character sets +------------------------------------------------------------------------------- + +csChar :: Char -> CS.CharSet +csChar = CS.singleton + +csAlphaNum :: CS.CharSet +csAlphaNum = CS.alphanum + +csNotSpace :: CS.CharSet +csNotSpace = CS.difference CS.universe $ CS.singleton ' ' + +csNotSpaceOrComma :: CS.CharSet +csNotSpaceOrComma = CS.difference csNotSpace $ CS.singleton ',' diff --git a/Cabal/Distribution/ModuleName.hs b/Cabal/Distribution/ModuleName.hs index acfc96f5abe..f9b072428e0 100644 --- a/Cabal/Distribution/ModuleName.hs +++ b/Cabal/Distribution/ModuleName.hs @@ -26,10 +26,11 @@ module Distribution.ModuleName ( import Distribution.Compat.Prelude import Prelude () +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty -import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText) -import System.FilePath (pathSeparator) +import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText) +import System.FilePath (pathSeparator) import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -57,6 +58,9 @@ instance Parsec ModuleName where cs <- P.munch validModuleChar return (c:cs) +instance Described ModuleName where + describe _ = RETodo + validModuleChar :: Char -> Bool validModuleChar c = isAlphaNum c || c == '_' || c == '\'' diff --git a/Cabal/Distribution/Parsec/Newtypes.hs b/Cabal/Distribution/Parsec/Newtypes.hs index 817d7447655..7a0691e5e0f 100644 --- a/Cabal/Distribution/Parsec/Newtypes.hs +++ b/Cabal/Distribution/Parsec/Newtypes.hs @@ -1,9 +1,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} -- | This module provides @newtype@ wrappers to be used with "Distribution.FieldGrammar". module Distribution.Parsec.Newtypes ( -- * List @@ -38,8 +38,9 @@ import Distribution.Compat.Prelude import Prelude () import Distribution.CabalSpecVersion -import Distribution.Compiler (CompilerFlavor) -import Distribution.License (License) +import Distribution.Compiler (CompilerFlavor) +import Distribution.FieldGrammar.Described +import Distribution.License (License) import Distribution.Parsec import Distribution.Pretty import Distribution.Version (LowerBound (..), Version, VersionRange, anyVersion, asVersionIntervals, mkVersion) @@ -69,29 +70,36 @@ class Sep sep where parseSep :: CabalParsing m => Proxy sep -> m a -> m [a] + describeSep :: Proxy sep -> Regex a -> Regex a + instance Sep CommaVCat where prettySep _ = vcat . punctuate comma parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p + describeSep _ = reCommaList instance Sep CommaFSep where prettySep _ = fsep . punctuate comma parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p + describeSep _ = reCommaList instance Sep VCat where prettySep _ = vcat parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p + describeSep _ = reCommaList instance Sep FSep where prettySep _ = fsep parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p + describeSep _ = reOptCommaList instance Sep NoCommaFSep where prettySep _ = fsep parseSep _ p = many (p <* P.spaces) + describeSep _ = reSpacedList -- | List separated with optional commas. Displayed with @sep@, arguments of -- type @a@ are parsed and pretty-printed as @b@. @@ -121,6 +129,10 @@ instance (Newtype a b, Sep sep, Parsec b) => Parsec (List sep b a) where instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . unpack +instance (Newtype a b, Sep sep, Described b) => Described (List sep b a) where + describe _ = describeSep (Proxy :: Proxy sep) (describe (Proxy :: Proxy b)) + +-- -- | Like 'List', but for 'Set'. -- -- @since 3.2.0.0 @@ -156,6 +168,9 @@ instance (Newtype a b, Ord a, Sep sep, Parsec b) => Parsec (Set' sep b a) where instance (Newtype a b, Sep sep, Pretty b) => Pretty (Set' sep b a) where pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . Set.toList . unpack +instance (Newtype a b, Ord a, Sep sep, Described b) => Described (Set' sep b a) where + describe _ = describeSep (Proxy :: Proxy sep) (describe (Proxy :: Proxy b)) + -- | Haskell string or @[^ ,]+@ newtype Token = Token { getToken :: String } @@ -167,6 +182,9 @@ instance Parsec Token where instance Pretty Token where pretty = showToken . unpack +instance Described Token where + describe _ = REUnion [reHsString, reMunch1CS csNotSpaceOrComma] + -- | Haskell string or @[^ ]+@ newtype Token' = Token' { getToken' :: String } @@ -178,6 +196,9 @@ instance Parsec Token' where instance Pretty Token' where pretty = showToken . unpack +instance Described Token' where + describe _ = REUnion [reHsString, reMunch1CS csNotSpace] + -- | Either @"quoted"@ or @un-quoted@. newtype MQuoted a = MQuoted { getMQuoted :: a } @@ -189,6 +210,10 @@ instance Parsec a => Parsec (MQuoted a) where instance Pretty a => Pretty (MQuoted a) where pretty = pretty . unpack +instance Described a => Described (MQuoted a) where + -- TODO: this is simplification + describe _ = describe ([] :: [a]) + -- | Version range or just version, i.e. @cabal-version@ field. -- -- There are few things to consider: @@ -215,6 +240,9 @@ instance Parsec SpecVersion where instance Pretty SpecVersion where pretty = either pretty pretty . unpack +instance Described SpecVersion where + describe _ = "3.0" -- :) + specVersionFromRange :: VersionRange -> Version specVersionFromRange versionRange = case asVersionIntervals versionRange of [] -> mkVersion [0] @@ -235,6 +263,9 @@ instance Parsec SpecLicense where instance Pretty SpecLicense where pretty = either pretty pretty . unpack +instance Described SpecLicense where + describe _ = RETodo + -- | Version range or just version newtype TestedWith = TestedWith { getTestedWith :: (CompilerFlavor, VersionRange) } @@ -247,6 +278,9 @@ instance Pretty TestedWith where pretty x = case unpack x of (compiler, vr) -> pretty compiler <+> pretty vr +instance Described TestedWith where + describe _ = RETodo + -- | Filepath are parsed as 'Token'. newtype FilePathNT = FilePathNT { getFilePathNT :: String } @@ -258,6 +292,9 @@ instance Parsec FilePathNT where instance Pretty FilePathNT where pretty = showFilePath . unpack +instance Described FilePathNT where + describe _ = describe ([] :: [Token]) + ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/AbiDependency.hs b/Cabal/Distribution/Types/AbiDependency.hs index 8442bf9d410..af0d067f63a 100644 --- a/Cabal/Distribution/Types/AbiDependency.hs +++ b/Cabal/Distribution/Types/AbiDependency.hs @@ -7,6 +7,7 @@ import Prelude () import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Package as Package @@ -39,6 +40,12 @@ instance Parsec AbiDependency where abi <- parsec return (AbiDependency uid abi) +instance Described AbiDependency where + describe _ = + describe (Proxy :: Proxy Package.UnitId) <> + reChar '=' <> + describe (Proxy :: Proxy Package.AbiHash) + instance Binary AbiDependency instance Structured AbiDependency instance NFData AbiDependency where rnf = genericRnf diff --git a/Cabal/Distribution/Types/AbiHash.hs b/Cabal/Distribution/Types/AbiHash.hs index 032f77fd1ef..1eb992b3305 100644 --- a/Cabal/Distribution/Types/AbiHash.hs +++ b/Cabal/Distribution/Types/AbiHash.hs @@ -13,6 +13,7 @@ import Distribution.Utils.ShortText import qualified Distribution.Compat.CharParsing as P import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import Text.PrettyPrint (text) @@ -59,3 +60,6 @@ instance Pretty AbiHash where instance Parsec AbiHash where parsec = fmap mkAbiHash (P.munch isAlphaNum) + +instance Described AbiHash where + describe _ = reMunchCS csAlphaNum diff --git a/Cabal/Distribution/Types/BenchmarkType.hs b/Cabal/Distribution/Types/BenchmarkType.hs index ccd7a9ea857..ff2efbcbf7c 100644 --- a/Cabal/Distribution/Types/BenchmarkType.hs +++ b/Cabal/Distribution/Types/BenchmarkType.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.BenchmarkType ( BenchmarkType(..), @@ -9,10 +10,11 @@ module Distribution.Types.BenchmarkType ( import Distribution.Compat.Prelude import Prelude () +import Distribution.FieldGrammar.Described (Described (..)) import Distribution.Parsec import Distribution.Pretty import Distribution.Version -import Text.PrettyPrint (char, text) +import Text.PrettyPrint (char, text) -- | The \"benchmark-type\" field in the benchmark stanza. -- @@ -37,3 +39,6 @@ instance Parsec BenchmarkType where parsec = parsecStandard $ \ver name -> case name of "exitcode-stdio" -> BenchmarkTypeExe ver _ -> BenchmarkTypeUnknown name ver + +instance Described BenchmarkType where + describe _ = "exitcode-stdio-1.0" diff --git a/Cabal/Distribution/Types/BuildType.hs b/Cabal/Distribution/Types/BuildType.hs index b7c8264b8cf..c8c3d812c9b 100644 --- a/Cabal/Distribution/Types/BuildType.hs +++ b/Cabal/Distribution/Types/BuildType.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.BuildType ( BuildType(..), @@ -12,6 +13,7 @@ import Distribution.Compat.Prelude import Distribution.CabalSpecVersion (CabalSpecVersion (..)) import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -52,3 +54,6 @@ instance Parsec BuildType where return Custom else fail ("unknown build-type: '" ++ name ++ "'") _ -> fail ("unknown build-type: '" ++ name ++ "'") + +instance Described BuildType where + describe _ = REUnion ["Simple","Configure","Custom","Make","Default"] diff --git a/Cabal/Distribution/Types/Dependency.hs b/Cabal/Distribution/Types/Dependency.hs index 08d4779dfd3..561b48d629e 100644 --- a/Cabal/Distribution/Types/Dependency.hs +++ b/Cabal/Distribution/Types/Dependency.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Types.Dependency ( Dependency(..) , depPkgName @@ -10,26 +10,26 @@ module Distribution.Types.Dependency , simplifyDependency ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () -import Distribution.Version ( VersionRange, thisVersion - , notThisVersion, anyVersion - , simplifyVersionRange ) +import Distribution.Version + (VersionRange, anyVersion, notThisVersion, simplifyVersionRange, thisVersion) import Distribution.CabalSpecVersion -import Distribution.Pretty -import qualified Text.PrettyPrint as PP +import Distribution.Compat.CharParsing (char, spaces) +import Distribution.Compat.Parsing (between, option) +import Distribution.FieldGrammar.Described import Distribution.Parsec -import Distribution.Compat.CharParsing (char, spaces) -import Distribution.Compat.Parsing (between, option) +import Distribution.Pretty +import Distribution.Types.LibraryName import Distribution.Types.PackageId import Distribution.Types.PackageName -import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName +import Text.PrettyPrint ((<+>)) -import Text.PrettyPrint ((<+>)) -import qualified Data.Set as Set +import qualified Data.Set as Set +import qualified Text.PrettyPrint as PP -- | Describes a dependency on a source package (API) -- @@ -95,6 +95,9 @@ versionGuardMultilibs expr = do -- >>> simpleParsec "mylib:{ sub1 , sub2 } ^>= 42" :: Maybe Dependency -- Just (Dependency (PackageName "mylib") (MajorBoundVersion (mkVersion [42])) (fromList [LSubLibName (UnqualComponentName "sub1"),LSubLibName (UnqualComponentName "sub2")])) -- +-- >>> simpleParsec "mylib:{ } ^>= 42" :: Maybe Dependency +-- Just (Dependency (PackageName "mylib") (MajorBoundVersion (mkVersion [42])) (fromList [])) +-- -- Spaces around colon are not allowed: -- -- >>> simpleParsec "mylib: sub" :: Maybe Dependency @@ -129,6 +132,28 @@ instance Parsec Dependency where (spaces <* char '}') $ parsecCommaList $ parseLib pn +instance Described Dependency where + describe _ = REAppend + [ RENamed "pkg-name" (describe (Proxy :: Proxy PackageName)) + , REOpt $ + RESpaces + <> reChar ':' + <> RESpaces + <> REUnion + [ reUnqualComponent + , REAppend + [ reChar '{' + , RESpaces + , RECommaList reUnqualComponent + , RESpaces + , reChar '}' + ] + ] + , REOpt $ RESpaces <> vr + ] + where + vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange)) + -- mempty should never be in a Dependency-as-dependency. -- This is only here until the Dependency-as-constraint problem is solved #5570. -- Same for below. diff --git a/Cabal/Distribution/Types/ExeDependency.hs b/Cabal/Distribution/Types/ExeDependency.hs index 80500f88810..ea8040aa650 100644 --- a/Cabal/Distribution/Types/ExeDependency.hs +++ b/Cabal/Distribution/Types/ExeDependency.hs @@ -8,6 +8,7 @@ module Distribution.Types.ExeDependency import Distribution.Compat.Prelude import Prelude () +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty import Distribution.Types.ComponentName @@ -16,7 +17,7 @@ import Distribution.Types.UnqualComponentName import Distribution.Version (VersionRange, anyVersion) import qualified Distribution.Compat.CharParsing as P -import Text.PrettyPrint (text, (<+>)) +import Text.PrettyPrint (text, (<+>)) -- | Describes a dependency on an executable from a package -- @@ -64,5 +65,9 @@ instance Parsec ExeDependency where ver <- parsec <|> pure anyVersion return (ExeDependency name exe ver) +instance Described ExeDependency where + describe _ = RETodo + qualifiedExeName :: ExeDependency -> ComponentName qualifiedExeName (ExeDependency _ ucn _) = CExeName ucn + diff --git a/Cabal/Distribution/Types/ExecutableScope.hs b/Cabal/Distribution/Types/ExecutableScope.hs index c163f828cc7..1649320b246 100644 --- a/Cabal/Distribution/Types/ExecutableScope.hs +++ b/Cabal/Distribution/Types/ExecutableScope.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.ExecutableScope ( ExecutableScope(..), @@ -10,6 +11,7 @@ import Distribution.Compat.Prelude import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -27,6 +29,9 @@ instance Parsec ExecutableScope where pub = ExecutablePublic <$ P.string "public" pri = ExecutablePrivate <$ P.string "private" +instance Described ExecutableScope where + describe _ = REUnion ["public","private"] + instance Binary ExecutableScope instance Structured ExecutableScope instance NFData ExecutableScope where rnf = genericRnf diff --git a/Cabal/Distribution/Types/ExposedModule.hs b/Cabal/Distribution/Types/ExposedModule.hs index 22f8d7b9803..f0f28f984fd 100644 --- a/Cabal/Distribution/Types/ExposedModule.hs +++ b/Cabal/Distribution/Types/ExposedModule.hs @@ -9,6 +9,7 @@ import Distribution.Backpack import Distribution.ModuleName import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -40,6 +41,9 @@ instance Parsec ExposedModule where return (ExposedModule m reexport) +instance Described ExposedModule where + describe _ = RETodo + instance Binary ExposedModule instance Structured ExposedModule instance NFData ExposedModule where rnf = genericRnf diff --git a/Cabal/Distribution/Types/ForeignLib.hs b/Cabal/Distribution/Types/ForeignLib.hs index 8bb89a23c62..3c96649e498 100644 --- a/Cabal/Distribution/Types/ForeignLib.hs +++ b/Cabal/Distribution/Types/ForeignLib.hs @@ -19,6 +19,7 @@ module Distribution.Types.ForeignLib( import Distribution.Compat.Prelude import Prelude () +import Distribution.FieldGrammar.Described import Distribution.ModuleName import Distribution.Parsec import Distribution.Pretty @@ -30,8 +31,8 @@ import Distribution.Types.UnqualComponentName import Distribution.Version import qualified Distribution.Compat.CharParsing as P -import qualified Text.PrettyPrint as Disp -import qualified Text.Read as Read +import qualified Text.PrettyPrint as Disp +import qualified Text.Read as Read import qualified Distribution.Types.BuildInfo.Lens as L @@ -101,6 +102,10 @@ instance Parsec LibVersionInfo where return (r,a) return $ mkLibVersionInfo (c,r,a) +instance Described LibVersionInfo where + describe _ = reDigits <> REOpt (reChar ':' <> reDigits <> REOpt (reChar ':' <> reDigits)) where + reDigits = reChars ['0'..'9'] + -- | Construct 'LibVersionInfo' from @(current, revision, age)@ -- numbers. -- diff --git a/Cabal/Distribution/Types/ForeignLibOption.hs b/Cabal/Distribution/Types/ForeignLibOption.hs index dfad3c63fcb..4c1c8d1fad1 100644 --- a/Cabal/Distribution/Types/ForeignLibOption.hs +++ b/Cabal/Distribution/Types/ForeignLibOption.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.ForeignLibOption( ForeignLibOption(..) @@ -10,6 +11,7 @@ import Distribution.Compat.Prelude import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -33,6 +35,9 @@ instance Parsec ForeignLibOption where "standalone" -> return ForeignLibStandalone _ -> fail "unrecognized foreign-library option" +instance Described ForeignLibOption where + describe _ = "standalone" + instance Binary ForeignLibOption instance Structured ForeignLibOption instance NFData ForeignLibOption where rnf = genericRnf diff --git a/Cabal/Distribution/Types/ForeignLibType.hs b/Cabal/Distribution/Types/ForeignLibType.hs index 4884ab8f7fb..5521c4dbc34 100644 --- a/Cabal/Distribution/Types/ForeignLibType.hs +++ b/Cabal/Distribution/Types/ForeignLibType.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.ForeignLibType( ForeignLibType(..), @@ -13,6 +14,7 @@ import Distribution.PackageDescription.Utils import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -41,6 +43,9 @@ instance Parsec ForeignLibType where "native-static" -> ForeignLibNativeStatic _ -> ForeignLibTypeUnknown +instance Described ForeignLibType where + describe _ = REUnion ["native-shared","native-static"] + instance Binary ForeignLibType instance Structured ForeignLibType instance NFData ForeignLibType where rnf = genericRnf diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index 0b0180652d7..0fd93b24448 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -14,6 +14,7 @@ import Distribution.CabalSpecVersion import Distribution.Compat.Lens (Lens', (&), (.~)) import Distribution.Compat.Newtype import Distribution.FieldGrammar +import Distribution.FieldGrammar.Described import Distribution.FieldGrammar.FieldDescrs import Distribution.License import Distribution.ModuleName @@ -21,9 +22,9 @@ import Distribution.Package import Distribution.Parsec import Distribution.Parsec.Newtypes import Distribution.Pretty +import Distribution.Types.LibraryName import Distribution.Types.LibraryVisibility import Distribution.Types.MungedPackageName -import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Distribution.Version @@ -180,6 +181,8 @@ instance Parsec ExposedModules where instance Pretty ExposedModules where pretty = showExposedModules . getExposedModules +instance Described ExposedModules where + describe _ = REMunch (REOpt reComma) (describe (Proxy :: Proxy ExposedModule)) newtype CompatPackageKey = CompatPackageKey { getCompatPackageKey :: String } @@ -192,6 +195,8 @@ instance Parsec CompatPackageKey where parsec = CompatPackageKey <$> P.munch1 uid_char where uid_char c = Char.isAlphaNum c || c `elem` ("-_.=[],:<>+" :: String) +instance Described CompatPackageKey where + describe _ = RETodo newtype InstWith = InstWith { getInstWith :: [(ModuleName,OpenModule)] } @@ -203,6 +208,8 @@ instance Pretty InstWith where instance Parsec InstWith where parsec = InstWith . Map.toList <$> parsecOpenModuleSubst +instance Described InstWith where + describe _ = RETodo -- | SPDX License expression or legacy license. Lenient parser, accepts either. newtype SpecLicenseLenient = SpecLicenseLenient { getSpecLicenseLenient :: Either SPDX.License License } @@ -215,6 +222,9 @@ instance Parsec SpecLicenseLenient where instance Pretty SpecLicenseLenient where pretty = either pretty pretty . getSpecLicenseLenient +instance Described SpecLicenseLenient where + describe _ = RETodo + ------------------------------------------------------------------------------- -- Basic fields ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/LegacyExeDependency.hs b/Cabal/Distribution/Types/LegacyExeDependency.hs index debd9e93d15..1aa77d53646 100644 --- a/Cabal/Distribution/Types/LegacyExeDependency.hs +++ b/Cabal/Distribution/Types/LegacyExeDependency.hs @@ -7,12 +7,13 @@ module Distribution.Types.LegacyExeDependency import Distribution.Compat.Prelude import Prelude () +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty -import Distribution.Version (VersionRange, anyVersion) +import Distribution.Version (VersionRange, anyVersion) import qualified Distribution.Compat.CharParsing as P -import Text.PrettyPrint (text, (<+>)) +import Text.PrettyPrint (text, (<+>)) -- | Describes a legacy `build-tools`-style dependency on an executable -- @@ -45,3 +46,6 @@ instance Parsec LegacyExeDependency where component = do cs <- P.munch1 (\c -> isAlphaNum c || c == '+' || c == '_') if all isDigit cs then fail "invalid component" else return cs + +instance Described LegacyExeDependency where + describe _ = RETodo diff --git a/Cabal/Distribution/Types/LibraryVisibility.hs b/Cabal/Distribution/Types/LibraryVisibility.hs index 8069bf59da6..7228f0f9386 100644 --- a/Cabal/Distribution/Types/LibraryVisibility.hs +++ b/Cabal/Distribution/Types/LibraryVisibility.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.LibraryVisibility( LibraryVisibility(..), @@ -10,6 +11,7 @@ import Prelude () import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -37,6 +39,9 @@ instance Parsec LibraryVisibility where "private" -> return LibraryVisibilityPrivate _ -> fail $ "Unknown visibility: " ++ name +instance Described LibraryVisibility where + describe _ = REUnion ["public","private"] + instance Binary LibraryVisibility instance Structured LibraryVisibility instance NFData LibraryVisibility where rnf = genericRnf diff --git a/Cabal/Distribution/Types/Mixin.hs b/Cabal/Distribution/Types/Mixin.hs index 47201a6e1ac..91d08b900ca 100644 --- a/Cabal/Distribution/Types/Mixin.hs +++ b/Cabal/Distribution/Types/Mixin.hs @@ -10,6 +10,7 @@ import Prelude () import Text.PrettyPrint ((<+>)) +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty import Distribution.Types.IncludeRenaming @@ -35,3 +36,6 @@ instance Parsec Mixin where P.spaces incl <- parsec return (Mixin mod_name incl) + +instance Described Mixin where + describe _ = RETodo diff --git a/Cabal/Distribution/Types/ModuleReexport.hs b/Cabal/Distribution/Types/ModuleReexport.hs index 635529abf8a..3a7801c92af 100644 --- a/Cabal/Distribution/Types/ModuleReexport.hs +++ b/Cabal/Distribution/Types/ModuleReexport.hs @@ -11,6 +11,7 @@ import Prelude () import Distribution.ModuleName import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import Distribution.Types.PackageName import qualified Distribution.Compat.CharParsing as P @@ -49,3 +50,6 @@ instance Parsec ModuleReexport where P.spaces parsec return (ModuleReexport mpkgname origname newname) + +instance Described ModuleReexport where + describe _ = RETodo diff --git a/Cabal/Distribution/Types/MungedPackageName.hs b/Cabal/Distribution/Types/MungedPackageName.hs index 6b80ebb8cce..8604068d2ca 100644 --- a/Cabal/Distribution/Types/MungedPackageName.hs +++ b/Cabal/Distribution/Types/MungedPackageName.hs @@ -14,6 +14,7 @@ import Distribution.Pretty import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -92,6 +93,9 @@ instance Pretty MungedPackageName where instance Parsec MungedPackageName where parsec = decodeCompatPackageName' <$> parsecUnqualComponentName +instance Described MungedPackageName where + describe _ = RETodo + ------------------------------------------------------------------------------- -- ZDashCode conversions ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/PackageName.hs b/Cabal/Distribution/Types/PackageName.hs index 9c306c84051..ca2b3fa2495 100644 --- a/Cabal/Distribution/Types/PackageName.hs +++ b/Cabal/Distribution/Types/PackageName.hs @@ -12,6 +12,7 @@ import Distribution.Utils.ShortText import qualified Text.PrettyPrint as Disp import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described -- | A package name. -- @@ -56,3 +57,7 @@ instance Parsec PackageName where instance NFData PackageName where rnf (PackageName pkg) = rnf pkg + +instance Described PackageName where + describe _ = reUnqualComponent + diff --git a/Cabal/Distribution/Types/PkgconfigDependency.hs b/Cabal/Distribution/Types/PkgconfigDependency.hs index ee23b52c874..f55eac84d6a 100644 --- a/Cabal/Distribution/Types/PkgconfigDependency.hs +++ b/Cabal/Distribution/Types/PkgconfigDependency.hs @@ -10,11 +10,12 @@ import Prelude () import Distribution.Types.PkgconfigName import Distribution.Types.PkgconfigVersionRange +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty import qualified Distribution.Compat.CharParsing as P -import Text.PrettyPrint ((<+>)) +import Text.PrettyPrint ((<+>)) -- | Describes a dependency on a pkg-config library -- @@ -38,3 +39,6 @@ instance Parsec PkgconfigDependency where P.spaces verRange <- parsec <|> pure anyPkgconfigVersion pure $ PkgconfigDependency name verRange + +instance Described PkgconfigDependency where + describe _ = RETodo diff --git a/Cabal/Distribution/Types/SourceRepo.hs b/Cabal/Distribution/Types/SourceRepo.hs index eb700732afa..d8590ed0ae6 100644 --- a/Cabal/Distribution/Types/SourceRepo.hs +++ b/Cabal/Distribution/Types/SourceRepo.hs @@ -18,6 +18,7 @@ import Distribution.Utils.Generic (lowercase) import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -162,6 +163,9 @@ instance Pretty RepoType where instance Parsec RepoType where parsec = classifyRepoType <$> P.munch1 isIdent +instance Described RepoType where + describe _ = reMunch1CS $ csAlphaNum <> csChar '_' <> csChar '-' + classifyRepoType :: String -> RepoType classifyRepoType s = fromMaybe (OtherRepoType s) $ lookup (lowercase s) repoTypeMap diff --git a/Cabal/Distribution/Types/TestType.hs b/Cabal/Distribution/Types/TestType.hs index c97e1278097..6842d1cb586 100644 --- a/Cabal/Distribution/Types/TestType.hs +++ b/Cabal/Distribution/Types/TestType.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Types.TestType ( TestType(..), @@ -10,9 +11,10 @@ import Distribution.Compat.Prelude import Distribution.Version import Prelude () +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty -import Text.PrettyPrint (char, text) +import Text.PrettyPrint (char, text) -- | The \"test-type\" field in the test suite stanza. -- @@ -40,3 +42,6 @@ instance Parsec TestType where "exitcode-stdio" -> TestTypeExe ver "detailed" -> TestTypeLib ver _ -> TestTypeUnknown name ver + +instance Described TestType where + describe _ = REUnion ["exitcode-stdio-1.0", "detailed-0.9"] diff --git a/Cabal/Distribution/Types/UnitId.hs b/Cabal/Distribution/Types/UnitId.hs index 047a43f27c3..bbbcb70ffa9 100644 --- a/Cabal/Distribution/Types/UnitId.hs +++ b/Cabal/Distribution/Types/UnitId.hs @@ -20,6 +20,7 @@ import Distribution.Utils.ShortText import qualified Distribution.Compat.CharParsing as P import Distribution.Pretty import Distribution.Parsec +import Distribution.FieldGrammar.Described import Distribution.Types.ComponentId import Distribution.Types.PackageId @@ -86,6 +87,9 @@ instance Parsec UnitId where isUnitChar '+' = True isUnitChar c = isAlphaNum c +instance Described UnitId where + describe _ = reMunch1CS $ csAlphaNum <> csChar '-' <> csChar '_' <> csChar '.' <> csChar '+' + -- | If you need backwards compatibility, consider using 'display' -- instead, which is supported by all versions of Cabal. -- diff --git a/Cabal/Distribution/Types/UnqualComponentName.hs b/Cabal/Distribution/Types/UnqualComponentName.hs index bb6beebe2c7..09f7bbfec2a 100644 --- a/Cabal/Distribution/Types/UnqualComponentName.hs +++ b/Cabal/Distribution/Types/UnqualComponentName.hs @@ -11,6 +11,7 @@ import Distribution.Utils.ShortText import Prelude () import Distribution.Parsec +import Distribution.FieldGrammar.Described import Distribution.Pretty import Distribution.Types.PackageName @@ -57,6 +58,9 @@ instance Pretty UnqualComponentName where instance Parsec UnqualComponentName where parsec = mkUnqualComponentName <$> parsecUnqualComponentName +instance Described UnqualComponentName where + describe _ = RETodo + instance NFData UnqualComponentName where rnf (UnqualComponentName pkg) = rnf pkg diff --git a/Cabal/Distribution/Types/Version.hs b/Cabal/Distribution/Types/Version.hs index fae5f889b01..e0706f7a012 100644 --- a/Cabal/Distribution/Types/Version.hs +++ b/Cabal/Distribution/Types/Version.hs @@ -21,6 +21,7 @@ import Prelude () import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import qualified Data.Version as Base import qualified Distribution.Compat.CharParsing as P @@ -101,6 +102,13 @@ instance Parsec Version where [] -> pure () (_ : _) -> parsecWarning PWTVersionTag "version with tags" +instance Described Version where + describe _ = REMunch1 reDot reDigits where + reDigits = REUnion + [ reChar '0' + , reChars ['1'..'9'] <> REMunchR 8 reEps (reChars ['0'..'9']) + ] + -- | An integral without leading zeroes. -- -- @since 3.0 diff --git a/Cabal/Distribution/Types/VersionRange/Internal.hs b/Cabal/Distribution/Types/VersionRange/Internal.hs index 9b84bea9cb3..1a7833f1698 100644 --- a/Cabal/Distribution/Types/VersionRange/Internal.hs +++ b/Cabal/Distribution/Types/VersionRange/Internal.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- | The only purpose of this module is to prevent the export of @@ -37,9 +38,10 @@ import Distribution.Types.Version import Prelude () import Distribution.CabalSpecVersion +import Distribution.FieldGrammar.Described import Distribution.Parsec import Distribution.Pretty -import Text.PrettyPrint ((<+>)) +import Text.PrettyPrint ((<+>)) import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.DList as DList @@ -263,6 +265,35 @@ instance Pretty VersionRange where instance Parsec VersionRange where parsec = versionRangeParser versionDigitParser +instance Described VersionRange where + describe _ = RERec "version-range" $ REUnion + [ "-any", "-none" + + , "==" <> RESpaces <> ver + , ">" <> RESpaces <> ver + , "<" <> RESpaces <> ver + , "<=" <> RESpaces <> ver + , ">=" <> RESpaces <> ver + , "^>=" <> RESpaces <> ver + + , reVar0 <> RESpaces <> "||" <> RESpaces <> reVar0 + , reVar0 <> RESpaces <> "&&" <> RESpaces <> reVar0 + , "(" <> RESpaces <> reVar0 <> RESpaces <> ")" + + -- ==0.1.* + , "==" <> RESpaces <> wildVer + + -- == { 0.1.2 } + -- silly haddock: ^>= { 0.1.2, 3.4.5 } + , "==" <> RESpaces <> verSet + , "^>=" <> RESpaces <> verSet + ] + where + ver' = describe (Proxy :: Proxy Version) + ver = RENamed "version" ver' + wildVer = ver' <> ".*" + verSet = "{" <> RESpaces <> REMunch1 reSpacedComma ver <> RESpaces <> "}" + -- | 'VersionRange' parser parametrised by version digit parser -- -- - 'versionDigitParser' is used for all 'VersionRange'. diff --git a/Cabal/Distribution/Utils/CharSet.hs b/Cabal/Distribution/Utils/CharSet.hs new file mode 100644 index 00000000000..b047995bb55 --- /dev/null +++ b/Cabal/Distribution/Utils/CharSet.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} +-- | Sets of characters. +-- +-- Using this is more efficint than 'RE.Type.Alt':ng individual characters. +module Distribution.Utils.CharSet ( + -- * Set of characters + CharSet, + -- * Construction + empty, + universe, + singleton, + insert, + union, + intersection, + complement, + difference, + -- * Query + size, + null, + member, + -- * Conversions + fromList, + toList, + fromIntervalList, + toIntervalList, + -- * Special lists + alpha, + alphanum, + ) where + +import Distribution.Compat.Prelude hiding (empty, null, toList) +import Prelude () + +#if MIN_VERSION_containers(0,5,0) +import qualified Data.IntMap.Strict as IM +#else +import qualified Data.IntMap as IM +#endif + +-- | A set of 'Char's. +-- +-- We use range set, which works great with 'Char'. +newtype CharSet = CS { unCS :: IM.IntMap Int } + deriving (Eq, Ord) + +instance IsString CharSet where + fromString = fromList + +instance Show CharSet where + showsPrec d cs + | size cs < 20 + = showsPrec d (toList cs) + | otherwise + = showParen (d > 10) + $ showString "CS " + . showsPrec 11 (unCS cs) + +instance Semigroup CharSet where + (<>) = union + +instance Monoid CharSet where + mempty = empty + mappend = (<>) + +-- | Empty character set. +empty :: CharSet +empty = CS IM.empty + +-- | universe +universe :: CharSet +universe = CS $ IM.singleton 0 0x10ffff + +-- | Check whether 'CharSet' is 'empty'. +null :: CharSet -> Bool +null (CS cs) = IM.null cs + +-- | Size of 'CharSet' +-- +-- >>> size $ fromIntervalList [('a','f'), ('0','9')] +-- 16 +-- +-- >>> length $ toList $ fromIntervalList [('a','f'), ('0','9')] +-- 16 +-- +size :: CharSet -> Int +size (CS m) = foldl' (\ !acc (lo, hi) -> acc + (hi - lo) + 1) 0 (IM.toList m) + +-- | Singleton character set. +singleton :: Char -> CharSet +singleton c = CS (IM.singleton (ord c) (ord c)) + +-- | Test whether character is in the set. +member :: Char -> CharSet -> Bool +#if MIN_VERSION_containers(0,5,0) +member c (CS m) = case IM.lookupLE i m of + Nothing -> False + Just (_, hi) -> i <= hi + where +#else +member c (CS m) = go (IM.toList m) + where + go [] = False + go ((x,y):zs) = (x <= i && i <= y) || go zs +#endif + i = ord c + +-- | Insert 'Char' into 'CharSet'. +insert :: Char -> CharSet -> CharSet +insert c (CS m) = normalise (IM.insert (ord c) (ord c) m) + +-- | Union of two 'CharSet's. +union :: CharSet -> CharSet -> CharSet +union (CS xs) (CS ys) = normalise (IM.unionWith max xs ys) + +-- | Intersection of two 'CharSet's +intersection :: CharSet -> CharSet -> CharSet +intersection (CS xs) (CS ys) = CS $ + IM.fromList (intersectRangeList (IM.toList xs) (IM.toList ys)) + +-- | Compute the intersection. +intersectRangeList :: Ord a => [(a, a)] -> [(a, a)] -> [(a, a)] +intersectRangeList aset@((x,y):as) bset@((u,v):bs) + | y < u = intersectRangeList as bset + | v < x = intersectRangeList aset bs + | y < v = (max x u, y) : intersectRangeList as bset + | otherwise = (max x u, v) : intersectRangeList aset bs +intersectRangeList _ [] = [] +intersectRangeList [] _ = [] + +-- | Complement of a CharSet +complement :: CharSet -> CharSet +complement (CS xs) = CS $ IM.fromList $ complementRangeList (IM.toList xs) + +-- | Compute the complement intersected with @[x,)@ assuming @x [(Int, Int)] -> [(Int, Int)] +complementRangeList' x ((u,v):s) = (x,pred u) : complementRangeList'' v s +complementRangeList' x [] = [(x,0x10ffff)] + +-- | Compute the complement intersected with @(x,)@. +complementRangeList'' :: Int -> [(Int, Int)] -> [(Int, Int)] +complementRangeList'' x s + | x == 0x10ffff = [] + | otherwise = complementRangeList' (succ x) s + +-- | Compute the complement. +-- +-- Note: we treat Ints as codepoints, i.e minBound is 0, and maxBound is 0x10ffff +complementRangeList :: [(Int, Int)] -> [(Int, Int)] +complementRangeList s@((x,y):s') + | x == 0 = complementRangeList'' y s' + | otherwise = complementRangeList' 0 s +complementRangeList [] = [(0, 0x10ffff)] + +-- | Difference of two 'CharSet's. +difference :: CharSet -> CharSet -> CharSet +difference xs ys = intersection xs (complement ys) + +-- | Make 'CharSet' from a list of characters, i.e. 'String'. +fromList :: String -> CharSet +fromList = normalise . foldl' (\ acc c -> IM.insert (ord c) (ord c) acc) IM.empty + +-- | Convert 'CharSet' to a list of characters i.e. 'String'. +toList :: CharSet -> String +toList = concatMap (uncurry enumFromTo) . toIntervalList + +-- | Convert to interval list +-- +-- >>> toIntervalList $ union "01234" "56789" +-- [('0','9')] +-- +toIntervalList :: CharSet -> [(Char, Char)] +toIntervalList (CS m) = [ (chr lo, chr hi) | (lo, hi) <- IM.toList m ] + +-- | Convert from interval pairs. +-- +-- >>> fromIntervalList [] +-- "" +-- +-- >>> fromIntervalList [('a','f'), ('0','9')] +-- "0123456789abcdef" +-- +-- >>> fromIntervalList [('Z','A')] +-- "" +-- +fromIntervalList :: [(Char,Char)] -> CharSet +fromIntervalList xs = normalise' $ sortBy (\a b -> compare (fst a) (fst b)) + [ (ord lo, ord hi) + | (lo, hi) <- xs + , lo <= hi + ] + +------------------------------------------------------------------------------- +-- Normalisation +------------------------------------------------------------------------------- + +normalise :: IM.IntMap Int -> CharSet +normalise = normalise'. IM.toList + +normalise' :: [(Int,Int)] -> CharSet +normalise' = CS . IM.fromList . go where + go :: [(Int,Int)] -> [(Int,Int)] + go [] = [] + go ((x,y):zs) = go' x y zs + + go' :: Int -> Int -> [(Int, Int)] -> [(Int, Int)] + go' lo hi [] = [(lo, hi)] + go' lo hi ws0@((u,v):ws) + | u <= succ hi = go' lo (max v hi) ws + | otherwise = (lo,hi) : go ws0 + +------------------------------------------------------------------------------- +-- Alpha Numeric character list +------------------------------------------------------------------------------- + +-- Computing this takes some time, +-- but they are not used in-non testing in Cabal's normal operation. + +-- | Note: this set varies depending on @base@ version. +-- +alpha :: CharSet +alpha = foldl' (flip insert) empty [ c | c <- [ minBound .. maxBound ], isAlpha c ] +{-# NOINLINE alpha #-} + +-- | Note: this set varies depending on @base@ version. +-- +alphanum :: CharSet +alphanum = foldl' (flip insert) empty [ c | c <- [ minBound .. maxBound ], isAlphaNum c ] +{-# NOINLINE alphanum #-} diff --git a/Cabal/Distribution/Utils/Regex.hs b/Cabal/Distribution/Utils/Regex.hs new file mode 100644 index 00000000000..11e6c9c8784 --- /dev/null +++ b/Cabal/Distribution/Utils/Regex.hs @@ -0,0 +1,202 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Distribution.Utils.Regex ( + -- * Regular expressions + Regex (..), + reEps, + reChar, + reChars, + reMunchCS, + reMunch1CS, + -- * Variables + reVar0, + reVar1, + -- * Pretty-printing + regexDoc, + ) where + +import Data.Char (isControl) +import Distribution.Compat.Prelude +import Prelude () + +import qualified Distribution.Utils.CharSet as CS +import qualified Text.PrettyPrint as PP + +------------------------------------------------------------------------------- +-- Regex +------------------------------------------------------------------------------- + +-- | Recursive regular expressions tuned for 'Described' use-case. +data Regex a + = REAppend [Regex a] -- ^ append @ab@ + | REUnion [Regex a] -- ^ union @a|b@ + + -- repetition + | REMunch (Regex a) (Regex a) -- ^ star @a*@, with a separator + | REMunch1 (Regex a) (Regex a) -- ^ plus @a+@, with a separator + | REMunchR Int (Regex a) (Regex a) -- ^ 1-n, with a separator + | REOpt (Regex a) -- ^ optional @r?@ + + | REString String -- ^ literal string @abcd@ + | RECharSet CS.CharSet -- ^ charset @[:alnum:]@ + | REVar a -- ^ variable + | RENamed String (Regex a) -- ^ named expression + | RERec String (Regex (Maybe a)) -- ^ recursive expressions + + -- cabal syntax specifics + | RESpaces -- ^ zero-or-more spaces + | RESpaces1 -- ^ one-or-more spaces + | RECommaList (Regex a) -- ^ comma list (note, leading or trailing commas) + | REOptCommaList (Regex a) -- ^ opt comma list + + | RETodo -- ^ unspecified + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +instance IsString (Regex a) where + fromString = REString + +instance Semigroup (Regex a) where + x <> y = REAppend (unAppend x ++ unAppend y) where + unAppend (REAppend rs) = rs + unAppend r = [r] + +instance Monoid (Regex a) where + mempty = REAppend [] + mappend = (<>) + +------------------------------------------------------------------------------- +-- Smart constructors +------------------------------------------------------------------------------- + +reEps :: Regex a +reEps = REAppend [] + +reChar :: Char -> Regex a +reChar = RECharSet . CS.singleton + +reChars :: [Char] -> Regex a +reChars = RECharSet . CS.fromList + +reMunch1CS :: CS.CharSet -> Regex a +reMunch1CS = REMunch1 reEps . RECharSet + +reMunchCS :: CS.CharSet -> Regex a +reMunchCS = REMunch reEps . RECharSet + +------------------------------------------------------------------------------- +-- Variables +------------------------------------------------------------------------------- + +reVar0 :: Regex (Maybe a) +reVar0 = REVar Nothing + +reVar1 :: Regex (Maybe (Maybe a)) +reVar1 = REVar (Just Nothing) + +------------------------------------------------------------------------------- +-- Pretty-printing +------------------------------------------------------------------------------- + +-- | +-- +-- >>> regexDoc $ REString "True" +-- \mathop{\mathord{``}\mathtt{True}\mathord{"}} +-- +-- Note: we don't simplify regexps yet: +-- +-- >>> regexDoc $ REString "foo" <> REString "bar" +-- \mathop{\mathord{``}\mathtt{foo}\mathord{"}}\mathop{\mathord{``}\mathtt{bar}\mathord{"}} +-- +regexDoc :: Regex Void -> PP.Doc +regexDoc = go 0 . vacuous where + go :: Int -> Regex PP.Doc -> PP.Doc + go _ (REAppend []) = "" + go d (REAppend rs) = parensIf (d > 2) $ PP.hcat (map (go 2) rs) + go d (REUnion [r]) = go d r + go _ (REUnion rs) = PP.hsep + [ "\\left\\{" + , if length rs < 4 + then PP.hcat (PP.punctuate (PP.text "\\mid") (map (go 0) rs)) + else "\\begin{gathered}" <<>> + PP.hcat (PP.punctuate "\\\\" (map (go 0) rs)) <<>> + "\\end{gathered}" + , "\\right\\}" ] + + go d (REMunch sep r) = parensIf (d > 3) $ + PP.text "{" <<>> go 4 r <<>> PP.text "}^\\ast_{" <<>> go 4 sep <<>> PP.text "}" + go d (REMunch1 sep r) = parensIf (d > 3) $ + PP.text "{" <<>> go 4 r <<>> PP.text "}^+_{" <<>> go 4 sep <<>> PP.text "}" + go d (REMunchR n sep r) = parensIf (d > 3) $ + PP.text "{" <<>> go 4 r <<>> PP.text "}^{\\in [0\\ldots" <<>> PP.int n <<>> "]}_{" <<>> go 4 sep <<>> PP.text "}" + go d (REOpt r) = parensIf (d > 3) $ + PP.text "{" <<>> go 4 r <<>> PP.text "}^?" + + go _ (REString s) = PP.text "\\mathop{\\mathord{``}\\mathtt{" <<>> PP.hcat (map charDoc s) <<>> PP.text "}\\mathord{\"}}" + go _ (RECharSet cs) = charsetDoc cs + + go _ RESpaces = "\\circ" + go _ RESpaces1 = "\\bullet" + + go _ (RECommaList r) = + "\\mathrm{commalist}" <<>> go 4 r + go _ (REOptCommaList r) = + "\\mathrm{optcommalist}" <<>> go 4 r + + go _ (REVar a) = a + go _ (RENamed n _) = terminalDoc n + go d (RERec n r) = parensIf (d > 0) $ + "\\mathbf{fix}\\;" <<>> n' <<>> "\\;\\mathbf{in}\\;" <<>> + go 0 (fmap (fromMaybe n') r) + where + n' = terminalDoc n + + go _ RETodo = PP.text "\\mathsf{\\color{red}{TODO}}" + + parensIf :: Bool -> PP.Doc -> PP.Doc + parensIf True d = PP.text "\\left(" <<>> d <<>> PP.text "\\right)" + parensIf False d = d + +terminalDoc :: String -> PP.Doc +terminalDoc s = PP.text "\\mathop{\\mathit{" <<>> PP.hcat (map charDoc s) <<>> PP.text "}}" + +charDoc :: Char -> PP.Doc +charDoc ' ' = PP.text "\\ " +charDoc '{' = PP.text "\\{" +charDoc '}' = PP.text "\\}" +charDoc '\\' = PP.text "\\text{\\\\}" +charDoc c + | isAlphaNum c = PP.char c + | isControl c = PP.int (ord c) -- TODO: some syntax + | otherwise = PP.text ("\\text{" ++ c : "}") + +inquotes :: PP.Doc -> PP.Doc +inquotes d = "\\mathop{\\mathord{``}" <<>> d <<>> "\\mathord{\"}}" + +mathtt :: PP.Doc -> PP.Doc +mathtt d = "\\mathtt{" <<>> d <<>> "}" + +charsetDoc :: CS.CharSet -> PP.Doc +charsetDoc acs + | acs == CS.alpha = terminalDoc "alpha" + | acs == CS.alphanum = terminalDoc "alpha-num" +charsetDoc acs = case CS.toIntervalList acs of + [] -> "\\emptyset" + [(x,y)] | x == y -> inquotes $ mathtt $ charDoc x + rs + | CS.size acs <= CS.size notAcs + -> PP.brackets $ PP.hcat $ map rangeDoc rs + | otherwise + -> PP.braces $ PP.brackets (PP.hcat $ map rangeDoc (CS.toIntervalList notAcs)) <<>> PP.text "^c" + where + notAcs = CS.complement acs + + rangeDoc :: (Char, Char) -> PP.Doc + rangeDoc (x, y) | x == y = inquotes (mathtt $ charDoc x) + | otherwise = inquotes (mathtt $ charDoc x) <<>> PP.text "\\cdots" <<>> inquotes (mathtt $ charDoc y) diff --git a/Cabal/Language/Haskell/Extension.hs b/Cabal/Language/Haskell/Extension.hs index b876cff0928..8cb592333b2 100644 --- a/Cabal/Language/Haskell/Extension.hs +++ b/Cabal/Language/Haskell/Extension.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | @@ -30,6 +31,7 @@ import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) import Distribution.Parsec import Distribution.Pretty +import Distribution.FieldGrammar.Described import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -72,6 +74,9 @@ instance Pretty Language where instance Parsec Language where parsec = classifyLanguage <$> P.munch1 isAlphaNum +instance Described Language where + describe _ = REUnion ["Haskell98", "Haskell2010"] + classifyLanguage :: String -> Language classifyLanguage = \str -> case lookup str langTable of Just lang -> lang @@ -872,6 +877,9 @@ instance Parsec Extension where instance Pretty KnownExtension where pretty ke = Disp.text (show ke) +instance Described Extension where + describe _ = RETodo + classifyExtension :: String -> Extension classifyExtension string = case classifyKnownExtension string of diff --git a/Cabal/doc/buildinfo-fields-reference.rst b/Cabal/doc/buildinfo-fields-reference.rst new file mode 100644 index 00000000000..b36f58d706f --- /dev/null +++ b/Cabal/doc/buildinfo-fields-reference.rst @@ -0,0 +1,650 @@ +.. _buildinfo-field-reference: + +================================================== + BuildInfo field reference +================================================== + +Notation +--------------- + +Field syntax is described as they are in the latest cabal file format version. + +* terminals are enclosed in quotes and type set in typewriter script: + + .. math:: + + \mathord{"}\mathtt{example}\mathord{"} + +* non-terminals are type set in italic: + + .. math:: + + \mathit{version\text-range} + +* character sets are type set resembling regular expression notation: + + + .. math:: + + [ \mathord{"}\mathtt{1}\mathord{"} \cdots \mathord{"}\mathtt{9}\mathord{"} ] + + Character set compelements have :math:`c` superscript: + + .. math:: + + [ \mathord{"}\mathtt{1}\mathord{"} \cdots \mathord{"}\mathtt{9}\mathord{"} ]^c + +* repetition is type set using regular expression inspired notation. + Superscripts tell how many time to repeat: + The generic notation is :math:`\in[n\ldots5]`, however there + are common shorthands: + :math:`\ast` for :math:`\in[0\ldots\infty]` (``many``), + :math:`+` for :math:`\in[1\ldots\infty]` (``some``), + :math:`?` for :math:`\in[0\ldots1]` (``optional``). + + Subscripts tell the used separator: + + .. math:: + + \mathit{digit}^+_{\mathord{"}\mathtt{.}\mathord{"}} + + Would be ``digit(\.digit)*`` in common regex syntax. + +* alternatives are listed in braces separated by vertical bar: + + .. math:: + + \{ \mathit{foo} \mid \mathit{bar} \} + + In case of multiple alternatives, the stacked notation is used + + .. math:: + + \left\{\begin{gathered} + \mathit{one} \\ + \mathit{two} \\ + \mathit{three} \\ + \mathit{four} \\ + \mathit{five} + \end{gathered}\right\} + +* parenthesis are used only for grouping: + + .. math:: + + \left(\mathit{foo} \mid \mathit{bar}\right)^+ + +* any amount of spaces, and at least single space are type set using + :math:`\circ` and :math:`\bullet` respectively. + They may appear standalone, not only as binary operators. + + .. math:: + + \mathit{module} \bullet \mathord{``}\mathtt{as}\mathord{"} \bullet \mathit{module} + +* While notation is heavily regular expression inspired, there + are also fixed points, which allow represent recursive grammars + + + .. math:: + + \mathbf{fix}\; \mathit{expr}\; \mathbf{in}\; \mathit{digit} + \mid \mathit{expr} \circ \mathord{``}\mathtt{+}\mathord{"} \circ \mathit{expr} + \mid \mathord{``}\mathtt{(} \mathord{"} \circ \mathit{expr} \circ \mathord{``}\mathtt{)}\mathord{"} + +Lists +----- + +Many fields in cabal file format are lists. There are three variations: + +Space separated + Are used for lists of things with simple grammars, for example :pkg-field:`ghc-options` + + .. math:: + {\mathop{\mathit{element}}}^\ast_{\bullet} + +Comma semarted + Are used for lists of things with complicated grammars, for example :pkg-field:`build-depends` + There can be leading or trailing comma (but not both) since ``cabal-version: 2.2``. + Note, the comma cannot exist alone. + + .. math:: + \mathrm{commalist}(\mathit{element}) = + \left\{ {\mathop{\mathit{element}}}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\mid\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ{\mathop{\mathit{element}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\mid{\mathop{\mathit{element}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}} \right\} + +Optional comma separated + Surprisingly many fields can have optional comma separator. + Since ``cabal-version: 3.0`` comma usage have to be consistent, + in other words either used everywhere or nowhere. + It's recommended to avoid using comma in these fields, + an example field is :pkg-field:`default-extensions`. + + .. math:: + \mathrm{optcommalist}(\mathit{element}) = + \left\{ \begin{gathered}{\mathop{\mathit{element}}}^\ast_{\bullet}\\{\mathop{\mathit{element}}}^\ast_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\\\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ{\mathop{\mathit{element}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\\{\mathop{\mathit{element}}}^+_{\left(\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\circ\right)}\circ\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}\end{gathered} \right\} + +Non-terminals +------------- + +In the syntax definitions below the following non-terminal symbols are used: + +hs-string + String as in Haskell; it's recommended to avoid using Haskell-specific escapes. + + .. math:: + \mathop{\mathord{``}\mathtt{\text{"}}\mathord{"}}{\left\{ {[\mathop{\mathord{``}\mathtt{\text{"}}\mathord{"}}\mathop{\mathord{``}\mathtt{\text{\\}}\mathord{"}}]^c}\mid\left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{\text{\\}\text{&}}\mathord{"}}\\\mathop{\mathord{``}\mathtt{\text{\\}\text{\\}}\mathord{"}}\\\left\{ \mathop{\mathord{``}\mathtt{\text{\\}n}\mathord{"}}\mid\mathop{\mathit{escapes}} \right\}\\\mathop{\mathord{``}\mathtt{\text{\\}}\mathord{"}}[\mathop{\mathord{``}\mathtt{0}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}]\\\mathop{\mathord{``}\mathtt{\text{\\}o}\mathord{"}}[\mathop{\mathord{``}\mathtt{0}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{7}\mathord{"}}]\\\mathop{\mathord{``}\mathtt{\text{\\}x}\mathord{"}}[\mathop{\mathord{``}\mathtt{0}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{9}\mathord{"}}\mathop{\mathord{``}\mathtt{A}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{F}\mathord{"}}\mathop{\mathord{``}\mathtt{a}\mathord{"}}\cdots\mathop{\mathord{``}\mathtt{f}\mathord{"}}]\\\left\{ \mathop{\mathord{``}\mathtt{\text{\\}\text{^}\text{@}}\mathord{"}}\mid\mathop{\mathit{control}} \right\}\\\left\{ \mathop{\mathord{``}\mathtt{\text{\\}NUL}\mathord{"}}\mid\mathop{\mathit{ascii}} \right\}\end{gathered} \right\} \right\}}^\ast_{}\mathop{\mathord{``}\mathtt{\text{"}}\mathord{"}} + +unqual-name + 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. + + .. math:: + {\left({\mathop{\mathit{alpha\text{-}num}}}^\ast_{}\mathop{\mathit{alpha}}{\mathop{\mathit{alpha\text{-}num}}}^\ast_{}\right)}^+_{\mathop{\mathord{``}\mathtt{\text{-}}\mathord{"}}} + +module-name + Haskell module name as recognized by Cabal parser. + + .. math:: + \mathsf{\color{red}{TODO}} + +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. + + .. math:: + {\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{"}}} + +version-range + Version range syntax is recursive. Also note the set syntax added in ``cabal-version: 3.0``, set cannot be empty. + + .. math:: + \mathbf{fix}\;\mathop{\mathit{version\text{-}range}}\;\mathbf{in}\;\left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{\text{-}any}\mathord{"}}\\\mathop{\mathord{``}\mathtt{\text{-}none}\mathord{"}}\\\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{\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{\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{\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 +----------------- + +asm-options + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`asm-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +asm-sources + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`asm-sources` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +autogen-includes + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`autogen-includes` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +autogen-modules + * Monoidal field + * Documentation of :pkg-field:`autogen-modules` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +build-depends + * Monoidal field + * Documentation of :pkg-field:`build-depends` + + .. math:: + \mathrm{commalist}\left(\mathop{\mathit{pkg\text{-}name}}{\left(\circ\mathop{\mathord{``}\mathtt{\text{:}}\mathord{"}}\circ\left\{ \mathop{\mathit{unqual\text{-}name}}\mid\mathop{\mathord{``}\mathtt{\{}\mathord{"}}\circ\mathrm{commalist}\mathop{\mathit{unqual\text{-}name}}\circ\mathop{\mathord{``}\mathtt{\}}\mathord{"}} \right\}\right)}^?{\left(\circ\mathop{\mathit{version\text{-}range}}\right)}^?\right) + +build-tool-depends + * Monoidal field + * Documentation of :pkg-field:`build-tool-depends` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +build-tools + * Monoidal field + * Deprecated since ``cabal-version: 2.0``: Please use 'build-tool-depends' field + * Removed in ``cabal-version: 3.0``: Please use 'build-tool-depends' field. + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +buildable + * Boolean field + * Default: ``True`` + * Documentation of :pkg-field:`buildable` + + .. math:: + \left\{ \mathop{\mathord{``}\mathtt{True}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{False}\mathord{"}} \right\} + +c-sources + * Monoidal field + * Documentation of :pkg-field:`c-sources` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +cc-options + * Monoidal field + * Documentation of :pkg-field:`cc-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +cmm-options + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`cmm-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +cmm-sources + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`cmm-sources` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +cpp-options + * Monoidal field + * Documentation of :pkg-field:`cpp-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +cxx-options + * Monoidal field + * Available since ``cabal-version: 2.2``. + * Documentation of :pkg-field:`cxx-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +cxx-sources + * Monoidal field + * Available since ``cabal-version: 2.2``. + * Documentation of :pkg-field:`cxx-sources` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +default-extensions + * Monoidal field + * Documentation of :pkg-field:`default-extensions` + + .. math:: + \mathrm{optcommalist}\mathsf{\color{red}{TODO}} + +default-language + * Optional field + * Documentation of :pkg-field:`default-language` + + .. math:: + \left\{ \mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}} \right\} + +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}\mathsf{\color{red}{TODO}} + +extra-bundled-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-bundled-libraries` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-dynamic-library-flavours + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`extra-dynamic-library-flavours` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-framework-dirs + * Monoidal field + * Documentation of :pkg-field:`extra-framework-dirs` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-ghci-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-ghci-libraries` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-lib-dirs + * Monoidal field + * Documentation of :pkg-field:`extra-lib-dirs` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-libraries` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-library-flavours + * Monoidal field + * Documentation of :pkg-field:`extra-library-flavours` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +frameworks + * Monoidal field + * Documentation of :pkg-field:`frameworks` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +ghc-options + * Monoidal field + * Documentation of :pkg-field:`ghc-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +ghc-prof-options + * Monoidal field + * Documentation of :pkg-field:`ghc-prof-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +ghc-shared-options + * Monoidal field + * Documentation of :pkg-field:`ghc-shared-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +ghcjs-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +ghcjs-prof-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-prof-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +ghcjs-shared-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-shared-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +hs-source-dir + * Monoidal field + * Deprecated since ``cabal-version: 1.2``: Please use 'hs-source-dirs' + * Removed in ``cabal-version: 3.0``: Please use 'hs-source-dirs' field. + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +hs-source-dirs + * Monoidal field + * Documentation of :pkg-field:`hs-source-dirs` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +include-dirs + * Monoidal field + * Documentation of :pkg-field:`include-dirs` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +includes + * Monoidal field + * Documentation of :pkg-field:`includes` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +install-includes + * Monoidal field + * Documentation of :pkg-field:`install-includes` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +js-sources + * Monoidal field + * Documentation of :pkg-field:`js-sources` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +ld-options + * Monoidal field + * Documentation of :pkg-field:`ld-options` + + .. math:: + {\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}]^c}}^+_{} \right\}}^\ast_{\bullet} + +mixins + * Monoidal field + * Available since ``cabal-version: 2.0``. + * Documentation of :pkg-field:`mixins` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +other-extensions + * Monoidal field + * Documentation of :pkg-field:`other-extensions` + + .. math:: + \mathrm{optcommalist}\mathsf{\color{red}{TODO}} + +other-languages + * Monoidal field + * Documentation of :pkg-field:`other-languages` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathord{``}\mathtt{Haskell98}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{Haskell2010}\mathord{"}} \right\} + +other-modules + * Monoidal field + * Documentation of :pkg-field:`other-modules` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +pkgconfig-depends + * Monoidal field + * Documentation of :pkg-field:`pkgconfig-depends` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + +virtual-modules + * Monoidal field + * Available since ``cabal-version: 2.2``. + * Documentation of :pkg-field:`virtual-modules` + + .. math:: + \mathrm{commalist}\mathsf{\color{red}{TODO}} + + +Package description fields +-------------------------- + +author + * Free text field + * Documentation of :pkg-field:`author` + +bug-reports + * Free text field + * Documentation of :pkg-field:`bug-reports` + +build-type + * Optional field + * Documentation of :pkg-field:`build-type` + + .. math:: + \left\{ \begin{gathered}\mathop{\mathord{``}\mathtt{Simple}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Configure}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Custom}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Make}\mathord{"}}\\\mathop{\mathord{``}\mathtt{Default}\mathord{"}}\end{gathered} \right\} + +cabal-version + * Optional field + * Default: ``-any`` + * Documentation of :pkg-field:`cabal-version` + + .. math:: + \mathop{\mathord{``}\mathtt{3\text{.}0}\mathord{"}} + +category + * Free text field + * Documentation of :pkg-field:`category` + +copyright + * Free text field + * Documentation of :pkg-field:`copyright` + +data-dir + * Optional field + * Default: ``""`` + * Documentation of :pkg-field:`data-dir` + + .. math:: + \left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +data-files + * Monoidal field + * Documentation of :pkg-field:`data-files` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +description + * Free text field + * Documentation of :pkg-field:`description` + +extra-doc-files + * Monoidal field + * Documentation of :pkg-field:`extra-doc-files` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-source-files + * Monoidal field + * Documentation of :pkg-field:`extra-source-files` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +extra-tmp-files + * Monoidal field + * Documentation of :pkg-field:`extra-tmp-files` + + .. math:: + \mathrm{commalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +homepage + * Free text field + * Documentation of :pkg-field:`homepage` + +license + * Optional field + * Default: ``NONE`` + * Documentation of :pkg-field:`license` + + .. math:: + \mathsf{\color{red}{TODO}} + +license-file + * Monoidal field + * Documentation of :pkg-field:`license-file` + + .. math:: + \mathrm{optcommalist}\left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +maintainer + * Free text field + * Documentation of :pkg-field:`maintainer` + +name + * Required field + * Documentation of :pkg-field:`name` + + .. math:: + \mathop{\mathit{unqual\text{-}name}} + +package-url + * Free text field + * Documentation of :pkg-field:`package-url` + +stability + * Free text field + * Documentation of :pkg-field:`stability` + +synopsis + * Free text field + * Documentation of :pkg-field:`synopsis` + +tested-with + * Monoidal field + * Documentation of :pkg-field:`tested-with` + + .. math:: + \mathrm{optcommalist}\mathsf{\color{red}{TODO}} + +version + * Required field + * Documentation of :pkg-field:`version` + + .. math:: + {\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 +----------------- + +main-is + * Optional field + * Documentation of :pkg-field:`main-is` + + .. math:: + \left\{ \mathop{\mathit{hs\text{-}string}}\mid{{[\mathop{\mathord{``}\mathtt{\ }\mathord{"}}\mathop{\mathord{``}\mathtt{\text{,}}\mathord{"}}]^c}}^+_{} \right\} + +test-module + * Optional field + * Documentation of :pkg-field:`test-module` + + .. math:: + \mathsf{\color{red}{TODO}} + +type + * Optional field + * Documentation of :pkg-field:`type` + + .. math:: + \left\{ \mathop{\mathord{``}\mathtt{exitcode\text{-}stdio\text{-}1\text{.}0}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{detailed\text{-}0\text{.}9}\mathord{"}} \right\} + + diff --git a/Cabal/doc/conf.py b/Cabal/doc/conf.py index 5cbcfb25870..5ddb7689b69 100644 --- a/Cabal/doc/conf.py +++ b/Cabal/doc/conf.py @@ -90,6 +90,9 @@ # Output file base name for HTML help builder. htmlhelp_basename = 'CabalUsersGuide' +# MathJax to use SVG rendering by default +mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS-MML_SVG' + # -- Options for LaTeX output --------------------------------------------- diff --git a/Cabal/doc/index.rst b/Cabal/doc/index.rst index 93fbbb90688..a625a19cc69 100644 --- a/Cabal/doc/index.rst +++ b/Cabal/doc/index.rst @@ -13,3 +13,4 @@ Welcome to the Cabal User Guide nix-local-build-overview nix-integration file-format-changelog + buildinfo-fields-reference diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs index e672961a850..11952ebb161 100644 --- a/Cabal/tests/UnitTests.hs +++ b/Cabal/tests/UnitTests.hs @@ -21,6 +21,7 @@ import qualified UnitTests.Distribution.Simple.Program.GHC import qualified UnitTests.Distribution.Simple.Program.Internal import qualified UnitTests.Distribution.Simple.Utils import qualified UnitTests.Distribution.System +import qualified UnitTests.Distribution.Utils.CharSet import qualified UnitTests.Distribution.Utils.Generic import qualified UnitTests.Distribution.Utils.NubList import qualified UnitTests.Distribution.Utils.ShortText @@ -28,6 +29,7 @@ import qualified UnitTests.Distribution.Utils.Structured import qualified UnitTests.Distribution.Version (versionTests) import qualified UnitTests.Distribution.PkgconfigVersion (pkgconfigVersionTests) import qualified UnitTests.Distribution.SPDX (spdxTests) +import qualified UnitTests.Distribution.Described import qualified UnitTests.Distribution.Types.GenericPackageDescription tests :: Int -> TestTree @@ -68,7 +70,9 @@ tests mtimeChangeCalibrated = UnitTests.Distribution.PkgconfigVersion.pkgconfigVersionTests , testGroup "Distribution.SPDX" UnitTests.Distribution.SPDX.spdxTests + , UnitTests.Distribution.Utils.CharSet.tests , UnitTests.Distribution.Utils.Structured.tests + , UnitTests.Distribution.Described.tests ] extraOptions :: [OptionDescription] diff --git a/Cabal/tests/UnitTests/Distribution/Described.hs b/Cabal/tests/UnitTests/Distribution/Described.hs new file mode 100644 index 00000000000..27a0488b024 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Described.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +module UnitTests.Distribution.Described where + +import Distribution.Compat.Prelude.Internal +import Prelude () + +import Data.Typeable (typeOf) +import Test.QuickCheck (Arbitrary (..), Gen, Property, choose, counterexample) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Distribution.FieldGrammar.Described (Described (..), Regex (..), reComma, reSpacedComma, reSpacedList) +import Distribution.Parsec (eitherParsec) +import Distribution.Pretty (prettyShow) + +import qualified Distribution.Utils.CharSet as CS + +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.Version (Version) +import Distribution.Types.VersionRange (VersionRange) + +import qualified RERE as RE +import qualified RERE.CharSet as RE + +-- instances +import Test.QuickCheck.Instances.Cabal () + +tests :: TestTree +tests = testGroup "Described" + [ testDescribed (Proxy :: Proxy PackageName) + , testDescribed (Proxy :: Proxy Version) + , testDescribed (Proxy :: Proxy VersionRange) + ] + +testDescribed + :: forall a. (Arbitrary a, Described a, Typeable a, Show a) + => Proxy a + -> TestTree +testDescribed _ = testGroup name + [ testProperty "parsec" propParsec + , testProperty "pretty" propPretty + ] + where + name = show (typeOf (undefined :: a)) + + propParsec :: Ex a -> Property + propParsec (Example str) = counterexample (show res) $ case res of + Right _ -> True + Left _ -> False + where + res :: Either String a + res = eitherParsec str + + rr :: RE.RE Void + rr = convert $ describe (Proxy :: Proxy a) + + propPretty :: a -> Property + propPretty x = counterexample str $ RE.matchR rr str + where + str = prettyShow x + +newtype Ex a = Example String + deriving (Show) + +instance Described a => Arbitrary (Ex a) where + arbitrary + = fmap Example + $ fromMaybe (return "") + $ RE.generate 10 5 + $ convert $ describe (Proxy :: Proxy a) + +genInt :: Int -> Int -> Gen Int +genInt lo hi = choose (lo, hi) + +------------------------------------------------------------------------------- +-- Conversion +------------------------------------------------------------------------------- + +convert :: Regex Void -> RE.RE Void +convert = go id . vacuous where + go :: Ord b => (a -> b) -> Regex a -> RE.RE b + go f (REAppend rs) = foldr (\r acc -> go f r <> acc) RE.Eps rs + go f (REUnion rs) = foldr (\r acc -> go f r RE.\/ acc) RE.Null rs + go _ (RECharSet cs) = RE.Ch (convertCS cs) + go _ (REString str) = RE.string_ str + + go f (REMunch sep r) = RE.Eps RE.\/ r' <> RE.star_ (sep' <> r') where + sep' = go f sep + r' = go f r + go f (REMunch1 sep r) = r' <> RE.star_ (sep' <> r') where + sep' = go f sep + r' = go f r + go f (REMunchR n sep r) + | n <= 0 = RE.Eps + | otherwise = RE.Eps RE.\/ r' <> go' (pred n) + where + sep' = go f sep + r' = go f r + + go' m | m <= 0 = RE.Eps + | otherwise = RE.Eps RE.\/ sep' <> r' <> go' (pred m) + + go f (REOpt r) = RE.Eps RE.\/ go f r + + go f (REVar a) = RE.Var (f a) + go f (RENamed _ r) = go f r + go f (RERec n r) = RE.fix_ (fromString n) + (go (maybe RE.B (RE.F . f)) r) + + go _ RESpaces = RE.Eps RE.\/ RE.ch_ ' ' RE.\/ " " RE.\/ "\n" + go _ RESpaces1 = RE.ch_ ' ' RE.\/ " " RE.\/ "\n" + + go f (RECommaList r) = go f (expandedCommaList r) + go f (REOptCommaList r) = go f (expandedOptCommaList r) + + go _ RETodo = RE.Null + +expandedCommaList :: Regex a -> Regex a +expandedCommaList = REUnion . expandedCommaList' + +expandedCommaList' :: Regex a -> [Regex a] +expandedCommaList' r = + [ REMunch reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + +expandedOptCommaList :: Regex a -> Regex a +expandedOptCommaList r = REUnion $ reSpacedList r : expandedCommaList' r + +convertCS :: CS.CharSet -> RE.CharSet +convertCS = RE.fromIntervalList . CS.toIntervalList diff --git a/Cabal/tests/UnitTests/Distribution/Utils/CharSet.hs b/Cabal/tests/UnitTests/Distribution/Utils/CharSet.hs new file mode 100644 index 00000000000..44efa858a01 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Utils/CharSet.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +-- isAlpha and isAlphaNum definitions change from base to base +#if MIN_VERSION_base(4,12,0) && !MIN_VERSION_base(4,13,0) +#define HAS_TESTS +#endif +module UnitTests.Distribution.Utils.CharSet where + +import Data.Char (isAlpha, isAlphaNum) +import Data.List (foldl') +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) + +import qualified Distribution.Utils.CharSet as CS + +tests :: TestTree +tests = testGroup "Distribution.Utils.CharSet" + [ testCase "alphanum" $ + CS.alphanum @?= foldl' (flip CS.insert) CS.empty + [ c | c <- [ minBound .. maxBound ], isAlphaNum c ] + + , testCase "alpha" $ + CS.alpha @?= foldl' (flip CS.insert) CS.empty + [ c | c <- [ minBound .. maxBound ], isAlpha c ] + + , testCase "alpha is subset of alphanum" $ + CS.union CS.alpha CS.alphanum @?= CS.alphanum + ] diff --git a/Makefile b/Makefile index f91f223f142..8e06b3a7f1e 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,7 @@ .PHONY : all lexer sdpx lib exe doctest .PHONY : gen-extra-source-files gen-extra-source-files-lib gen-extra-source-files-cli .PHONY : cabal-install-dev cabal-install-prod +.PHONY : phony CABALBUILD := cabal v2-build CABALRUN := cabal v2-run @@ -52,6 +53,12 @@ templates : $(TEMPLATE_MACROS) $(TEMPLATE_MACROS) : boot/cabal_macros.template.h cabal-dev-scripts/src/GenCabalMacros.hs cabal v2-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-cabal-macros -- $< $@ +# generated docs + +Cabal/doc/buildinfo-fields-reference.rst : phony + cabal build --builddir=dist-newstyle-bi --project-file=cabal.project.buildinfo buildinfo-reference-generator + $$(cabal-plan list-bin --builddir=dist-newstyle-bi buildinfo-reference-generator) buildinfo-reference-generator/template.zinza | tee $@ + # cabal-install.cabal file generation cabal-install-prod : cabal-install/cabal-install.cabal.pp diff --git a/buildinfo-reference-generator/buildinfo-reference-generator.cabal b/buildinfo-reference-generator/buildinfo-reference-generator.cabal new file mode 100644 index 00000000000..950d5d04cdc --- /dev/null +++ b/buildinfo-reference-generator/buildinfo-reference-generator.cabal @@ -0,0 +1,15 @@ +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.12 + , Cabal + , containers + , pretty + , zinza ^>=0.2 diff --git a/buildinfo-reference-generator/src/Main.hs b/buildinfo-reference-generator/src/Main.hs new file mode 100644 index 00000000000..763dd0b9825 --- /dev/null +++ b/buildinfo-reference-generator/src/Main.hs @@ -0,0 +1,275 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +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.FieldGrammar.Described +import Distribution.Utils.Regex + +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 "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 -> Regex 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 :: Regex a -> Regex a +expandedCommaList = REUnion . expandedCommaList' + +expandedCommaList' :: Regex a -> [Regex a] +expandedCommaList' r = + [ REMunch reSpacedComma r + , reComma <> RESpaces <> REMunch1 reSpacedComma r + , REMunch1 reSpacedComma r <> RESpaces <> reComma + ] + +expandedOptCommaList :: Regex a -> Regex 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 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/buildinfo-reference-generator/template.zinza b/buildinfo-reference-generator/template.zinza new file mode 100644 index 00000000000..f1387af27ad --- /dev/null +++ b/buildinfo-reference-generator/template.zinza @@ -0,0 +1,234 @@ +.. _buildinfo-field-reference: + +================================================== + BuildInfo field reference +================================================== + +Notation +--------------- + +Field syntax is described as they are in the latest cabal file format version. + +* terminals are enclosed in quotes and type set in typewriter script: + + .. math:: + + \mathord{"}\mathtt{example}\mathord{"} + +* non-terminals are type set in italic: + + .. math:: + + \mathit{version\text-range} + +* character sets are type set resembling regular expression notation: + + + .. math:: + + [ \mathord{"}\mathtt{1}\mathord{"} \cdots \mathord{"}\mathtt{9}\mathord{"} ] + + Character set compelements have :math:`c` superscript: + + .. math:: + + [ \mathord{"}\mathtt{1}\mathord{"} \cdots \mathord{"}\mathtt{9}\mathord{"} ]^c + +* repetition is type set using regular expression inspired notation. + Superscripts tell how many time to repeat: + The generic notation is :math:`\in[n\ldots5]`, however there + are common shorthands: + :math:`\ast` for :math:`\in[0\ldots\infty]` (``many``), + :math:`+` for :math:`\in[1\ldots\infty]` (``some``), + :math:`?` for :math:`\in[0\ldots1]` (``optional``). + + Subscripts tell the used separator: + + .. math:: + + \mathit{digit}^+_{\mathord{"}\mathtt{.}\mathord{"}} + + Would be ``digit(\.digit)*`` in common regex syntax. + +* alternatives are listed in braces separated by vertical bar: + + .. math:: + + \{ \mathit{foo} \mid \mathit{bar} \} + + In case of multiple alternatives, the stacked notation is used + + .. math:: + + \left\{\begin{gathered} + \mathit{one} \\ + \mathit{two} \\ + \mathit{three} \\ + \mathit{four} \\ + \mathit{five} + \end{gathered}\right\} + +* parenthesis are used only for grouping: + + .. math:: + + \left(\mathit{foo} \mid \mathit{bar}\right)^+ + +* any amount of spaces, and at least single space are type set using + :math:`\circ` and :math:`\bullet` respectively. + They may appear standalone, not only as binary operators. + + .. math:: + + \mathit{module} \bullet \mathord{``}\mathtt{as}\mathord{"} \bullet \mathit{module} + +* While notation is heavily regular expression inspired, there + are also fixed points, which allow represent recursive grammars + + + .. math:: + + \mathbf{fix}\; \mathit{expr}\; \mathbf{in}\; \mathit{digit} + \mid \mathit{expr} \circ \mathord{``}\mathtt{+}\mathord{"} \circ \mathit{expr} + \mid \mathord{``}\mathtt{(} \mathord{"} \circ \mathit{expr} \circ \mathord{``}\mathtt{)}\mathord{"} + +Lists +----- + +Many fields in cabal file format are lists. There are three variations: + +Space separated + Are used for lists of things with simple grammars, for example :pkg-field:`ghc-options` + + .. math:: + {{spaceList}} + +Comma semarted + Are used for lists of things with complicated grammars, for example :pkg-field:`build-depends` + There can be leading or trailing comma (but not both) since ``cabal-version: 2.2``. + Note, the comma cannot exist alone. + + .. math:: + \mathrm{commalist}(\mathit{element}) = + {{commaList}} + +Optional comma separated + Surprisingly many fields can have optional comma separator. + Since ``cabal-version: 3.0`` comma usage have to be consistent, + in other words either used everywhere or nowhere. + It's recommended to avoid using comma in these fields, + an example field is :pkg-field:`default-extensions`. + + .. math:: + \mathrm{optcommalist}(\mathit{element}) = + {{optCommaList}} + +Non-terminals +------------- + +In the syntax definitions below the following non-terminal symbols are used: + +{% for production in productions %} +{{ production.name }} + {{ production.description }} + + .. math:: + {{ production.syntax }} + +{% endfor %} + +Build info fields +----------------- + +{% for field in buildInfoFields %} +{{ 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:`{{field.name}}` +{% endif %} +{% endif %} +{% if notNull field.syntax %} + + .. math:: + {{field.syntax}} +{% endif %} + +{% endfor %} + +Package description fields +-------------------------- + +{% for field in packageDescriptionFields %} +{{ 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:`{{field.name}}` +{% endif %} +{% endif %} +{% if notNull field.syntax %} + + .. math:: + {{field.syntax}} +{% endif %} + +{% endfor %} + +Test-suite fields +----------------- + +{% for field in testSuiteFields %} +{{ 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:`{{field.name}}` +{% endif %} +{% endif %} +{% if notNull field.syntax %} + + .. math:: + {{field.syntax}} +{% endif %} + +{% endfor %} diff --git a/cabal.project.buildinfo b/cabal.project.buildinfo new file mode 100644 index 00000000000..bfbf046c61b --- /dev/null +++ b/cabal.project.buildinfo @@ -0,0 +1,5 @@ +packages: Cabal/ +packages: buildinfo-reference-generator/ +tests: False +optimization: False +with-compiler: ghc-8.6.5