CabalSpecVersion

Author: phadej

Cabal/Cabal.cabal

@@ -130,6 +130,7 @@ library
     Distribution.Backpack.ModSubst
     Distribution.Backpack.ModuleShape
     Distribution.Backpack.PreModuleShape
+    Distribution.CabalSpecVersion
     Distribution.Utils.IOData
     Distribution.Utils.LogProgress
     Distribution.Utils.MapAccum

Cabal/Distribution/CabalSpecVersion.hs

@@ -0,0 +1,38 @@
+{-# 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
+    -- | @v@ can act as own proxy
+    cabalSpecVersion   :: v
+
+    versionedParsec    :: Parsec a => v -> ParsecParser a
+
+    -- given a version since something is available, do we support it?
+    versionedAvailable :: v -> [Int] -> Bool
+
+    specHasElif            :: v -> HasElif
+
+data SpecVersionOld = SpecVersionOld
+data SpecVersion22  = SpecVersion22
+
+instance CabalSpecVersion SpecVersionOld where
+    cabalSpecVersion  = SpecVersionOld
+    versionedParsec _ = parsec
+    versionedAvailable _ vs = vs < [2,1]
+    specHasElif _ = NoElif
+
+instance CabalSpecVersion SpecVersion22  where
+    cabalSpecVersion  = SpecVersion22
+    versionedParsec _ = parsec22
+    versionedAvailable _ _ = True
+    specHasElif _ = HasElif
+
+-------------------------------------------------------------------------------
+-- HasElif
+-------------------------------------------------------------------------------
+
+data HasElif = HasElif | NoElif
+  deriving (Eq, Show)

Cabal/Distribution/FieldGrammar.hs

@@ -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 ^^^
 

Cabal/Distribution/FieldGrammar/Parsec.hs

@@ -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.
 --
@@ -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
 
@@ -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 _) ->
@@ -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  #-}
 
@@ -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
@@ -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 (versionedParsec (cabalSpecVersion :: v)) fls
 
     booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser
       where
@@ -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 (versionedParsec (cabalSpecVersion :: v)) fls
 
     optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
       where
@@ -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 (versionedParsec (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 (versionedParsec (cabalSpecVersion :: v)) fls
 
     prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (pure . parser)
       where
@@ -199,6 +202,7 @@ instance FieldGrammar ParsecFieldGrammar where
         trim :: String -> String
         trim = dropWhile isSpace . dropWhileEnd isSpace
 
+    -- TODO: use versionedAvailable to drop parsing if old field.
     availableSince _ = id
 
     deprecatedSince (_ : _) _ grammar = grammar -- pass on non-empty version

Cabal/Distribution/PackageDescription/FieldGrammar.hs

@@ -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 (..))
@@ -127,7 +128,8 @@ libraryFieldGrammar n = Library n
     <*> monoidalFieldAla  "signatures"         (alaList' VCat MQuoted) L.signatures
     <*> booleanFieldDef   "exposed"                                    L.libExposed True
     <*> blurFieldGrammar L.libBuildInfo buildInfoFieldGrammar
-{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' Library #-}
+{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' SpecVersionOld Library #-}
+{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' SpecVersion22 Library #-}
 {-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> PrettyFieldGrammar' Library #-}
 
 -------------------------------------------------------------------------------
@@ -144,7 +146,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' SpecVersionOld ForeignLib #-}
+{-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' SpecVersion22 ForeignLib #-}
 {-# SPECIALIZE foreignLibFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' ForeignLib #-}
 
 -------------------------------------------------------------------------------
@@ -159,7 +162,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' SpecVersionOld Executable #-}
+{-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' SpecVersion22 Executable #-}
 {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-}
 
 -------------------------------------------------------------------------------
@@ -398,7 +402,8 @@ buildInfoFieldGrammar = BuildInfo
     <*> prefixedFields   "x-"                                                 L.customFieldsBI
     <*> monoidalFieldAla "build-depends"        (alaList  CommaVCat)          L.targetBuildDepends
     <*> monoidalFieldAla "mixins"               (alaList  CommaVCat)          L.mixins
-{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-}
+{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' SpecVersionOld BuildInfo #-}
+{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' SpecVersion22 BuildInfo #-}
 {-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-}
 
 hsSourceDirsGrammar
@@ -481,7 +486,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' SpecVersionOld Flag #-}
+{-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' SpecVersion22 Flag #-}
 {-# SPECIALIZE flagFieldGrammar :: FlagName -> PrettyFieldGrammar' Flag #-}
 
 -------------------------------------------------------------------------------
@@ -498,7 +504,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' SpecVersionOld SourceRepo #-}
+{-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind -> ParsecFieldGrammar' SpecVersion22 SourceRepo #-}
 {-# SPECIALIZE sourceRepoFieldGrammar :: RepoKind ->PrettyFieldGrammar' SourceRepo #-}
 
 -------------------------------------------------------------------------------
@@ -510,5 +517,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' SpecVersionOld SetupBuildInfo #-}
+{-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' SpecVersion22 SetupBuildInfo #-}
 {-# SPECIALIZE setupBInfoFieldGrammar :: Bool ->PrettyFieldGrammar' SetupBuildInfo #-}