diff --git a/Stackage/InstallBuild.hs b/Stackage/InstallBuild.hs new file mode 100644 index 00000000..abe8a14e --- /dev/null +++ b/Stackage/InstallBuild.hs @@ -0,0 +1,96 @@ +{-# 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 + , ifEnableLibProfiling :: !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 + , pbEnableLibProfiling = ifEnableLibProfiling + , 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" diff --git a/app/stackage.hs b/app/stackage.hs index 1f61496f..8fdd2833 100644 --- a/app/stackage.hs +++ b/app/stackage.hs @@ -7,8 +7,10 @@ import Data.Monoid import Data.String (fromString) import Data.Version import Options.Applicative +import Filesystem.Path.CurrentOS (decodeString) import Paths_stackage (version) import Stackage.CompleteBuild +import Stackage.InstallBuild main :: IO () main = @@ -25,9 +27,9 @@ main = 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 +57,19 @@ main = (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 exec parse name desc = command name $ info - (fmap exec parse) + (fmap exec (parse <**> helpOption)) (progDesc desc) + buildFlags = BuildFlags <$> fmap @@ -86,3 +95,53 @@ main = 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")) <*> + switch + (long "enable-library-profiling" <> + help "Enable profiling 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") diff --git a/stackage.cabal b/stackage.cabal index c5e848e7..94b42da9 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -24,6 +24,7 @@ library Stackage.CheckBuildPlan Stackage.UpdateBuildPlan Stackage.GithubPings + Stackage.InstallBuild Stackage.PackageDescription Stackage.ServerBundle Stackage.Upload @@ -70,6 +71,7 @@ executable stackage build-depends: base , stackage , optparse-applicative >= 0.11 + , system-filepath ghc-options: -rtsopts -threaded -with-rtsopts=-N test-suite spec