From af041d0832ffeaee4a3f7df200c2840697ac18f9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 25 Sep 2019 11:38:35 +0300 Subject: [PATCH] Add buildinfo-reference-generator --- Cabal/Cabal.cabal | 2 + Cabal/Distribution/FieldGrammar/Class.hs | 23 +- Cabal/Distribution/FieldGrammar/Described.hs | 266 +++++++++ Cabal/Distribution/ModuleName.hs | 8 +- Cabal/Distribution/Parsec/Newtypes.hs | 42 +- 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 | 44 +- 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 | 6 +- Cabal/Language/Haskell/Extension.hs | 8 + Cabal/doc/buildinfo-fields-reference.rst | 558 ++++++++++++++++++ Cabal/doc/index.rst | 1 + Cabal/tests/UnitTests.hs | 2 + .../tests/UnitTests/Distribution/Described.hs | 49 ++ Makefile | 7 + .../buildinfo-reference-generator.cabal | 15 + buildinfo-reference-generator/src/Main.hs | 204 +++++++ buildinfo-reference-generator/template.zinza | 164 +++++ cabal.project.buildinfo | 5 + 40 files changed, 1498 insertions(+), 39 deletions(-) create mode 100644 Cabal/Distribution/FieldGrammar/Described.hs create mode 100644 Cabal/doc/buildinfo-fields-reference.rst create mode 100644 Cabal/tests/UnitTests/Distribution/Described.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.cabal b/Cabal/Cabal.cabal index 30e70cf45ac..f04be664409 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -505,6 +505,7 @@ library Distribution.Compat.CharParsing Distribution.FieldGrammar Distribution.FieldGrammar.Class + Distribution.FieldGrammar.Described Distribution.FieldGrammar.FieldDescrs Distribution.FieldGrammar.Parsec Distribution.FieldGrammar.Pretty @@ -615,6 +616,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 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..d9518991207 --- /dev/null +++ b/Cabal/Distribution/FieldGrammar/Described.hs @@ -0,0 +1,266 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Distribution.FieldGrammar.Described ( + Described (..), + describeDoc, + -- * Regular expressions + Regex (..), + RTerm (..), + reHsString, + reEps, + reChar, + reChars, + reDot, + reComma, + reSpacedComma, + reMunchCS, + reMunch1CS, + -- * Character Sets + csChar, + csAlphaNum, + csNotSpace, + csNotSpaceOrComma, + -- * Pretty-printing + regexDoc, + -- * Generation + generate, + ) where + +import Data.Char (isControl) +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Parsec (Parsec) +import Distribution.Pretty (Pretty) + +import qualified Distribution.Utils.AnsiCharSet as ACS +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 RTerm + +-- | Pretty-print description. +-- +-- >>> describeDoc ([] :: [Bool]) +-- \mathop{\mathord{"}\mathtt{True}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{False}\mathord{"}} +-- +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]) + +------------------------------------------------------------------------------- +-- Regex +------------------------------------------------------------------------------- + +-- | Regular expressions tuned for 'Described' use-case. +data Regex a + = REAppend [Regex a] -- ^ append @ab@ + | REUnion [Regex a] -- ^ union @a|b@ + | REMunch (Regex a) (Regex a) -- ^ star @a*@, with a separator + | REMunch1 (Regex a) (Regex a) -- ^ plus @a+@, with a separator + | REOpt (Regex a) -- ^ optional @r?@ + | REString String -- ^ literal string @abcd@ + | RECharSet ACS.AnsiCharSet -- ^ charset @[:alnum:]@ + | RESpaces -- ^ zero-or-more spaces + | RESpaces1 -- ^ one-or-more spaces + | REVar a -- ^ variable + | RELet String (Regex a) + (Regex (Maybe a)) -- ^ named expression + | RERec String (Regex (Maybe a)) -- ^ recursive expressions + + | RETodo -- ^ unspecified + deriving (Eq, Ord, Show) + +-- | Terminals used by field grammars. +-- +-- TODO: remove +data RTerm + = RHaskellString + | RUnqualName + deriving (Eq, Ord, Show) + +reHsString :: Regex RTerm +reHsString = REVar RHaskellString + +reEps :: Regex a +reEps = REAppend [] + +reChar :: Char -> Regex a +reChar = RECharSet . ACS.singleton + +reChars :: [Char] -> Regex a +reChars = RECharSet . ACS.fromList + +reDot :: Regex a +reDot = reChar '.' + +reComma :: Regex a +reComma = reChar ',' + +reSpacedComma :: Regex a +reSpacedComma = RESpaces <> reComma <> RESpaces + +reMunch1CS :: ACS.AnsiCharSet -> Regex a +reMunch1CS = REMunch1 reEps . RECharSet + +reMunchCS :: ACS.AnsiCharSet -> Regex a +reMunchCS = REMunch reEps . RECharSet + +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 = (<>) + +------------------------------------------------------------------------------- +-- Character sets +------------------------------------------------------------------------------- + +csChar :: Char -> ACS.AnsiCharSet +csChar = ACS.singleton + +csAlphaNum :: ACS.AnsiCharSet +csAlphaNum = ACS.alphanum + +csNotSpace :: ACS.AnsiCharSet +csNotSpace = ACS.filter (\c -> not (isControl c) && c /= ' ') ACS.full + +csNotSpaceOrComma :: ACS.AnsiCharSet +csNotSpaceOrComma = ACS.filter (/= ',') csNotSpace + +------------------------------------------------------------------------------- +-- 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 RTerm -> PP.Doc +regexDoc = go termDoc 0 where + go :: (a -> PP.Doc) -> Int -> Regex a -> PP.Doc + go f d (REAppend rs) = parensIf (d > 2) $ PP.hcat (map (go f 2) rs) + go f d (REUnion rs) = parensIf (d > 1) $ PP.hcat (PP.punctuate (PP.text "\\mid") (map (go f 1) rs)) + + go f d (REMunch sep r) = parensIf (d > 3) $ + PP.text "{" <<>> go f 3 r <<>> PP.text "}^\\ast_{" <<>> go f 0 sep <<>> PP.text "}" + go f d (REMunch1 sep r) = parensIf (d > 3) $ + PP.text "{" <<>> go f 3 r <<>> PP.text "}^+_{" <<>> go f 0 sep <<>> PP.text "}" + go f d (REOpt r) = parensIf (d > 3) $ + PP.text "{" <<>> go f 3 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 f _ (REVar a) = f a + go f d (RELet n _ r) = go (maybe (terminalDoc n) f) d r + go _ _ (RERec 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 + +termDoc :: RTerm -> PP.Doc +termDoc RHaskellString = terminalDoc "hs-string" +termDoc RUnqualName = terminalDoc "unqual-name" + +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 c + | isAlphaNum c = PP.char c + | otherwise = PP.text ("\\text{" ++ c : "}") + +inquotes :: PP.Doc -> PP.Doc +inquotes d = "\\mathop{\\mathord{\"}" <<>> d <<>> "\\mathord{\"}}" + +charsetDoc :: ACS.AnsiCharSet -> PP.Doc +charsetDoc acs + | acs == csAlphaNum = terminalDoc "alpha-num" + | acs == csNotSpace = terminalDoc "not-space" + | acs == csNotSpaceOrComma = terminalDoc "not-space-nor-comma" +charsetDoc acs = case ACS.ranges acs of + [] -> PP.brackets PP.empty + [(x,y)] | x == y -> inquotes (charDoc x) + rs -> PP.brackets $ PP.hcat $ map rangeDoc rs + where + rangeDoc :: (Char, Char) -> PP.Doc + rangeDoc (x, y) | x == y = inquotes (charDoc x) + | otherwise = inquotes (charDoc x) <<>> PP.char '-' <<>> inquotes (charDoc y) + +------------------------------------------------------------------------------- +-- Generation +------------------------------------------------------------------------------- + +-- | Generate an example string. +generate + :: (Monad m, Applicative m) + => (Int -> Int -> m Int) -- ^ generate integer in range + -> (a -> m String) -- ^ generate variables + -> Regex a -- ^ regex + -> m String -- ^ an example string. +generate rnd f (REAppend rs) = do + xs <- traverse (generate rnd f) rs + return (concat xs) +generate rnd f (REUnion rs) = do + n <- rnd 0 (length rs - 1) + generate rnd f (rs !! n) +generate rnd f (REMunch sep r) = do + n <- rnd 0 5 + xs <- traverse (generate rnd f) (intersperse sep (replicate n r)) + return (concat xs) +generate rnd f (REMunch1 sep r) = do + n <- rnd 1 5 + xs <- traverse (generate rnd f) (intersperse sep (replicate n r)) + return (concat xs) +generate rnd f (REOpt r) = do + n <- rnd 0 2 + case n of + 0 -> return "" + _ -> generate rnd f r +generate _ _ (REString str) = return str +generate rnd _ (RECharSet cs) = return <$> generateCS rnd cs +generate rnd _ RESpaces1 = (\n -> replicate n ' ') <$> rnd 1 3 +generate rnd _ RESpaces = (\n -> replicate n ' ') <$> rnd 0 3 + +generate _ f (REVar x) = f x +generate _ _ (RELet _ _ _) = error "generate let" +generate _ _ (RERec _ _) = error "generate rec" +generate _ _ RETodo = return "TODO" + +generateCS + :: Monad m + => (Int -> Int -> m Int) -- ^ generate integer in range + -> ACS.AnsiCharSet + -> m Char +generateCS rnd asc = do + n <- rnd 0 (ACS.size asc - 1) + return (ACS.toList asc !! n) 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..9c3eae9c68f 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 RTerm + instance Sep CommaVCat where prettySep _ = vcat . punctuate comma parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p + describeSep _ = reSpacedComma instance Sep CommaFSep where prettySep _ = fsep . punctuate comma parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p + describeSep _ = reSpacedComma instance Sep VCat where prettySep _ = vcat parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p + describeSep _ = reSpacedComma instance Sep FSep where prettySep _ = fsep parseSep _ p = do v <- askCabalSpecVersion if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p + describeSep _ = RESpaces1 <> REOpt (reChar ',' <> RESpaces) instance Sep NoCommaFSep where prettySep _ = fsep parseSep _ p = many (p <* P.spaces) + describeSep _ = RESpaces1 -- | List separated with optional commas. Displayed with @sep@, arguments of -- type @a@ are parsed and pretty-printed as @b@. @@ -121,6 +129,9 @@ 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 _ = REMunch (describeSep (Proxy :: Proxy sep)) (describe (Proxy :: Proxy b)) +-- -- | Like 'List', but for 'Set'. -- -- @since 3.2.0.0 @@ -156,6 +167,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 _ = REMunch (describeSep (Proxy :: Proxy sep)) (describe (Proxy :: Proxy b)) + -- | Haskell string or @[^ ,]+@ newtype Token = Token { getToken :: String } @@ -167,6 +181,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 +195,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 +209,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 +239,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 +262,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 +277,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 +291,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 73a99e43b00..72bca553d0a 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) -- @@ -101,6 +101,26 @@ instance Parsec Dependency where (spaces <* char '}') $ parsecCommaList $ parseLib pn +instance Described Dependency where + describe _ = REAppend + [ RELet "pkg-name" (describe (Proxy :: Proxy PackageName)) (REVar Nothing) + , REOpt $ + RESpaces + <> reChar ':' + <> RESpaces + <> REUnion + [ REVar RUnqualName + , REAppend + [ reChar '{' + , RESpaces + , REMunch reSpacedComma (REVar RUnqualName) + , RESpaces + , reChar '}' + ] + ] + , REOpt $ RESpaces <> RELet "version-range" (describe (Proxy :: Proxy VersionRange)) (REVar Nothing) + ] + -- 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..0b123515135 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 _ = REVar RUnqualName + 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 4bdb09c9f3b..a7cdca495fa 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 @@ -80,6 +81,9 @@ instance Pretty UnitId where instance Parsec UnitId where parsec = mkUnitId <$> P.munch1 (\c -> isAlphaNum c || c `elem` "-_.+") +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..0f369983d5b 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'] <> REMunch 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 73605d7e65d..7e08c244433 100644 --- a/Cabal/Distribution/Types/VersionRange/Internal.hs +++ b/Cabal/Distribution/Types/VersionRange/Internal.hs @@ -37,9 +37,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 +264,9 @@ instance Pretty VersionRange where instance Parsec VersionRange where parsec = versionRangeParser versionDigitParser +instance Described VersionRange where + describe _ = RETodo + -- | 'VersionRange' parser parametrised by version digit parser -- -- - 'versionDigitParser' is used for all 'VersionRange'. 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..b21588a1777 --- /dev/null +++ b/Cabal/doc/buildinfo-fields-reference.rst @@ -0,0 +1,558 @@ +.. _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{"} - \mathord{"}\mathtt{9}\mathord{"} ] + +* repetition is type set using regular expression inspired notation. + Superscripts tell how many time to repeat: + :math:`\ast` zero to many, + :math:`+` one to many, + :math:`?` one or zero times. + Subscripts tell the used separator. + + .. math:: + + \mathit{digit}^+_{\mathord{"}\mathtt{.}\mathord{"}} + +* alternatives are separated by vertical bar :math:`\mid`: + + .. math:: + + \mathit{foo} \mid \mathit{bar} + +* 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} + + +Non-terminals +------------- + +In the syntax definitions below the following non-terminal symbols are used: + +TBW + + +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{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +asm-sources + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`asm-sources` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +autogen-includes + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`autogen-includes` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +autogen-modules + * Monoidal field + * Documentation of :pkg-field:`autogen-modules` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +build-depends + * Monoidal field + * Documentation of :pkg-field:`build-depends` + + .. math:: + {\left(\mathop{\mathit{pkg\text{-}name}}{\left(\circ\mathop{\mathord{"}\text{:}\mathord{"}}\circ\left(\mathop{\mathit{unqual\text{-}name}}\mid\mathop{\mathord{"}\{\mathord{"}}\circ{\mathop{\mathit{unqual\text{-}name}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ}\circ\mathop{\mathord{"}\}\mathord{"}}\right)\right)}^?{\left(\circ\mathop{\mathit{version\text{-}range}}\right)}^?\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +build-tool-depends + * Monoidal field + * Documentation of :pkg-field:`build-tool-depends` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +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:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +buildable + * Boolean field + * Default: ``True`` + * Documentation of :pkg-field:`buildable` + + .. math:: + \mathop{\mathord{"}\mathtt{True}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{False}\mathord{"}} + +c-sources + * Monoidal field + * Documentation of :pkg-field:`c-sources` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +cc-options + * Monoidal field + * Documentation of :pkg-field:`cc-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\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{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +cmm-sources + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`cmm-sources` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +cpp-options + * Monoidal field + * Documentation of :pkg-field:`cpp-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\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{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +cxx-sources + * Monoidal field + * Available since ``cabal-version: 2.2``. + * Documentation of :pkg-field:`cxx-sources` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +default-extensions + * Monoidal field + * Documentation of :pkg-field:`default-extensions` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +default-language + * Optional field + * Documentation of :pkg-field:`default-language` + + .. math:: + \mathop{\mathord{"}\mathtt{Haskell98}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Haskell2010}\mathord{"}} + +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:: + {\mathsf{\color{red}{TODO}}}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +extra-bundled-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-bundled-libraries` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-dynamic-library-flavours + * Monoidal field + * Available since ``cabal-version: 3.0``. + * Documentation of :pkg-field:`extra-dynamic-library-flavours` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-framework-dirs + * Monoidal field + * Documentation of :pkg-field:`extra-framework-dirs` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +extra-ghci-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-ghci-libraries` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-lib-dirs + * Monoidal field + * Documentation of :pkg-field:`extra-lib-dirs` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +extra-libraries + * Monoidal field + * Documentation of :pkg-field:`extra-libraries` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-library-flavours + * Monoidal field + * Documentation of :pkg-field:`extra-library-flavours` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +frameworks + * Monoidal field + * Documentation of :pkg-field:`frameworks` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +ghc-options + * Monoidal field + * Documentation of :pkg-field:`ghc-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +ghc-prof-options + * Monoidal field + * Documentation of :pkg-field:`ghc-prof-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +ghc-shared-options + * Monoidal field + * Documentation of :pkg-field:`ghc-shared-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +ghcjs-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +ghcjs-prof-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-prof-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +ghcjs-shared-options + * Monoidal field + * Documentation of :pkg-field:`ghcjs-shared-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\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:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +hs-source-dirs + * Monoidal field + * Documentation of :pkg-field:`hs-source-dirs` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +include-dirs + * Monoidal field + * Documentation of :pkg-field:`include-dirs` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +includes + * Monoidal field + * Documentation of :pkg-field:`includes` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +install-includes + * Monoidal field + * Documentation of :pkg-field:`install-includes` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +js-sources + * Monoidal field + * Documentation of :pkg-field:`js-sources` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +ld-options + * Monoidal field + * Documentation of :pkg-field:`ld-options` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space}}}^+_{}\right)}^\ast_{\bullet} + +mixins + * Monoidal field + * Available since ``cabal-version: 2.0``. + * Documentation of :pkg-field:`mixins` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +other-extensions + * Monoidal field + * Documentation of :pkg-field:`other-extensions` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +other-languages + * Monoidal field + * Documentation of :pkg-field:`other-languages` + + .. math:: + {\left(\mathop{\mathord{"}\mathtt{Haskell98}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Haskell2010}\mathord{"}}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +other-modules + * Monoidal field + * Documentation of :pkg-field:`other-modules` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +pkgconfig-depends + * Monoidal field + * Documentation of :pkg-field:`pkgconfig-depends` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +virtual-modules + * Monoidal field + * Available since ``cabal-version: 2.2``. + * Documentation of :pkg-field:`virtual-modules` + + .. math:: + {\mathsf{\color{red}{TODO}}}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + + +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:: + \mathop{\mathord{"}\mathtt{Simple}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Configure}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Custom}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Make}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{Default}\mathord{"}} + +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:: + \mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{} + +data-files + * Monoidal field + * Documentation of :pkg-field:`data-files` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +description + * Free text field + * Documentation of :pkg-field:`description` + +extra-doc-files + * Monoidal field + * Documentation of :pkg-field:`extra-doc-files` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-source-files + * Monoidal field + * Documentation of :pkg-field:`extra-source-files` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +extra-tmp-files + * Monoidal field + * Documentation of :pkg-field:`extra-tmp-files` + + .. math:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\circ\mathop{\mathord{"}\text{,}\mathord{"}}\circ} + +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:: + {\left(\mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{}\right)}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\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:: + {\mathsf{\color{red}{TODO}}}^\ast_{\bullet{\left(\mathop{\mathord{"}\text{,}\mathord{"}}\circ\right)}^?} + +version + * Required field + * Documentation of :pkg-field:`version` + + .. math:: + {\left(\mathop{\mathord{"}0\mathord{"}}\mid[\mathop{\mathord{"}1\mathord{"}}-\mathop{\mathord{"}9\mathord{"}}]{[\mathop{\mathord{"}0\mathord{"}}-\mathop{\mathord{"}9\mathord{"}}]}^\ast_{}\right)}^+_{\mathop{\mathord{"}\text{.}\mathord{"}}} + + +Test-suite fields +----------------- + +main-is + * Optional field + * Documentation of :pkg-field:`main-is` + + .. math:: + \mathop{\mathit{hs\text{-}string}}\mid{\mathop{\mathit{not\text{-}space\text{-}nor\text{-}comma}}}^+_{} + +test-module + * Optional field + * Documentation of :pkg-field:`test-module` + + .. math:: + \mathsf{\color{red}{TODO}} + +type + * Optional field + * Documentation of :pkg-field:`type` + + .. math:: + \mathop{\mathord{"}\mathtt{exitcode\text{-}stdio\text{-}1\text{.}0}\mathord{"}}\mid\mathop{\mathord{"}\mathtt{detailed\text{-}0\text{.}9}\mathord{"}} + + 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..6dbd676943b 100644 --- a/Cabal/tests/UnitTests.hs +++ b/Cabal/tests/UnitTests.hs @@ -28,6 +28,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 @@ -69,6 +70,7 @@ tests mtimeChangeCalibrated = , testGroup "Distribution.SPDX" UnitTests.Distribution.SPDX.spdxTests , 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..457ab290dae --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Described.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module UnitTests.Distribution.Described where + +import Data.Proxy (Proxy (..)) +import Data.Typeable (Typeable, typeOf) +import Test.QuickCheck (Arbitrary (..), Gen, Property, choose, counterexample, elements) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Distribution.FieldGrammar.Described (Described (..), RTerm (..), generate) +import Distribution.Parsec (Parsec, eitherParsec) + +import qualified Distribution.Types.Version as C + +tests :: TestTree +tests = testGroup "Described" + [ testProperty "dummy" $ 'x' == 'x' + , testDescribed (Proxy :: Proxy C.Version) + ] + +testDescribed + :: forall a. (Described a, Parsec a, Typeable a, Show a) + => Proxy a + -> TestTree +testDescribed _ = testProperty name prop + where + name = show (typeOf (undefined :: a)) + + prop :: Ex a -> Property + prop (Example str) = counterexample (show res) $ case res of + Right _ -> True + Left _ -> False + where + res :: Either String a + res = eitherParsec str + +newtype Ex a = Example String + deriving (Show) + +instance Described a => Arbitrary (Ex a) where + arbitrary = fmap Example (generate genInt genRTerm (describe (Proxy :: Proxy a))) + +genInt :: Int -> Int -> Gen Int +genInt lo hi = choose (lo, hi) + +-- TODO: use Regex itself. +genRTerm :: RTerm -> Gen String +genRTerm RUnqualName = elements ["foo", "bar"] +genRTerm RHaskellString = return (show "foo") 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..0c638cda0a4 --- /dev/null +++ b/buildinfo-reference-generator/src/Main.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +module Main (main) where + +import Data.Map.Strict (Map) + +import Data.Bifunctor (first) +import Distribution.CabalSpecVersion +import Distribution.Compat.Newtype (pack') +import Distribution.FieldGrammar.Class +import Distribution.FieldGrammar.Described +import Distribution.Fields.Field (FieldName) +import Distribution.PackageDescription.FieldGrammar +import Distribution.Pretty (pretty) +import Distribution.Simple.Utils (fromUTF8BS) +import GHC.Generics (Generic) +import System.Environment (getArgs) +import System.Exit (exitFailure) + +import qualified Data.Map.Strict as Map +import qualified Text.PrettyPrint as PP + +import qualified Zinza as Z + +------------------------------------------------------------------------------- +-- 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 + , zNull = null + , zNotNull = not . null + } + + putStrLn contents + _ -> do + putStrLn "Usage: generator " + exitFailure + +------------------------------------------------------------------------------- +-- Template Inputs +------------------------------------------------------------------------------- + +data Z = Z + { zBuildInfoFields :: [ZField] + , zPackageDescriptionFields :: [ZField] + , zTestSuiteFields :: [ZField] + , 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) + +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 + + + +------------------------------------------------------------------------------- +-- 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..fe41bb1bfd4 --- /dev/null +++ b/buildinfo-reference-generator/template.zinza @@ -0,0 +1,164 @@ +.. _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{"} - \mathord{"}\mathtt{9}\mathord{"} ] + +* repetition is type set using regular expression inspired notation. + Superscripts tell how many time to repeat: + :math:`\ast` zero to many, + :math:`+` one to many, + :math:`?` one or zero times. + Subscripts tell the used separator. + + .. math:: + + \mathit{digit}^+_{\mathord{"}\mathtt{.}\mathord{"}} + +* alternatives are separated by vertical bar :math:`\mid`: + + .. math:: + + \mathit{foo} \mid \mathit{bar} + +* 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} + + +Non-terminals +------------- + +In the syntax definitions below the following non-terminal symbols are used: + +TBW + + +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