Skip to content

Versioned grammars + leading comma support for build-depends #4953

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
phadej wants to merge 2 commits into from
Closed

Versioned grammars + leading comma support for build-depends #4953

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c4bc19d
CabalSpecVersion + Leading (or trailing) comma for build-depends
phadej Dec 12, 2017
8034e91
Implement availableSince.
phadej Dec 13, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions Cabal/Cabal.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,8 @@ extra-source-files:
tests/ParserTests/errors/common2.errors
tests/ParserTests/errors/common3.cabal
tests/ParserTests/errors/common3.errors
tests/ParserTests/errors/leading-comma.cabal
tests/ParserTests/errors/leading-comma.errors
tests/ParserTests/regressions/Octree-0.5.cabal
tests/ParserTests/regressions/Octree-0.5.format
tests/ParserTests/regressions/common.cabal
Expand All @@ -55,10 +57,14 @@ extra-source-files:
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/leading-comma.cabal
tests/ParserTests/regressions/leading-comma.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/regressions/wl-pprint-indef.cabal
tests/ParserTests/regressions/wl-pprint-indef.format
tests/ParserTests/warnings/bom.cabal
tests/ParserTests/warnings/bool.cabal
tests/ParserTests/warnings/deprecatedfield.cabal
Expand Down Expand Up @@ -148,6 +154,7 @@ library
Distribution.Backpack.ModSubst
Distribution.Backpack.ModuleShape
Distribution.Backpack.PreModuleShape
Distribution.CabalSpecVersion
Distribution.Utils.IOData
Distribution.Utils.LogProgress
Distribution.Utils.MapAccum
Expand Down
55 changes: 55 additions & 0 deletions Cabal/Distribution/CabalSpecVersion.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,55 @@
{-# LANGUAGE FlexibleContexts, RankNTypes #-}
module Distribution.CabalSpecVersion where

import Distribution.Parsec.Class (Parsec (..), ParsecParser)

-- A class to select how to parse different fields.
class CabalSpecVersion v where
Copy link
Member

@23Skidoo 23Skidoo Dec 19, 2017

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks like it should be easy to convert this type class to a GADT? Then we could have

cabalSpecVersionOld :: CabalSpecVersion
cabalSpecVersionOld = ...


cabalSpecVersion22 :: CabalSpecVersion
cabalSpecVersion22 = ...

etc.

Copy link
Member

@23Skidoo 23Skidoo Dec 19, 2017

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you really need data CabalSpecOld = CabalSpecOld / ..., you can make that a phantom type parameter.

Copy link
Collaborator Author

@phadej phadej Dec 19, 2017

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

hmm, GADT is not a bad idea. I however abuse implicit dictionary passing, so I'd need a class for that anyway... :)

-- | @v@ can act as own proxy
cabalSpecVersion :: v

-- | Parsec parser according to the spec version
specParsec :: Parsec a => v -> ParsecParser a

-- given a version, whether this spec knows about it's fields
specKnows :: v -> [Int] -> Bool

specHasElif :: v -> HasElif
specHasCommonStanzas :: v -> HasCommonStanzas

data CabalSpecOld = CabalSpecOld
data CabalSpecV20 = CabalSpecV20
data CabalSpecV22 = CabalSpecV22

instance CabalSpecVersion CabalSpecOld where
cabalSpecVersion = CabalSpecOld
specParsec _ = parsec
specKnows _ vs = vs < [1,25]
specHasElif _ = NoElif
specHasCommonStanzas _ = NoCommonStanzas

instance CabalSpecVersion CabalSpecV20 where
cabalSpecVersion = CabalSpecV20
specParsec _ = parsec
specKnows _ vs = vs < [2,1]
specHasElif _ = NoElif
specHasCommonStanzas _ = NoCommonStanzas

instance CabalSpecVersion CabalSpecV22 where
cabalSpecVersion = CabalSpecV22
specParsec _ = parsec22
specKnows _ _ = True
specHasElif _ = HasElif
specHasCommonStanzas _ = HasCommonStanzas

type CabalSpecLatest = CabalSpecV22

-------------------------------------------------------------------------------
-- "Booleans"
-------------------------------------------------------------------------------

data HasElif = HasElif | NoElif
Copy link
Member

@23Skidoo 23Skidoo Dec 19, 2017

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Alternatively, we could just do something like

data CabalSpecFeature = Elif | CommonStanzas | ...

data CabalSpecVersion where
    ...
    cabalSpecVersionFeatures :: [CabalSpecFeature]
    ...

hasElif :: CabalSpecVersion -> Bool
hasElif = elem ElIf . cabalSpecVersionFeatures

hasCommonStanzas ::  :: CabalSpecVersion -> Bool
...

to make it more consistent with Compiler and Extension.

Copy link
Collaborator Author

@phadej phadej Dec 19, 2017 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, have to think how to deal with expanding feature set. But not now. (maybe in follow-up PR)

Copy link
Collaborator Author

@phadej phadej Dec 19, 2017

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One way is to encode availableSince using CabalSpecFeature, then it will definitely make sense!

deriving (Eq, Show)

data HasCommonStanzas = HasCommonStanzas | NoCommonStanzas
deriving (Eq, Show)
4 changes: 2 additions & 2 deletions Cabal/Distribution/FieldGrammar.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,8 +40,8 @@ import Distribution.FieldGrammar.Pretty
import Distribution.Parsec.Field
import Distribution.Utils.Generic (spanMaybe)

type ParsecFieldGrammar' a = ParsecFieldGrammar a a
type PrettyFieldGrammar' a = PrettyFieldGrammar a a
type ParsecFieldGrammar' v a = ParsecFieldGrammar v a a
type PrettyFieldGrammar' a = PrettyFieldGrammar a a

infixl 5 ^^^

Expand Down
1 change: 1 addition & 0 deletions Cabal/Distribution/FieldGrammar/Class.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,7 @@ class FieldGrammar g where
-- | Annotate field with since spec-version.
availableSince
:: [Int] -- ^ spec version
-> a -- ^ default value
-> g s a
-> g s a

Expand Down
53 changes: 34 additions & 19 deletions Cabal/Distribution/FieldGrammar/Parsec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module provides a 'FieldGrammarParser', one way to parse
-- @.cabal@ -like files.
--
Expand Down Expand Up @@ -61,16 +62,18 @@ module Distribution.FieldGrammar.Parsec (
runFieldParser',
) where

import Data.List (dropWhileEnd)
import Data.Ord (comparing)
import Data.Set (Set)
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype
import Distribution.Compat.Prelude
import Distribution.Simple.Utils (fromUTF8BS)
import Prelude ()

import qualified Data.ByteString as BS
import Data.List (dropWhileEnd)
import Data.Ord (comparing)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Distribution.Compat.Map.Strict as Map
import Distribution.Compat.Prelude
import Distribution.Compat.Newtype
import Distribution.Simple.Utils (fromUTF8BS)
import Prelude ()
import qualified Text.Parsec as P
import qualified Text.Parsec.Error as P

Expand Down Expand Up @@ -98,14 +101,14 @@ data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann]
-- ParsecFieldGrammar
-------------------------------------------------------------------------------

data ParsecFieldGrammar s a = ParsecFG
data ParsecFieldGrammar v s a = ParsecFG
{ fieldGrammarKnownFields :: !(Set FieldName)
, fieldGrammarKnownPrefixes :: !(Set FieldName)
, fieldGrammarParser :: !(Fields Position -> ParseResult a)
}
deriving (Functor)

parseFieldGrammar :: Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar :: Fields Position -> ParsecFieldGrammar v s a -> ParseResult a
parseFieldGrammar fields grammar = do
for_ (Map.toList (Map.filterWithKey isUnknownField fields)) $ \(name, nfields) ->
for_ nfields $ \(MkNamelessField pos _) ->
Expand All @@ -120,10 +123,10 @@ parseFieldGrammar fields grammar = do
k `Set.member` fieldGrammarKnownFields grammar
|| any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar)

fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList :: ParsecFieldGrammar v s a -> [FieldName]
fieldGrammarKnownFieldList = Set.toList . fieldGrammarKnownFields

instance Applicative (ParsecFieldGrammar s) where
instance Applicative (ParsecFieldGrammar v s) where
pure x = ParsecFG mempty mempty (\_ -> pure x)
{-# INLINE pure #-}

Expand All @@ -133,7 +136,7 @@ instance Applicative (ParsecFieldGrammar s) where
(\fields -> f'' fields <*> x'' fields)
{-# INLINE (<*>) #-}

instance FieldGrammar ParsecFieldGrammar where
instance CabalSpecVersion v => FieldGrammar (ParsecFieldGrammar v) where
blurFieldGrammar _ (ParsecFG s s' parser) = ParsecFG s s' parser

uniqueFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
Expand All @@ -147,7 +150,7 @@ instance FieldGrammar ParsecFieldGrammar where
Just xs-> parseOne (last xs)

parseOne (MkNamelessField pos fls) =
unpack' _pack <$> runFieldParser pos parsec fls
unpack' _pack <$> runFieldParser pos (specParsec (cabalSpecVersion :: v)) fls

booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser
where
Expand All @@ -160,7 +163,7 @@ instance FieldGrammar ParsecFieldGrammar where
-- TODO: warn about duplicate optional fields?
Just xs -> parseOne (last xs)

parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls
parseOne (MkNamelessField pos fls) = runFieldParser pos (specParsec (cabalSpecVersion :: v)) fls

optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
where
Expand All @@ -173,15 +176,15 @@ instance FieldGrammar ParsecFieldGrammar where

parseOne (MkNamelessField pos fls)
| null fls = pure Nothing
| otherwise = Just . (unpack' _pack) <$> runFieldParser pos parsec fls
| otherwise = Just . (unpack' _pack) <$> runFieldParser pos (specParsec (cabalSpecVersion :: v)) fls

monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
where
parser fields = case Map.lookup fn fields of
Nothing -> pure mempty
Just xs -> foldMap (unpack' _pack) <$> traverse parseOne xs

parseOne (MkNamelessField pos fls) = runFieldParser pos parsec fls
parseOne (MkNamelessField pos fls) = runFieldParser pos (specParsec (cabalSpecVersion :: v)) fls

prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (pure . parser)
where
Expand All @@ -199,8 +202,20 @@ instance FieldGrammar ParsecFieldGrammar where
trim :: String -> String
trim = dropWhile isSpace . dropWhileEnd isSpace

availableSince _ = id
availableSince vs def p@(ParsecFG names _ _)
| specKnows (cabalSpecVersion :: v) vs = p
| otherwise = ParsecFG mempty mempty parser'
where
parser' values = do
let unknownFields = Map.intersection values $ Map.fromSet (const ()) names
for_ (Map.toList unknownFields) $ \(name, fields) ->
for_ fields $ \(MkNamelessField pos _) ->
parseWarning pos PWTUnknownField $
"The field " <> show name <> " is available since Cabal " ++ show vs

pure def

-- todo we know about this field
deprecatedSince (_ : _) _ grammar = grammar -- pass on non-empty version
deprecatedSince _ msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'
where
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/FieldGrammar/Pretty.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,5 +66,5 @@ instance FieldGrammar PrettyFieldGrammar where
knownField _ = pure ()
deprecatedSince [] _ _ = PrettyFG (\_ -> mempty)
deprecatedSince _ _ x = x
availableSince _ = id
availableSince _ _ = id
hiddenField _ = PrettyFG (\_ -> mempty)
30 changes: 22 additions & 8 deletions Cabal/Distribution/PackageDescription/FieldGrammar.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Prelude ()

import Distribution.CabalSpecVersion
import Distribution.Compiler (CompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.License (License (..))
Expand Down Expand Up @@ -125,9 +126,11 @@ libraryFieldGrammar n = Library n
<$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules
<*> monoidalFieldAla "reexported-modules" (alaList CommaVCat) L.reexportedModules
<*> monoidalFieldAla "signatures" (alaList' VCat MQuoted) L.signatures
^^^ availableSince [2,0] []
<*> booleanFieldDef "exposed" L.libExposed True
<*> blurFieldGrammar L.libBuildInfo buildInfoFieldGrammar
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' Library #-}
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' CabalSpecOld Library #-}
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' CabalSpecV22 Library #-}
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> PrettyFieldGrammar' Library #-}

-------------------------------------------------------------------------------
Expand All @@ -144,7 +147,8 @@ foreignLibFieldGrammar n = ForeignLib n
<*> optionalField "lib-version-info" L.foreignLibVersionInfo
<*> optionalField "lib-version-linux" L.foreignLibVersionLinux
<*> monoidalFieldAla "mod-def-file" (alaList' FSep FilePathNT) L.foreignLibModDefFile
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' ForeignLib #-}
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' CabalSpecOld ForeignLib #-}
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' CabalSpecV22 ForeignLib #-}
{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' ForeignLib #-}

-------------------------------------------------------------------------------
Expand All @@ -159,7 +163,8 @@ executableFieldGrammar n = Executable n
<$> optionalFieldDefAla "main-is" FilePathNT L.modulePath ""
<*> monoidalField "scope" L.exeScope
<*> blurFieldGrammar L.buildInfo buildInfoFieldGrammar
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' Executable #-}
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' CabalSpecOld Executable #-}
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' CabalSpecV22 Executable #-}
{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-}

-------------------------------------------------------------------------------
Expand Down Expand Up @@ -364,7 +369,11 @@ buildInfoFieldGrammar = BuildInfo
<*> monoidalFieldAla "build-tools" (alaList CommaFSep) L.buildTools
^^^ deprecatedSince [2,0] "Please use 'build-tool-depends' field"
<*> monoidalFieldAla "build-tool-depends" (alaList CommaFSep) L.buildToolDepends
^^^ availableSince [2,0]
-- {- ^^^ availableSince [2,0] [] -}
-- here, we explicitly want to recognise build-tool-depends for all Cabal files
-- as otherwise cabal new-build cannot really work.
--
-- I.e. we don't want trigger unknown field warning
<*> monoidalFieldAla "cpp-options" (alaList' NoCommaFSep Token') L.cppOptions
<*> monoidalFieldAla "asm-options" (alaList' NoCommaFSep Token') L.asmOptions
<*> monoidalFieldAla "cmm-options" (alaList' NoCommaFSep Token') L.cmmOptions
Expand Down Expand Up @@ -404,7 +413,9 @@ buildInfoFieldGrammar = BuildInfo
<*> prefixedFields "x-" L.customFieldsBI
<*> monoidalFieldAla "build-depends" (alaList CommaVCat) L.targetBuildDepends
<*> monoidalFieldAla "mixins" (alaList CommaVCat) L.mixins
{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-}
^^^ availableSince [2,0] []
{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' CabalSpecOld BuildInfo #-}
{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' CabalSpecV22 BuildInfo #-}
{-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-}

hsSourceDirsGrammar
Expand Down Expand Up @@ -487,7 +498,8 @@ flagFieldGrammar name = MkFlag name
<$> optionalFieldDefAla "description" FreeText L.flagDescription ""
<*> booleanFieldDef "default" L.flagDefault True
<*> booleanFieldDef "manual" L.flagManual False
{-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' Flag #-}
{-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' CabalSpecOld Flag #-}
{-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' CabalSpecV22 Flag #-}
{-# SPECIALIZE flagFieldGrammar :: FlagName -> PrettyFieldGrammar' Flag #-}

-------------------------------------------------------------------------------
Expand All @@ -504,7 +516,8 @@ sourceRepoFieldGrammar kind = SourceRepo kind
<*> optionalFieldAla "branch" Token L.repoBranch
<*> optionalFieldAla "tag" Token L.repoTag
<*> optionalFieldAla "subdir" FilePathNT L.repoSubdir
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> ParsecFieldGrammar' SourceRepo #-}
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> ParsecFieldGrammar' CabalSpecOld SourceRepo #-}
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> ParsecFieldGrammar' CabalSpecV22 SourceRepo #-}
{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind ->PrettyFieldGrammar' SourceRepo #-}

-------------------------------------------------------------------------------
Expand All @@ -516,5 +529,6 @@ setupBInfoFieldGrammar
=> Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar def = flip SetupBuildInfo def
<$> monoidalFieldAla "setup-depends" (alaList CommaVCat) L.setupDepends
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' SetupBuildInfo #-}
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' CabalSpecOld SetupBuildInfo #-}
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' CabalSpecV22 SetupBuildInfo #-}
{-# SPECIALIZE setupBInfoFieldGrammar :: Bool ->PrettyFieldGrammar' SetupBuildInfo #-}
Loading