git.iko.soy/stackage
on 4cb98cd help sign in
stackage/Stackage/InstallBuild.hs
96 lines 3.5 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 , ifEnableLibProfiling :: !Bool
32 , ifVerbose :: !Bool
33 , ifSkipCheck :: !Bool
34 } deriving (Show)
36-- | Source for build plan.
37data BuildPlanSource = BPSBundleWeb String
38 | BPSFile FilePath
39 deriving (Show)
41getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
42getPerformBuild 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 }
56-- | Install stackage from an existing build plan.
57installBuild :: InstallFlags -> IO ()
58installBuild installFlags@InstallFlags{..} = do
59 hSetBuffering stdout LineBuffering
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
70 if ifSkipCheck
71 then putStrLn "Skipping build plan check"
72 else do
73 putStrLn "Checking build plan"
74 checkBuildPlan plan
76 putStrLn "Performing build"
77 performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
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
89 decodeBuildPlan =
90 either throwIO return . Yaml.decodeEither' . toStrict
92data InstallBuildException = NoBuildPlanException
93 deriving (Typeable)
94instance Exception InstallBuildException
95instance Show InstallBuildException where
96 show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"