on 13ebae0 help sign in
stackage/Stackage/InstallBuild.hs
98 lines 3.6 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 , ifVerbose :: !Bool
34 , ifSkipCheck :: !Bool
35 } deriving (Show)
37-- | Source for build plan.
38data BuildPlanSource = BPSBundleWeb String
39 | BPSFile FilePath
40 deriving (Show)
42getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
43getPerformBuild plan InstallFlags{..} =
44 PerformBuild
45 { pbPlan = plan
46 , pbInstallDest = ifInstallDest
47 , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir
48 , pbLog = hPut stdout
49 , pbJobs = ifJobs
50 , pbGlobalInstall = ifGlobalInstall
51 , pbEnableTests = ifEnableTests
52 , pbEnableHaddock = ifEnableHaddock
53 , pbEnableLibProfiling = ifEnableLibProfiling
54 , pbVerbose = ifVerbose
55 , pbAllowNewer = ifSkipCheck
56 }
58-- | Install stackage from an existing build plan.
59installBuild :: InstallFlags -> IO ()
60installBuild installFlags@InstallFlags{..} = do
61 hSetBuffering stdout LineBuffering
63 putStrLn $ "Loading build plan"
64 plan <- case ifPlanSource of
65 BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
66 req <- parseUrl url
67 res <- httpLbs req man
68 planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
69 decodeBuildPlan planBSL
70 BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
72 if ifSkipCheck
73 then putStrLn "Skipping build plan check"
74 else do
75 putStrLn "Checking build plan"
76 checkBuildPlan plan
78 putStrLn "Performing build"
79 performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
81 where
82 getPlanEntry Tar.Done = throwIO NoBuildPlanException
83 getPlanEntry (Tar.Fail e) = throwIO e
84 getPlanEntry (Tar.Next entry entries)
85 | Tar.entryPath entry == "build-plan.yaml" =
86 case Tar.entryContent entry of
87 Tar.NormalFile bs _ -> return bs
88 _ -> throwIO NoBuildPlanException
89 | otherwise = getPlanEntry entries
91 decodeBuildPlan =
92 either throwIO return . Yaml.decodeEither' . toStrict
94data InstallBuildException = NoBuildPlanException
95 deriving (Typeable)
96instance Exception InstallBuildException
97instance Show InstallBuildException where
98 show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"