Add install subcommand.

Used to install a Stackage snapshot from a build plan.

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"

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")

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