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