on baf7dca help sign in
stackage/Stackage/InstallBuild.hs
102 lines 3.8 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6module Stackage.InstallBuild
7 ( InstallFlags (..)
8 , BuildPlanSource (..)
9 , installBuild
10 ) where
12import qualified Codec.Archive.Tar as Tar
13import qualified Codec.Compression.GZip as GZip
14import qualified Data.Yaml as Yaml
15import Network.HTTP.Client
16import Network.HTTP.Client.TLS (tlsManagerSettings)
17import Stackage.BuildPlan
18import Stackage.CheckBuildPlan
19import Stackage.PerformBuild
20import Stackage.Prelude
21import System.IO (BufferMode (LineBuffering), hSetBuffering)
23-- | Flags passed in from the command line.
24data InstallFlags = InstallFlags
25 { ifPlanSource :: !BuildPlanSource
26 , ifInstallDest :: !FilePath
27 , ifLogDir :: !(Maybe FilePath)
28 , ifJobs :: !Int
29 , ifGlobalInstall :: !Bool
30 , ifEnableTests :: !Bool
31 , ifEnableHaddock :: !Bool
32 , ifEnableLibProfiling :: !Bool
33 , ifEnableExecDyn :: !Bool
34 , ifVerbose :: !Bool
35 , ifSkipCheck :: !Bool
36 , ifBuildHoogle :: !Bool
37 } deriving (Show)
39-- | Source for build plan.
40data BuildPlanSource = BPSBundleWeb String
41 | BPSFile FilePath
42 deriving (Show)
44getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
45getPerformBuild plan InstallFlags{..} =
46 PerformBuild
47 { pbPlan = plan
48 , pbInstallDest = ifInstallDest
49 , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir
50 , pbLog = hPut stdout
51 , pbJobs = ifJobs
52 , pbGlobalInstall = ifGlobalInstall
53 , pbEnableTests = ifEnableTests
54 , pbEnableHaddock = ifEnableHaddock
55 , pbEnableLibProfiling = ifEnableLibProfiling
56 , pbEnableExecDyn = ifEnableExecDyn
57 , pbVerbose = ifVerbose
58 , pbAllowNewer = ifSkipCheck
59 , pbBuildHoogle = ifBuildHoogle
60 }
62-- | Install stackage from an existing build plan.
63installBuild :: InstallFlags -> IO ()
64installBuild installFlags@InstallFlags{..} = do
65 hSetBuffering stdout LineBuffering
67 putStrLn $ "Loading build plan"
68 plan <- case ifPlanSource of
69 BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
70 req <- parseUrl url
71 res <- httpLbs req man
72 planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
73 decodeBuildPlan planBSL
74 BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
76 if ifSkipCheck
77 then putStrLn "Skipping build plan check"
78 else do
79 putStrLn "Checking build plan"
80 checkBuildPlan plan
82 putStrLn "Performing build"
83 performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
85 where
86 getPlanEntry Tar.Done = throwIO NoBuildPlanException
87 getPlanEntry (Tar.Fail e) = throwIO e
88 getPlanEntry (Tar.Next entry entries)
89 | Tar.entryPath entry == "build-plan.yaml" =
90 case Tar.entryContent entry of
91 Tar.NormalFile bs _ -> return bs
92 _ -> throwIO NoBuildPlanException
93 | otherwise = getPlanEntry entries
95 decodeBuildPlan =
96 either throwIO return . Yaml.decodeEither' . toStrict
98data InstallBuildException = NoBuildPlanException
99 deriving (Typeable)
100instance Exception InstallBuildException
101instance Show InstallBuildException where
102 show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"