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