stackage-curator 0.13.1 → 0.13.2

raw patch · 9 files changed

+105/−25 lines, 9 filesdep +syb

Dependencies added: syb

Files

• ChangeLog.md +6/−0
• Stackage/BuildPlan.hs +9/−1
• Stackage/CheckBuildPlan.hs +33/−12
• Stackage/CompleteBuild.hs +4/−1
• Stackage/Curator/UploadDocs.hs +1/−1
• Stackage/InstallBuild.hs +2/−0
• Stackage/PerformBuild.hs +40/−8
• app/stackage.hs +8/−1
• stackage-curator.cabal +2/−1

@@ -1,3 +1,9 @@+## 0.13.2++* --no-rebuild-cabal+* Fix allow-newer by simply stripping all version bounds in .cabal files+* Fix build failure [#13](https://github.com/fpco/stackage-curator/issues/13)+ ## 0.13.1  * Let test suite pass when no package index available [stackage#1165](https://github.com/fpco/stackage/issues/1165)

@@ -134,8 +134,16 @@     name = spdName spd     ppVersion = spdVersion spd     ppGithubPings = applyGithubMapping bc $ spdGithubPings spd-    ppConstraints = bcPackageConstraints bc name+    ppConstraints = onlyRelevantFlags $ bcPackageConstraints bc name     ppUsers = mempty -- must be filled in later++    -- Only include flags that are actually provided by the package. For more+    -- information, see: https://github.com/fpco/stackage-curator/issues/11+    onlyRelevantFlags :: PackageConstraints -> PackageConstraints+    onlyRelevantFlags pc = pc+        { pcFlagOverrides = pcFlagOverrides pc `intersection`+                            spdPackageFlags spd+        }      ccPackageName = name     ccOS = siOS

@@ -29,38 +29,44 @@     allPackages = map (,mempty) (siCorePackages bpSystemInfo) ++                   map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages     errs@(BadBuildPlan errs') =-        execWriter $ mapM_ (checkDeps allPackages) $ mapToList bpPackages+        execWriter $ mapM_ (checkDeps getMaint allPackages) $ mapToList bpPackages     -- Only looking at libraries and executables, benchmarks and tests     -- are allowed to create cycles (e.g. test-framework depends on     -- text, which uses test-framework in its test-suite).     libAndExe (DepInfo cs _) = any (flip elem [CompLibrary,CompExecutable]) cs +    getMaint :: PackageName -> Maybe Maintainer+    getMaint pn = do+        pp <- lookup pn bpPackages+        pcMaintainer $ ppConstraints pp+ -- | For a given package name and plan, check that its dependencies are: -- -- 1. Existent (existing in the provided package map) -- 2. Within version range -- 3. Check for dependency cycles.-checkDeps :: Map PackageName (Version,[PackageName])+checkDeps :: (PackageName -> Maybe Maintainer)+          -> Map PackageName (Version,[PackageName])           -> (PackageName, PackagePlan)           -> Writer BadBuildPlan ()-checkDeps allPackages (user, pb) =+checkDeps getMaint allPackages (user, pb) =     mapM_ go $ mapToList $ sdPackages $ ppDesc pb   where     go (dep, diRange -> range) =         case lookup dep allPackages of-            Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap+            Nothing -> tell $ BadBuildPlan $ singletonMap (dep, getMaint dep, Nothing) errMap             Just (version,deps)                 | version `withinRange` range ->                     occursCheck allPackages                                 (\d v ->                                      tell $ BadBuildPlan $ singletonMap-                                     (d,v)+                                     (d, getMaint dep, v)                                      errMap)                                 dep                                 deps                                 []                 | otherwise -> tell $ BadBuildPlan $ singletonMap-                    (dep, Just version)+                    (dep, getMaint dep, Just version)                     errMap       where         errMap = singletonMap pu range@@ -124,25 +130,40 @@     : map (cons '@') (setToList puGithubPings)  newtype BadBuildPlan =-    BadBuildPlan (Map (PackageName, Maybe Version) (Map PkgUser VersionRange))+    BadBuildPlan (Map (PackageName, Maybe Maintainer, Maybe Version) (Map PkgUser VersionRange))     deriving Typeable instance Exception BadBuildPlan instance Show BadBuildPlan where     show (BadBuildPlan errs) =         unpack $ concatMap go $ mapToList errs       where-        go ((dep, mdepVer), users) = unlines+        go ((dep, mmaint, mdepVer), users) = unlines             $ ""-            : showDepVer dep mdepVer+            : showDepVer dep mmaint mdepVer             : map showUser (mapToList users) -        showDepVer :: PackageName -> Maybe Version -> Text-        showDepVer dep Nothing = display dep ++ " (not present) depended on by:"-        showDepVer dep (Just version) = concat+        showDepVer :: PackageName+                   -> Maybe Maintainer+                   -> Maybe Version+                   -> Text+        showDepVer dep mmaint Nothing = T.concat             [ display dep+            , displayMaint mmaint+            , " (not present) depended on by:"+            ]+        showDepVer dep mmaint (Just version) = concat+            [ display dep             , "-"             , display version+            , displayMaint mmaint             , " is out of bounds for:"+            ]++        displayMaint Nothing = ""+        displayMaint (Just (Maintainer t)) = T.concat+            [ " ("+            , t+            , ")"             ]          showUser :: (PkgUser, VersionRange) -> Text

@@ -33,7 +33,7 @@ import Stackage.BuildPlan import Stackage.CheckBuildPlan import Stackage.PerformBuild-import Stackage.Prelude+import Stackage.Prelude          hiding (threadDelay, getNumCapabilities) import Stackage.ServerBundle import Stackage.UpdateBuildPlan import Stackage.Upload@@ -409,10 +409,12 @@     -> Bool -- ^ enable executable dynamic?     -> Bool -- ^ verbose?     -> Bool -- ^ allow-newer?+    -> Bool -- ^ no rebuild cabal?     -> IO () makeBundle   planFile docmapFile bundleFile target mjobs skipTests skipHaddocks skipHoogle   enableLibraryProfiling enableExecutableDynamic verbose allowNewer+  noRebuildCabal         = do     plan <- decodeFileEither planFile >>= either throwM return     jobs <- maybe getNumCapabilities return mjobs@@ -433,6 +435,7 @@             , pbVerbose = verbose             , pbAllowNewer = allowNewer             , pbBuildHoogle = not skipHoogle+            , pbNoRebuildCabal = noRebuildCabal             }      putStrLn "Performing build"

@@ -11,7 +11,7 @@     ( uploadDocs     , upload     ) where-import           ClassyPrelude.Conduit+import           ClassyPrelude.Conduit         hiding (threadDelay) import qualified Codec.Archive.Tar             as Tar import qualified Codec.Archive.Tar.Entry       as Tar import           Control.Monad.Trans.Resource  (liftResourceT)

@@ -35,6 +35,7 @@     , ifVerbose            :: !Bool     , ifSkipCheck          :: !Bool     , ifBuildHoogle        :: !Bool+    , ifNoRebuildCabal     :: !Bool     } deriving (Show)  -- | Source for build plan.@@ -58,6 +59,7 @@     , pbVerbose            = ifVerbose     , pbAllowNewer         = ifSkipCheck     , pbBuildHoogle        = ifBuildHoogle+    , pbNoRebuildCabal     = ifNoRebuildCabal     }  -- | Install stackage from an existing build plan.

@@ -18,10 +18,14 @@ import           Control.Concurrent.STM.TSem import           Control.Monad.Writer.Strict (execWriter, tell) import qualified Data.ByteString             as S+import           Data.Generics               (mkT, everywhere) import qualified Data.Map                    as Map import           Data.NonNull                (fromNullable) import           Distribution.PackageDescription (buildType, packageDescription, BuildType (Simple),                                                  condTestSuites)+import           Distribution.Package        (Dependency (..))+import           Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription)+import           Distribution.Version        (anyVersion) import           Filesystem                  (canonicalizePath, createTree,                                               getWorkingDirectory,                                               removeTree, rename, removeFile)@@ -78,11 +82,14 @@     , pbEnableExecDyn      :: Bool     , pbVerbose            :: Bool     , pbAllowNewer         :: Bool-    -- ^ Pass --allow-newer to cabal configure+    -- ^ Strip out version bounds in .cabal files     , pbBuildHoogle        :: Bool     -- ^ Should we build Hoogle database?     --     -- May be disabled due to: https://ghc.haskell.org/trac/ghc/ticket/9921+    , pbNoRebuildCabal     :: !Bool+    -- ^ Ignore new Cabal version from the plan and use whatever's in the+    -- database. Useful for testing pre-release GHCs     }  data PackageInfo = PackageInfo@@ -285,7 +292,11 @@   where     libComps = setFromList [CompLibrary, CompExecutable]     testComps = insertSet CompTestSuite libComps-    inner = do++    inner+      | pname == PackageName "Cabal" && pbNoRebuildCabal =+            atomically $ putTMVar (piResult sbPackageInfo) True+      | otherwise = do         let wfd comps =                 waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo                 . withTSem sbSem@@ -324,8 +335,18 @@             , "\n"             ]         hFlush outH-        withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->-            (return () :: IO ())++        -- instead of using withCheckedProcess, we go lower-level so that we+        -- can kill the process in the case of an async exception (via the+        -- timeout call below)+        let cp' = cp outH+        (ClosedStream, UseProvidedHandle, UseProvidedHandle, sph)+            <- streamingProcess cp'+        ec <- waitForStreamingProcess sph `onException` do+            -- Call the process+            let ph = streamingProcessHandleRaw sph+            terminateProcess ph+        unless (ec == ExitSuccess) $ throwIO $ ProcessExitedUnsuccessfully cp' ec       where         cp outH = (proc (unpack cmd) (map unpack args))             { cwd = Just wdir@@ -377,7 +398,6 @@             Just db -> ("-package-db=" ++ pack db) : rest)      configArgs = ($ []) $ execWriter $ do-        when pbAllowNewer $ tell' "--allow-newer"         tell' "--package-db=clear"         tell' "--package-db=global"         forM_ (pbDatabase pb) $ \db -> tell' $ "--package-db=" ++ pack db@@ -423,7 +443,7 @@                             log' $ "Unpacking " ++ namever                             runParent getOutH "stack" ["unpack", namever] -                            gpd <- createSetupHs childDir name+                            gpd <- createSetupHs childDir name pbAllowNewer                             writeIORef gpdRef $ Just gpd                              return gpd@@ -744,10 +764,18 @@ -- Also deletes any Setup.lhs if necessary createSetupHs :: FilePath               -> Text -- ^ package name+              -> Bool -- ^ allow newer?               -> IO GenericPackageDescription-createSetupHs dir name = do+createSetupHs dir name allowNewer = do     bs <- readFile cabalFP-    gpd <- gpdFromLBS cabalFP (fromStrict bs)+    gpd' <- gpdFromLBS cabalFP (fromStrict bs)+    gpd <-+        if allowNewer+            then do+                let gpd = stripVersionBounds gpd'+                writeGenericPackageDescription cabalFP gpd+                return gpd+            else return gpd'     let simple = buildType (packageDescription gpd) == Just Simple     when simple $ do         _ <- tryIO $ removeFile $ fromString setuplhs@@ -757,3 +785,7 @@     cabalFP = dir </> unpack name <.> "cabal"     setuphs = dir </> "Setup.hs"     setuplhs = dir </> "Setup.lhs"++-- | Strip all version bounds from a GenericPackageDescription+stripVersionBounds :: GenericPackageDescription -> GenericPackageDescription+stripVersionBounds = everywhere $ mkT $ \(Dependency name _) -> Dependency name anyVersion

@@ -86,6 +86,7 @@         <*> enableExecutableDynamic         <*> verbose         <*> allowNewer+        <*> noRebuildCabal       installFlags :: Parser InstallFlags@@ -148,7 +149,13 @@             not             (switch                  (long "skip-hoogle" <>-                  help "Skip generating Hoogle input files"))+                  help "Skip generating Hoogle input files")) <*>+        noRebuildCabal++    noRebuildCabal =+        switch+            (long "no-rebuild-cabal" <>+             help "Ignore new Cabal version from the plan and use whatever's in the database. Useful for testing pre-release GHCs")      jobs =         (fmap Just (option

@@ -1,5 +1,5 @@ name:                stackage-curator-version:             0.13.1+version:             0.13.2 synopsis:            Tools for curating Stackage bundles description:         Please see <http://www.stackage.org/package/stackage-curator> for a description and documentation. homepage:            https://github.com/fpco/stackage@@ -91,6 +91,7 @@                      , lucid                      , binary                      , binary-tagged+                     , syb  executable stackage-curator   default-language:    Haskell2010