git.iko.soy/stackage
on 894eae4 help sign in
stackage/app/stackage.hs
129 lines 5.5 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2import Data.Set (fromList)
3import Stackage.Build (build, defaultBuildSettings)
4import Stackage.BuildPlan (readBuildPlan, writeBuildPlan)
5import Stackage.CheckPlan (checkPlan)
6import Stackage.GhcPkg (getGhcVersion)
7import Stackage.Init (stackageInit)
8import Stackage.Select (defaultSelectSettings, select)
9import Stackage.Tarballs (makeTarballs)
10import Stackage.Test (runTestSuites)
11import Stackage.Types
12import Stackage.Util (allowPermissive)
13import System.Environment (getArgs, getProgName)
14import System.IO (hFlush, stdout)
16data SelectArgs = SelectArgs
17 { excluded :: [String]
18 , noPlatform :: Bool
19 , onlyPermissive :: Bool
20 , allowed :: [String]
21 , buildPlanDest :: FilePath
22 , globalDB :: Bool
23 }
25parseSelectArgs :: [String] -> IO SelectArgs
26parseSelectArgs =
27 loop SelectArgs
28 { excluded = []
29 , noPlatform = False
30 , onlyPermissive = False
31 , allowed = []
32 , buildPlanDest = defaultBuildPlan
33 , globalDB = False
34 }
35 where
36 loop x [] = return x
37 loop x ("--exclude":y:rest) = loop x { excluded = y : excluded x } rest
38 loop x ("--no-platform":rest) = loop x { noPlatform = True } rest
39 loop x ("--only-permissive":rest) = loop x { onlyPermissive = True } rest
40 loop x ("--allow":y:rest) = loop x { allowed = y : allowed x } rest
41 loop x ("--build-plan":y:rest) = loop x { buildPlanDest = y } rest
42 loop x ("--use-global-db":rest) = loop x { globalDB = True } rest
43 loop _ (y:_) = error $ "Did not understand argument: " ++ y
45data BuildArgs = BuildArgs
46 { sandbox :: String
47 , buildPlanSrc :: FilePath
48 , extraArgs' :: [String] -> [String]
49 , noDocs :: Bool
50 , buildCores :: Maybe Int
51 }
53parseBuildArgs :: GhcMajorVersion -> [String] -> IO BuildArgs
54parseBuildArgs version =
55 loop BuildArgs
56 { sandbox = sandboxRoot $ defaultBuildSettings Nothing version
57 , buildPlanSrc = defaultBuildPlan
58 , extraArgs' = id
59 , noDocs = False
60 , buildCores = Nothing
61 }
62 where
63 loop x [] = return x
64 loop x ("--sandbox":y:rest) = loop x { sandbox = y } rest
65 loop x ("--build-plan":y:rest) = loop x { buildPlanSrc = y } rest
66 loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
67 loop x ("--no-docs":rest) = loop x { noDocs = True } rest
68 loop x ("-j":y:rest) = loop x { buildCores = Just $ read y } rest
69 loop _ (y:_) = error $ "Did not understand argument: " ++ y
71defaultBuildPlan :: FilePath
72defaultBuildPlan = "build-plan.txt"
74withBuildSettings :: [String] -> (BuildSettings -> BuildPlan -> IO a) -> IO a
75withBuildSettings args f = do
76 version <- getGhcVersion
77 BuildArgs {..} <- parseBuildArgs version args
78 bp <- readBuildPlan buildPlanSrc
79 let bs = defaultBuildSettings buildCores version
80 let settings = bs
81 { sandboxRoot = sandbox
82 , extraArgs = extraArgs' . extraArgs bs
83 , buildDocs = not noDocs
84 }
85 f settings bp
87main :: IO ()
88main = do
89 args <- getArgs
90 case args of
91 "select":rest -> do
92 SelectArgs {..} <- parseSelectArgs rest
93 ghcVersion <- getGhcVersion
94 bp <- select
95 (defaultSelectSettings ghcVersion)
96 { excludedPackages = fromList $ map PackageName excluded
97 , requireHaskellPlatform = not noPlatform
98 , allowedPackage =
99 if onlyPermissive
100 then allowPermissive allowed
101 else const $ Right ()
102 , useGlobalDatabase = globalDB
103 }
104 writeBuildPlan buildPlanDest bp
105 ("check":rest) -> withBuildSettings rest checkPlan
106 ("build":rest) -> withBuildSettings rest build
107 ("test":rest) -> withBuildSettings rest runTestSuites
108 ("tarballs":rest) -> withBuildSettings rest $ const makeTarballs
109 ["init"] -> do
110 putStrLn "Note: init isn't really ready for prime time use."
111 putStrLn "Using it may make it impossible to build stackage."
112 putStr "Are you sure you want continue (y/n)? "
113 hFlush stdout
114 x <- getLine
115 case x of
116 c:_ | c `elem` "yY" -> stackageInit
117 _ -> putStrLn "Probably a good decision, exiting."
118 ["update"] -> stackageInit >> error "FIXME update"
119 _ -> do
120 pn <- getProgName
121 putStrLn $ "Usage: " ++ pn ++ " <command>"
122 putStrLn "Available commands:"
123 --putStrLn " update Download updated Stackage databases. Automatically calls init."
124 --putStrLn " init Initialize your cabal file to use Stackage"
125 putStrLn " uploads"
126 putStrLn " select [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package] [--build-plan file]"
127 putStrLn " check [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
128 putStrLn " build [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
129 putStrLn " test [--build-plan file] [--sandbox rootdir] [--arg cabal-arg] [--no-docs]"