git.iko.soy/stackage
on master help sign in
Add `install` subcommand.
f51b86eEmanuel Borsboom
Stackage/InstallBuild.hsnew file+96
compare with master
unifiedsplit
@@ -0,0 +1,96 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE RecordWildCards #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+module Stackage.InstallBuild
7+ ( InstallFlags (..)
8+ , BuildPlanSource (..)
9+ , installBuild
10+ ) where
11+
12+import qualified Codec.Archive.Tar as Tar
13+import qualified Codec.Compression.GZip as GZip
14+import qualified Data.Yaml as Yaml
15+import Network.HTTP.Client
16+import Network.HTTP.Client.TLS (tlsManagerSettings)
17+import Stackage.BuildPlan
18+import Stackage.CheckBuildPlan
19+import Stackage.PerformBuild
20+import Stackage.Prelude
21+import System.IO (BufferMode (LineBuffering), hSetBuffering)
22+
23+-- | Flags passed in from the command line.
24+data InstallFlags = InstallFlags
25+ { ifPlanSource :: !BuildPlanSource
26+ , ifInstallDest :: !FilePath
27+ , ifLogDir :: !(Maybe FilePath)
28+ , ifJobs :: !Int
29+ , ifGlobalInstall :: !Bool
30+ , ifEnableTests :: !Bool
31+ , ifEnableLibProfiling :: !Bool
32+ , ifVerbose :: !Bool
33+ , ifSkipCheck :: !Bool
34+ } deriving (Show)
35+
36+-- | Source for build plan.
37+data BuildPlanSource = BPSBundleWeb String
38+ | BPSFile FilePath
39+ deriving (Show)
40+
41+getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
42+getPerformBuild plan InstallFlags{..} =
43+ PerformBuild
44+ { pbPlan = plan
45+ , pbInstallDest = ifInstallDest
46+ , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir
47+ , pbLog = hPut stdout
48+ , pbJobs = ifJobs
49+ , pbGlobalInstall = ifGlobalInstall
50+ , pbEnableTests = ifEnableTests
51+ , pbEnableLibProfiling = ifEnableLibProfiling
52+ , pbVerbose = ifVerbose
53+ , pbAllowNewer = ifSkipCheck
54+ }
55+
56+-- | Install stackage from an existing build plan.
57+installBuild :: InstallFlags -> IO ()
58+installBuild installFlags@InstallFlags{..} = do
59+ hSetBuffering stdout LineBuffering
60+
61+ putStrLn $ "Loading build plan"
62+ plan <- case ifPlanSource of
63+ BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
64+ req <- parseUrl url
65+ res <- httpLbs req man
66+ planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
67+ decodeBuildPlan planBSL
68+ BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
69+
70+ if ifSkipCheck
71+ then putStrLn "Skipping build plan check"
72+ else do
73+ putStrLn "Checking build plan"
74+ checkBuildPlan plan
75+
76+ putStrLn "Performing build"
77+ performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
78+
79+ where
80+ getPlanEntry Tar.Done = throwIO NoBuildPlanException
81+ getPlanEntry (Tar.Fail e) = throwIO e
82+ getPlanEntry (Tar.Next entry entries)
83+ | Tar.entryPath entry == "build-plan.yaml" =
84+ case Tar.entryContent entry of
85+ Tar.NormalFile bs _ -> return bs
86+ _ -> throwIO NoBuildPlanException
87+ | otherwise = getPlanEntry entries
88+
89+ decodeBuildPlan =
90+ either throwIO return . Yaml.decodeEither' . toStrict
91+
92+data InstallBuildException = NoBuildPlanException
93+ deriving (Typeable)
94+instance Exception InstallBuildException
95+instance Show InstallBuildException where
96+ show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"
app/stackage.hs+63−4
@@ -7,8 +7,10 @@ import Data.Monoid
7import Data.String (fromString)
7import Data.String (fromString)
8import Data.Version
8import Data.Version
9import Options.Applicative
9import Options.Applicative
10+import Filesystem.Path.CurrentOS (decodeString)
10import Paths_stackage (version)
11import Paths_stackage (version)
11import Stackage.CompleteBuild
12import Stackage.CompleteBuild
13+import Stackage.InstallBuild
12
14
13main :: IO ()
15main :: IO ()
14main =
16main =
@@ -25,9 +27,9 @@ main =
25 help "Show this help text"
27 help "Show this help text"
26 versionOption =
28 versionOption =
27 infoOption
29 infoOption
28− ("fpbuild version " ++ showVersion version)
30+ ("stackage version " ++ showVersion version)
29 (long "version" <>
31 (long "version" <>
30− help "Show fpbuild version")
32+ help "Show stackage version")
31 config =
33 config =
32 subparser $
34 subparser $
33 mconcat
35 mconcat
@@ -55,12 +57,19 @@ main =
55 (const justCheck)
57 (const justCheck)
56 (pure ())
58 (pure ())
57 "check"
59 "check"
58− "Just check that the build plan is ok"]
60+ "Just check that the build plan is ok"
61+ , cmnd
62+ installBuild
63+ installFlags
64+ "install"
65+ "Install a snapshot from an existing build plan"]
66+
59 cmnd exec parse name desc =
67 cmnd exec parse name desc =
60 command name $
68 command name $
61 info
69 info
62− (fmap exec parse)
70+ (fmap exec (parse <**> helpOption))
63 (progDesc desc)
71 (progDesc desc)
72+
64 buildFlags =
73 buildFlags =
65 BuildFlags <$>
74 BuildFlags <$>
66 fmap
75 fmap
@@ -86,3 +95,53 @@ main =
86 nightlyUploadFlags = fromString <$> strArgument
95 nightlyUploadFlags = fromString <$> strArgument
87 (metavar "DATE" <>
96 (metavar "DATE" <>
88 help "Date, in YYYY-MM-DD format")
97 help "Date, in YYYY-MM-DD format")
98+
99+ installFlags =
100+ InstallFlags <$>
101+ (fmap
102+ BPSBundleWeb
103+ (strOption
104+ (long "bundle" <>
105+ metavar "URL" <>
106+ help "Stackage bundle containing build plan")) <|>
107+ fmap
108+ (BPSFile . decodeString)
109+ (strOption
110+ (long "build-plan" <>
111+ metavar "PATH" <>
112+ help "Build-plan YAML file"))) <*>
113+ fmap
114+ decodeString
115+ (strArgument
116+ (metavar "DESTINATION-PATH" <>
117+ help "Destination directory path")) <*>
118+ (fmap
119+ (Just . decodeString)
120+ (strOption
121+ (long "log-dir" <>
122+ metavar "PATH" <>
123+ help "Location of log files (default DESTINATION-PATH/logs)")) <|>
124+ pure Nothing) <*>
125+ option
126+ auto
127+ (long "jobs" <>
128+ metavar "NUMBER" <>
129+ showDefault <> value 8 <>
130+ help "Number of threads") <*>
131+ switch
132+ (long "global" <>
133+ help "Install in global package database") <*>
134+ fmap
135+ not
136+ (switch
137+ (long "skip-tests" <>
138+ help "Skip build and running the test suites")) <*>
139+ switch
140+ (long "enable-library-profiling" <>
141+ help "Enable profiling when building") <*>
142+ switch
143+ (long "verbose" <> short 'v' <>
144+ help "Output verbose detail about the build steps") <*>
145+ switch
146+ (long "skip-check" <>
147+ help "Skip the check phase, and pass --allow-newer to cabal configure")
stackage.cabal+2
@@ -24,6 +24,7 @@ library
24 Stackage.CheckBuildPlan
24 Stackage.CheckBuildPlan
25 Stackage.UpdateBuildPlan
25 Stackage.UpdateBuildPlan
26 Stackage.GithubPings
26 Stackage.GithubPings
27+ Stackage.InstallBuild
27 Stackage.PackageDescription
28 Stackage.PackageDescription
28 Stackage.ServerBundle
29 Stackage.ServerBundle
29 Stackage.Upload
30 Stackage.Upload
@@ -70,6 +71,7 @@ executable stackage
70 build-depends: base
71 build-depends: base
71 , stackage
72 , stackage
72 , optparse-applicative >= 0.11
73 , optparse-applicative >= 0.11
74+ , system-filepath
73 ghc-options: -rtsopts -threaded -with-rtsopts=-N
75 ghc-options: -rtsopts -threaded -with-rtsopts=-N
74
76
75test-suite spec
77test-suite spec