stackage-curator 0.13.0 → 0.13.1
raw patch · 5 files changed
+101/−29 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- Stackage/CheckBuildPlan.hs +1/−1
- Stackage/PerformBuild.hs +82/−25
- stackage-curator.cabal +2/−1
- test/Stackage/PackageIndexSpec.hs +12/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.13.1++* Let test suite pass when no package index available [stackage#1165](https://github.com/fpco/stackage/issues/1165)+ ## 0.13.0 * build-tool-overrides
Stackage/CheckBuildPlan.hs view
@@ -142,7 +142,7 @@ [ display dep , "-" , display version- , " depended on by:"+ , " is out of bounds for:" ] showUser :: (PkgUser, VersionRange) -> Text
Stackage/PerformBuild.hs view
@@ -17,9 +17,11 @@ import Control.Concurrent.Async (async) import Control.Concurrent.STM.TSem import Control.Monad.Writer.Strict (execWriter, tell)+import qualified Data.ByteString as S import qualified Data.Map as Map import Data.NonNull (fromNullable)-import Distribution.PackageDescription (buildType, packageDescription, BuildType (Simple))+import Distribution.PackageDescription (buildType, packageDescription, BuildType (Simple),+ condTestSuites) import Filesystem (canonicalizePath, createTree, getWorkingDirectory, removeTree, rename, removeFile)@@ -37,8 +39,9 @@ import System.Environment (getEnvironment) import System.Exit import System.IO (IOMode (WriteMode),- openBinaryFile)+ openBinaryFile, hFlush) import System.IO.Temp (withSystemTempDirectory)+import System.Timeout (timeout) data BuildException = BuildException (Map PackageName BuildFailure) [Text] deriving Typeable@@ -97,7 +100,7 @@ -> IO a waitForDeps toolMap packageMap activeComps bp pi action = do atomically $ do- mapM_ checkPackage $ Map.keys $ filterUnused $ sdPackages $ ppDesc $ piPlan pi+ mapM_ checkPackage $ addCabal $ Map.keysSet $ filterUnused $ sdPackages $ ppDesc $ piPlan pi forM_ (Map.keys $ filterUnused $ sdTools $ ppDesc $ piPlan pi) $ \exe -> do case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of Nothing@@ -127,6 +130,11 @@ isCore = (`member` siCorePackages (bpSystemInfo bp)) isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp)) + -- Since we build every package using the Cabal library, it's an implicit+ -- dependency of everything+ addCabal :: Set PackageName -> Set PackageName+ addCabal = insertSet (PackageName "Cabal")+ withCounter :: TVar Int -> IO a -> IO a withCounter counter = bracket_ (atomically $ modifyTVar counter (+ 1))@@ -295,12 +303,31 @@ , version ] + quote :: Text -> Text+ quote s+ | any special s = tshow s+ | otherwise = s+ where+ special ' ' = True+ special '\'' = True+ special '"' = True+ special _ = False++ runIn :: FilePath -> IO Handle -> Text -> [Text] -> IO () runIn wdir getOutH cmd args = do outH <- getOutH+ S.hPut outH $ encodeUtf8 $ concat+ [ "> "+ , pack wdir+ , "$ "+ , unwords $ map quote $ cmd : args+ , "\n"+ ]+ hFlush outH withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle -> (return () :: IO ()) where- cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))+ cp outH = (proc (unpack cmd) (map unpack args)) { cwd = Just wdir , std_out = UseHandle outH , std_err = UseHandle outH@@ -323,7 +350,6 @@ ] libOut = pbLogDir </> unpack namever </> "build.out" testOut = pbLogDir </> unpack namever </> "test.out"- testRunOut = pbLogDir </> unpack namever </> "test-run.out" wf fp inner' = do ref <- newIORef Nothing@@ -387,18 +413,24 @@ runChild getOutH a b cabal args = run "runghc" $ runghcArgs $ "Setup" : args - isUnpacked <- newIORef False+ gpdRef <- newIORef Nothing let withUnpacked inner' = do- unlessM (readIORef isUnpacked) $ do- log' $ "Unpacking " ++ namever- runParent getOutH "stack" ["unpack", namever]+ mgpd <- readIORef gpdRef+ gpd <-+ case mgpd of+ Just gpd -> return gpd+ Nothing -> do+ log' $ "Unpacking " ++ namever+ runParent getOutH "stack" ["unpack", namever] - createSetupHs childDir name- writeIORef isUnpacked True- inner'+ gpd <- createSetupHs childDir name+ writeIORef gpdRef $ Just gpd + return gpd+ inner' gpd+ isConfiged <- newIORef False- let withConfiged inner' = withUnpacked $ do+ let withConfiged inner' = withUnpacked $ \_gpd -> do unlessM (readIORef isConfiged) $ do log' $ "Configuring " ++ namever cabal $ "configure" : configArgs@@ -509,7 +541,7 @@ let needTest = pbEnableTests && checkPrevResult prevTestResult pcTests && not pcSkipBuild- when needTest $ withUnpacked $ do+ when needTest $ withUnpacked $ \gpd -> do log' $ "Test configure " ++ namever cabal $ "configure" : "--enable-tests" : configArgs @@ -517,9 +549,34 @@ log' $ "Test build " ++ namever cabal ["build"] - log' $ "Test run " ++ namever- cabal ["test", "--log=" ++ pack testRunOut]+ let tests = map fst $ condTestSuites gpd+ forM_ tests $ \test -> do+ log' $ concat+ [ "Test run "+ , namever+ , " ("+ , pack test+ , ")"+ ]+ let exe = "dist/build" </> test </> test + exists <- liftIO $ doesFileExist $ childDir </> exe+ if exists+ then do+ mres <- timeout maximumTestSuiteTime $ run (pack exe) []+ case mres of+ Just () -> return ()+ Nothing -> error $ concat+ [ "Test suite timed out: "+ , unpack namever+ , ":"+ , test+ ]+ else do+ outH <- getOutH+ hPutStrLn outH $ "Test suite not built: " ++ test+ hFlush outH+ savePreviousResult pb Test pident $ either (const False) (const True) eres case (eres, pcTests) of (Left e, ExpectSuccess) -> throwM e@@ -541,6 +598,10 @@ Just bf -> bf Nothing -> BuildFailureException exc +-- | Maximum time (in microseconds) to run a single test suite+maximumTestSuiteTime :: Int+maximumTestSuiteTime = 10 * 60 * 1000 * 1000 -- ten minutes+ renameOrCopy :: FilePath -> FilePath -> IO () renameOrCopy src dest = rename (fromString src) (fromString dest)@@ -683,20 +744,16 @@ -- Also deletes any Setup.lhs if necessary createSetupHs :: FilePath -> Text -- ^ package name- -> IO ()+ -> IO GenericPackageDescription createSetupHs dir name = do- simple <- isSimple cabalFP+ bs <- readFile cabalFP+ gpd <- gpdFromLBS cabalFP (fromStrict bs)+ let simple = buildType (packageDescription gpd) == Just Simple when simple $ do _ <- tryIO $ removeFile $ fromString setuplhs writeFile setuphs $ asByteString "import Distribution.Simple\nmain = defaultMain\n"+ return gpd where cabalFP = dir </> unpack name <.> "cabal" setuphs = dir </> "Setup.hs" setuplhs = dir </> "Setup.lhs"---- | Check if the given cabal file has a simple build plan-isSimple :: FilePath -> IO Bool-isSimple fp = do- bs <- readFile fp- gpd <- gpdFromLBS fp (fromStrict bs)- return $ buildType (packageDescription gpd) == Just Simple
stackage-curator.cabal view
@@ -1,5 +1,5 @@ name: stackage-curator-version: 0.13.0+version: 0.13.1 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@@ -128,6 +128,7 @@ , containers , http-client , http-client-tls+ , directory source-repository head type: git
test/Stackage/PackageIndexSpec.hs view
@@ -5,11 +5,12 @@ import Stackage.Prelude import Test.Hspec import Distribution.Package (packageId)+import System.Directory (doesFileExist, getAppUserDataDirectory) spec :: Spec spec = do- it "works" $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ())- it "getLatestDescriptions gives reasonable results" $ do+ it "works" $ ifIndexExists $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ())+ it "getLatestDescriptions gives reasonable results" $ ifIndexExists $ do let f x y = (display x, display y) `member` asSet (setFromList [ (asText "base", asText "4.5.0.0") , ("does-not-exist", "9999999999999999999")@@ -19,3 +20,12 @@ p <- simpleParse $ asText "base" v <- simpleParse $ asText "4.5.0.0" (spdVersion <$> m) `shouldBe` singletonMap p v++ifIndexExists :: IO () -> IO ()+ifIndexExists inner = do+ stack <- getAppUserDataDirectory "stack"+ let fp = stack </> "indices" </> "Hackage" </> "00-index.tar"+ exists <- doesFileExist fp+ if exists+ then inner+ else pendingWith "00-index.tar not available, skipping test"