stackage 0.5.2 → 0.6.0
raw patch · 12 files changed
+797/−169 lines, 12 filesdep +conduitdep +http-conduit
Dependencies added: conduit, http-conduit
Files
- ChangeLog.md +4/−0
- Stackage/BuildConstraints.hs +1/−1
- Stackage/CompleteBuild.hs +75/−39
- Stackage/GhcPkg.hs +104/−0
- Stackage/InstallBuild.hs +100/−0
- Stackage/PerformBuild.hs +150/−45
- Stackage/Prelude.hs +13/−0
- Stackage/ServerBundle.hs +165/−8
- Stackage/Upload.hs +62/−70
- app/stackage.hs +112/−5
- stackage.cabal +9/−1
- test/Stackage/BuildPlanSpec.hs +2/−0
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.6.0++* Upload bundle V2 stuff+ ## 0.5.2 * Upload LTS to Hackage with the name LTSHaskell
Stackage/BuildConstraints.hs view
@@ -120,7 +120,7 @@ pcBuildBenchmarks <- o .: "build-benchmarks" pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags" pcMaintainer <- o .:? "maintainer"- pcEnableLibProfile <- fmap (fromMaybe False) (o .:? "library-profiling")+ pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling") return PackageConstraints {..} -- | The proposed plan from the requirements provided by contributors.
Stackage/CompleteBuild.hs view
@@ -8,6 +8,7 @@ , completeBuild , justCheck , justUploadNightly+ , getStackageAuthToken ) where import Control.Concurrent (threadDelay)@@ -33,10 +34,13 @@ -- | Flags passed in from the command line. data BuildFlags = BuildFlags { bfEnableTests :: !Bool+ , bfEnableHaddock :: !Bool , bfDoUpload :: !Bool , bfEnableLibProfile :: !Bool+ , bfEnableExecDyn :: !Bool , bfVerbose :: !Bool , bfSkipCheck :: !Bool+ , bfUploadV2 :: !Bool } deriving (Show) data BuildType = Nightly | LTS BumpType@@ -55,6 +59,8 @@ , setArgs :: Text -> UploadBundle -> UploadBundle , postBuild :: IO () , distroName :: Text -- ^ distro name on Hackage+ , snapshotType :: SnapshotType+ , bundleDest :: FilePath } nightlyPlanFile :: Text -- ^ day@@ -66,7 +72,7 @@ -> Settings nightlySettings day plan' = Settings { planFile = nightlyPlanFile day- , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day+ , buildDir = fpFromText $ "builds/nightly" , logDir = fpFromText $ "logs/stackage-nightly-" ++ day , title = \ghcVer -> concat [ "Stackage Nightly "@@ -79,6 +85,8 @@ , plan = plan' , postBuild = return () , distroName = "Stackage"+ , snapshotType = STNightly+ , bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle" } where slug' = "nightly-" ++ day@@ -119,7 +127,7 @@ return Settings { planFile = newfile- , buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new+ , buildDir = fpFromText $ "builds/lts" , logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new , title = \ghcVer -> concat [ "LTS Haskell "@@ -140,6 +148,10 @@ putStrLn "Pushing to Git repository" git ["push"] , distroName = "LTSHaskell"+ , snapshotType =+ case new of+ LTSVer x y -> STLTS x y+ , bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle" } data LTSVer = LTSVer !Int !Int@@ -203,7 +215,9 @@ , pbJobs = 8 , pbGlobalInstall = False , pbEnableTests = bfEnableTests buildFlags+ , pbEnableHaddock = bfEnableHaddock buildFlags , pbEnableLibProfiling = bfEnableLibProfile buildFlags+ , pbEnableExecDyn = bfEnableExecDyn buildFlags , pbVerbose = bfVerbose buildFlags , pbAllowNewer = bfSkipCheck buildFlags }@@ -227,10 +241,19 @@ checkBuildPlan plan putStrLn "Performing build"- performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn+ let pb = getPerformBuild buildFlags settings+ performBuild pb >>= mapM_ putStrLn + putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest+ createBundleV2 CreateBundleV2+ { cb2Plan = plan+ , cb2Type = snapshotType+ , cb2DocsDir = pbDocDir pb+ , cb2Dest = bundleDest+ }+ when (bfDoUpload buildFlags) $- finallyUpload settings man+ finallyUpload (bfUploadV2 buildFlags) settings man justUploadNightly :: Text -- ^ nightly date@@ -238,41 +261,63 @@ justUploadNightly day = do plan <- decodeFileEither (fpToString $ nightlyPlanFile day) >>= either throwM return- withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan+ withManager tlsManagerSettings $ finallyUpload False $ nightlySettings day plan +getStackageAuthToken :: IO Text+getStackageAuthToken = do+ mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"+ case mtoken of+ Nothing -> decodeUtf8 <$> readFile "/auth-token"+ Just token -> return $ pack token+ -- | The final part of the complete build process: uploading a bundle, -- docs and a distro to hackage.-finallyUpload :: Settings -> Manager -> IO ()-finallyUpload settings@Settings{..} man = do+finallyUpload :: Bool -- ^ use v2 upload+ -> Settings -> Manager -> IO ()+finallyUpload useV2 settings@Settings{..} man = do putStrLn "Uploading bundle to Stackage Server" - mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"- token <-- case mtoken of- Nothing -> decodeUtf8 <$> readFile "/auth-token"- Just token -> return $ pack token+ token <- getStackageAuthToken - now <- epochTime- let ghcVer = display $ siGhcVersion $ bpSystemInfo plan- (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def- { ubContents = serverBundle now (title ghcVer) slug plan- , ubAuthToken = token- }- putStrLn $ "New ident: " ++ unSnapshotIdent ident- forM_ mloc $ \loc ->- putStrLn $ "Track progress at: " ++ loc+ if useV2+ then do+ res <- flip uploadBundleV2 man UploadBundleV2+ { ub2Server = def+ , ub2AuthToken = token+ , ub2Bundle = bundleDest+ }+ putStrLn $ "New snapshot available at: " ++ res+ else do+ now <- epochTime+ let ghcVer = display $ siGhcVersion $ bpSystemInfo plan+ (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def+ { ubContents = serverBundle now (title ghcVer) slug plan+ , ubAuthToken = token+ }+ putStrLn $ "New ident: " ++ unSnapshotIdent ident+ forM_ mloc $ \loc ->+ putStrLn $ "Track progress at: " ++ loc - postBuild `catchAny` print+ putStrLn "Uploading docs to Stackage Server"+ res1 <- tryAny $ uploadDocs UploadDocs+ { udServer = def+ , udAuthToken = token+ , udDocs = pbDocDir pb+ , udSnapshot = ident+ } man+ putStrLn $ "Doc upload response: " ++ tshow res1 - putStrLn "Uploading docs to Stackage Server"- res1 <- uploadDocs UploadDocs- { udServer = def- , udAuthToken = token- , udDocs = pbDocDir pb- , udSnapshot = ident- } man- putStrLn $ "Doc upload response: " ++ tshow res1+ putStrLn "Uploading doc map"+ tryAny (uploadDocMap UploadDocMap+ { udmServer = def+ , udmAuthToken = token+ , udmSnapshot = ident+ , udmDocDir = pbDocDir pb+ , udmPlan = plan+ } man) >>= print + postBuild `catchAny` print+ ecreds <- tryIO $ readFile "/hackage-creds" case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of [username, password] -> do@@ -280,14 +325,5 @@ res2 <- uploadHackageDistroNamed distroName plan username password man putStrLn $ "Distro upload response: " ++ tshow res2 _ -> putStrLn "No creds found, skipping Hackage distro upload"-- putStrLn "Uploading doc map"- uploadDocMap UploadDocMap- { udmServer = def- , udmAuthToken = token- , udmSnapshot = ident- , udmDocDir = pbDocDir pb- , udmPlan = plan- } man >>= print where pb = getPerformBuild (error "finallyUpload.buildFlags") settings
+ Stackage/GhcPkg.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+-- | General commands related to ghc-pkg.++module Stackage.GhcPkg+ ( setupPackageDatabase+ ) where++import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Conduit.Process+import qualified Data.Conduit.Text as CT+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Distribution.Compat.ReadP+import Distribution.Package+import Distribution.Text (parse)+import Filesystem.Path.CurrentOS (FilePath)+import qualified Filesystem.Path.CurrentOS as FP+import Data.Map (Map)+import Data.Version (Version)+import Stackage.Prelude+import Filesystem (removeTree)++setupPackageDatabase+ :: Maybe FilePath -- ^ database location, Nothing if using global DB+ -> FilePath -- ^ documentation root+ -> (ByteString -> IO ()) -- ^ logging+ -> Map PackageName Version -- ^ packages and versions to be installed+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package+ -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup+setupPackageDatabase mdb docDir log' toInstall onUnregister = do+ registered1 <- getRegisteredPackages flags+ forM_ registered1 $ \pi@(PackageIdentifier name version) ->+ case lookup name toInstall of+ Just version' | version /= version' -> unregisterPackage log' onUnregister docDir flags pi+ _ -> return ()+ broken <- getBrokenPackages flags+ forM_ broken $ unregisterPackage log' onUnregister docDir flags+ foldMap (\(PackageIdentifier name _) -> singletonSet name)+ <$> getRegisteredPackages flags+ where+ flags = ghcPkgFlags mdb++ghcPkgFlags :: Maybe FilePath -> [String]+ghcPkgFlags mdb =+ "--no-user-package-db" :+ case mdb of+ Nothing -> ["--global"]+ Just fp -> ["--package-db=" ++ fpToString fp]++-- | Get broken packages.+getBrokenPackages :: [String] -> IO [PackageIdentifier]+getBrokenPackages flags = do+ (_,ps) <- sourceProcessWithConsumer+ (proc+ "ghc-pkg"+ ("check" : "--simple-output" : flags))+ (CT.decodeUtf8 $= CT.lines $= CL.consume)+ return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))++-- | Get available packages.+getRegisteredPackages :: [String] -> IO [PackageIdentifier]+getRegisteredPackages flags = do+ (_,ps) <- sourceProcessWithConsumer+ (proc+ "ghc-pkg"+ ("list" : "--simple-output" : flags))+ (CT.decodeUtf8 $= CT.lines $= CL.consume)+ return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))++-- | Parse a package identifier: foo-1.2.3+parsePackageIdent :: Text -> Maybe PackageIdentifier+parsePackageIdent = fmap fst .+ listToMaybe .+ filter (null . snd) .+ readP_to_S parse . T.unpack++-- | Unregister a package.+unregisterPackage :: (ByteString -> IO ()) -- ^ log func+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package+ -> FilePath -- ^ doc directory+ -> [String] -> PackageIdentifier -> IO ()+unregisterPackage log' onUnregister docDir flags ident@(PackageIdentifier name _) = do+ log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"+ onUnregister ident++ -- Delete libraries+ sourceProcessWithConsumer+ (proc "ghc-pkg" ("describe" : flags ++ [unpack $ display ident]))+ (CT.decodeUtf8+ $= CT.lines+ $= CL.mapMaybe parseLibraryDir+ $= CL.mapM_ (void . tryIO . removeTree))++ void (readProcessWithExitCode+ "ghc-pkg"+ ("unregister": flags ++ ["--force", unpack $ display name])+ "")++ void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)+ where+ parseLibraryDir = fmap fpFromText . stripPrefix "library-dirs: "
+ Stackage/InstallBuild.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Stackage.InstallBuild+ ( InstallFlags (..)+ , BuildPlanSource (..)+ , installBuild+ ) where++import qualified Codec.Archive.Tar as Tar+import qualified Codec.Compression.GZip as GZip+import qualified Data.Yaml as Yaml+import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Stackage.BuildPlan+import Stackage.CheckBuildPlan+import Stackage.PerformBuild+import Stackage.Prelude+import System.IO (BufferMode (LineBuffering), hSetBuffering)++-- | Flags passed in from the command line.+data InstallFlags = InstallFlags+ { ifPlanSource :: !BuildPlanSource+ , ifInstallDest :: !FilePath+ , ifLogDir :: !(Maybe FilePath)+ , ifJobs :: !Int+ , ifGlobalInstall :: !Bool+ , ifEnableTests :: !Bool+ , ifEnableHaddock :: !Bool+ , ifEnableLibProfiling :: !Bool+ , ifEnableExecDyn :: !Bool+ , ifVerbose :: !Bool+ , ifSkipCheck :: !Bool+ } deriving (Show)++-- | Source for build plan.+data BuildPlanSource = BPSBundleWeb String+ | BPSFile FilePath+ deriving (Show)++getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild+getPerformBuild plan InstallFlags{..} =+ PerformBuild+ { pbPlan = plan+ , pbInstallDest = ifInstallDest+ , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir+ , pbLog = hPut stdout+ , pbJobs = ifJobs+ , pbGlobalInstall = ifGlobalInstall+ , pbEnableTests = ifEnableTests+ , pbEnableHaddock = ifEnableHaddock+ , pbEnableLibProfiling = ifEnableLibProfiling+ , pbEnableExecDyn = ifEnableExecDyn+ , pbVerbose = ifVerbose+ , pbAllowNewer = ifSkipCheck+ }++-- | Install stackage from an existing build plan.+installBuild :: InstallFlags -> IO ()+installBuild installFlags@InstallFlags{..} = do+ hSetBuffering stdout LineBuffering++ putStrLn $ "Loading build plan"+ plan <- case ifPlanSource of+ BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do+ req <- parseUrl url+ res <- httpLbs req man+ planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)+ decodeBuildPlan planBSL+ BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return++ if ifSkipCheck+ then putStrLn "Skipping build plan check"+ else do+ putStrLn "Checking build plan"+ checkBuildPlan plan++ putStrLn "Performing build"+ performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn++ where+ getPlanEntry Tar.Done = throwIO NoBuildPlanException+ getPlanEntry (Tar.Fail e) = throwIO e+ getPlanEntry (Tar.Next entry entries)+ | Tar.entryPath entry == "build-plan.yaml" =+ case Tar.entryContent entry of+ Tar.NormalFile bs _ -> return bs+ _ -> throwIO NoBuildPlanException+ | otherwise = getPlanEntry entries++ decodeBuildPlan =+ either throwIO return . Yaml.decodeEither' . toStrict++data InstallBuildException = NoBuildPlanException+ deriving (Typeable)+instance Exception InstallBuildException+instance Show InstallBuildException where+ show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"
Stackage/PerformBuild.hs view
@@ -19,17 +19,18 @@ import Data.NonNull (fromNullable) import Filesystem (canonicalizePath, createTree, getWorkingDirectory, isDirectory,- removeTree, rename)+ removeTree, rename, isFile, removeFile) import Filesystem.Path (parent) import qualified Filesystem.Path as F import Stackage.BuildConstraints import Stackage.BuildPlan+import Stackage.GhcPkg import Stackage.PackageDescription import Stackage.Prelude hiding (pi) import System.Directory (findExecutable) import System.Environment (getEnvironment) import System.IO (IOMode (WriteMode),- withBinaryFile)+ openBinaryFile) import System.IO.Temp (withSystemTempDirectory) data BuildException = BuildException (Map PackageName BuildFailure) [Text]@@ -62,7 +63,9 @@ , pbGlobalInstall :: Bool -- ^ Register packages in the global database , pbEnableTests :: Bool+ , pbEnableHaddock :: Bool , pbEnableLibProfiling :: Bool+ , pbEnableExecDyn :: Bool , pbVerbose :: Bool , pbAllowNewer :: Bool -- ^ Pass --allow-newer to cabal configure@@ -88,7 +91,9 @@ case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of Nothing | isCoreExe exe -> return ()- | otherwise -> throwSTM $ ToolMissing exe+ -- https://github.com/jgm/zip-archive/issues/23+ -- | otherwise -> throwSTM $ ToolMissing exe+ | otherwise -> return () Just packages -> ofoldl1' (<|>) packages action where@@ -131,6 +136,10 @@ pbDataDir pb = pbInstallDest pb </> "share" pbDocDir pb = pbInstallDest pb </> "doc" +-- | Directory keeping previous result info+pbPrevResDir :: PerformBuild -> FilePath+pbPrevResDir pb = pbInstallDest pb </> "prevres"+ performBuild :: PerformBuild -> IO [Text] performBuild pb = do cwd <- getWorkingDirectory@@ -158,12 +167,13 @@ $ \ClosedStream Inherited Inherited -> return () let removeTree' fp = whenM (isDirectory fp) (removeTree fp)- mapM_ removeTree' [pbInstallDest, pbLogDir]+ removeTree' pbLogDir - forM_ (pbDatabase pb) $ \db -> do- createTree $ parent db- withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])- $ \ClosedStream Inherited Inherited -> return ()+ forM_ (pbDatabase pb) $ \db ->+ unlessM (isFile $ db </> "package.cache") $ do+ createTree $ parent db+ withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])+ $ \ClosedStream Inherited Inherited -> return () pbLog $ encodeUtf8 "Copying built-in Haddocks\n" copyBuiltInHaddocks (pbDocDir pb) @@ -183,7 +193,15 @@ env <- getEnvironment haddockFiles <- newTVarIO mempty - forM_ packageMap $ \pi -> void $ async $ singleBuild pb SingleBuild+ registeredPackages <- setupPackageDatabase+ (pbDatabase pb)+ (pbDocDir pb)+ pbLog+ (ppVersion <$> bpPackages pbPlan)+ (deletePreviousResults pb)++ forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages+ SingleBuild { sbSem = sem , sbErrsVar = errsVar , sbWarningsVar = warningsVar@@ -245,8 +263,10 @@ , sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file } -singleBuild :: PerformBuild -> SingleBuild -> IO ()-singleBuild pb@PerformBuild {..} SingleBuild {..} =+singleBuild :: PerformBuild+ -> Set PackageName -- ^ registered packages+ -> SingleBuild -> IO ()+singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = withCounter sbActive $ handle updateErrs $ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))@@ -258,22 +278,25 @@ let wfd comps = waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo . withTSem sbSem- wfd libComps buildLibrary+ withUnpacked <- wfd libComps buildLibrary - wfd testComps runTests+ wfd testComps (runTests withUnpacked) - name = display $ piName sbPackageInfo+ pname = piName sbPackageInfo+ pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)+ name = display pname namever = concat [ name , "-" , display $ ppVersion $ piPlan sbPackageInfo ] - runIn wdir outH cmd args =- withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle ->+ runIn wdir getOutH cmd args = do+ outH <- getOutH+ withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle -> (return () :: IO ()) where- cp = (proc (unpack $ asText cmd) (map (unpack . asText) args))+ cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args)) { cwd = Just $ fpToString wdir , std_out = UseHandle outH , std_err = UseHandle outH@@ -299,9 +322,22 @@ testRunOut = pbLogDir </> fpFromText namever </> "test-run.out" wf fp inner' = do- createTree $ parent fp- withBinaryFile (fpToString fp) WriteMode inner'+ ref <- newIORef Nothing+ let cleanup = do+ mh <- readIORef ref+ forM_ mh hClose+ getH = do+ mh <- readIORef ref+ case mh of+ Just h -> return h+ Nothing -> mask_ $ do+ createTree $ parent fp+ h <- openBinaryFile (fpToString fp) WriteMode+ writeIORef ref $ Just h+ return h + inner' getH `finally` cleanup+ configArgs = ($ []) $ execWriter $ do when pbAllowNewer $ tell' "--allow-newer" tell' "--package-db=clear"@@ -314,6 +350,7 @@ tell' $ "--flags=" ++ flags when (pbEnableLibProfiling && pcEnableLibProfile) $ tell' "--enable-library-profiling"+ when pbEnableExecDyn $ tell' "--enable-executable-dynamic" where tell' x = tell (x:) @@ -327,23 +364,41 @@ PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo - buildLibrary = wf libOut $ \outH -> do+ buildLibrary = wf libOut $ \getOutH -> do let run a b = do when pbVerbose $ log' (unwords (a : b))- runChild outH a b- log' $ "Unpacking " ++ namever- runParent outH "cabal" ["unpack", namever]+ runChild getOutH a b - log' $ "Configuring " ++ namever- run "cabal" $ "configure" : configArgs+ isUnpacked <- newIORef False+ let withUnpacked inner = do+ unlessM (readIORef isUnpacked) $ do+ log' $ "Unpacking " ++ namever+ runParent getOutH "cabal" ["unpack", namever]+ writeIORef isUnpacked True+ inner - log' $ "Building " ++ namever- run "cabal" ["build"]+ isConfiged <- newIORef False+ let withConfiged inner = withUnpacked $ do+ unlessM (readIORef isConfiged) $ do+ log' $ "Configuring " ++ namever+ run "cabal" $ "configure" : configArgs+ writeIORef isConfiged True+ inner - log' $ "Copying/registering " ++ namever- run "cabal" ["copy"]- withMVar sbRegisterMutex $ const $- run "cabal" ["register"]+ prevBuildResult <- getPreviousResult pb Build pident+ unless (prevBuildResult == PRSuccess) $ withConfiged $ do+ assert (pname `notMember` registeredPackages) $ do+ deletePreviousResults pb pident + log' $ "Building " ++ namever+ run "cabal" ["build"]++ log' $ "Copying/registering " ++ namever+ run "cabal" ["copy"]+ withMVar sbRegisterMutex $ const $+ run "cabal" ["register"]++ savePreviousResult pb Build pident True+ -- Even if the tests later fail, we can allow other libraries to build -- on top of our successful results --@@ -352,7 +407,11 @@ -- dependency's haddocks before this finishes atomically $ putTMVar (piResult sbPackageInfo) True - when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do+ prevHaddockResult <- getPreviousResult pb Haddock pident+ let needHaddock = pbEnableHaddock+ && checkPrevResult prevHaddockResult pcHaddocks+ && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)+ when needHaddock $ withConfiged $ do log' $ "Haddocks " ++ namever hfs <- readTVarIO sbHaddockFiles let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat@@ -387,15 +446,21 @@ $ modifyTVar sbHaddockFiles $ insertMap namever newPath + savePreviousResult pb Haddock pident $ either (const False) (const True) eres case (eres, pcHaddocks) of (Left e, ExpectSuccess) -> throwM e (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success" _ -> return () - runTests = wf testOut $ \outH -> do- let run = runChild outH+ return withUnpacked - when (pbEnableTests && pcTests /= Don'tBuild) $ do+ runTests withUnpacked = wf testOut $ \getOutH -> do+ let run = runChild getOutH++ prevTestResult <- getPreviousResult pb Test pident+ let needTest = pbEnableTests+ && checkPrevResult prevTestResult pcTests+ when needTest $ withUnpacked $ do log' $ "Test configure " ++ namever run "cabal" $ "configure" : "--enable-tests" : configArgs @@ -406,6 +471,7 @@ log' $ "Test run " ++ namever run "cabal" ["test", "--log=" ++ fpToText testRunOut] + savePreviousResult pb Test pident $ either (const False) (const True) eres case (eres, pcTests) of (Left e, ExpectSuccess) -> throwM e (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"@@ -429,16 +495,6 @@ renameOrCopy :: FilePath -> FilePath -> IO () renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest -copyDir :: FilePath -> FilePath -> IO ()-copyDir src dest =- runResourceT $ sourceDirectoryDeep False src $$ mapM_C go- where- src' = src </> ""- go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do- let dest' = dest </> suffix- liftIO $ createTree $ parent dest'- sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ())- copyBuiltInHaddocks :: FilePath -> IO () copyBuiltInHaddocks docdir = do mghc <- findExecutable "ghc"@@ -448,3 +504,52 @@ src <- canonicalizePath (parent (fpFromString ghc) </> "../share/doc/ghc/html/libraries") copyDir src docdir++------------- Previous results++-- | The previous actions that can be run+data ResultType = Build | Haddock | Test+ deriving (Show, Enum, Eq, Ord, Bounded, Read)++-- | The result generated on a previous run+data PrevResult = PRNoResult | PRSuccess | PRFailure+ deriving (Show, Enum, Eq, Ord, Bounded, Read)++-- | Check if we should rerun based on a PrevResult and the expected status+checkPrevResult :: PrevResult -> TestState -> Bool+checkPrevResult _ Don'tBuild = False+checkPrevResult PRNoResult _ = True+checkPrevResult PRSuccess _ = False+checkPrevResult PRFailure ExpectSuccess = True+checkPrevResult PRFailure _ = False++withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a+withPRPath pb rt ident inner = do+ createTree $ parent fp+ inner fp+ where+ fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)++successBS, failureBS :: ByteString+successBS = "success"+failureBS = "failure"++getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult+getPreviousResult w x y = withPRPath w x y $ \fp -> do+ eres <- tryIO $ readFile fp+ return $ case eres of+ Right bs+ | bs == successBS -> PRSuccess+ | bs == failureBS -> PRFailure+ _ -> PRNoResult++savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()+savePreviousResult pb rt ident res =+ withPRPath pb rt ident $ \fp -> writeFile fp $+ if res then successBS else failureBS++deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()+deletePreviousResults pb name =+ forM_ [minBound..maxBound] $ \rt ->+ withPRPath pb rt name $ \fp ->+ void $ tryIO $ removeFile fp
Stackage/Prelude.hs view
@@ -20,6 +20,9 @@ VersionRange) import Distribution.Version as X (withinRange) import qualified Distribution.Version as C+import Filesystem (createTree)+import Filesystem.Path (parent)+import qualified Filesystem.Path as F unPackageName :: PackageName -> Text unPackageName (PackageName str) = pack str@@ -101,3 +104,13 @@ data TopologicalSortException key = NoEmptyDeps (Map key (Set key)) deriving (Show, Typeable) instance (Show key, Typeable key) => Exception (TopologicalSortException key)++copyDir :: FilePath -> FilePath -> IO ()+copyDir src dest =+ runResourceT $ sourceDirectoryDeep False src $$ mapM_C go+ where+ src' = src </> ""+ go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do+ let dest' = dest </> suffix+ liftIO $ createTree $ parent dest'+ sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ())
Stackage/ServerBundle.hs view
@@ -7,21 +7,31 @@ , epochTime , bpAllPackages , docsListing+ , createBundleV2+ , CreateBundleV2 (..)+ , SnapshotType (..)+ , writeIndexStyle+ , DocMap+ , PackageDocs (..) ) where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Compression.GZip as GZip import qualified Data.Map as M+import Data.Aeson (ToJSON (..), (.=), object, FromJSON (..), (.:), withObject)+import System.IO.Temp (withTempDirectory) import qualified Data.Yaml as Y-import Filesystem (isFile)+import Filesystem (isFile, getWorkingDirectory, listDirectory, isDirectory, canonicalizePath) import Foreign.C.Types (CTime (CTime)) import Stackage.BuildConstraints import Stackage.BuildPlan import Stackage.Prelude+import System.IO.Temp (withTempDirectory) import qualified System.PosixCompat.Time as PC import qualified Text.XML as X import Text.XML.Cursor+import System.PosixCompat.Files (createSymbolicLink) -- | Get current time epochTime :: IO Tar.EpochTime@@ -73,13 +83,30 @@ map (\(PackageName name) -> name) (M.keys $ siCorePackages bpSystemInfo) +-- | Package name is key+type DocMap = Map Text PackageDocs+data PackageDocs = PackageDocs+ { pdVersion :: Text+ , pdModules :: Map Text [Text]+ -- ^ module name, path+ }+instance ToJSON PackageDocs where+ toJSON PackageDocs {..} = object+ [ "version" .= pdVersion+ , "modules" .= pdModules+ ]+instance FromJSON PackageDocs where+ parseJSON = withObject "PackageDocs" $ \o -> PackageDocs+ <$> o .: "version"+ <*> o .: "modules"+ docsListing :: BuildPlan -> FilePath -- ^ docs directory- -> IO ByteString+ -> IO DocMap docsListing bp docsDir =- fmap (Y.encode . fold) $ mapM go $ mapToList $ bpAllPackages bp+ fmap fold $ mapM go $ mapToList $ bpAllPackages bp where- go :: (PackageName, Version) -> IO (Map Text Y.Value)+ go :: (PackageName, Version) -> IO DocMap go (package, version) = do -- handleAny (const $ return mempty) $ do let dirname = fpFromText (concat [ display package@@ -107,8 +134,138 @@ return $ if e then asMap $ singletonMap name [fpToText dirname, href] else mempty- return $ singletonMap (display package) $ Y.object- [ "version" Y..= display version- , "modules" Y..= m- ]+ return $ singletonMap (display package) $ PackageDocs+ { pdVersion = display version+ , pdModules = m+ } else return mempty++data SnapshotType = STNightly+ | STLTS !Int !Int -- ^ major, minor+ deriving (Show, Read, Eq, Ord)++instance ToJSON SnapshotType where+ toJSON STNightly = object+ [ "type" .= asText "nightly"+ ]+ toJSON (STLTS major minor) = object+ [ "type" .= asText "lts"+ , "major" .= major+ , "minor" .= minor+ ]+instance FromJSON SnapshotType where+ parseJSON = withObject "SnapshotType" $ \o -> do+ t <- o .: "type"+ case asText t of+ "nightly" -> return STNightly+ "lts" -> STLTS+ <$> o .: "major"+ <*> o .: "minor"+ _ -> fail $ "Unknown type for SnapshotType: " ++ unpack t++data CreateBundleV2 = CreateBundleV2+ { cb2Plan :: BuildPlan+ , cb2Type :: SnapshotType+ , cb2DocsDir :: FilePath+ , cb2Dest :: FilePath+ }++-- | Create a V2 bundle, which contains the build plan, metadata, docs, and doc+-- map.+createBundleV2 :: CreateBundleV2 -> IO ()+createBundleV2 CreateBundleV2 {..} = do+ docsDir <- canonicalizePath cb2DocsDir+ docMap <- docsListing cb2Plan cb2DocsDir++ Y.encodeFile (fpToString $ docsDir </> "build-plan.yaml") cb2Plan+ Y.encodeFile (fpToString $ docsDir </> "build-type.yaml") cb2Type+ Y.encodeFile (fpToString $ docsDir </> "docs-map.yaml") docMap+ void $ writeIndexStyle Nothing cb2DocsDir++ currentDir <- getWorkingDirectory+ files <- listDirectory docsDir++ let args = "cfJ"+ : fpToString (currentDir </> cb2Dest)+ : "--dereference"+ : map (fpToString . filename) files+ cp = (proc "tar" args) { cwd = Just $ fpToString docsDir }+ withCheckedProcess cp $ \ClosedStream Inherited Inherited -> return ()++writeIndexStyle :: Maybe Text -- ^ snapshot id+ -> FilePath -- ^ docs dir+ -> IO [String]+writeIndexStyle msnapid dir = do+ dirs <- fmap sort+ $ runResourceT+ $ sourceDirectory dir+ $$ filterMC (liftIO . isDirectory)+ =$ mapC (fpToString . filename)+ =$ sinkList+ writeFile (dir </> "index.html") $ mkIndex+ (unpack <$> msnapid)+ dirs+ writeFile (dir </> "style.css") styleCss+ return dirs++mkIndex :: Maybe String -> [String] -> String+mkIndex msnapid dirs = concat+ [ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"+ , "<link rel='stylesheet' href='https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css'>"+ , "<link rel='stylesheet' href='style.css'>"+ , "<link rel='shortcut icon' href='http://www.stackage.org/static/img/favicon.ico' />"+ , "</head>"+ , "<body><div class='container'>"+ , "<div class='row'><div class='span12 col-md-12'>"+ , "<h1>Haddock documentation index</h1>"+ , flip foldMap msnapid $ \snapid -> concat+ [ "<p class='return'><a href=\"http://www.stackage.org/stackage/"+ , snapid+ , "\">Return to snapshot</a></p>"+ ]+ , "<ul>"+ , concatMap toLI dirs+ , "</ul></div></div></div></body></html>"+ ]+ where+ toLI name = concat+ [ "<li><a href='"+ , name+ , "/index.html'>"+ , name+ , "</a></li>"+ ]++styleCss :: String+styleCss = concat+ [ "@media (min-width: 530px) {"+ , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }"+ , "}"+ , "@media (min-width: 760px) {"+ , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }"+ , "}"+ , "ul {"+ , " margin-left: 0;"+ , " padding-left: 0;"+ , " list-style-type: none;"+ , "}"+ , "body {"+ , " background: #f0f0f0;"+ , " font-family: 'Lato', sans-serif;"+ , " text-shadow: 1px 1px 1px #ffffff;"+ , " font-size: 20px;"+ , " line-height: 30px;"+ , " padding-bottom: 5em;"+ , "}"+ , "h1 {"+ , " font-weight: normal;"+ , " color: #06537d;"+ , " font-size: 45px;"+ , "}"+ , ".return a {"+ , " color: #06537d;"+ , " font-style: italic;"+ , "}"+ , ".return {"+ , " margin-bottom: 1em;"+ , "}"]
Stackage/Upload.hs view
@@ -14,17 +14,25 @@ , uploadHackageDistroNamed , UploadDocMap (..) , uploadDocMap+ , uploadBundleV2+ , UploadBundleV2 (..)+ , def+ , unStackageServer ) where import Control.Monad.Writer.Strict (execWriter, tell) import Data.Default.Class (Default (..))+import Data.Function (fix) import Filesystem (isDirectory, isFile) import Network.HTTP.Client+import qualified Network.HTTP.Client.Conduit as HCC import Network.HTTP.Client.MultipartFormData import Stackage.BuildPlan (BuildPlan) import Stackage.Prelude-import Stackage.ServerBundle (bpAllPackages, docsListing)+import Stackage.ServerBundle (bpAllPackages, docsListing, writeIndexStyle) import System.IO.Temp (withSystemTempFile)+import qualified System.IO as IO+import qualified Data.Yaml as Y newtype StackageServer = StackageServer { unStackageServer :: Text } deriving (Show, Eq, Ord, Hashable, IsString)@@ -107,17 +115,7 @@ where uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do hClose h- dirs <- fmap sort- $ runResourceT- $ sourceDirectory fp0- $$ filterMC (liftIO . isDirectory)- =$ mapC (fpToString . filename)- =$ sinkList- writeFile (fp0 </> "index.html") $ mkIndex- (unpack $ unSnapshotIdent ident)- dirs- writeFile (fp0 </> "style.css") styleCss- -- FIXME write index.html, style.css+ dirs <- writeIndexStyle (Just $ unSnapshotIdent ident) fp0 let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs) { cwd = Just $ fpToString fp0 }@@ -201,7 +199,7 @@ uploadDocMap UploadDocMap {..} man = do docmap <- docsListing udmPlan udmDocDir req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"- req2 <- formDataBody (formData docmap) req1+ req2 <- formDataBody (formData $ Y.encode docmap) req1 let req3 = req2 { method = "PUT" , requestHeaders =@@ -219,61 +217,55 @@ , partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap ] -mkIndex :: String -> [String] -> String-mkIndex snapid dirs = concat- [ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"- , "<link rel='stylesheet' href='https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css'>"- , "<link rel='stylesheet' href='style.css'>"- , "<link rel='shortcut icon' href='http://www.stackage.org/static/img/favicon.ico' />"- , "</head>"- , "<body><div class='container'>"- , "<div class='row'><div class='span12 col-md-12'>"- , "<h1>Haddock documentation index</h1>"- , "<p class='return'><a href=\"http://www.stackage.org/stackage/"- , snapid- , "\">Return to snapshot</a></p><ul>"- , concatMap toLI dirs- , "</ul></div></div></div></body></html>"- ]- where- toLI name = concat- [ "<li><a href='"- , name- , "/index.html'>"- , name- , "</a></li>"- ]+data UploadBundleV2 = UploadBundleV2+ { ub2Server :: StackageServer+ , ub2AuthToken :: Text+ , ub2Bundle :: FilePath+ } -styleCss :: String-styleCss = concat- [ "@media (min-width: 530px) {"- , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }"- , "}"- , "@media (min-width: 760px) {"- , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }"- , "}"- , "ul {"- , " margin-left: 0;"- , " padding-left: 0;"- , " list-style-type: none;"- , "}"- , "body {"- , " background: #f0f0f0;"- , " font-family: 'Lato', sans-serif;"- , " text-shadow: 1px 1px 1px #ffffff;"- , " font-size: 20px;"- , " line-height: 30px;"- , " padding-bottom: 5em;"- , "}"- , "h1 {"- , " font-weight: normal;"- , " color: #06537d;"- , " font-size: 45px;"- , "}"- , ".return a {"- , " color: #06537d;"- , " font-style: italic;"- , "}"- , ".return {"- , " margin-bottom: 1em;"- , "}"]+uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text+uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do+ size <- IO.hFileSize h+ putStrLn $ "Bundle size: " ++ tshow size+ req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"+ let req2 = req1+ { method = "PUT"+ , requestHeaders =+ [ ("Authorization", encodeUtf8 ub2AuthToken)+ , ("Accept", "application/json")+ , ("Content-Type", "application/x-tar")+ ]+ , requestBody = HCC.requestBodySource (fromIntegral size)+ $ sourceHandle h $= printProgress size+ }+ sink = decodeUtf8C =$ fix (\loop -> do+ mx <- peekC+ case mx of+ Nothing -> error $ "uploadBundleV2: premature end of stream"+ Just _ -> do+ l <- lineC $ takeCE 4096 =$ foldC+ let (cmd, msg') = break (== ':') l+ msg = dropWhile (== ' ') $ dropWhile (== ':') msg'+ case cmd of+ "CONT" -> do+ putStrLn msg+ loop+ "FAILURE" -> error $ "uploadBundleV2 failed: " ++ unpack msg+ "SUCCESS" -> return msg+ _ -> error $ "uploadBundleV2: unknown command " ++ unpack cmd+ )+ withResponse req2 man $ \res -> HCC.bodyReaderSource (responseBody res) $$ sink+ where+ printProgress total =+ loop 0 0+ where+ loop sent lastPercent =+ await >>= maybe (putStrLn "Upload complete") go+ where+ go bs = do+ yield bs+ let sent' = sent + fromIntegral (length bs)+ percent = sent' * 100 `div` total+ when (percent /= lastPercent)+ $ putStrLn $ "Upload progress: " ++ tshow percent ++ "%"+ loop sent' percent
app/stackage.hs view
@@ -7,8 +7,14 @@ import Data.String (fromString) import Data.Version import Options.Applicative+import Filesystem.Path.CurrentOS (decodeString) import Paths_stackage (version) import Stackage.CompleteBuild+import Stackage.Upload+import Stackage.InstallBuild+import Network.HTTP.Client (withManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import qualified Data.Text as T main :: IO () main =@@ -25,9 +31,9 @@ help "Show this help text" versionOption = infoOption- ("fpbuild version " ++ showVersion version)+ ("stackage version " ++ showVersion version) (long "version" <>- help "Show fpbuild version")+ help "Show stackage version") config = subparser $ mconcat@@ -55,12 +61,25 @@ (const justCheck) (pure ()) "check"- "Just check that the build plan is ok"]+ "Just check that the build plan is ok"+ , cmnd+ installBuild+ installFlags+ "install"+ "Install a snapshot from an existing build plan"+ , cmnd+ uploadv2+ uploadv2Flags+ "upload2"+ "Upload a pre-existing v2 bundle"+ ]+ cmnd exec parse name desc = command name $ info- (fmap exec parse)+ (fmap exec (parse <**> helpOption)) (progDesc desc)+ buildFlags = BuildFlags <$> fmap@@ -71,18 +90,106 @@ fmap not (switch+ (long "skip-haddock" <>+ help "Skip generating haddock documentation")) <*>+ fmap+ not+ (switch (long "skip-upload" <> help "Skip uploading bundle, docs, etc.")) <*> switch (long "enable-library-profiling" <> help "Enable profiling when building") <*> switch+ (long "enable-executable-dynamic" <>+ help "Enable dynamic executables when building") <*>+ switch (long "verbose" <> short 'v' <> help "Output verbose detail about the build steps") <*> switch (long "skip-check" <>- help "Skip the check phase, and pass --allow-newer to cabal configure")+ help "Skip the check phase, and pass --allow-newer to cabal configure") <*>+ switch+ (long "upload-v2" <>+ help "Use the V2 upload code") nightlyUploadFlags = fromString <$> strArgument (metavar "DATE" <> help "Date, in YYYY-MM-DD format")++ installFlags =+ InstallFlags <$>+ (fmap+ BPSBundleWeb+ (strOption+ (long "bundle" <>+ metavar "URL" <>+ help "Stackage bundle containing build plan")) <|>+ fmap+ (BPSFile . decodeString)+ (strOption+ (long "build-plan" <>+ metavar "PATH" <>+ help "Build-plan YAML file"))) <*>+ fmap+ decodeString+ (strArgument+ (metavar "DESTINATION-PATH" <>+ help "Destination directory path")) <*>+ (fmap+ (Just . decodeString)+ (strOption+ (long "log-dir" <>+ metavar "PATH" <>+ help "Location of log files (default DESTINATION-PATH/logs)")) <|>+ pure Nothing) <*>+ option+ auto+ (long "jobs" <>+ metavar "NUMBER" <>+ showDefault <> value 8 <>+ help "Number of threads") <*>+ switch+ (long "global" <>+ help "Install in global package database") <*>+ fmap+ not+ (switch+ (long "skip-tests" <>+ help "Skip build and running the test suites")) <*>+ fmap+ not+ (switch+ (long "skip-haddock" <>+ help "Skip generating haddock documentation")) <*>+ switch+ (long "enable-library-profiling" <>+ help "Enable profiling when building") <*>+ switch+ (long "enable-executable-dynamic" <>+ help "Enable dynamic executables when building") <*>+ switch+ (long "verbose" <> short 'v' <>+ help "Output verbose detail about the build steps") <*>+ switch+ (long "skip-check" <>+ help "Skip the check phase, and pass --allow-newer to cabal configure")++ uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do+ token <- getStackageAuthToken+ res <- flip uploadBundleV2 man UploadBundleV2+ { ub2AuthToken = token+ , ub2Server = fromString url+ , ub2Bundle = decodeString path+ }+ putStrLn $ "New URL: " ++ T.unpack res++ uploadv2Flags = (,)+ <$> (strArgument+ (metavar "BUNDLE-PATH" <>+ help "Bundle path"))+ <*> strOption+ (long "server-url" <>+ metavar "SERVER-URL" <>+ showDefault <> value (T.unpack $ unStackageServer def) <>+ help "Server to upload bundle to")
stackage.cabal view
@@ -1,5 +1,5 @@ name: stackage-version: 0.5.2+version: 0.6.0 synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage. description: Please see <http://www.stackage.org/package/stackage> for a description and documentation. homepage: https://github.com/fpco/stackage@@ -23,7 +23,9 @@ Stackage.BuildPlan Stackage.CheckBuildPlan Stackage.UpdateBuildPlan+ Stackage.GhcPkg Stackage.GithubPings+ Stackage.InstallBuild Stackage.PackageDescription Stackage.ServerBundle Stackage.Upload@@ -53,6 +55,7 @@ , yaml , unix-compat , http-client+ , http-conduit , http-client-tls , temporary , data-default-class@@ -62,6 +65,7 @@ , streaming-commons >= 0.1.7.1 , semigroups , xml-conduit+ , conduit executable stackage default-language: Haskell2010@@ -70,6 +74,10 @@ build-depends: base , stackage , optparse-applicative >= 0.11+ , system-filepath+ , http-client+ , http-client-tls+ , text ghc-options: -rtsopts -threaded -with-rtsopts=-N test-suite spec
test/Stackage/BuildPlanSpec.hs view
@@ -36,8 +36,10 @@ [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])]) ,("bar", [0, 0, 0], [("mu", thisV [0, 0, 0])]) ,("mu", [0, 0, 0], [("foo", thisV [0, 0, 0])])]+ {- Shouldn't be testing this actually it "default package set checks ok" $ check defaultBuildConstraints getLatestAllowedPlans+ -} -- | Checking should be considered a bad build plan. badBuildPlan :: (BuildConstraints -> IO (Map PackageName PackagePlan))