Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 280 lines (247 sloc) 10.835 kb
3d5a304 Update copyright notices in Haskell sources
Jonathan Daugherty authored
1 {- Copyright (c) 2011 Galois, Inc -}
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
2 module Main
3 ( main )
4 where
5
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
6 import Data.Char ( isSpace, isLetter )
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
7 import Data.List ( intercalate, transpose )
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
8 import Data.Maybe ( listToMaybe )
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
9 import Data.Version ( showVersion )
057798a refactor line wrapping
Josh Hoyt authored
10 import Control.Monad ( unless )
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
11 import System.Exit ( exitWith, ExitCode(..) )
2638c17 fixed bug in Windows when the PATH env var is not ALLCAPS
Daniel Pratt authored
12 import System.Environment ( getArgs, getProgName, getEnv )
13 import System.IO.Error ( catchIOError )
0864a08 @sol Add sandbox bin dir to path
sol authored
14 import System.SetEnv (setEnv)
15 import System.FilePath ((</>), searchPathSeparator)
bd3c69a Try harder to pass through arguments to cabal unaltered
Josh Hoyt authored
16 import System.Console.GetOpt ( usageInfo, getOpt, ArgOrder(Permute) )
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
17 import Distribution.Simple.Utils ( cabalVersion, debug )
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
18 import Distribution.Text ( display )
057798a refactor line wrapping
Josh Hoyt authored
19 import Control.Monad.Trans.State ( evalState, gets, modify )
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
20
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
21 import Distribution.Dev.Command ( CommandActions(..), CommandResult(..) )
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
22 import Distribution.Dev.Flags ( parseGlobalFlags, helpRequested, globalOpts
9b2e723 Created a data type for cabal-dev configuration. Also added the ability ...
Josh Hoyt authored
23 , GlobalFlag(Version), getOpt'', fromFlags
d70f63a @isturdy Recognized CABAL_SANDBOX environment variable.
isturdy authored
24 , getVerbosity, Config, getSandbox, getEnvVars
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
25 )
10bc18e Fix cabal file missing some modules for dist. Add test for building from...
Josh Hoyt authored
26 import qualified Distribution.Dev.AddSource as AddSource
2aa8599 @creswick implemented caba-dev ghci
authored
27 import qualified Distribution.Dev.Ghci as Ghci
8ae005c Add support for invoking cabal-install with a per-project configuration
Josh Hoyt authored
28 import qualified Distribution.Dev.InvokeCabal as InvokeCabal
932bbbb Added install-deps command, bumped to version 0.3
Josh Hoyt authored
29 import qualified Distribution.Dev.InstallDependencies as InstallDeps
6d41ec3 Add command to extract the build options to GHC
Josh Hoyt authored
30 import qualified Distribution.Dev.BuildOpts as BuildOpts
0bd810d Add a ghc-pkg command, and fix the cabal file to specify the version of ...
Josh Hoyt authored
31 import qualified Distribution.Dev.GhcPkg as GhcPkg
11fe927 Use Template Haskell to extract the available commands at compile time
Josh Hoyt authored
32 import qualified Distribution.Dev.CabalInstall as CI
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
33 import Paths_cabal_dev ( version )
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
34
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
35 import qualified Data.Map as Map
36
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
37 cabalDevCommands :: [(String, CommandActions, String)]
38 cabalDevCommands = [ ( "add-source"
39 , AddSource.actions
40 , "Make a package available for cabal-install to " ++
41 "install (in a sandbox-local Hackage repository). " ++
42 "Note that this command does NOT install the " ++
43 "package in the sandbox, and does require the " ++
44 "package to have a working sdist."
45 )
46 , ( "install-deps"
47 , InstallDeps.actions
48 , "Install the packages that depend on the specified " ++
49 "packages, but not the packages themselves. " ++
50 "(Equivalent to install --only-dependencies for " ++
51 "cabal-install > 0.10)"
52 )
53 , ( "ghci"
54 , Ghci.actions
55 , "Start ghci with the sandbox's GHC package " ++
56 "repository available. This command does not " ++
57 "yet take into account the contents of the .cabal " ++
58 "file (e.g. source directories, available packages " ++
59 "LANGUAGE pragmas)."
60 )
6d41ec3 Add command to extract the build options to GHC
Josh Hoyt authored
61 , ( "buildopts"
62 , BuildOpts.actions
63 , "Extract the options that would be passed to the " ++
64 "compiler when building"
65 )
0bd810d Add a ghc-pkg command, and fix the cabal file to specify the version of ...
Josh Hoyt authored
66 , ( "ghc-pkg"
67 , GhcPkg.actions
68 , "Invoke ghc-pkg including the appropriate " ++
69 "--package-conf argument to run on the sandbox's " ++
70 "package database."
71 )
71f4b86 Make the --help output more readable
Josh Hoyt authored
72 ]
73
74 cabalInstallCommands :: [(String, CommandActions)]
75 cabalInstallCommands = map cabal CI.allCommands
8ae005c Add support for invoking cabal-install with a per-project configuration
Josh Hoyt authored
76 where
ce1baac Only pass supported options to cabal-install for the specified command (...
Josh Hoyt authored
77 cabal s = (CI.commandToString s, InvokeCabal.actions s)
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
78
71f4b86 Make the --help output more readable
Josh Hoyt authored
79 allCommands :: [(String, CommandActions)]
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
80 allCommands = [(s, a) | (s, a, _) <- cabalDevCommands] ++ cabalInstallCommands
71f4b86 Make the --help output more readable
Josh Hoyt authored
81
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
82 printVersion :: IO ()
83 printVersion = do
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
84 putStr versionString
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
85 exitWith ExitSuccess
86
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
87 versionString :: String
88 versionString = unlines $
89 [ "cabal-dev " ++ showVersion version
90 , "built with Cabal " ++ display cabalVersion
91 ]
92
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
93 printNumericVersion :: IO ()
94 printNumericVersion = do
95 putStrLn $ showVersion version
96 exitWith ExitSuccess
97
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
98 main :: IO ()
99 main = do
d70f63a @isturdy Recognized CABAL_SANDBOX environment variable.
isturdy authored
100 envConf <- getEnvVars
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
101 (globalFlags, args, errs) <- parseGlobalFlags `fmap` getArgs
102 unless (null errs) $ do
103 mapM_ putStrLn errs
104 putStr =<< globalUsage
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
105 exitWith (ExitFailure 1)
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
106
d70f63a @isturdy Recognized CABAL_SANDBOX environment variable.
isturdy authored
107 let cfg = fromFlags envConf globalFlags
0864a08 @sol Add sandbox bin dir to path
sol authored
108
109 -- add sandbox bin dir to PATH, so that custom preprocessors that are
110 -- installed into the sandbox are found
111 let binDir = getSandbox cfg </> "bin"
2638c17 fixed bug in Windows when the PATH env var is not ALLCAPS
Daniel Pratt authored
112 mPath <- maybeGetEnv "PATH"
0864a08 @sol Add sandbox bin dir to path
sol authored
113 let path = maybe binDir ((binDir ++ [searchPathSeparator]) ++) mPath
114 setEnv "PATH" path
115
c1c9546 Added version flag and debugging output for adding a source distribution
Josh Hoyt authored
116 case [f|(Version f) <- globalFlags] of
117 (True:_) -> printNumericVersion
118 (False:_) -> printVersion
119 [] -> return ()
120
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
121 debug (getVerbosity cfg) versionString
122
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
123 case args of
124 (name:args') ->
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
125 case nameCmd name of
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
126 Just cmdAct | helpRequested globalFlags ->
127 do putStrLn $ cmdDesc cmdAct
128 putStr =<< globalUsage
129 exitWith ExitSuccess
130 | otherwise -> runCmd cmdAct cfg args'
131
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
132 Nothing -> do putStrLn $ "Unknown command: " ++ show name
133 putStr =<< globalUsage
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
134 exitWith (ExitFailure 1)
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
135 _ | helpRequested globalFlags -> do
136 putStr =<< globalUsage
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
137 exitWith ExitSuccess
772f802 Start of work toward a mk-repo command that creates a cabal sandbox
Josh Hoyt authored
138 | otherwise -> do
139 putStrLn "Missing command name"
140 putStr =<< globalUsage
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
141 exitWith (ExitFailure 1)
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
142
143 globalUsage :: IO String
144 globalUsage = do
145 progName <- getProgName
0bd810d Add a ghc-pkg command, and fix the cabal file to specify the version of ...
Josh Hoyt authored
146 let fmtCommands cmds =
147 fmtTable " " [ [[""], [n], wrap 60 d] | (n, _, d) <- cmds ]
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
148 let preamble =
149 unlines $
150 [ ""
151 , "Usage: " ++ progName ++ " <command>"
152 , ""
153 , "Where <command> is one of:"
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
154 ] ++ fmtCommands cabalDevCommands ++
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
155 [ ""
71f4b86 Make the --help output more readable
Josh Hoyt authored
156 , "or any cabal-install command (see cabal --help for documentation)."
157 , ""
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
158 , "Options to cabal-dev:"
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
159 ]
160 return $ usageInfo preamble globalOpts
161
162 nameCmd :: String -> Maybe CommandActions
163 nameCmd s = listToMaybe [a | (n, a) <- allCommands, n == s]
164
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
165 runCmd :: CommandActions -> Config -> [String] -> IO ()
166 runCmd cmdAct cfg args =
167 do res <- run
168 case res of
169 CommandOk -> exitWith ExitSuccess
170 CommandError msg -> showError [msg]
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
171 where
172 showError msgs = do
430ecbb Better handle some errors
Josh Hoyt authored
173 putStr $ unlines $ "FAILED:":msgs ++ [replicate 50 '-', cmdDesc cmdAct]
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
174 putStr =<< globalUsage
bc785c1 Documentation, finish GHC 6.8, Cabal 1.4 compatibility
Josh Hoyt authored
175 exitWith (ExitFailure 1)
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
176
177 run = case cmdAct of
d28012a Pass through flags to cabal invocations, rename mk-repo to add-source
Josh Hoyt authored
178 (CommandActions _ r o passFlags) ->
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
179 let (cmdFlags, cmdArgs, cmdErrs) =
d28012a Pass through flags to cabal invocations, rename mk-repo to add-source
Josh Hoyt authored
180 if passFlags
bd3c69a Try harder to pass through arguments to cabal unaltered
Josh Hoyt authored
181 then getOpt'' o args
d28012a Pass through flags to cabal invocations, rename mk-repo to add-source
Josh Hoyt authored
182 else getOpt Permute o args
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
183 in if null cmdErrs
ab5bd5f Added additional debugging output of versions of cabal-dev, Cabal, and c...
Josh Hoyt authored
184 then r cfg cmdFlags cmdArgs
faf1126 Refactor so that all exit calls happen in Main
Josh Hoyt authored
185 else showError cmdErrs
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
186
187 -- |Format a table
188 fmtTable :: String -- ^Column separator
189 -> [[[String]]] -- ^Table rows (each cell may have more than
190 -- one line)
191 -> [String] -- ^Lines of output
192 fmtTable colSep rows = map fmtLine $ fmtRow =<< rows
193 where
194 fmtRow cs = transpose $ map (pad [] (maximum $ map length cs)) cs
195 fmtLine l = intercalate colSep $ zipWith (pad ' ') widths l
196 widths = map (maximum . map length . concat) $ transpose rows
197 pad c w s = take w $ s ++ repeat c
198
199 -- |Wrap a String of text to lines shorter than the specified number.
200 --
201 -- This function has heuristics for human-readability, such as
202 -- avoiding splitting in the middle of words when possible.
057798a refactor line wrapping
Josh Hoyt authored
203 wrap :: Int -- ^Maximum line length
204 -> String -- ^Text to wrap
205 -> [String] -- ^Wrapped lines
206 wrap _ "" = []
207 wrap w orig = snd $ evalState (go 0 orig) Map.empty
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
208 where
057798a refactor line wrapping
Josh Hoyt authored
209 go loc s = do
210 precomputed <- gets $ Map.lookup loc
211 case precomputed of
212 Nothing -> bestAnswer loc =<< mapM (scoreSplit loc) (splits w s)
213 Just answer -> return answer
214
215 scoreSplit loc (offset, lineScore, line, s') =
216 case s' of
217 "" -> return (lineScore, [line])
218 _ -> do
219 (restScore, lines_) <- go (loc + offset) s'
220 return (lineScore + restScore, line:lines_)
221
222 bestAnswer _ [] = error "No splits found!"
223 bestAnswer loc answers = do
224 let answer = minimum answers
225 modify $ Map.insert loc answer
226 return answer
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
227
228 -- Find all the locations that make sense to split the next line, and
229 -- score them.
230 splits :: Int -> String -> [(Int, Int, String, String)]
231 splits w s = map (\k -> score k $ splitAt k s) [w - 1,w - 2..1]
232 where
233 score k ([], cs) = (k, w * w, [], cs)
234 score k (r, []) = (k, 0, r, [])
235 score k (r, cs@(c:_)) = let (sps, cs') = countDropSpaces 0 cs
057798a refactor line wrapping
Josh Hoyt authored
236 spaceLeft = w - length r
237 in ( -- How much of the string was consumed?
238 k + sps
239
240 -- How much does it cost to split here?
241 , penalty (last r) c + spaceLeft * spaceLeft
242
243 -- The text of the line that results
244 -- from this split
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
245 , r
057798a refactor line wrapping
Josh Hoyt authored
246
247 -- The text that has not yet been split
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
248 , cs'
249 )
250
251 countDropSpaces i (c:cs) | isSpace c = countDropSpaces (i + 1) cs
252 countDropSpaces i cs = (i, cs)
253
254 -- Characters that want to stick to non-whitespace characters to
255 -- their right
256 rbind = (`elem` "\"'([<")
257
057798a refactor line wrapping
Josh Hoyt authored
258 -- How much should it cost to make a split between these
259 -- characters?
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
260 penalty b c
261 -- Don't penalize boundaries between space and non-space
262 | not (isSpace b) && isSpace c = 0
263 | isSpace b && not (isSpace c) = 2
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
264 | rbind b && not (isSpace c) = w `div` 2
7c2c2f8 Added command documentation to the --help output
Josh Hoyt authored
265 -- Penalize splitting a word heavily
266 | isLetter b && isLetter c = w * 2
267 -- Prefer splitting after a letter if it's not
268 -- followed by a letter
269 | isLetter c = 3
270 -- Other kinds of splits are not as bad as splitting
271 -- between words, but are still pretty harmful.
f0c6085 Make word wrapping more efficient
Josh Hoyt authored
272 | otherwise = w
2638c17 fixed bug in Windows when the PATH env var is not ALLCAPS
Daniel Pratt authored
273
274 -- Return the value of the environment variable with the given name
275 -- or Nothing if the variable is not defined.
276 -- Probably should be replaced with System.Environment.lookupEnv
277 -- when the base library is upgraded >= 4.6
278 maybeGetEnv :: String -> IO (Maybe String)
279 maybeGetEnv name = (Just `fmap` getEnv name) `catchIOError` const (return Nothing)
Something went wrong with that request. Please try again.