git.iko.soy/stackage
on master help sign in
Merge branch 'master' into new-upload
commitc3d3821b8756dc41f6a630274b53e45f709a9048 authorMichael Snoyman <michael@snoyman.com> dateSun 15 Mar 2015, 18:32 (12 years ago) parent51f3aa1e80a8d0
3 files changed+48−15
compare with master
unifiedsplit
Stackage/GhcPkg.hs+18−4 Stackage/PerformBuild.hs+26−11 build-constraints.yaml+4
Stackage/GhcPkg.hs+18−4
@@ -28,15 +28,16 @@ setupPackageDatabase
2828 -> FilePath -- ^ documentation root
2929 -> (ByteString -> IO ()) -- ^ logging
3030 -> Map PackageName Version -- ^ packages and versions to be installed
31+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
3132 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
32−setupPackageDatabase mdb docDir log' toInstall = do
33+setupPackageDatabase mdb docDir log' toInstall onUnregister = do
3334 registered1 <- getRegisteredPackages flags
3435 forM_ registered1 $ \pi@(PackageIdentifier name version) ->
3536 case lookup name toInstall of
36− Just version' | version /= version' -> unregisterPackage log' docDir flags pi
37+ Just version' | version /= version' -> unregisterPackage log' onUnregister docDir flags pi
3738 _ -> return ()
3839 broken <- getBrokenPackages flags
39− forM_ broken $ unregisterPackage log' docDir flags
40+ forM_ broken $ unregisterPackage log' onUnregister docDir flags
4041 foldMap (\(PackageIdentifier name _) -> singletonSet name)
4142 <$> getRegisteredPackages flags
4243 where
@@ -78,13 +79,26 @@ parsePackageIdent = fmap fst .
7879
7980-- | Unregister a package.
8081unregisterPackage :: (ByteString -> IO ()) -- ^ log func
82+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
8183 -> FilePath -- ^ doc directory
8284 -> [String] -> PackageIdentifier -> IO ()
83−unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do
85+unregisterPackage log' onUnregister docDir flags ident@(PackageIdentifier name _) = do
8486 log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"
87+ onUnregister ident
88+
89+ -- Delete libraries
90+ sourceProcessWithConsumer
91+ (proc "ghc-pkg" ("describe" : flags ++ [unpack $ display ident]))
92+ (CT.decodeUtf8
93+ $= CT.lines
94+ $= CL.mapMaybe parseLibraryDir
95+ $= CL.mapM_ (void . tryIO . removeTree))
96+
8597 void (readProcessWithExitCode
8698 "ghc-pkg"
8799 ("unregister": flags ++ ["--force", unpack $ display name])
88100 "")
89101
90102 void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)
103+ where
104+ parseLibraryDir = fmap fpFromText . stripPrefix "library-dirs: "
Stackage/PerformBuild.hs+26−11
@@ -30,7 +30,7 @@ import Stackage.Prelude hiding (pi)
3030import System.Directory (findExecutable)
3131import System.Environment (getEnvironment)
3232import System.IO (IOMode (WriteMode),
33− withBinaryFile)
33+ openBinaryFile)
3434import System.IO.Temp (withSystemTempDirectory)
3535
3636data BuildException = BuildException (Map PackageName BuildFailure) [Text]
@@ -198,6 +198,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
198198 (pbDocDir pb)
199199 pbLog
200200 (ppVersion <$> bpPackages pbPlan)
201+ (deletePreviousResults pb)
201202
202203 forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
203204 SingleBuild
@@ -290,11 +291,12 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
290291 , display $ ppVersion $ piPlan sbPackageInfo
291292 ]
292293
293− runIn wdir outH cmd args =
294− withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
294+ runIn wdir getOutH cmd args = do
295+ outH <- getOutH
296+ withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
295297 (return () :: IO ())
296298 where
297− cp = (proc (unpack $ asText cmd) (map (unpack . asText) args))
299+ cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))
298300 { cwd = Just $ fpToString wdir
299301 , std_out = UseHandle outH
300302 , std_err = UseHandle outH
@@ -320,8 +322,21 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
320322 testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"
321323
322324 wf fp inner' = do
323− createTree $ parent fp
324− withBinaryFile (fpToString fp) WriteMode inner'
325+ ref <- newIORef Nothing
326+ let cleanup = do
327+ mh <- readIORef ref
328+ forM_ mh hClose
329+ getH = do
330+ mh <- readIORef ref
331+ case mh of
332+ Just h -> return h
333+ Nothing -> mask_ $ do
334+ createTree $ parent fp
335+ h <- openBinaryFile (fpToString fp) WriteMode
336+ writeIORef ref $ Just h
337+ return h
338+
339+ inner' getH `finally` cleanup
325340
326341 configArgs = ($ []) $ execWriter $ do
327342 when pbAllowNewer $ tell' "--allow-newer"
@@ -349,15 +364,15 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
349364
350365 PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
351366
352− buildLibrary = wf libOut $ \outH -> do
367+ buildLibrary = wf libOut $ \getOutH -> do
353368 let run a b = do when pbVerbose $ log' (unwords (a : b))
354− runChild outH a b
369+ runChild getOutH a b
355370
356371 isUnpacked <- newIORef False
357372 let withUnpacked inner = do
358373 unlessM (readIORef isUnpacked) $ do
359374 log' $ "Unpacking " ++ namever
360− runParent outH "cabal" ["unpack", namever]
375+ runParent getOutH "cabal" ["unpack", namever]
361376 writeIORef isUnpacked True
362377 inner
363378
@@ -439,8 +454,8 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
439454
440455 return withUnpacked
441456
442− runTests withUnpacked = wf testOut $ \outH -> do
443− let run = runChild outH
457+ runTests withUnpacked = wf testOut $ \getOutH -> do
458+ let run = runChild getOutH
444459
445460 prevTestResult <- getPreviousResult pb Test pident
446461 let needTest = pbEnableTests
build-constraints.yaml+4
@@ -1086,6 +1086,10 @@ expected-haddock-failures:
10861086 # https://github.com/wereHamster/rethinkdb-client-driver/issues/1
10871087 - rethinkdb-client-driver
10881088
1089+ # Requires build before haddock, which doesn't always happen in incremental
1090+ # builds. Could consider special-casing this requirement.
1091+ - gtk
1092+
10891093# Benchmarks which should not be built. Note that Stackage does *not* generally
10901094# build benchmarks. The difference here will be whether dependencies for these
10911095# benchmarks are included or not.