Merge pull request #6586 from phadej/more-checks-in-version-range-parser

More checks in version range parser

Cabal/Cabal.cabal

@@ -246,6 +246,7 @@ extra-source-files:
   tests/ParserTests/warnings/nbsp.cabal
   tests/ParserTests/warnings/newsyntax.cabal
   tests/ParserTests/warnings/oldsyntax.cabal
+  tests/ParserTests/warnings/operator.cabal
   tests/ParserTests/warnings/subsection.cabal
   tests/ParserTests/warnings/tab.cabal
   tests/ParserTests/warnings/trailingfield.cabal
@@ -253,6 +254,7 @@ extra-source-files:
   tests/ParserTests/warnings/unknownsection.cabal
   tests/ParserTests/warnings/utf8.cabal
   tests/ParserTests/warnings/versiontag.cabal
+  tests/ParserTests/warnings/wildcard.cabal
   tests/cbits/rpmvercmp.c
   tests/hackage/check.sh
   tests/hackage/download.sh
@@ -760,6 +762,7 @@ test-suite hackage-tests
   build-depends:
     base-compat          >=0.11.0   && <0.12,
     base-orphans         >=0.6      && <0.9,
+    clock                >=0.8      && <0.9,
     optparse-applicative >=0.13.2.0 && <0.16,
     stm                  >=2.4.5.0  && <2.6,
     tar                  >=0.5.0.3  && <0.6

Cabal/Distribution/PackageDescription/Check.hs

@@ -1253,40 +1253,6 @@ checkCabalVersion pkg =
         ++ "the 'other-extensions' field lists extensions that are used in "
         ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."
 
-    -- check use of "foo (>= 1.0 && < 1.4) || >=1.8 " version-range syntax
-  , checkVersion [1,8] (not (null versionRangeExpressions)) $
-      PackageDistInexcusable $
-           "The package uses full version-range expressions "
-        ++ "in a 'build-depends' field: "
-        ++ commaSep (map displayRawDependency versionRangeExpressions)
-        ++ ". To use this new syntax the package needs to specify at least "
-        ++ "'cabal-version: >= 1.8'. Alternatively, if broader compatibility "
-        ++ "is important, then convert to conjunctive normal form, and use "
-        ++ "multiple 'build-depends:' lines, one conjunct per line."
-
-    -- check use of "build-depends: foo == 1.*" syntax
-  , checkVersion [1,6] (not (null depsUsingWildcardSyntax)) $
-      PackageDistInexcusable $
-           "The package uses wildcard syntax in the 'build-depends' field: "
-        ++ commaSep (map prettyShow depsUsingWildcardSyntax)
-        ++ ". To use this new syntax the package need to specify at least "
-        ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
-        ++ "is important then use: " ++ commaSep
-           [ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
-           | Dependency name versionRange _ <- depsUsingWildcardSyntax ]
-
-    -- check use of "build-depends: foo ^>= 1.2.3" syntax
-  , checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $
-      PackageDistInexcusable $
-           "The package uses major bounded version syntax in the "
-        ++ "'build-depends' field: "
-        ++ commaSep (map prettyShow depsUsingMajorBoundSyntax)
-        ++ ". To use this new syntax the package need to specify at least "
-        ++ "'cabal-version: 2.0'. Alternatively, if broader compatibility "
-        ++ "is important then use: " ++ commaSep
-           [ prettyShow (Dependency name (eliminateMajorBoundSyntax versionRange) Set.empty)
-           | Dependency name versionRange _ <- depsUsingMajorBoundSyntax ]
-
   , checkVersion [3,0] (any (not . null)
                         (concatMap buildInfoField
                          [ asmSources
@@ -1312,26 +1278,6 @@ checkCabalVersion pkg =
            "The use of 'virtual-modules' requires the package "
         ++ " to specify at least 'cabal-version: >= 2.1'."
 
-    -- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax
-  , checkVersion [1,8] (not (null testedWithVersionRangeExpressions)) $
-      PackageDistInexcusable $
-           "The package uses full version-range expressions "
-        ++ "in a 'tested-with' field: "
-        ++ commaSep (map displayRawDependency testedWithVersionRangeExpressions)
-        ++ ". To use this new syntax the package needs to specify at least "
-        ++ "'cabal-version: >= 1.8'."
-
-    -- check use of "tested-with: GHC == 6.12.*" syntax
-  , checkVersion [1,6] (not (null testedWithUsingWildcardSyntax)) $
-      PackageDistInexcusable $
-           "The package uses wildcard syntax in the 'tested-with' field: "
-        ++ commaSep (map prettyShow testedWithUsingWildcardSyntax)
-        ++ ". To use this new syntax the package need to specify at least "
-        ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
-        ++ "is important then use: " ++ commaSep
-           [ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
-           | Dependency name versionRange _ <- testedWithUsingWildcardSyntax ]
-
     -- check use of "source-repository" section
   , checkVersion [1,6] (not (null (sourceRepos pkg))) $
       PackageDistInexcusable $
@@ -1403,15 +1349,6 @@ checkCabalVersion pkg =
 
     buildInfoField field         = map field (allBuildInfo pkg)
 
-    versionRangeExpressions =
-        [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
-              , usesNewVersionRangeSyntax vr ]
-
-    testedWithVersionRangeExpressions =
-        [ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty
-        | (compiler, vr) <- testedWith pkg
-        , usesNewVersionRangeSyntax vr ]
-
     simpleSpecVersionRangeSyntax =
         either (const True) (cataVersionRange alg) (specVersionRaw pkg)
       where
@@ -1422,63 +1359,8 @@ checkCabalVersion pkg =
     simpleSpecVersionSyntax =
       either (const True) (const False) (specVersionRaw pkg)
 
-    usesNewVersionRangeSyntax :: VersionRange -> Bool
-    usesNewVersionRangeSyntax
-        = (> 2) -- uses the new syntax if depth is more than 2
-        . cataVersionRange alg
-      where
-        alg (UnionVersionRangesF a b) = a + b
-        alg (IntersectVersionRangesF a b) = a + b
-        alg (VersionRangeParensF _) = 3
-        alg _ = 1 :: Int
-
-    depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
-                                    , usesWildcardSyntax vr ]
-
-    depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
-                                      , usesMajorBoundSyntax vr ]
-
     usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)
 
-    testedWithUsingWildcardSyntax =
-      [ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty
-      | (compiler, vr) <- testedWith pkg
-      , usesWildcardSyntax vr ]
-
-    usesWildcardSyntax :: VersionRange -> Bool
-    usesWildcardSyntax = cataVersionRange alg
-      where
-        alg (WildcardVersionF _)          = True
-        alg (UnionVersionRangesF a b)     = a || b
-        alg (IntersectVersionRangesF a b) = a || b
-        alg (VersionRangeParensF a)       = a
-        alg _                             = False
-
-    -- NB: this eliminates both, WildcardVersion and MajorBoundVersion
-    -- because when WildcardVersion is not support, neither is MajorBoundVersion
-    eliminateWildcardSyntax = hyloVersionRange embed projectVersionRange
-      where
-        embed (WildcardVersionF v) = intersectVersionRanges
-            (orLaterVersion v) (earlierVersion (wildcardUpperBound v))
-        embed (MajorBoundVersionF v) = intersectVersionRanges
-            (orLaterVersion v) (earlierVersion (majorUpperBound v))
-        embed vr = embedVersionRange vr
-
-    usesMajorBoundSyntax :: VersionRange -> Bool
-    usesMajorBoundSyntax = cataVersionRange alg
-      where
-        alg (MajorBoundVersionF _)        = True
-        alg (UnionVersionRangesF a b)     = a || b
-        alg (IntersectVersionRangesF a b) = a || b
-        alg (VersionRangeParensF a)       = a
-        alg _                             = False
-
-    eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange
-      where
-        embed (MajorBoundVersionF v) = intersectVersionRanges
-            (orLaterVersion v) (earlierVersion (majorUpperBound v))
-        embed vr = embedVersionRange vr
-
     mentionedExtensions = [ ext | bi <- allBuildInfo pkg
                                 , ext <- allExtensions bi ]
     mentionedExtensionsThatNeedCabal12 =
@@ -1529,11 +1411,6 @@ checkCabalVersion pkg =
 
     allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)
 
-displayRawDependency :: Dependency -> String
-displayRawDependency (Dependency pkg vr _sublibs) =
-  prettyShow pkg ++ " " ++ prettyShow vr
-
-
 -- ------------------------------------------------------------
 -- * Checks on the GenericPackageDescription
 -- ------------------------------------------------------------

Cabal/Distribution/Parsec.hs

@@ -9,9 +9,12 @@ module Distribution.Parsec (
     runParsecParser,
     runParsecParser',
     simpleParsec,
+    simpleParsec',
+    simpleParsecW',
     lexemeParsec,
     eitherParsec,
     explicitEitherParsec,
+    explicitEitherParsec',
     -- * CabalParsing and and diagnostics
     CabalParsing (..),
     -- ** Warnings
@@ -171,6 +174,25 @@ simpleParsec
     . runParsecParser lexemeParsec "<simpleParsec>"
     . fieldLineStreamFromString
 
+-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
+--
+-- @since 3.4.0.0
+simpleParsec' :: Parsec a => CabalSpecVersion -> String -> Maybe a
+simpleParsec' spec
+    = either (const Nothing) Just
+    . runParsecParser' spec lexemeParsec "<simpleParsec>"
+    . fieldLineStreamFromString
+
+-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
+-- Fail if there are any warnings.
+--
+-- @since 3.4.0.0
+simpleParsecW' :: Parsec a => CabalSpecVersion -> String -> Maybe a
+simpleParsecW' spec
+    = either (const Nothing) (\(x, ws) -> if null ws then Just x else Nothing)
+    . runParsecParser' spec ((,) <$> lexemeParsec <*> liftParsec Parsec.getState) "<simpleParsec>"
+    . fieldLineStreamFromString
+
 -- | Parse a 'String' with 'lexemeParsec'.
 eitherParsec :: Parsec a => String -> Either String a
 eitherParsec = explicitEitherParsec parsec
@@ -182,6 +204,17 @@ explicitEitherParsec parser
     . runParsecParser (parser <* P.spaces) "<eitherParsec>"
     . fieldLineStreamFromString
 
+-- | Parse a 'String' with given 'ParsecParser' and 'CabalSpecVersion'. Trailing whitespace is accepted.
+-- See 'explicitEitherParsec'.
+--
+-- @since 3.4.0.0
+--
+explicitEitherParsec' :: CabalSpecVersion -> ParsecParser a -> String -> Either String a
+explicitEitherParsec' spec parser
+    = either (Left . show) Right
+    . runParsecParser' spec (parser <* P.spaces) "<eitherParsec>"
+    . fieldLineStreamFromString
+
 -- | Run 'ParsecParser' with 'cabalSpecLatest'.
 runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a
 runParsecParser = runParsecParser' cabalSpecLatest

Cabal/Distribution/Parsec/Warning.hs

@@ -35,6 +35,9 @@ data PWarnType
     | PWTDoubleDash            -- ^ Double dash token, most likely it's a mistake - it's not a comment
     | PWTMultipleSingularField -- ^ e.g. name or version should be specified only once.
     | PWTBuildTypeDefault      -- ^ Workaround for derive-package having build-type: Default. See <https://github.com/haskell/cabal/issues/5020>.
+
+    | PWTVersionOperator       -- ^ Version operators used (without cabal-version: 1.8)
+    | PWTVersionWildcard       -- ^ Version wildcard used (without cabal-version: 1.6)
     deriving (Eq, Ord, Show, Enum, Bounded, Generic)
 
 instance Binary PWarnType

Cabal/Distribution/Types/PkgconfigVersionRange.hs

@@ -69,7 +69,7 @@ instance Parsec PkgconfigVersionRange where
         csv <- askCabalSpecVersion
         if csv >= CabalSpecV3_0
         then pkgconfigParser
-        else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral
+        else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral csv
 
 -- "modern" parser of @pkg-config@ package versions.
 pkgconfigParser :: CabalParsing m => m PkgconfigVersionRange

Cabal/Distribution/Types/VersionRange/Internal.hs

@@ -262,8 +262,40 @@ instance Pretty VersionRange where
         punct p p' | p < p'    = Disp.parens
                    | otherwise = id
 
+-- | 
+--
+-- >>> simpleParsec "^>= 3.4" :: Maybe VersionRange
+-- Just (MajorBoundVersion (mkVersion [3,4]))
+--
+-- Small history:
+--
+-- Set operations are introduced in 3.0
+--
+-- >>> map (`simpleParsec'` "^>= { 1.2 , 1.3 }") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe VersionRange]
+-- [Nothing,Just (UnionVersionRanges (MajorBoundVersion (mkVersion [1,2])) (MajorBoundVersion (mkVersion [1,3])))]
+--
+-- @^>=@ is introduced in 2.0
+--
+-- >>> map (`simpleParsec'` "^>=1.2") [CabalSpecV1_24, CabalSpecV2_0] :: [Maybe VersionRange]
+-- [Nothing,Just (MajorBoundVersion (mkVersion [1,2]))]
+--
+-- @-none@ is introduced in 1.22
+--
+-- >>> map (`simpleParsec'` "-none") [CabalSpecV1_20, CabalSpecV1_22] :: [Maybe VersionRange]
+-- [Nothing,Just (IntersectVersionRanges (LaterVersion (mkVersion [1])) (EarlierVersion (mkVersion [1])))]
+--
+-- Operators are introduced in 1.8. Issues only a warning.
+--
+-- >>> map (`simpleParsecW'` "== 1 || ==2") [CabalSpecV1_6, CabalSpecV1_8] :: [Maybe VersionRange]
+-- [Nothing,Just (UnionVersionRanges (ThisVersion (mkVersion [1])) (ThisVersion (mkVersion [2])))]
+--
+-- Wild-version ranges are introduced in 1.6. Issues only a warning.
+--
+-- >>> map (`simpleParsecW'` "== 1.2.*") [CabalSpecV1_4, CabalSpecV1_6] :: [Maybe VersionRange]
+-- [Nothing,Just (WildcardVersion (mkVersion [1,2]))]
+--
 instance Parsec VersionRange where
-    parsec = versionRangeParser versionDigitParser
+    parsec = askCabalSpecVersion >>= versionRangeParser versionDigitParser
 
 instance Described VersionRange where
     describe _ = RERec "version-range" $ REUnion
@@ -301,13 +333,14 @@ instance Described VersionRange where
 --   versions, 'PkgConfigVersionRange'.
 --
 -- @since 3.0
-versionRangeParser :: forall m. CabalParsing m => m Int -> m VersionRange
-versionRangeParser digitParser = expr
+versionRangeParser :: forall m. CabalParsing m => m Int -> CabalSpecVersion -> m VersionRange
+versionRangeParser digitParser csv = expr
       where
         expr   = do P.spaces
                     t <- term
                     P.spaces
                     (do _  <- P.string "||"
+                        checkOp
                         P.spaces
                         e <- expr
                         return (unionVersionRanges t e)
@@ -316,6 +349,7 @@ versionRangeParser digitParser = expr
         term   = do f <- factor
                     P.spaces
                     (do _  <- P.string "&&"
+                        checkOp
                         P.spaces
                         t <- term
                         return (intersectVersionRanges f t)
@@ -331,6 +365,7 @@ versionRangeParser digitParser = expr
                 "==" -> do
                     P.spaces
                     (do (wild, v) <- verOrWild
+                        checkWild wild
                         pure $ (if wild then withinVersion else thisVersion) v
                      <|>
                      (verSet' thisVersion =<< verSet))
@@ -356,6 +391,27 @@ versionRangeParser digitParser = expr
                         ">"   -> pure $ laterVersion v
                         _ -> fail $ "Unknown version operator " ++ show op
 
+        -- Cannot be warning
+        -- On 2020-03-16 there was around 27400 files on Hackage failing to parse due this
+        -- For example https://hackage.haskell.org/package/haxr-3000.0.0/haxr.cabal
+        --
+        checkOp = when (csv < CabalSpecV1_8) $
+            parsecWarning PWTVersionOperator $ unwords
+                [ "version operators used."
+                , "To use version operators the package needs to specify at least 'cabal-version: >= 1.8'."
+                ]
+
+        -- Cannot be warning
+        -- On 2020-03-16 there was 46 files on Hackage failing to parse due this
+        -- For example https://hackage.haskell.org/package/derive-0.1.2/derive.cabal
+        --
+        checkWild False = pure ()
+        checkWild True  = when (csv < CabalSpecV1_6) $
+            parsecWarning PWTVersionWildcard $ unwords
+                [ "Wildcard syntax used."
+                , "To use version wildcards the package needs to specify at least 'cabal-version: >= 1.6'."
+                ]
+
         -- https://gitlab.haskell.org/ghc/ghc/issues/17752
         isOpChar '<' = True
         isOpChar '=' = True
@@ -364,13 +420,8 @@ versionRangeParser digitParser = expr
         isOpChar '-' = True
         isOpChar _   = False
 
-        -- Note: There are other features:
-        -- && and || since 1.8
-        -- x.y.* (wildcard) since 1.6
-
         -- -none version range is available since 1.22
-        noVersion' = do
-            csv <- askCabalSpecVersion
+        noVersion' =
             if csv >= CabalSpecV1_22
             then pure noVersion
             else fail $ unwords
@@ -381,8 +432,7 @@ versionRangeParser digitParser = expr
                 ]
 
         -- ^>= is available since 2.0
-        majorBoundVersion' v = do
-            csv <- askCabalSpecVersion
+        majorBoundVersion' v =
             if csv >= CabalSpecV2_0
             then pure $ majorBoundVersion v
             else fail $ unwords
@@ -398,8 +448,7 @@ versionRangeParser digitParser = expr
             embed vr = embedVersionRange vr
 
         -- version set notation (e.g. "== { 0.0.1.0, 0.0.2.0, 0.1.0.0 }")
-        verSet' op vs = do
-            csv <- askCabalSpecVersion
+        verSet' op vs =
             if csv >= CabalSpecV3_0
             then pure $ foldr1 unionVersionRanges (fmap op vs)
             else fail $ unwords

Cabal/tests/HackageTests.hs

@@ -6,25 +6,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 #endif
 
--- | The following RTS parameters seem to speed up running the test
---
--- @
--- +RTS -s -qg -I0 -A64M -N2 -RTS
--- @
---
--- * @-qg@ No parallel GC (you can try @-qn2@ on GHC-8.2+)
--- * @-I0@ No idle GC (shouldn't matter, but to be sure)
--- * @-A64M@ Set allocation area to about the maximum residence size tests have
--- * @-N4@ More capabilities (depends on your machine)
---
--- @-N1@ vs. @-N4@ gives
---
--- * @1m 48s@ to @1m 00s@ speedup for full Hackage @parsec@ test, and
---
--- * @6m 16s@ to @3m 30s@ speedup for full Hackage @roundtrip@ test.
---
--- i.e. not linear, but substantial improvement anyway.
---
 module Main where
 
 import Distribution.Compat.Semigroup
@@ -32,23 +13,18 @@ import Prelude ()
 import Prelude.Compat
 
 import Control.Applicative                         (many, (<**>), (<|>))
-import Control.Concurrent
-       (ThreadId, forkIO, getNumCapabilities, killThread, myThreadId, throwTo)
-import Control.Concurrent.STM
 import Control.DeepSeq                             (NFData (..), force)
-import Control.Exception
-       (AsyncException (ThreadKilled), SomeException, bracket, catch, evaluate, fromException,
-       mask, throwIO)
-import Control.Monad                               (forever, join, replicateM, unless, when)
-import Data.Foldable                               (for_, traverse_)
-import Data.IORef                                  (modifyIORef', newIORef, readIORef)
+import Control.Exception                           (evaluate)
+import Control.Monad                               (join, unless, when)
+import Data.Foldable                               (traverse_)
 import Data.List                                   (isPrefixOf, isSuffixOf)
 import Data.Maybe                                  (mapMaybe)
 import Data.Monoid                                 (Sum (..))
 import Distribution.PackageDescription.Check       (PackageCheck (..), checkPackage)
 import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
 import Distribution.PackageDescription.Quirks      (patchQuirks)
-import Distribution.Simple.Utils                   (fromUTF8BS, toUTF8BS, fromUTF8BS)
+import Distribution.Simple.Utils                   (fromUTF8BS, toUTF8BS)
+import Numeric                                     (showFFloat)
 import System.Directory                            (getAppUserDataDirectory)
 import System.Environment                          (lookupEnv)
 import System.Exit                                 (exitFailure)
@@ -64,11 +40,12 @@ import qualified Distribution.Fields.Parser             as Parsec
 import qualified Distribution.Fields.Pretty             as PP
 import qualified Distribution.PackageDescription.Parsec as Parsec
 import qualified Distribution.Parsec                    as Parsec
+import qualified Options.Applicative                    as O
+import qualified System.Clock                           as Clock
 
 import           Distribution.Compat.Lens
 import qualified Distribution.Types.GenericPackageDescription.Lens as L
 import qualified Distribution.Types.PackageDescription.Lens        as L
-import qualified Options.Applicative                               as O
 
 -- import Distribution.Types.BuildInfo                (BuildInfo (cppOptions))
 -- import qualified Distribution.Types.BuildInfo.Lens                 as L
@@ -102,7 +79,7 @@ parseIndex predicate action = do
         case mx of
             Just x  -> return x
             Nothing -> return (cabalDir </> "config")
-    
+
 
 parseIndex'
     :: (Monoid a, NFData a)
@@ -152,15 +129,37 @@ readFieldTest fpath bs = case Parsec.readFields bs' of
 -- Parsec test: whether we can parse everything
 -------------------------------------------------------------------------------
 
-parseParsecTest :: FilePath -> B.ByteString -> IO (Sum Int)
-parseParsecTest fpath bs = do
-    let (_warnings, parsec) = Parsec.runParseResult $
+parseParsecTest :: Bool -> FilePath -> B.ByteString -> IO ThreeInt
+parseParsecTest keepGoing fpath bs = do
+    let (warnings, parsec) = Parsec.runParseResult $
                               Parsec.parseGenericPackageDescription bs
+
+    let w | null warnings = 0
+          | otherwise     = 1
+
     case parsec of
-        Right _ -> return (Sum 1)
-        Left (_, errors) -> do
-            traverse_ (putStrLn . Parsec.showPError fpath) errors
-            exitFailure
+        Right _                       -> return (ThreeInt 1 w 0)
+        Left (_, errors) | keepGoing  -> return (ThreeInt 1 w 1)
+                          | otherwise -> do
+                traverse_ (putStrLn . Parsec.showPError fpath) errors
+                exitFailure
+
+-------------------------------------------------------------------------------
+-- ThreeInt
+-------------------------------------------------------------------------------
+
+data ThreeInt = ThreeInt !Int !Int !Int
+  deriving (Eq, Show)
+
+instance Semigroup ThreeInt where
+    ThreeInt x y z <> ThreeInt u v w = ThreeInt (x + u) (y + v) (z + w)
+
+instance Monoid ThreeInt where
+    mempty  = ThreeInt 0 0 0
+    mappend = (<>)
+
+instance NFData ThreeInt where
+    rnf (ThreeInt _ _ _) = ()
 
 -------------------------------------------------------------------------------
 -- Check test
@@ -178,9 +177,9 @@ parseCheckTest fpath bs = do
 
             -- Look into invalid cpp options
             -- _ <- L.traverseBuildInfos checkCppFlags gpd
-            
+
             -- one for file, many checks
-            return (CheckResult 1 (w warnings) 0 0 0 0 0 <> foldMap toCheckResult checks)
+            return (CheckResult 1 (w warnings) 0 0 0 0 0 0 <> foldMap toCheckResult checks)
         Left (_, errors) -> do
             traverse_ (putStrLn . Parsec.showPError fpath) errors
             exitFailure
@@ -190,28 +189,28 @@ parseCheckTest fpath bs = do
 --     for_ (cppOptions bi) $ \opt ->
 --         unless (any (`isPrefixOf` opt) ["-D", "-U", "-I"]) $
 --             putStrLn opt
--- 
+--
 --     return bi
 
-data CheckResult = CheckResult !Int !Int !Int !Int !Int !Int !Int
+data CheckResult = CheckResult !Int !Int !Int !Int !Int !Int !Int !Int
 
 instance NFData CheckResult where
     rnf !_ = ()
 
 instance Semigroup CheckResult where
-    CheckResult n w a b c d e <> CheckResult n' w' a' b' c' d' e' =
-        CheckResult (n + n') (w + w') (a + a') (b + b') (c + c') (d + d') (e + e')
+    CheckResult n w a b c d e f <> CheckResult n' w' a' b' c' d' e' f' =
+        CheckResult (n + n') (w + w') (a + a') (b + b') (c + c') (d + d') (e + e') (f + f')
 
 instance Monoid CheckResult where
-    mempty = CheckResult 0 0 0 0 0 0 0
+    mempty = CheckResult 0 0 0 0 0 0 0 0
     mappend = (<>)
 
 toCheckResult :: PackageCheck -> CheckResult
-toCheckResult PackageBuildImpossible {}    = CheckResult 0 0 1 0 0 0 0
-toCheckResult PackageBuildWarning {}       = CheckResult 0 0 0 1 0 0 0
-toCheckResult PackageDistSuspicious {}     = CheckResult 0 0 0 0 1 0 0
-toCheckResult PackageDistSuspiciousWarn {} = CheckResult 0 0 0 0 0 1 0
-toCheckResult PackageDistInexcusable {}    = CheckResult 0 0 0 0 0 0 1
+toCheckResult PackageBuildImpossible {}    = CheckResult 0 0 1 1 0 0 0 0
+toCheckResult PackageBuildWarning {}       = CheckResult 0 0 1 0 1 0 0 0
+toCheckResult PackageDistSuspicious {}     = CheckResult 0 0 1 0 0 1 0 0
+toCheckResult PackageDistSuspiciousWarn {} = CheckResult 0 0 1 0 0 0 1 0
+toCheckResult PackageDistInexcusable {}    = CheckResult 0 0 1 0 0 0 0 1
 
 -------------------------------------------------------------------------------
 -- Roundtrip test
@@ -313,15 +312,27 @@ main = join (O.execParser opts)
 
     defaultA = do
         putStrLn "Default action: parsec k"
-        parsecA (mkPredicate ["k"])
+        parsecA (mkPredicate ["k"]) False
 
     readFieldsP = readFieldsA <$> prefixP
     readFieldsA pfx = parseIndex pfx readFieldTest
 
-    parsecP = parsecA <$> prefixP
-    parsecA pfx = do
-        Sum n <- parseIndex pfx parseParsecTest
+    parsecP = parsecA <$> prefixP <*> keepGoingP
+    keepGoingP =
+        O.flag' True  (O.long "keep-going") <|>
+        O.flag' False (O.long "no-keep-going") <|>
+        pure False
+
+    parsecA pfx keepGoing = do
+        begin <- Clock.getTime Clock.Monotonic
+        ThreeInt n w f <- parseIndex pfx (parseParsecTest keepGoing)
+        end <- Clock.getTime Clock.Monotonic
+        let diff = Clock.toNanoSecs $ Clock.diffTimeSpec end begin
+
         putStrLn $ show n ++ " files processed"
+        putStrLn $ show w ++ " files contained warnings"
+        putStrLn $ show f ++ " files failed to parse"
+        putStrLn $ showFFloat (Just 6) (fromInteger diff / 1e9 :: Double) " seconds elapsed"
 
     roundtripP = roundtripA <$> prefixP <*> testFieldsP
     roundtripA pfx testFieldsTransform = do
@@ -330,9 +341,10 @@ main = join (O.execParser opts)
 
     checkP = checkA <$> prefixP
     checkA pfx = do
-        CheckResult n w a b c d e <- parseIndex pfx parseCheckTest
+        CheckResult n w x a b c d e <- parseIndex pfx parseCheckTest
         putStrLn $ show n ++ " files processed"
-        putStrLn $ show w ++ " have lexer/parser warnings"