351c03b · stackage · git.iko.soy

git.iko.soy/stackage

on master help sign in

Use PackageIdentifier

351c03bMichael Snoyman12 years ago

Stackage/GhcPkg.hs+1−1

compare with master

unifiedsplit

@@ -81,7 +81,7 @@ unregisterPackage :: (ByteString -> IO ()) -- ^ log func

81 -> FilePath -- ^ doc directory

82 -> [String] -> PackageIdentifier -> IO ()

83unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do

84− log' $ "Unregistering " ++ encodeUtf8 (display ident)

84+ log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"

85 void (readProcessWithExitCode

86 "ghc-pkg"

87 ("unregister": flags ++ ["--force", unpack $ display name])

Stackage/PerformBuild.hs+15−12

@@ -281,6 +281,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

281 wfd testComps (runTests withUnpacked)

282

283 pname = piName sbPackageInfo

284+ pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)

284 name = display pname

285 name = display pname

285 namever = concat

286 namever = concat

286 [ name

287 [ name

@@ -385,7 +386,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

385 -- dependency's haddocks before this finishes

386 -- dependency's haddocks before this finishes

386 atomically $ putTMVar (piResult sbPackageInfo) True

387 atomically $ putTMVar (piResult sbPackageInfo) True

387

388

388− prevHaddockResult <- getPreviousResult pb Haddock pname

389+ prevHaddockResult <- getPreviousResult pb Haddock pident

389 let needHaddock = pbEnableHaddock

390 let needHaddock = pbEnableHaddock

390 && checkPrevResult prevHaddockResult pcHaddocks

391 && checkPrevResult prevHaddockResult pcHaddocks

391 && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)

392 && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)

@@ -424,7 +425,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

424 $ modifyTVar sbHaddockFiles

425 $ modifyTVar sbHaddockFiles

425 $ insertMap namever newPath

426 $ insertMap namever newPath

426

427

427− savePreviousResult pb Haddock pname $ either (const False) (const True) eres

428+ savePreviousResult pb Haddock pident $ either (const False) (const True) eres

428 case (eres, pcHaddocks) of

429 case (eres, pcHaddocks) of

429 (Left e, ExpectSuccess) -> throwM e

430 (Left e, ExpectSuccess) -> throwM e

430 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"

431 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"

@@ -435,7 +436,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

435 runTests withUnpacked = wf testOut $ \outH -> do

436 runTests withUnpacked = wf testOut $ \outH -> do

436 let run = runChild outH

437 let run = runChild outH

437

438

438− prevTestResult <- getPreviousResult pb Test pname

439+ prevTestResult <- getPreviousResult pb Test pident

439 let needTest = pbEnableTests

440 let needTest = pbEnableTests

440 && checkPrevResult prevTestResult pcTests

441 && checkPrevResult prevTestResult pcTests

441 when needTest $ withUnpacked $ do

442 when needTest $ withUnpacked $ do

@@ -449,7 +450,7 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

449 log' $ "Test run " ++ namever

450 log' $ "Test run " ++ namever

450 run "cabal" ["test", "--log=" ++ fpToText testRunOut]

451 run "cabal" ["test", "--log=" ++ fpToText testRunOut]

451

452

452− savePreviousResult pb Test pname $ either (const False) (const True) eres

453+ savePreviousResult pb Test pident $ either (const False) (const True) eres

453 case (eres, pcTests) of

454 case (eres, pcTests) of

454 (Left e, ExpectSuccess) -> throwM e

455 (Left e, ExpectSuccess) -> throwM e

455 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"

456 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"

@@ -501,26 +502,28 @@ data ResultType = Haddock | Test

501

502

502-- | The result generated on a previous run

503-- | The result generated on a previous run

503data PrevResult = PRNoResult | PRSuccess | PRFailure

504data PrevResult = PRNoResult | PRSuccess | PRFailure

505+ deriving (Show, Enum, Eq, Ord, Bounded, Read)

504

506

505-- | Check if we should rerun based on a PrevResult and the expected status

507-- | Check if we should rerun based on a PrevResult and the expected status

508+checkPrevResult :: PrevResult -> TestState -> Bool

506checkPrevResult _ Don'tBuild = False

509checkPrevResult _ Don'tBuild = False

507checkPrevResult PRNoResult _ = True

510checkPrevResult PRNoResult _ = True

508checkPrevResult PRSuccess _ = False

511checkPrevResult PRSuccess _ = False

509checkPrevResult PRFailure ExpectSuccess = True

512checkPrevResult PRFailure ExpectSuccess = True

510checkPrevResult PRFailure _ = False

513checkPrevResult PRFailure _ = False

511

514

512−withPRPath :: PerformBuild -> ResultType -> PackageName -> (FilePath -> IO a) -> IO a

515+withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a

513−withPRPath pb rt (PackageName name) inner = do

516+withPRPath pb rt ident inner = do

514 createTree $ parent fp

517 createTree $ parent fp

515 inner fp

518 inner fp

516 where

519 where

517− fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromString name

520+ fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)

518

521

519successBS, failureBS :: ByteString

522successBS, failureBS :: ByteString

520successBS = "success"

523successBS = "success"

521failureBS = "failure"

524failureBS = "failure"

522

525

523−getPreviousResult :: PerformBuild -> ResultType -> PackageName -> IO PrevResult

526+getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult

524getPreviousResult w x y = withPRPath w x y $ \fp -> do

527getPreviousResult w x y = withPRPath w x y $ \fp -> do

525 eres <- tryIO $ readFile fp

528 eres <- tryIO $ readFile fp

526 return $ case eres of

529 return $ case eres of

@@ -529,12 +532,12 @@ getPreviousResult w x y = withPRPath w x y $ \fp -> do

529 | bs == failureBS -> PRFailure

532 | bs == failureBS -> PRFailure

530 _ -> PRNoResult

533 _ -> PRNoResult

531

534

532−savePreviousResult :: PerformBuild -> ResultType -> PackageName -> Bool -> IO ()

535+savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()

533−savePreviousResult pb rt name res =

536+savePreviousResult pb rt ident res =

534− withPRPath pb rt name $ \fp -> writeFile fp $

537+ withPRPath pb rt ident $ \fp -> writeFile fp $

535 if res then successBS else failureBS

538 if res then successBS else failureBS

536

539

537−deletePreviousResults :: PerformBuild -> PackageName -> IO ()

540+deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()

538deletePreviousResults pb name =

541deletePreviousResults pb name =

539 forM_ [minBound..maxBound] $ \rt ->

542 forM_ [minBound..maxBound] $ \rt ->

540 withPRPath pb rt name $ \fp ->

543 withPRPath pb rt name $ \fp ->