Commit bfb1967c authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Common stanzas

- common stanzas can be include other common stanzas
- `import: name1, name2` to import multiple stanzas
- Parse common stanzas in the same pass with other sections.
- Common stanzas have to be defined before use.
- Also negative tests
- Terse documentation, let's improve it as questions are asked

- Edit gen-extra-source-files to include golden files
- Amend elif warning to mention cabal-version: 2.2
- In regression golden tests, include also warnings

Note: ATM the common stanzas are completely handled inside parser,
GenericPackageDescription doesn't know about them anymore.
That can be changed, but the the flattening of
GenericPackageDescription to PackageDescription may fail.
I don't want to do that refactor now.
parent 2493a560
......@@ -32,15 +32,33 @@ extra-source-files:
-- Generated with 'misc/gen-extra-source-files.sh'
-- Do NOT edit this section manually; instead, run the script.
-- BEGIN gen-extra-source-files
tests/ParserTests/errors/common1.cabal
tests/ParserTests/errors/common1.errors
tests/ParserTests/errors/common2.cabal
tests/ParserTests/errors/common2.errors
tests/ParserTests/errors/common3.cabal
tests/ParserTests/errors/common3.errors
tests/ParserTests/regressions/Octree-0.5.cabal
tests/ParserTests/regressions/Octree-0.5.format
tests/ParserTests/regressions/common.cabal
tests/ParserTests/regressions/common.format
tests/ParserTests/regressions/common2.cabal
tests/ParserTests/regressions/common2.format
tests/ParserTests/regressions/elif.cabal
tests/ParserTests/regressions/elif.format
tests/ParserTests/regressions/elif2.cabal
tests/ParserTests/regressions/elif2.format
tests/ParserTests/regressions/encoding-0.8.cabal
tests/ParserTests/regressions/encoding-0.8.format
tests/ParserTests/regressions/generics-sop.cabal
tests/ParserTests/regressions/generics-sop.format
tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal
tests/ParserTests/regressions/issue-774.cabal
tests/ParserTests/regressions/issue-774.format
tests/ParserTests/regressions/nothing-unicode.cabal
tests/ParserTests/regressions/nothing-unicode.format
tests/ParserTests/regressions/shake.cabal
tests/ParserTests/regressions/shake.format
tests/ParserTests/warnings/bom.cabal
tests/ParserTests/warnings/bool.cabal
tests/ParserTests/warnings/deprecatedfield.cabal
......
......@@ -175,6 +175,9 @@ data TestSuiteStanza = TestSuiteStanza
, _testStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo TestSuiteStanza where
buildInfo = testStanzaBuildInfo
testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType f s = fmap (\x -> s { _testStanzaTestType = x }) (f (_testStanzaTestType s))
{-# INLINE testStanzaTestType #-}
......@@ -274,6 +277,9 @@ data BenchmarkStanza = BenchmarkStanza
, _benchmarkStanzaBuildInfo :: BuildInfo
}
instance L.HasBuildInfo BenchmarkStanza where
buildInfo = benchmarkStanzaBuildInfo
benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType f s = fmap (\x -> s { _benchmarkStanzaBenchmarkType = x }) (f (_benchmarkStanzaBenchmarkType s))
{-# INLINE benchmarkStanzaBenchmarkType #-}
......
......@@ -42,7 +42,7 @@ import Distribution.FieldGrammar
import Distribution.PackageDescription
import Distribution.PackageDescription.FieldGrammar
import Distribution.PackageDescription.Quirks (patchQuirks)
import Distribution.Parsec.Class (parsec)
import Distribution.Parsec.Class (parsecCommaList, parsec, parsecToken)
import Distribution.Parsec.Common
import Distribution.Parsec.ConfVar (parseConditionConfVar)
import Distribution.Parsec.Field (FieldName, getName)
......@@ -52,6 +52,7 @@ import Distribution.Parsec.ParseResult
import Distribution.Simple.Utils (die', fromUTF8BS, warn)
import Distribution.Text (display)
import Distribution.Types.CondTree
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName
(UnqualComponentName, mkUnqualComponentName)
......@@ -62,6 +63,7 @@ import Distribution.Version
import System.Directory (doesFileExist)
import Distribution.Compat.Lens
import qualified Distribution.Types.BuildInfo.Lens as L
import qualified Distribution.Types.GenericPackageDescription.Lens as L
import qualified Distribution.Types.PackageDescription.Lens as L
......@@ -124,7 +126,21 @@ fieldlinesToBS :: [FieldLine ann] -> BS.ByteString
fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs)
-- Monad in which sections are parsed
type SectionParser = StateT GenericPackageDescription ParseResult
type SectionParser = StateT SectionS ParseResult
-- | State of section parser
data SectionS = SectionS
{ _stateGpd :: !GenericPackageDescription
, _stateCommonStanzas :: !(Map String CondTreeBuildInfo)
}
stateGpd :: Lens' SectionS GenericPackageDescription
stateGpd f (SectionS gpd cs) = (\x -> SectionS x cs) <$> f gpd
{-# INLINE stateGpd #-}
stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfo)
stateCommonStanzas f (SectionS gpd cs) = SectionS gpd <$> f cs
{-# INLINE stateCommonStanzas #-}
-- Note [Accumulating parser]
--
......@@ -147,9 +163,10 @@ parseGenericPackageDescription' lexWarnings fs = do
-- Sections
let gpd = emptyGpd & L.packageDescription .~ pd
-- elif conditional is accepted if spec version is >= 2.1
let hasElif = if specVersion pd >= mkVersion [2,1] then HasElif else NoElif
execStateT (goSections hasElif sectionFields) gpd
-- parse sections
view stateGpd <$> execStateT
(goSections (specVersion pd) sectionFields)
(SectionS gpd Map.empty)
where
emptyGpd :: GenericPackageDescription
emptyGpd = GenericPackageDescription emptyPackageDescription [] Nothing [] [] [] [] []
......@@ -180,9 +197,14 @@ parseGenericPackageDescription' lexWarnings fs = do
maybeWarnCabalVersion _ _ = return ()
-- Sections
goSections :: HasElif -> [Field Position] -> SectionParser ()
goSections hasElif = traverse_ process
goSections :: Version -> [Field Position] -> SectionParser ()
goSections sv = traverse_ process
where
hasElif = if sv >= mkVersion [2,1] then HasElif else NoElif
-- Common stanzas are avaiable since cabal-version: 2.1
hasCommonStanzas = sv >= mkVersion [2,1]
process (Field (Name pos name) _) =
lift $ parseWarning pos PWTTrailingFields $
"Ignoring trailing fields after sections: " ++ show name
......@@ -193,55 +215,75 @@ goSections hasElif = traverse_ process
parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser ()
parseSection (Name pos name) args fields
| not hasCommonStanzas, name == "common" = lift $ do
parseWarning pos PWTUnknownSection $ "Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas."
| name == "common" = do
commonStanzas <- use stateCommonStanzas
name' <- lift $ parseCommonName pos args
biTree <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas buildInfoFieldGrammar commonStanzas fields
case Map.lookup name' commonStanzas of
Nothing -> stateCommonStanzas .= Map.insert name' biTree commonStanzas
Just _ -> lift $ parseFailure pos $
"Duplicate common stanza: " ++ name'
| name == "library" && null args = do
lib <- lift $ parseCondTree hasElif (libraryFieldGrammar Nothing) (targetBuildDepends . libBuildInfo) fields
commonStanzas <- use stateCommonStanzas
lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar Nothing) commonStanzas fields
-- TODO: check that library is defined once
L.condLibrary ?= lib
stateGpd . L.condLibrary ?= lib
-- Sublibraries
-- TODO: check cabal-version
| name == "library" = do
-- TODO: check cabal-version
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
lib <- lift $ parseCondTree hasElif (libraryFieldGrammar $ Just name') (targetBuildDepends . libBuildInfo) fields
lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar $ Just name') commonStanzas fields
-- TODO check duplicate name here?
L.condSubLibraries %= snoc (name', lib)
stateGpd . L.condSubLibraries %= snoc (name', lib)
-- TODO: check cabal-version
| name == "foreign-library" = do
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
flib <- lift $ parseCondTree hasElif (foreignLibFieldGrammar name') (targetBuildDepends . foreignLibBuildInfo) fields
flib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (foreignLibFieldGrammar name') commonStanzas fields
-- TODO check duplicate name here?
L.condForeignLibs %= snoc (name', flib)
stateGpd . L.condForeignLibs %= snoc (name', flib)
| name == "executable" = do
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
exe <- lift $ parseCondTree hasElif (executableFieldGrammar name') (targetBuildDepends . buildInfo) fields
exe <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (executableFieldGrammar name') commonStanzas fields
-- TODO check duplicate name here?
L.condExecutables %= snoc (name', exe)
stateGpd . L.condExecutables %= snoc (name', exe)
| name == "test-suite" = do
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
testStanza <- lift $ parseCondTree hasElif testSuiteFieldGrammar (targetBuildDepends . _testStanzaBuildInfo) fields
testStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas testSuiteFieldGrammar commonStanzas fields
testSuite <- lift $ traverse (validateTestSuite pos) testStanza
-- TODO check duplicate name here?
L.condTestSuites %= snoc (name', testSuite)
stateGpd . L.condTestSuites %= snoc (name', testSuite)
| name == "benchmark" = do
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
benchStanza <- lift $ parseCondTree hasElif benchmarkFieldGrammar (targetBuildDepends . _benchmarkStanzaBuildInfo) fields
benchStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas benchmarkFieldGrammar commonStanzas fields
bench <- lift $ traverse (validateBenchmark pos) benchStanza
-- TODO check duplicate name here?
L.condBenchmarks %= snoc (name', bench)
stateGpd . L.condBenchmarks %= snoc (name', bench)
| name == "flag" = do
name' <- parseName pos args
name'' <- lift $ runFieldParser' pos parsec name' `recoverWith` mkFlagName ""
flag <- lift $ parseFields fields (flagFieldGrammar name'')
-- Check default flag
L.genPackageFlags %= snoc flag
stateGpd . L.genPackageFlags %= snoc flag
| name == "custom-setup" && null args = do
sbi <- lift $ parseFields fields (setupBInfoFieldGrammar False)
L.packageDescription . L.setupBuildInfo ?= sbi
stateGpd . L.packageDescription . L.setupBuildInfo ?= sbi
| name == "source-repository" = do
kind <- lift $ case args of
......@@ -255,12 +297,13 @@ goSections hasElif = traverse_ process
pure RepoHead
sr <- lift $ parseFields fields (sourceRepoFieldGrammar kind)
L.packageDescription . L.sourceRepos %= snoc sr
stateGpd . L.packageDescription . L.sourceRepos %= snoc sr
| otherwise = lift $
parseWarning pos PWTUnknownSection $ "Ignoring section: " ++ show name
parseName :: Position -> [SectionArg Position] -> SectionParser String
-- TODO: use strict parser
parseName pos args = case args of
[SecArgName _pos secName] ->
pure $ fromUTF8BS secName
......@@ -274,6 +317,20 @@ parseName pos args = case args of
lift $ parseFailure pos $ "Invalid name " ++ show args
pure ""
parseCommonName :: Position -> [SectionArg Position] -> ParseResult String
parseCommonName pos args = case args of
[SecArgName _pos secName] ->
pure $ fromUTF8BS secName
[SecArgStr _pos secName] ->
pure $ fromUTF8BS secName
[] -> do
parseFailure pos $ "name required"
pure ""
_ -> do
-- TODO: pretty print args
parseFailure pos $ "Invalid name " ++ show args
pure ""
parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser UnqualComponentName
parseUnqualComponentName pos args = mkUnqualComponentName <$> parseName pos args
......@@ -291,7 +348,6 @@ warnInvalidSubsection :: Section Position -> ParseResult ()
warnInvalidSubsection (MkSection (Name pos name) _ _) =
void (parseFailure pos $ "invalid subsection " ++ show name)
data HasElif = HasElif | NoElif
deriving (Eq, Show)
......@@ -333,6 +389,8 @@ parseCondTree hasElif grammar cond = go
sections' <- parseIfs sections
return (Just elseFields, sections')
parseElseIfs (MkSection (Name _ name) test fields : sections) | hasElif == HasElif, name == "elif" = do
-- TODO: check cabal-version
test' <- parseConditionConfVar test
......@@ -342,6 +400,10 @@ parseCondTree hasElif grammar cond = go
a <- parseFieldGrammar mempty grammar
return (Just $ CondNode a (cond a) [CondBranch test' fields' elseFields], sections')
parseElseIfs (MkSection (Name pos name) _ _ : sections) | name == "elif" = do
parseWarning pos PWTInvalidSubsection $ "invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals."
(,) Nothing <$> parseIfs sections
parseElseIfs sections = (,) Nothing <$> parseIfs sections
{- Note [Accumulating parser]
......@@ -366,6 +428,111 @@ When/if we re-implement the parser to support formatting preservging roundtrip
with new AST, this all need to be rewritten.
-}
-------------------------------------------------------------------------------
-- Common stanzas
-------------------------------------------------------------------------------
-- $commonStanzas
--
-- [Note: Common stanzas]
--
-- In Cabal 2.2 we support simple common stanzas:
--
-- * Commons stanzas define 'BuildInfo'
--
-- * import "fields" can only occur at top of other stanzas (think: imports)
--
-- In particular __there aren't__
--
-- * implicit stanzas
--
-- * More specific common stanzas (executable, test-suite).
--
--
-- The approach uses the fact that 'BuildInfo' is a 'Monoid':
--
-- @
-- mergeCommonStanza' :: HasBuildInfo comp => BuildInfo -> comp -> comp
-- mergeCommonStanza' bi = over L.BuildInfo (bi <>)
-- @
--
-- Real 'mergeCommonStanza' is more complicated as we have to deal with
-- conditional trees.
--
-- The approach is simple, and have good properties:
--
-- * Common stanzas are parsed exactly once, even if not-used. Thus we report errors in them.
--
type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo
-- | Create @a@ from 'BuildInfo'.
--
-- Law: @view buildInfo . fromBuildInfo = id@
class L.HasBuildInfo a => FromBuildInfo a where
fromBuildInfo :: BuildInfo -> a
instance FromBuildInfo BuildInfo where fromBuildInfo = id
instance FromBuildInfo Library where fromBuildInfo bi = set L.buildInfo bi emptyLibrary
instance FromBuildInfo ForeignLib where fromBuildInfo bi = set L.buildInfo bi emptyForeignLib
instance FromBuildInfo Executable where fromBuildInfo bi = set L.buildInfo bi emptyExecutable
instance FromBuildInfo TestSuiteStanza where
fromBuildInfo = TestSuiteStanza Nothing Nothing Nothing
instance FromBuildInfo BenchmarkStanza where
fromBuildInfo = BenchmarkStanza Nothing Nothing Nothing
parseCondTreeWithCommonStanzas
:: forall a. FromBuildInfo a
=> HasElif -- ^ accept @elif@
-> Bool -- ^ accept @import@
-> ParsecFieldGrammar' a -- ^ grammar
-> Map String CondTreeBuildInfo -- ^ common stanzas
-> [Field Position]
-> ParseResult (CondTree ConfVar [Dependency] a)
parseCondTreeWithCommonStanzas hasElif hasCommonStanzas grammar commonStanzas = goImports []
where
-- parse leading imports
-- not supported:
goImports acc (Field (Name pos name) _ : fields) | name == "import", not hasCommonStanzas = do
parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas"
goImports acc fields
-- supported:
goImports acc (Field (Name pos name) fls : fields) | name == "import" = do
names <- runFieldParser pos (parsecCommaList parsecToken) fls
names' <- for names $ \commonName ->
case Map.lookup commonName commonStanzas of
Nothing -> do
parseFailure pos $ "Undefined common stanza imported: " ++ commonName
pure Nothing
Just commonTree ->
pure (Just commonTree)
goImports (acc ++ catMaybes names') fields
-- Go to parsing condTree after first non-import 'Field'.
goImports acc fields = go acc fields
-- parse actual CondTree
go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a)
go bis fields = do
x <- parseCondTree hasElif grammar (view L.targetBuildDepends) fields
pure $ foldr mergeCommonStanza x bis
mergeCommonStanza
:: forall a. FromBuildInfo a
=> CondTree ConfVar [Dependency] BuildInfo
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
mergeCommonStanza (CondNode bi _ bis) (CondNode x _ cs) =
CondNode x' (x' ^. L.targetBuildDepends) cs'
where
-- new value is old value with buildInfo field _prepended_.
x' = x & L.buildInfo %~ (bi <>)
-- tree components are appended together.
cs' = map (fmap fromBuildInfo) bis ++ cs
-------------------------------------------------------------------------------
-- Old syntax
-------------------------------------------------------------------------------
......
......@@ -63,8 +63,9 @@ data P sep = P
class Sep sep where
prettySep :: P sep -> [Doc] -> Doc
parseSep
:: P sep -> P.Stream s Identity Char
=> P.Parsec s [PWarning] a
:: P.Stream s Identity Char
=> P sep
-> P.Parsec s [PWarning] a
-> P.Parsec s [PWarning] [a]
instance Sep CommaVCat where
......
......@@ -29,6 +29,7 @@
* Support for building with Win32 version 2.6 (#4835).
* Compilation with section splitting is now supported via the
'--enable-split-sections' flag (#4819)
* Support for common stanzas (#4751)
* TODO
2.0.1.1 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> December 2017
......
......@@ -1251,7 +1251,7 @@ Executables
^^^^^^^^^^^
.. pkg-section:: executable name
:synopsis: Exectuable build info section.
:synopsis: Executable build info section.
Executable sections (if present) describe executable programs contained
in the package and must have an argument after the section label, which
......@@ -2520,6 +2520,45 @@ and outside then they are combined using the following rules.
else
Main-is: Main.hs
Common stanzas
^^^^^^^^^^^^^^
.. pkg-section:: common name
:synopsis: Common build info section
Starting with Cabal-2.2 it's possible to use common build info stanzas.
::
common deps
build-depends: base ^>= 4.11
ghc-options: -Wall
common test-deps
build-depends: tasty
library
import: deps
exposed-modules: Foo
test-suite tests
import: deps, test-deps
type: exitcode-stdio-1.0
main-is: Tests.hs
build-depends: foo
- You can use `build information`_ fields in common stanzas.
- Common stanzas must be defined before use.
- Common stanzas can import other common stanzas.
- You can import multiple stanzas at once. Stanza names must be separated by commas.
.. Note::
The name `import` was chosen, because there is ``includes`` field.
Source Repositories
^^^^^^^^^^^^^^^^^^^
......
......@@ -27,8 +27,9 @@ import qualified Distribution.Types.PackageDescription.Lens as L
tests :: TestTree
tests = testGroup "parsec tests"
[ warningTests
, regressionTests
[ regressionTests
, warningTests
, errorTests
]
-------------------------------------------------------------------------------
......@@ -69,6 +70,33 @@ warningTest wt fp = testCase (show wt) $ do
[] -> assertFailure "got no warnings"
_ -> assertFailure $ "got multiple warnings: " ++ show warns
-------------------------------------------------------------------------------
-- Errors
-------------------------------------------------------------------------------
errorTests :: TestTree
errorTests = testGroup "errors"
[ errorTest "common1.cabal"
, errorTest "common2.cabal"
, errorTest "common3.cabal"
]
errorTest :: FilePath -> TestTree
errorTest fp = cabalGoldenTest "errors" correct $ do
contents <- BS.readFile input
let res = parseGenericPackageDescription contents
let (_, errs, x) = runParseResult res
return $ toUTF8BS $ case x of
Just gpd | null errs ->
"UNXPECTED SUCCESS\n" ++
showGenericPackageDescription gpd
_ ->
unlines $ map show errs
where
input = "tests" </> "ParserTests" </> "errors" </> fp
correct = replaceExtension input "errors"
-------------------------------------------------------------------------------
-- Regressions
-------------------------------------------------------------------------------
......@@ -83,6 +111,8 @@ regressionTests = testGroup "regressions"
, regressionTest "elif.cabal"
, regressionTest "elif2.cabal"
, regressionTest "shake.cabal"
, regressionTest "common.cabal"
, regressionTest "common2.cabal"
]
regressionTest :: FilePath -> TestTree
......@@ -95,11 +125,12 @@ formatGoldenTest :: FilePath -> TestTree
formatGoldenTest fp = cabalGoldenTest "format" correct $ do
contents <- BS.readFile input
let res = parseGenericPackageDescription contents
let (_, errs, x) = runParseResult res
let (warns, errs, x) = runParseResult res
return $ toUTF8BS $ case x of
Just gpd | null errs ->
showGenericPackageDescription gpd
unlines (map show warns)
++ showGenericPackageDescription gpd
_ ->
unlines $ "ERROR" : map show errs
where
......
name: common
version: 0
synopsis: Common-stanza demo demo
build-type: Simple
cabal-version: >=2.1
source-repository head
Type: git
Location: https://github.com/hvr/-.git
common windows
if os(windows)
build-depends: Win32
-- Non-existing common stanza
common deps
import: windo
build-depends:
base >=4.10 && <4.11,
containers
library
import: deps
default-language: Haskell2010
exposed-modules: ElseIf
build-depends:
ghc-prim
PError (Position 17 3) "Undefined common stanza imported: windo"
</
name: common
version: 0
synopsis: Common-stanza demo demo
build-type: Simple
cabal-version: >=2.1
source-repository head
Type: git
Location: https://github.com/hvr/-.git
-- Used before use
common deps
import: windows
build-depends:
base >=4.10 && <4.11,
containers
common windows
if os(windows)
build-depends: Win32
library
import: deps
default-language: Haskell2010
exposed-modules: ElseIf
build-depends:
ghc-prim