Merge pull request #3304 from commercialhaskell/unsupported-cabal-2-dot-0

Support for Stackage Nightly based on GHC 8.2.1

Author: snoyberg

.travis.yml

@@ -73,10 +73,12 @@ before_install:
 
 install:
  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+ # Note: we build store by itself below due to high memory usage
  - case "$BUILD" in
      style)
        stack --system-ghc --no-terminal install hlint;;
      stack)
+       stack --no-terminal build store;
        stack --no-terminal test --only-dependencies;;
      cabal)
        cabal --version;

ChangeLog.md

@@ -1,6 +1,18 @@
 # Changelog
 
 
+## 1.5.1
+
+Bug fixes:
+
+* Stack eagerly tries to parse all cabal files related to a
+  snapshot. Starting with Stackage Nightly 2017-07-31, snapshots are
+  using GHC 8.2.1, and the `ghc.cabal` file implicitly referenced uses
+  the (not yet supported) Cabal 2.0 file format. Future releases of
+  Stack will both be less eager about cabal file parsing and support
+  Cabal 2.0. This patch simply bypasses the error for invalid parsing.
+
+
 ## 1.5.0
 
 Behavior changes:

src/Stack/Build.hs

@@ -323,7 +323,10 @@ withLoadPackage inner = do
             -- Intentionally ignore warnings, as it's not really
             -- appropriate to print a bunch of warnings out while
             -- resolving the package index.
-            (_warnings,pkg) <- readPackageBS (depPackageConfig econfig flags ghcOptions) bs
+            (_warnings,pkg) <- readPackageBS
+              (depPackageConfig econfig flags ghcOptions)
+              (PackageIdentifier name version)
+              bs
             return pkg
   where
     -- | Package config to be used for dependencies

src/Stack/BuildPlan.hs

@@ -299,9 +299,14 @@ addDeps allowMissing compilerVersion toCalc = do
                             Nothing -> (Map.empty, [], Nothing)
                             Just (_, x, y, z) -> (x, y, z)
                  in (indexName $ rpIndex rp, [(rp, (cache, ghcOptions, sha))])
-    res <- forM (Map.toList byIndex) $ \(indexName', pkgs) -> withCabalFiles indexName' pkgs
-        $ \ident (flags, ghcOptions, mgitSha) cabalBS -> do
-            (_warnings,gpd) <- readPackageUnresolvedBS Nothing cabalBS
+    res <- forM (Map.toList byIndex) $ \(indexName', pkgs) ->
+      fmap Map.unions $ withCabalFiles indexName' pkgs
+        $ \ident (flags, ghcOptions, mgitSha) cabalBS ->
+        case readPackageUnresolvedBS (Right ident) cabalBS of
+          Left e
+            | allowedToSkip ident -> return Map.empty
+            | otherwise -> throwM e
+          Right (_warnings, gpd) -> do
             let packageConfig = PackageConfig
                     { packageConfigEnableTests = False
                     , packageConfigEnableBenchmarks = False
@@ -314,7 +319,7 @@ addDeps allowMissing compilerVersion toCalc = do
                 pd = resolvePackageDescription packageConfig gpd
                 exes = Set.fromList $ map (ExeName . T.pack . exeName) $ executables pd
                 notMe = Set.filter (/= name) . Map.keysSet
-            return (name, MiniPackageInfo
+            return $ Map.singleton name MiniPackageInfo
                 { mpiVersion = packageIdentifierVersion ident
                 , mpiFlags = flags
                 , mpiGhcOptions = ghcOptions
@@ -326,13 +331,31 @@ addDeps allowMissing compilerVersion toCalc = do
                     (buildable . libBuildInfo)
                     (library pd)
                 , mpiGitSHA1 = mgitSha
-                })
-    return (Map.fromList $ concat res, missingIdents)
+                }
+    return (Map.unions res, missingIdents)
   where
     shaMap = Map.fromList
         $ map (\(n, (v, _f, _ghcOptions, gitsha)) -> (PackageIdentifier n v, gitsha))
         $ Map.toList toCalc
 
+    -- Michael Snoyman, 2017-07-31:
+    --
+    -- This is a stop-gap measure to address a specific concern around
+    -- the GHC 8.2.1 release. The current Stack version (1.5.0) will
+    -- eagerly parse all cabal files mentioned in a snapshot,
+    -- including global packages. Additionally, for the first time
+    -- (AFAICT), GHC 8.2.1 is providing a package on Hackage with a
+    -- ghc.cabal file, which requires the (not yet supported) Cabal
+    -- 2.0 file format. To work around this, we're adding a special
+    -- dispensation to ignore parse failures for this package.
+    --
+    -- Master already does better by simply ignoring global
+    -- information and looking things up in the database. We may want
+    -- to consider going a step further and simply ignoring _all_
+    -- parse failures, or turning them into warnings, though I haven't
+    -- considered the repercussions of that.
+    allowedToSkip (PackageIdentifier name _) = name == $(mkPackageName "ghc")
+
 -- | Resolve all packages necessary to install for the needed packages.
 getDeps :: MiniBuildPlan
         -> (PackageName -> Bool) -- ^ is it shadowed by a local package?

src/Stack/Package.hs

@@ -110,17 +110,17 @@ readPackageUnresolved :: (MonadIO m, MonadThrow m)
                       -> m ([PWarning],GenericPackageDescription)
 readPackageUnresolved cabalfp =
   liftIO (BS.readFile (FL.toFilePath cabalfp))
-  >>= readPackageUnresolvedBS (Just cabalfp)
+  >>= readPackageUnresolvedBS (Left cabalfp)
 
 -- | Read the raw, unresolved package information from a ByteString.
 readPackageUnresolvedBS :: (MonadThrow m)
-                        => Maybe (Path Abs File)
+                        => Either (Path Abs File) PackageIdentifier
                         -> BS.ByteString
                         -> m ([PWarning],GenericPackageDescription)
-readPackageUnresolvedBS mcabalfp bs =
+readPackageUnresolvedBS source bs =
     case parsePackageDescription chars of
        ParseFailed per ->
-         throwM (PackageInvalidCabalFile mcabalfp per)
+         throwM (PackageInvalidCabalFile source per)
        ParseOk warnings gpkg -> return (warnings,gpkg)
   where
     chars = T.unpack (dropBOM (decodeUtf8With lenientDecode bs))
@@ -140,10 +140,11 @@ readPackage packageConfig cabalfp =
 -- | Reads and exposes the package information, from a ByteString
 readPackageBS :: (MonadThrow m)
               => PackageConfig
+              -> PackageIdentifier
               -> BS.ByteString
               -> m ([PWarning],Package)
-readPackageBS packageConfig bs =
-  do (warnings,gpkg) <- readPackageUnresolvedBS Nothing bs
+readPackageBS packageConfig ident bs =
+  do (warnings,gpkg) <- readPackageUnresolvedBS (Right ident) bs
      return (warnings,resolvePackage packageConfig gpkg)
 
 -- | Get 'GenericPackageDescription' and 'PackageDescription' reading info

src/Stack/SDist.hs

@@ -177,8 +177,8 @@ getCabalLbs :: (StackM env m, HasEnvConfig env)
             -> FilePath
             -> m (PackageIdentifier, L.ByteString)
 getCabalLbs pvpBounds mrev fp = do
-    bs <- liftIO $ S.readFile fp
-    (_warnings, gpd) <- readPackageUnresolvedBS Nothing bs
+    path <- liftIO $ resolveFile' fp
+    (_warnings, gpd) <- readPackageUnresolved path
     (_, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
     menv <- getMinimalEnvOverride
     (installedMap, _, _, _) <- getInstalled menv GetInstalledOpts

src/Stack/Types/Package.hs

@@ -48,20 +48,25 @@ import           Stack.Types.Version
 
 -- | All exceptions thrown by the library.
 data PackageException
-  = PackageInvalidCabalFile (Maybe (Path Abs File)) PError
+  = PackageInvalidCabalFile (Either (Path Abs File) PackageIdentifier) PError
   | PackageNoCabalFileFound (Path Abs Dir)
   | PackageMultipleCabalFilesFound (Path Abs Dir) [Path Abs File]
   | MismatchedCabalName (Path Abs File) PackageName
   deriving Typeable
 instance Exception PackageException
 instance Show PackageException where
-    show (PackageInvalidCabalFile mfile err) =
-        "Unable to parse cabal file" ++
-        (case mfile of
-            Nothing -> ""
-            Just file -> ' ' : toFilePath file) ++
-        ": " ++
-        show err
+    show (PackageInvalidCabalFile (Left file) err) = concat
+        [ "Unable to parse cabal file "
+        , toFilePath file
+        , ": "
+        , show err
+        ]
+    show (PackageInvalidCabalFile (Right ident) err) = concat
+        [ "Unable to parse cabal file for "
+        , packageIdentifierString ident
+        , ": "
+        , show err
+        ]
     show (PackageNoCabalFileFound dir) = concat
         [ "Stack looks for packages in the directories configured in"
         , " the 'packages' variable defined in your stack.yaml\n"