summaryrefslogtreecommitdiff
path: root/Merge.hs
blob: 0944c64e719f822acdfcfe8545512ca8122dec47 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
module Merge
  ( merge
  , mergeGenericPackageDescription
  ) where

import Control.Monad
import Control.Exception
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Builder as BL (stringUtf8, toLazyByteString)
import Data.Function (on)
import Data.Maybe
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Time.Clock as TC

-- cabal
import qualified Distribution.Package as Cabal
import qualified Distribution.Version as Cabal
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription.PrettyPrint as Cabal (showPackageDescription)
import qualified Distribution.Solver.Types.SourcePackage as CabalInstall
import qualified Distribution.Solver.Types.PackageIndex as CabalInstall

import Distribution.Text (display)
import Distribution.Verbosity
import Distribution.Simple.Utils

-- cabal-install
import Distribution.Client.IndexUtils ( getSourcePackages )
import qualified Distribution.Client.GlobalFlags as CabalInstall
import Distribution.Client.Types

-- others
import qualified Data.List.Split as DLS
import System.Directory ( getCurrentDirectory
                        , setCurrentDirectory
                        , createDirectoryIfMissing
                        , doesFileExist
                        , listDirectory
                        )
import System.Process (system)
import System.FilePath ((</>), isExtensionOf)
import System.Exit

import qualified Cabal2Ebuild as C2E
import qualified Portage.EBuild as E
import qualified Portage.EMeta as EM
import Error as E

import qualified Portage.Cabal as Portage
import qualified Portage.PackageId as Portage
import qualified Portage.Version as Portage
import qualified Portage.Metadata as Portage
import qualified Portage.Overlay as Overlay
import qualified Portage.Resolve as Portage
import qualified Portage.Dependency as Portage
import qualified Portage.Use as Portage

import qualified Portage.GHCCore as GHCCore

import qualified Merge.Dependencies as Merge

(<.>) :: String -> String -> String
a <.> b = a ++ '.':b

{-
Requested features:
  * Add files to git?
-}

readPackageString :: [String]
                  -> Either HackPortError ( Maybe Portage.Category
                                          , Cabal.PackageName
                                          , Maybe Portage.Version
                                          )
readPackageString args = do
  packageString <-
    case args of
      [] -> Left (ArgumentError "Need an argument, [category/]package[-version]")
      [pkg] -> return pkg
      _ -> Left (ArgumentError ("Too many arguments: " ++ unwords args))
  case Portage.parseFriendlyPackage packageString of
    Just v@(_,_,Nothing) -> return v
    -- we only allow versions we can convert into cabal versions
    Just v@(_,_,Just (Portage.Version _ Nothing [] 0)) -> return v
    _ -> Left (ArgumentError ("Could not parse [category/]package[-version]: " ++ packageString))



-- | Given a list of available packages, and maybe a preferred version,
-- return the available package with that version. Latest version is chosen
-- if no preference.
resolveVersion :: [UnresolvedSourcePackage] -> Maybe Cabal.Version -> Maybe UnresolvedSourcePackage
resolveVersion avails Nothing = Just $ L.maximumBy (comparing (Cabal.pkgVersion . CabalInstall.packageInfoId)) avails
resolveVersion avails (Just ver) = listToMaybe (filter match avails)
  where
    match avail = ver == Cabal.pkgVersion (CabalInstall.packageInfoId avail)

merge :: Verbosity -> CabalInstall.RepoContext -> [String] -> FilePath -> Maybe String -> IO ()
merge verbosity repoContext args overlayPath users_cabal_flags = do
  (m_category, user_pName, m_version) <-
    case readPackageString args of
      Left err -> throwEx err
      Right (c,p,m_v) ->
        case m_v of
          Nothing -> return (c,p,Nothing)
          Just v -> case Portage.toCabalVersion v of
                      Nothing -> throwEx (ArgumentError "illegal version")
                      Just ver -> return (c,p,Just ver)

  debug verbosity $ "Category: " ++ show m_category
  debug verbosity $ "Package: " ++ show user_pName
  debug verbosity $ "Version: " ++ show m_version

  let user_pname_str = Cabal.unPackageName user_pName

  overlay <- Overlay.loadLazy overlayPath
  -- portage_path <- Host.portage_dir `fmap` Host.getInfo
  -- portage <- Overlay.loadLazy portage_path
  index <- fmap packageIndex $ getSourcePackages verbosity repoContext

  -- find all packages that maches the user specified package name
  availablePkgs <-
    case map snd (CabalInstall.searchByName index user_pname_str) of
      [] -> throwEx (PackageNotFound user_pname_str)
      [pkg] -> return pkg
      pkgs  -> do let cabal_pkg_to_pn pkg = Cabal.unPackageName $ Cabal.pkgName (CabalInstall.packageInfoId pkg)
                      names      = map (cabal_pkg_to_pn . L.head) pkgs
                  notice verbosity $ "Ambiguous names: " ++ L.intercalate ", " names
                  forM_ pkgs $ \ps ->
                      do let p_name = (cabal_pkg_to_pn . L.head) ps
                         notice verbosity $ p_name ++ ": " ++ (L.intercalate ", " $ map (display . Cabal.pkgVersion . CabalInstall.packageInfoId) ps)
                  return $ concat pkgs

  -- select a single package taking into account the user specified version
  selectedPkg <-
    case resolveVersion availablePkgs m_version of
      Nothing -> do
        putStrLn "No such version for that package, available versions:"
        forM_ availablePkgs $ \ avail ->
          putStrLn (display . CabalInstall.packageInfoId $ avail)
        throwEx (ArgumentError "no such version for that package")
      Just avail -> return avail

  -- print some info
  info verbosity "Selecting package:"
  forM_ availablePkgs $ \ avail -> do
    let match_text | CabalInstall.packageInfoId avail == CabalInstall.packageInfoId selectedPkg = "* "
                   | otherwise = "- "
    info verbosity $ match_text ++ (display . CabalInstall.packageInfoId $ avail)

  let cabal_pkgId = CabalInstall.packageInfoId selectedPkg
      norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)
  cat <- maybe (Portage.resolveCategory verbosity overlay norm_pkgName) return m_category
  mergeGenericPackageDescription verbosity overlayPath cat (CabalInstall.packageDescription selectedPkg) True users_cabal_flags

  -- Maybe generate a diff
  let pkgPath = overlayPath </> (Portage.unCategory cat) </> (Cabal.unPackageName norm_pkgName)
      newPkgId = Portage.fromCabalPackageId cat cabal_pkgId
  pkgDir <- listDirectory pkgPath
  case getPreviousPackageId pkgDir newPkgId of
    Just validPkg -> do info verbosity "Generating a diff..."
                        diffEbuilds overlayPath validPkg newPkgId
    _ -> info verbosity "Nothing to diff!"
  
-- | Call diff between two ebuilds.
diffEbuilds :: FilePath -> Portage.PackageId -> Portage.PackageId -> IO ()
diffEbuilds fp a b = do _ <- system $ "diff -u --color=auto "
                             ++ fp </> Portage.packageIdToFilePath a ++ " "
                             ++ fp </> Portage.packageIdToFilePath b
                        exitSuccess

-- | Maybe return a PackageId of the next highest version for a given
--   package, relative to the provided PackageId of the new version.
--   We achieve this by mapping Portage.filePathToPackageId over the
--   provided package directory, whose contents are filtered for files
--   with the '.ebuild' file extension
getPreviousPackageId :: [FilePath] -- ^ list of ebuilds for given package
                     -> Portage.PackageId -- ^ new PackageId
                     -> Maybe Portage.PackageId -- ^ maybe PackageId of previous version
getPreviousPackageId pkgDir newPkgId = do
  let pkgIds = reverse 
               . L.sortOn (Portage.pkgVersion)
               . filter (<newPkgId)
               $ Portage.filePathToPackageId newPkgId
               <$> filter (\fp -> ".ebuild" `isExtensionOf` fp) pkgDir
  case pkgIds of
    x:_ -> Just x
    _ -> Nothing

first_just_of :: [Maybe a] -> Maybe a
first_just_of = msum

-- Gentoo allows underscore ('_') names in IUSE only for
-- USE_EXPAND values. If it's not a user-specified rename mangle
-- it into a hyphen ('-').
mangle_iuse :: String -> String
mangle_iuse = map f
  where f '_' = '-'
        f c   = c

-- | Remove "with_" or "with-" from beginning of flag names.
drop_with :: String -> String
drop_with = \x ->
  case splitAt 5 x of
    ("with_", b) -> b
    ("with-", b) -> b
    _ -> x

-- used to be FlagAssignment in Cabal but now it's an opaque type
type CabalFlags = [(Cabal.FlagName, Bool)]

mergeGenericPackageDescription :: Verbosity -> FilePath -> Portage.Category -> Cabal.GenericPackageDescription -> Bool -> Maybe String -> IO ()
mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch users_cabal_flags = do
  overlay <- Overlay.loadLazy overlayPath
  let merged_cabal_pkg_name = Cabal.pkgName (Cabal.package (Cabal.packageDescription pkgGenericDesc))
      merged_PN = Portage.cabal_pn_to_PN merged_cabal_pkg_name
      pkgdir    = overlayPath </> Portage.unCategory cat </> merged_PN
  existing_meta <- EM.findExistingMeta pkgdir
  let requested_cabal_flags = first_just_of [users_cabal_flags, EM.cabal_flags existing_meta]

      -- accepts things, like: "cabal_flag:iuse_name", "+cabal_flag", "-cabal_flag"
      read_fas :: Maybe String -> (CabalFlags, [(String, String)])
      read_fas Nothing = ([], [])
      read_fas (Just user_fas_s) = (user_fas, user_renames)
          where user_fas = [ (cf, b)
                           | ((cf, _), Just b) <- cn_in_mb
                           ]
                user_renames = [ (cfn, ein)
                               | ((cabal_cfn, ein), Nothing) <- cn_in_mb
                               , let cfn = Cabal.unFlagName cabal_cfn
                               ]
                cn_in_mb = map read_fa $ DLS.splitOn "," user_fas_s
                read_fa :: String -> ((Cabal.FlagName, String), Maybe Bool)
                read_fa [] = error $ "read_fas: empty flag?"
                read_fa (op:flag) =
                    case op of
                        '+'   -> (get_rename flag, Just True)
                        '-'   -> (get_rename flag, Just False)
                        _     -> (get_rename (op:flag), Nothing)
                  where get_rename :: String -> (Cabal.FlagName, String)
                        get_rename s =
                            case DLS.splitOn ":" s of
                                [cabal_flag_name] -> (Cabal.mkFlagName cabal_flag_name, cabal_flag_name)
                                [cabal_flag_name, iuse_name] -> (Cabal.mkFlagName cabal_flag_name, iuse_name)
                                _                 -> error $ "get_rename: too many components" ++ show (s)

      (user_specified_fas, cf_to_iuse_rename) = read_fas requested_cabal_flags

  debug verbosity "searching for minimal suitable ghc version"
  (compiler_info, ghc_packages, pkgDesc0, _flags, pix) <- case GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc (Cabal.mkFlagAssignment user_specified_fas) of
              Just v  -> return v
              Nothing -> let pn = display merged_cabal_pkg_name
                             cn = display cat
                         in error $ unlines [ "mergeGenericPackageDescription: failed to find suitable GHC for " ++ pn
                                            , "  You can try to merge the package manually:"
                                            , "  $ cabal unpack " ++ pn
                                            , "  $ cd " ++ pn ++ "*/"
                                            , "  # fix " ++ pn ++ ".cabal"
                                            , "  $ hackport make-ebuild " ++ cn ++ " " ++ pn ++ ".cabal"
                                            ]

  let (accepted_deps, skipped_deps) = Portage.partition_depends ghc_packages merged_cabal_pkg_name (Cabal.buildDepends pkgDesc0)
      pkgDesc = pkgDesc0 { Cabal.buildDepends = accepted_deps }
      cabal_flag_descs = Cabal.genPackageFlags pkgGenericDesc
      all_flags = map Cabal.flagName cabal_flag_descs
      make_fas  :: [Cabal.Flag] -> [CabalFlags]
      make_fas  [] = [[]]
      make_fas  (f:rest) = [ (fn, is_enabled) : fas
                           | fas <- make_fas rest
                           , let fn = Cabal.flagName f
                                 users_choice = lookup fn user_specified_fas
                           , is_enabled <- maybe [False, True]
                                                 (\b -> [b])
                                                 users_choice
                           ]
      all_possible_flag_assignments :: [CabalFlags]
      all_possible_flag_assignments = make_fas cabal_flag_descs

      pp_fa :: CabalFlags -> String
      pp_fa fa = L.intercalate ", " [ (if b then '+' else '-') : f
                                    | (cabal_f, b) <- fa
                                    , let f = Cabal.unFlagName cabal_f
                                    ]

      cfn_to_iuse :: String -> String
      cfn_to_iuse cfn =
          case lookup cfn cf_to_iuse_rename of
              Nothing  -> mangle_iuse . drop_with $ cfn
              Just ein -> ein

      -- key idea is to generate all possible list of flags
      deps1 :: [(CabalFlags, Merge.EDep)]
      deps1  = [ ( f `updateFa` Cabal.unFlagAssignment fr
                 , cabal_to_emerge_dep pkgDesc_filtered_bdeps)
               | f <- all_possible_flag_assignments
               -- TODO: move from 'finalizePackageDescription' to 'finalizePD'
               , Right (pkgDesc1,fr) <- [GHCCore.finalizePackageDescription (Cabal.mkFlagAssignment f)
                                                                  (GHCCore.dependencySatisfiable pix)
                                                                  GHCCore.platform
                                                                  compiler_info
                                                                  []
                                                                  pkgGenericDesc]
               -- drop circular deps and shipped deps
               , let (ad, _sd) = Portage.partition_depends ghc_packages merged_cabal_pkg_name (Cabal.buildDepends pkgDesc1)
               -- TODO: drop ghc libraries from tests depends as well
               -- (see deepseq in hackport-0.3.5 as an example)
               , let pkgDesc_filtered_bdeps = pkgDesc1 { Cabal.buildDepends = ad }
               ]
          where
            updateFa :: CabalFlags -> CabalFlags -> CabalFlags
            updateFa [] _ = []
            updateFa (x:xs) y = case lookup (fst x) y of
                                  -- TODO: when does this code get triggered?
                                  Nothing ->          x : updateFa xs y
                                  Just y' -> (fst x,y') : updateFa xs y
      -- then remove all flags that can't be changed
      successfully_resolved_flag_assignments = map fst deps1
      common_fa = L.foldl1' L.intersect successfully_resolved_flag_assignments
      common_flags = map fst common_fa
      active_flags = all_flags L.\\ common_flags
      active_flag_descs = filter (\x -> Cabal.flagName x `elem` active_flags) cabal_flag_descs
      irresolvable_flag_assignments = all_possible_flag_assignments L.\\ successfully_resolved_flag_assignments
      -- flags, not guarding any dependency variation, like:
      --     if flag(foo)
      --         ghc-options: -O2
      (irrelevant_flags, deps1') = L.foldl' drop_irrelevant ([], deps1) active_flags
          where drop_irrelevant :: ([Cabal.FlagName], [(CabalFlags, Merge.EDep)]) -> Cabal.FlagName -> ([Cabal.FlagName], [(CabalFlags, Merge.EDep)])
                drop_irrelevant (ifs, ds) f =
                    case fenabled_ds' == fdisabled_ds' of
                        True  -> (f:ifs, fenabled_ds')
                        False -> (  ifs, ds)
                    where (fenabled_ds', fdisabled_ds') = ( L.sort $ map drop_f fenabled_ds
                                                          , L.sort $ map drop_f fdisabled_ds
                                                          )
                          drop_f :: (CabalFlags, Merge.EDep) -> (CabalFlags, Merge.EDep)
                          drop_f (fas, d) = (filter ((f /=) . fst) fas, d)
                          (fenabled_ds, fdisabled_ds) = L.partition is_fe ds
                          is_fe :: (CabalFlags, Merge.EDep) -> Bool
                          is_fe (fas, _d) =
                              case lookup f fas of
                                  Just v  -> v
                                  -- should not happen
                                  Nothing -> error $ unwords [ "ERROR: drop_irrelevant: searched for missing flag"
                                                             , show f
                                                             , "in assignment"
                                                             , show fas
                                                             ]

      -- and finally prettify all deps:
      leave_only_dynamic_fa :: CabalFlags -> CabalFlags
      leave_only_dynamic_fa fa = filter (\(fn, _) -> all (fn /=) irrelevant_flags) $ fa L.\\ common_fa

      -- build roughly balanced complete dependency tree instead of skewed one
      bimerge :: [Merge.EDep] -> Merge.EDep
      bimerge deps = case go deps of
                         []  -> mempty
                         [r] -> r
                         _   -> error "bimerge: something bad happened"
          where go deps' =
                    case deps' of
                        (d1:d2:ds) -> go (mappend d1 d2 : go ds)
                        _          -> deps'

      tdeps :: Merge.EDep
      tdeps = bimerge $ map set_fa_to_ed deps1'

      set_fa_to_ed :: (CabalFlags, Merge.EDep) -> Merge.EDep
      set_fa_to_ed (fa, ed) = ed { Merge.rdep = liftFlags (leave_only_dynamic_fa fa) $ Merge.rdep ed
                                 , Merge.dep  = liftFlags (leave_only_dynamic_fa fa) $ Merge.dep ed
                                 }

      liftFlags :: CabalFlags -> Portage.Dependency -> Portage.Dependency
      liftFlags fs e = let k = foldr (\(y,b) x -> Portage.mkUseDependency (b, Portage.Use . cfn_to_iuse . Cabal.unFlagName $ y) . x)
                                      id fs
                       in k e

      cabal_to_emerge_dep :: Cabal.PackageDescription -> Merge.EDep
      cabal_to_emerge_dep cabal_pkg = Merge.resolveDependencies overlay cabal_pkg compiler_info ghc_packages merged_cabal_pkg_name

  debug verbosity $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0
  debug verbosity $ "buildDepends pkgDesc0: " ++ show (map display (Cabal.buildDepends pkgDesc0))
  debug verbosity $ "buildDepends pkgDesc:  " ++ show (map display (Cabal.buildDepends pkgDesc))

  notice verbosity $ "Accepted depends: " ++ show (map display accepted_deps)
  notice verbosity $ "Skipped  depends: " ++ show (map display skipped_deps)
  notice verbosity $ "Dead flags: " ++ show (map pp_fa irresolvable_flag_assignments)
  notice verbosity $ "Dropped  flags: " ++ show (map (Cabal.unFlagName.fst) common_fa)
  notice verbosity $ "Active flags: " ++ show (map Cabal.unFlagName active_flags)
  notice verbosity $ "Irrelevant flags: " ++ show (map Cabal.unFlagName irrelevant_flags)
  -- mapM_ print tdeps

  forM_ ghc_packages $
      \name -> info verbosity $ "Excluded packages (comes with ghc): " ++ Cabal.unPackageName name

  let pp_fn (cabal_fn, yesno) = b yesno ++ Cabal.unFlagName cabal_fn
          where b True  = ""
                b False = "-"

      -- appends 's' to each line except the last one
      --  handy to build multiline shell expressions
      icalate _s []     = []
      icalate _s [x]    = [x]
      icalate  s (x:xs) = (x ++ s) : icalate s xs

      build_configure_call :: [String] -> [String]
      build_configure_call [] = []
      build_configure_call conf_args = icalate " \\" $
                                           "haskell-cabal_src_configure" :
                                           map ('\t':) conf_args

      -- returns list USE-parameters to './setup configure'
      selected_flags :: ([Cabal.FlagName], CabalFlags) -> [String]
      selected_flags ([], []) = []
      selected_flags (active_fns, users_fas) = map snd (L.sortBy (compare `on` fst) flag_pairs)
          where flag_pairs :: [(String, String)]
                flag_pairs = active_pairs ++ users_pairs
                active_pairs = map (\fn -> (fn,                    "$(cabal_flag " ++ cfn_to_iuse fn ++ " " ++ fn ++ ")")) $ map Cabal.unFlagName active_fns
                users_pairs  = map (\fa -> ((Cabal.unFlagName . fst) fa, "--flag=" ++ pp_fn fa)) users_fas
      to_iuse x = let fn = Cabal.unFlagName $ Cabal.flagName x
                      p  = if Cabal.flagDefault x then "+" else ""
                  in p ++ cfn_to_iuse fn

      ebuild =   (\e -> e { E.depend        =            Merge.dep tdeps} )
               . (\e -> e { E.depend_extra  = S.toList $ Merge.dep_e tdeps } )
               . (\e -> e { E.rdepend       =            Merge.rdep tdeps} )
               . (\e -> e { E.rdepend_extra = S.toList $ Merge.rdep_e tdeps } )
               . (\e -> e { E.src_configure = build_configure_call $
                                                  selected_flags (active_flags, user_specified_fas) } )
               . (\e -> e { E.iuse = E.iuse e ++ map to_iuse active_flag_descs })
               . ( case requested_cabal_flags of
                       Nothing  -> id
                       Just ucf -> (\e -> e { E.used_options  = E.used_options e ++ [("flags", ucf)] }))
               $ C2E.cabal2ebuild cat pkgDesc

  mergeEbuild verbosity existing_meta pkgdir ebuild active_flag_descs
  when fetch $ do
    let cabal_pkgId = Cabal.packageId pkgDesc
        norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)
    fetchDigestAndCheck verbosity (overlayPath </> display cat </> display norm_pkgName)

fetchDigestAndCheck :: Verbosity
                    -> FilePath -- ^ directory of ebuild
                    -> IO ()
fetchDigestAndCheck verbosity ebuildDir =
  withWorkingDirectory ebuildDir $ do
     notice verbosity "Recalculating digests (repoman manifest)..."
     rm <- system "repoman manifest"
     when (rm /= ExitSuccess) $
         notice verbosity "repoman manifest failed horribly. Do something about it!"
     rf <- system "repoman full --include-dev"
     when (rf /= ExitSuccess) $
         notice verbosity "repoman full --include-dev found an error. Do something about it!"
     return ()

withWorkingDirectory :: FilePath -> IO a -> IO a
withWorkingDirectory newDir action = do
  oldDir <- getCurrentDirectory
  bracket
    (setCurrentDirectory newDir)
    (\_ -> setCurrentDirectory oldDir)
    (\_ -> action)

-- "amd64" -> "~amd64"
to_unstable :: String -> String
to_unstable kw =
    case kw of
        '~':_ -> kw
        '-':_ -> kw
        _     -> '~':kw

-- | Generate a list of tuples containing Cabal flag names and descriptions
metaFlags :: [Cabal.Flag] -> [(String, String)]
metaFlags flags = zip (mangle_iuse . drop_with . Cabal.unFlagName . Cabal.flagName <$> flags) (Cabal.flagDescription <$> flags)

mergeEbuild :: Verbosity -> EM.EMeta -> FilePath -> E.EBuild -> [Cabal.Flag] -> IO ()
mergeEbuild verbosity existing_meta pkgdir ebuild flags = do
  let edir = pkgdir
      elocal = E.name ebuild ++"-"++ E.version ebuild <.> "ebuild"
      epath = edir </> elocal
      emeta = "metadata.xml"
      mpath = edir </> emeta
      default_meta = BL.toLazyByteString . BL.stringUtf8
                     $ Portage.makeDefaultMetadata (E.long_desc ebuild)
                     $ metaFlags flags
  createDirectoryIfMissing True edir
  now <- TC.getCurrentTime

  let (existing_keywords, existing_license, existing_description) = (EM.keywords existing_meta, EM.license existing_meta, EM.description existing_meta)
      new_keywords = maybe (E.keywords ebuild) (map to_unstable) existing_keywords
      new_license  = either (\err -> maybe (Left err)
                                           Right
                                           existing_license)
                            Right
                            (E.license ebuild)
      new_description = maybe (E.description ebuild) id existing_description
      ebuild'      = ebuild { E.keywords = new_keywords
                            , E.license = new_license
                            , E.description = new_description
                            }
      s_ebuild'    = E.showEBuild now ebuild'

  notice verbosity $ "Current keywords: " ++ show existing_keywords ++ " -> " ++ show new_keywords
  notice verbosity $ "Current license:  " ++ show existing_license ++ " -> " ++ show new_license

  notice verbosity $ "Writing " ++ elocal
  length s_ebuild' `seq` BL.writeFile epath (BL.pack s_ebuild')

  yet_meta <- doesFileExist mpath
  if not yet_meta -- TODO: add --force-meta-rewrite to opts
      then do notice verbosity $ "Writing " ++ emeta
              BL.writeFile mpath default_meta
      else do current_meta <- BL.readFile mpath
              when (current_meta /= default_meta) $
                  notice verbosity $ "Default and current " ++ emeta ++ " differ."