Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 426 lines (370 sloc) 13.775 kB
aff37c2 First release of HackPort, the Hackage tool for Portage
der_eq@freenet.de authored
1 module Main where
2
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
3 import Control.Monad
03de0f6 Adding diff command to HackPort
der_eq@freenet.de authored
4 import Data.Char
7d1091e @kolmodin Change parameter to merge and remove --portage-category
kolmodin authored
5 import Data.Maybe
cfd83a3 Introducing a local cache to speed things up
der_eq@freenet.de authored
6 import Data.List
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
7 import Data.Monoid
8 ( Monoid(..) )
9
10 -- cabal
11 import Distribution.Simple.Setup
12 ( Flag(..), fromFlag
13 , falseArg
14 , flagToMaybe, flagToList
a973398 @kolmodin Fix verbosity flag
kolmodin authored
15 , optionVerbosity
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
16 )
ffabce4 Update to Cabal-1.4 api
Duncan Coutts authored
17 import Distribution.PackageDescription.Configuration
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
18 ( flattenPackageDescription )
19 import Distribution.ReadE ( succeedReadE )
20 import Distribution.Simple.Command -- commandsRun
21 import Distribution.Simple.Utils ( die )
22 import qualified Distribution.PackageDescription as Cabal
23 import Distribution.Verbosity (Verbosity, normal)
24
25 import Network.URI
26 import System.Environment ( getArgs, getProgName )
27 import System.Exit ( exitFailure )
e35e41e @kolmodin Make merging respect categories
kolmodin authored
28 import System.IO
263875a Less ugly debug method
der_eq@freenet.de authored
29
9b8eb4b @kolmodin Fix broken flag handling for 'hackport status'
kolmodin authored
30 import Bash
5078263 @kolmodin Make diffing respect categories
kolmodin authored
31 import qualified Cabal2Ebuild as E
9448bb7 @kolmodin Rewritten overlayonly functionality
kolmodin authored
32 import Cache
03de0f6 Adding diff command to HackPort
der_eq@freenet.de authored
33 import Diff
9448bb7 @kolmodin Rewritten overlayonly functionality
kolmodin authored
34 import Error
63b57b8 Adapted HackPort to the new Hackage interface
der_eq@freenet.de authored
35 import Index
78d22a2 @kolmodin Rename overlayonly to status
kolmodin authored
36 import Status
47991e5 @kolmodin Add stub for supporting overlays defined in paludis
kolmodin authored
37 import Overlays
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
38 import Merge
9448bb7 @kolmodin Rewritten overlayonly functionality
kolmodin authored
39
32a344c @trofi hackport-cabal2ebuild.patch
trofi authored
40 import Cabal2Ebuild
41
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
42 -----------------------------------------------------------------------
43 -- List
44 -----------------------------------------------------------------------
45
04af916 @kolmodin Enable --verbose for 'hackport list'
kolmodin authored
46 data ListFlags = ListFlags {
47 listVerbosity :: Flag Verbosity
48 }
49
50 instance Monoid ListFlags where
51 mempty = ListFlags {
52 listVerbosity = mempty
53 }
54 mappend a b = ListFlags {
55 listVerbosity = combine listVerbosity
56 }
57 where combine field = field a `mappend` field b
58
59 defaultListFlags :: ListFlags
60 defaultListFlags = ListFlags {
61 listVerbosity = Flag normal
62 }
63
64 listCommand :: CommandUI ListFlags
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
65 listCommand = CommandUI {
66 commandName = "list",
67 commandSynopsis = "List packages",
68 commandDescription = Just $ \pname ->
69 "TODO: this is the commandDescription for listCommand\n",
70 commandUsage = usagePackages "list",
04af916 @kolmodin Enable --verbose for 'hackport list'
kolmodin authored
71 commandDefaultFlags = defaultListFlags,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
72 commandOptions = \showOrParseArgs ->
04af916 @kolmodin Enable --verbose for 'hackport list'
kolmodin authored
73 [ optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v })
74 ]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
75 }
76
04af916 @kolmodin Enable --verbose for 'hackport list'
kolmodin authored
77 listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
78 listAction flags args globalFlags = do
79 let verbose = fromFlag (listVerbosity flags)
dab787f @kolmodin Fix more flags
kolmodin authored
80 portdirM = flagToMaybe (globalOverlayPath globalFlags)
81 overlay <- maybe (getOverlayPath verbose) return portdirM
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
82 index <- readCache overlay
83 let index' | null name = index
84 | otherwise = filterIndexByPV matchSubstringCaseInsensitive index
85 pkgs = [ pkg ++ "-" ++ ver | (pkg,ver,_) <- index']
86 if null pkgs
87 then throwEx (PackageNotFound name)
88 else putStr . unlines . sort $ pkgs
89 where
90 name | null args = []
91 | otherwise = head args
92 matchSubstringCaseInsensitive otherName _pVver =
93 map toLower name `isInfixOf` map toLower otherName
94
95 -----------------------------------------------------------------------
96 -- Make Ebuild
97 -----------------------------------------------------------------------
98
a096cbf @kolmodin Enable --verbose for 'hackport make-ebuild'
kolmodin authored
99 data MakeEbuildFlags = MakeEbuildFlags {
100 makeEbuildVerbosity :: Flag Verbosity
101 }
102
103 instance Monoid MakeEbuildFlags where
104 mempty = MakeEbuildFlags {
105 makeEbuildVerbosity = mempty
106 }
107 mappend a b = MakeEbuildFlags {
108 makeEbuildVerbosity = combine makeEbuildVerbosity
109 }
110 where combine field = field a `mappend` field b
111
112 defaultMakeEbuildFlags :: MakeEbuildFlags
113 defaultMakeEbuildFlags = MakeEbuildFlags {
114 makeEbuildVerbosity = Flag normal
115 }
116
117 makeEbuildAction :: MakeEbuildFlags -> [String] -> GlobalFlags -> IO ()
118 makeEbuildAction flags args globalFlags = do
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
119 when (null args) $
120 die "make-ebuild needs at least one argument"
a096cbf @kolmodin Enable --verbose for 'hackport make-ebuild'
kolmodin authored
121 let _verbosity = fromFlag (makeEbuildVerbosity flags)
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
122 forM_ args $ \cabalFileName -> do
32a344c @trofi hackport-cabal2ebuild.patch
trofi authored
123 pkg <- Cabal.readPackageDescription normal cabalFileName
ffabce4 Update to Cabal-1.4 api
Duncan Coutts authored
124 let ebuild = cabal2ebuild (flattenPackageDescription pkg)
32a344c @trofi hackport-cabal2ebuild.patch
trofi authored
125 let ebuildFileName = name ebuild ++ "-" ++ version ebuild ++ ".ebuild"
126 writeFile ebuildFileName (showEBuild ebuild)
127
a096cbf @kolmodin Enable --verbose for 'hackport make-ebuild'
kolmodin authored
128 makeEbuildCommand :: CommandUI MakeEbuildFlags
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
129 makeEbuildCommand = CommandUI {
130 commandName = "make-ebuild",
131 commandSynopsis = "Make an ebuild from a .cabal file",
132 commandDescription = Just $ \pname ->
133 "TODO: this is the commandDescription for makeEbuildCommand\n",
134 commandUsage = \_ -> [],
a096cbf @kolmodin Enable --verbose for 'hackport make-ebuild'
kolmodin authored
135 commandDefaultFlags = defaultMakeEbuildFlags,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
136 commandOptions = \showOrParseArgs ->
a096cbf @kolmodin Enable --verbose for 'hackport make-ebuild'
kolmodin authored
137 [ optionVerbosity makeEbuildVerbosity (\v flags -> flags { makeEbuildVerbosity = v })
138 ]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
139 }
140
141 -----------------------------------------------------------------------
142 -- Diff
143 -----------------------------------------------------------------------
144
145 data DiffFlags = DiffFlags {
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
146 diffMode :: Flag DiffMode,
147 diffVerbosity :: Flag Verbosity
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
148 }
149
150 instance Monoid DiffFlags where
151 mempty = DiffFlags {
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
152 diffMode = mempty,
153 diffVerbosity = mempty
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
154 }
155 mappend a b = DiffFlags {
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
156 diffMode = combine diffMode,
157 diffVerbosity = combine diffVerbosity
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
158 }
159 where combine field = field a `mappend` field b
160
161 defaultDiffFlags :: DiffFlags
162 defaultDiffFlags = DiffFlags {
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
163 diffMode = Flag ShowAll,
164 diffVerbosity = Flag normal
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
165 }
166
167 diffCommand :: CommandUI DiffFlags
168 diffCommand = CommandUI {
169 commandName = "diff",
170 commandSynopsis = "Run diff",
171 commandDescription = Just $ \pname ->
172 "TODO: this is the commandDescription for diffCommand\n",
173 commandUsage = usagePackages "diff",
174 commandDefaultFlags = defaultDiffFlags,
175 commandOptions = \showOrParseArgs ->
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
176 [ optionVerbosity diffVerbosity (\v flags -> flags { diffVerbosity = v })
177 ]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
178 }
179
180 diffAction :: DiffFlags -> [String] -> GlobalFlags -> IO ()
181 diffAction flags args globalFlags = do
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
182 let verbose = fromFlag (diffVerbosity flags)
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
183 overlayPath = fromFlag (globalOverlayPath globalFlags)
184 dm = fromFlag (diffMode flags)
185 runDiff verbose overlayPath dm
186
187 -----------------------------------------------------------------------
188 -- Update
189 -----------------------------------------------------------------------
190
c4d52c5 @kolmodin Enable --verbose for 'hackport update'
kolmodin authored
191 data UpdateFlags = UpdateFlags {
192 updateVerbosity :: Flag Verbosity,
193 updateServerURI :: Flag String
194 }
195
196 instance Monoid UpdateFlags where
197 mempty = UpdateFlags {
198 updateVerbosity = mempty,
199 updateServerURI = mempty
200 }
201 mappend a b = UpdateFlags {
202 updateVerbosity = combine updateVerbosity,
203 updateServerURI = combine updateServerURI
204 }
205 where combine field = field a `mappend` field b
206
207 defaultUpdateFlags :: UpdateFlags
208 defaultUpdateFlags = UpdateFlags {
209 updateVerbosity = Flag normal,
210 updateServerURI = Flag defaultHackageServerURI
211 }
212
213 updateCommand :: CommandUI UpdateFlags
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
214 updateCommand = CommandUI {
215 commandName = "update",
216 commandSynopsis = "Update the local cache",
217 commandDescription = Just $ \pname ->
218 "TODO: this is the commandDescription for updateCommand\n",
219 commandUsage = usageFlags "update",
c4d52c5 @kolmodin Enable --verbose for 'hackport update'
kolmodin authored
220 commandDefaultFlags = defaultUpdateFlags,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
221 commandOptions = \_ ->
c4d52c5 @kolmodin Enable --verbose for 'hackport update'
kolmodin authored
222 [ optionVerbosity updateVerbosity (\v flags -> flags { updateVerbosity = v })
223
224 , option [] ["server"]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
225 "Set the server you'd like to update the cache from"
c4d52c5 @kolmodin Enable --verbose for 'hackport update'
kolmodin authored
226 updateServerURI (\v flags -> flags { updateServerURI = v} )
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
227 (reqArgFlag "SERVER")
228 ]
229 }
230
c4d52c5 @kolmodin Enable --verbose for 'hackport update'
kolmodin authored
231 updateAction :: UpdateFlags -> [String] -> GlobalFlags -> IO ()
232 updateAction flags args globalFlags = do
233 let verbose = fromFlag (updateVerbosity flags)
234 server = fromFlag (updateServerURI flags)
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
235 case parseURI server of
236 Just uri -> updateCache verbose uri
237 Nothing -> throwEx (InvalidServer server)
cfd83a3 Introducing a local cache to speed things up
der_eq@freenet.de authored
238
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
239 -----------------------------------------------------------------------
240 -- Status
241 -----------------------------------------------------------------------
242
243 data StatusFlags = StatusFlags {
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
244 statusVerbosity :: Flag Verbosity,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
245 statusToPortage :: Flag Bool
246 }
247
248 instance Monoid StatusFlags where
249 mempty = StatusFlags {
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
250 statusVerbosity = mempty,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
251 statusToPortage = mempty
252 }
253 mappend a b = StatusFlags {
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
254 statusVerbosity = combine statusVerbosity,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
255 statusToPortage = combine statusToPortage
256 }
257 where combine field = field a `mappend` field b
258
259 defaultStatusFlags :: StatusFlags
260 defaultStatusFlags = StatusFlags {
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
261 statusVerbosity = Flag normal,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
262 statusToPortage = Flag False
263 }
264
265 statusCommand :: CommandUI StatusFlags
266 statusCommand = CommandUI {
267 commandName = "status",
268 commandSynopsis = "Show status(??)",
269 commandDescription = Just $ \pname ->
270 "TODO: this is the commandDescription for statusCommand\n",
271 commandUsage = usagePackages "status",
272 commandDefaultFlags = defaultStatusFlags,
273 commandOptions = \showOrParseArgs ->
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
274 [ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })
275
276 , option [] ["to-portage"]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
277 "Print only packages likely to be interesting to move to the portage tree."
278 statusToPortage (\v flags -> flags { statusToPortage = v })
279 falseArg
280 ]
281 }
282
283 statusAction :: StatusFlags -> [String] -> GlobalFlags -> IO ()
284 statusAction flags args globalFlags = do
72143ba @kolmodin Enable --verbose for 'hackport status'
kolmodin authored
285 let verbose = fromFlag (statusVerbosity flags)
9b8eb4b @kolmodin Fix broken flag handling for 'hackport status'
kolmodin authored
286 overlayPathM = flagToMaybe (globalOverlayPath globalFlags)
287 portdirM = flagToMaybe (globalPortDir globalFlags)
288 toPortdir = fromFlag (statusToPortage flags)
289 portdir <- maybe getSystemPortdir return portdirM
290 overlayPath <- maybe (getOverlayPath verbose) return overlayPathM
291 runStatus verbose portdir overlayPath toPortdir
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
292
293 -----------------------------------------------------------------------
294 -- Merge
295 -----------------------------------------------------------------------
296
dab787f @kolmodin Fix more flags
kolmodin authored
297 data MergeFlags = MergeFlags {
298 mergeVerbosity :: Flag Verbosity,
299 mergeServerURI :: Flag String
300 }
301
302 instance Monoid MergeFlags where
303 mempty = MergeFlags {
304 mergeVerbosity = mempty,
305 mergeServerURI = mempty
306 }
307 mappend a b = MergeFlags {
308 mergeVerbosity = combine mergeVerbosity,
309 mergeServerURI = combine mergeServerURI
310 }
311 where combine field = field a `mappend` field b
312
313 defaultMergeFlags :: MergeFlags
314 defaultMergeFlags = MergeFlags {
315 mergeVerbosity = Flag normal,
316 mergeServerURI = Flag defaultHackageServerURI
317 }
318
319 mergeCommand :: CommandUI MergeFlags
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
320 mergeCommand = CommandUI {
321 commandName = "merge",
322 commandSynopsis = "Make an ebuild out of hackage package",
323 commandDescription = Just $ \pname ->
324 "TODO: this is the commandDescription for mergeCommand\n",
325 commandUsage = usagePackages "merge",
dab787f @kolmodin Fix more flags
kolmodin authored
326 commandDefaultFlags = defaultMergeFlags,
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
327 commandOptions = \showOrParseArgs ->
dab787f @kolmodin Fix more flags
kolmodin authored
328 [ optionVerbosity mergeVerbosity (\v flags -> flags { mergeVerbosity = v })
329
330 , option [] ["server"]
331 "Set the server you'd like to update the cache from"
332 mergeServerURI (\v flags -> flags { mergeServerURI = v} )
333 (reqArgFlag "SERVER")
334 ]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
335 }
336
dab787f @kolmodin Fix more flags
kolmodin authored
337 mergeAction :: MergeFlags -> [String] -> GlobalFlags -> IO ()
338 mergeAction flags [pkg] globalFlags = do
339 let verbose = fromFlag (mergeVerbosity flags)
340 server = fromFlag (mergeServerURI flags)
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
341 case parseURI server of
342 Just uri -> merge verbose uri pkg
343 Nothing -> throwEx (InvalidServer server)
344
345 mergeAction _ _ _ =
346 throwEx (ArgumentError "'merge' needs exactly one parameter")
347
348 -----------------------------------------------------------------------
349 -- Main and utils
350 -----------------------------------------------------------------------
351
352 defaultHackageServerURI :: String
353 defaultHackageServerURI = "http://hackage.haskell.org/packages/archive/"
354
355 reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description ->
356 (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b
357 reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
358
359 usagePackages :: String -> String -> String
360 usagePackages name pname =
361 "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS] [PACKAGE]\n\n"
362 ++ "Flags for " ++ name ++ ":"
363
364 usageFlags :: String -> String -> String
365 usageFlags name pname =
366 "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n\n"
367 ++ "Flags for " ++ name ++ ":"
368
369 data GlobalFlags = GlobalFlags {
370 globalVersion :: Flag Bool,
371 globalOverlayPath :: Flag FilePath,
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
372 globalPortDir :: Flag FilePath
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
373 }
374
375 defaultGlobalFlags :: GlobalFlags
376 defaultGlobalFlags = GlobalFlags {
377 globalVersion = Flag False,
378 globalOverlayPath = NoFlag,
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
379 globalPortDir = NoFlag
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
380 }
381
382 globalCommand :: CommandUI GlobalFlags
383 globalCommand = CommandUI {
384 commandName = "",
385 commandSynopsis = "",
386 commandDescription = Just $ \pname ->
387 "TODO: this is the commandDescription for globalCommand\n",
388 commandUsage = \_ -> [],
389 commandDefaultFlags = defaultGlobalFlags,
390 commandOptions = \showOrParseArgs ->
a08b0e7 @kolmodin Enable --verbose for 'hackport diff'
kolmodin authored
391 [ ]
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
392 }
393
394 mainWorker :: [String] -> IO ()
395 mainWorker args =
396 case commandsRun globalCommand commands args of
397 CommandHelp help -> printHelp help
398 CommandList opts -> printOptionsList opts
399 CommandErrors errs -> printErrors errs
400 CommandReadyToGo (globalflags, commandParse) -> do
401 case commandParse of
402 CommandHelp help -> printHelp help
403 CommandList opts -> printOptionsList opts
404 CommandErrors errs -> printErrors errs
405 CommandReadyToGo action -> catchEx (action globalflags) errorHandler
406 where
407 printHelp help = getProgName >>= putStr . help
408 printOptionsList = putStr . unlines
409 printErrors errs = do
410 putStr (concat (intersperse "\n" errs))
411 exitFailure
412 errorHandler :: HackPortError -> IO ()
413 errorHandler e = do
414 putStrLn (hackPortShowError e)
415 commands =
416 [ listCommand `commandAddAction` listAction
417 , makeEbuildCommand `commandAddAction` makeEbuildAction
418 , statusCommand `commandAddAction` statusAction
419 , diffCommand `commandAddAction` diffAction
420 , updateCommand `commandAddAction` updateAction
421 , mergeCommand `commandAddAction` mergeAction
422 ]
423
aff37c2 First release of HackPort, the Hackage tool for Portage
der_eq@freenet.de authored
424 main :: IO ()
a1730ad @kolmodin Switch to using Cabal's CLI API
kolmodin authored
425 main = getArgs >>= mainWorker
Something went wrong with that request. Please try again.