packages feed

hackport 0.7.1.1 → 0.7.1.2

raw patch · 65 files changed

+5671/−5601 lines, 65 filesdep +Globdep +base-compatdep +cabal-doctestdep −lukkodep −old-localedep ~QuickCheckdep ~arraydep ~asyncsetup-changed

Dependencies added: Glob, base-compat, cabal-doctest, echo, edit-distance, hackport, hackport-external-libs, regex-base, regex-posix, resolv

Dependencies removed: lukko, old-locale

Dependency ranges changed: QuickCheck, array, async, base, base16-bytestring, binary, bytestring, containers, deepseq, directory, ed25519, filepath, mtl, network, network-uri, parallel, parsec, pretty, process, random, tar, template-haskell, text, time, transformers, unix, xml, zlib

Files

.github/workflows/haskell.yml view
@@ -41,5 +41,5 @@         cabal build --only-dependencies --enable-tests --enable-benchmarks     - name: Build       run: cabal v2-build --enable-tests all-    - name: Run hspec tests-      run: cabal v2-test spec --test-option=--color --test-show-details=streaming+    - name: Run all enabled tests+      run: cabal test --test-option=--color --test-show-details=streaming
− AnsiColor.hs 
@@ -1,46 +0,0 @@-{-|-    Stability   :  provisional-    Portability :  haskell98--    Simplistic ANSI color support.--}--module AnsiColor-  ( Color(..)-  , bold-  , inColor-  ) where--import Data.List--data Color  =  Black-            |  Red-            |  Green-            |  Yellow-            |  Blue-            |  Magenta-            |  Cyan-            |  White-            |  Default-  deriving Enum--esc :: [String] -> String-esc []  =  ""-esc xs  =  "\ESC[" ++ (intercalate ";" xs) ++ "m"--col :: Color -> Bool -> Color -> [String]-col fg bf bg = show (fromEnum fg + 30) : bf' [show (fromEnum bg + 40)]-  where bf' | bf         =  ("01" :)-            | otherwise  =  id--inColor :: Color -> Bool -> Color -> String -> String-inColor c bf bg txt = esc (col c bf bg) ++ txt ++ esc ["00"]--bold :: String -> String-bold = ansi "1" "22"--- italic    = ansi "3" "23"--- underline = ansi "4" "24"--- inverse   = ansi "7" "27"--ansi :: String -> String -> String -> String-ansi on off txt = esc [on] ++ txt ++ esc [off]
− Cabal2Ebuild.hs 
@@ -1,114 +0,0 @@-{-|-Module      : Cabal2Ebuild-Copyright   : (C) 2005, Duncan Coutts-License     : GPL-2+-Maintainer  : haskell@gentoo.org--A program for generating a Gentoo ebuild from a .cabal file--}--- This library is free software; you can redistribute it and/or--- modify it under the terms of the GNU General Public License--- as published by the Free Software Foundation; either version 2--- of the License, or (at your option) any later version.---- This library is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU--- General Public License for more details.----module Cabal2Ebuild-        (cabal2ebuild-        ,convertDependencies-        ,convertDependency) where--import qualified Distribution.PackageDescription as Cabal-                                                ( PackageDescription(..), license)-import qualified Distribution.Package as Cabal  ( PackageIdentifier(..)-                                                , Dependency(..))-import qualified Distribution.Version as Cabal  ( VersionRange-                                                , cataVersionRange, normaliseVersionRange-                                                , majorUpperBound, mkVersion )-import Distribution.Version (VersionRangeF(..))-import Distribution.Pretty (prettyShow)--import qualified Distribution.Utils.ShortText as ST--import Data.Char          (isUpper)-import Data.Maybe--import Portage.Dependency-import qualified Portage.Cabal as Portage-import qualified Portage.PackageId as Portage-import qualified Portage.EBuild as Portage-import qualified Portage.EBuild.CabalFeature as Portage-import qualified Portage.Resolve as Portage-import qualified Portage.EBuild as E-import qualified Portage.Overlay as O-import Portage.Version---- | Generate a 'Portage.EBuild' from a 'Portage.Category' and a 'Cabal.PackageDescription'.-cabal2ebuild :: Portage.Category -> Cabal.PackageDescription -> Portage.EBuild-cabal2ebuild cat pkg = Portage.ebuildTemplate {-    E.name        = Portage.cabal_pn_to_PN cabal_pn,-    E.category    = prettyShow cat,-    E.hackage_name= cabalPkgName,-    E.version     = prettyShow (Cabal.pkgVersion (Cabal.package pkg)),-    E.description = ST.fromShortText $ if ST.null (Cabal.synopsis pkg)-                                          then Cabal.description pkg-                                          else Cabal.synopsis pkg,-    E.homepage        = thisHomepage,-    E.license         = Portage.convertLicense $ Cabal.license pkg,-    E.slot            = (E.slot E.ebuildTemplate) ++ (if hasLibs then "/${PV}" else ""),-    E.my_pn           = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,-    E.features        = E.features E.ebuildTemplate-                   ++ (if hasLibs then ([ Portage.Lib-                                        , Portage.Profile-                                        , Portage.Haddock-                                        , Portage.Hoogle-                                        ]-                                        ++ if cabalPkgName == "hscolour"-                                                then []-                                                else [Portage.HsColour])-                                  else [])-                   ++ (if hasTests then [Portage.TestSuite]-                                   else [])-  } where-        cabal_pn = Cabal.pkgName $ Cabal.package pkg-        cabalPkgName = prettyShow cabal_pn-        hasLibs = isJust (Cabal.library pkg)-        hasTests = (not . null) (Cabal.testSuites pkg)-        thisHomepage = if (ST.null $ Cabal.homepage pkg)-                         then E.homepage E.ebuildTemplate-                         else ST.fromShortText $ Cabal.homepage pkg---- | Map 'convertDependency' over ['Cabal.Dependency'].-convertDependencies :: O.Overlay -> Portage.Category -> [Cabal.Dependency] -> [Dependency]-convertDependencies overlay category = map (convertDependency overlay category)---- | Convert 'Cabal.Dependency' into 'Dependency'.-convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> Dependency-convertDependency overlay category (Cabal.Dependency pname versionRange _lib)-  = convert versionRange-  where-    pn = case Portage.resolveFullPortageName overlay pname of-            Just r  -> r-            Nothing -> Portage.PackageName category (Portage.normalizeCabalPackageName pname)-    mk_p :: DRange -> Dependency-    mk_p dr = DependAtom (Atom pn dr (DAttr AnySlot []))-    p_v v   = fromCabalVersion v--    convert :: Cabal.VersionRange -> Dependency-    convert = Cabal.cataVersionRange alg . Cabal.normaliseVersionRange-              where-                alg (ThisVersionF v)                = mk_p $ DExact $ p_v v-                alg (LaterVersionF v)               = mk_p $ DRange (StrictLB $ p_v v) InfinityB-                alg (EarlierVersionF v)             = mk_p $ DRange ZeroB $ StrictUB $ p_v v-                alg (OrLaterVersionF v)             = if v == Cabal.mkVersion [0] -- any version-                                                      then mk_p $ DRange ZeroB InfinityB-                                                      else mk_p $ DRange (NonstrictLB $ p_v v)-                                                           InfinityB-                alg (OrEarlierVersionF v)           = mk_p $ DRange ZeroB $ NonstrictUB $ p_v v-                alg (MajorBoundVersionF v)          = mk_p $ DRange (NonstrictLB $ p_v v)-                                                      $ StrictUB $ p_v $ Cabal.majorUpperBound v-                alg (UnionVersionRangesF v1 v2)     = DependAnyOf [v1, v2]-                alg (IntersectVersionRangesF v1 v2) = DependAllOf [v1, v2]
− Error.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Error (HackPortError(..), throwEx, catchEx, hackPortShowError) where--import Data.Typeable-import Control.Exception.Extensible as EE---- | Type holding all of the 'HackPortError' constructors.-data HackPortError-    = ArgumentError String-    | ConnectionFailed String String-    | PackageNotFound String-    | InvalidTarballURL String String-    | InvalidSignatureURL String String-    | VerificationFailed String String-    | DownloadFailed String String-    | UnknownCompression String-    | UnpackingFailed String Int-    | NoCabalFound String-    | ExtractionFailed String String Int-    | CabalParseFailed String String-    | BashNotFound-    | BashError String-    | NoOverlay-    | MultipleOverlays [String]-    | UnknownVerbosityLevel String-    -- | WrongCacheVersion-    -- | InvalidCache-    | InvalidServer String-    deriving (Typeable-             , Show-             , Eq -- ^ needed for spec test-suite-             )--instance Exception HackPortError where---- | Throw a 'HackPortError'.-throwEx :: HackPortError -> IO a-throwEx = EE.throw---- | Catch a 'HackPortError'.-catchEx :: IO a -> (HackPortError -> IO a) -> IO a-catchEx = EE.catch---- | Show the error string for a given 'HackPortError'.-hackPortShowError :: HackPortError -> String-hackPortShowError err = case err of-    ArgumentError str -> "Argument error: "++str-    ConnectionFailed server reason -> "Connection to hackage server '"++server++"' failed: "++reason-    PackageNotFound pkg -> "Package '"++ pkg ++"' not found on server. Try 'hackport update'?"-    InvalidTarballURL url reason -> "Error while downloading tarball '"++url++"': "++reason-    InvalidSignatureURL url reason -> "Error while downloading signature '"++url++"': "++reason-    VerificationFailed file signature -> "Error while checking signature('"++signature++"') of '"++file++"'"-    DownloadFailed url reason -> "Error while downloading '"++url++"': "++reason-    UnknownCompression tarball -> "Couldn't guess compression type of '"++tarball++"'"-    UnpackingFailed tarball code -> "Unpacking '"++tarball++"' failed with exit code '"++show code++"'"-    NoCabalFound tarball -> "Tarball '"++tarball++"' doesn't contain a cabal file"-    ExtractionFailed tarball file code -> "Extracting '"++file++"' from '"++tarball++"' failed with '"++show code++"'"-    CabalParseFailed file reason -> "Error while parsing cabal file '"++file++"': "++reason-    BashNotFound -> "The 'bash' executable was not found. It is required to figure out your portage-overlay. If you don't want to install bash, use '-p path-to-overlay'"-    BashError str -> "Error while guessing your repository's location. Either set a repository 'haskell' in '/etc/portage/repos.conf' or use '-p path-to-overlay'.\nThe error was: \""++str++"\""-    MultipleOverlays overlays -> "You have the following overlays available: '"++unwords overlays++"'. Please choose one by using 'hackport -p path-to-overlay' <command>"-    NoOverlay -> "Unable to find a repository 'haskell'. Consider defining it in '/etc/portage/repos.conf' and verify '~/.hackport/repositories' (in overlay_list) or use '-p path-to-overlay'"-    UnknownVerbosityLevel str -> "The verbosity level '"++str++"' is invalid. Please use debug,normal or silent"-    InvalidServer srv -> "Invalid server address, could not parse: " ++ srv-    --WrongCacheVersion -> "The version of the cache is too old. Please update the cache using 'hackport update'"-    --InvalidCache -> "Could not read the cache. Please ensure that it's up to date using 'hackport update'"
− HackPort/GlobalFlags.hs 
@@ -1,51 +0,0 @@-module HackPort.GlobalFlags-    ( GlobalFlags(..)-    , defaultGlobalFlags-    , withHackPortContext-    ) where--import qualified Distribution.Verbosity as DV-import qualified Distribution.Simple.Setup as DSS-import qualified Distribution.Client.Config as DCC-import qualified Distribution.Client.GlobalFlags as DCG-import qualified Distribution.Client.Types as DCT-import qualified Distribution.Utils.NubList as DUN--import qualified Network.URI as NU--import System.FilePath ((</>))--import qualified Overlays---- | Type containing global flags.-data GlobalFlags =-    GlobalFlags { globalVersion :: DSS.Flag Bool-                , globalNumericVersion :: DSS.Flag Bool-                , globalPathToOverlay :: DSS.Flag (Maybe FilePath)-                , globalPathToPortage :: DSS.Flag (Maybe FilePath)-                }---- | Default 'GlobalFlags'.-defaultGlobalFlags :: GlobalFlags-defaultGlobalFlags =-    GlobalFlags { globalVersion = DSS.Flag False-                , globalNumericVersion = DSS.Flag False-                , globalPathToOverlay = DSS.Flag Nothing-                , globalPathToPortage = DSS.Flag Nothing-                }---- | Default remote repository. Defaults to [hackage](hackage.haskell.org).-defaultRemoteRepo :: DCT.RemoteRepo-defaultRemoteRepo = DCC.addInfoForKnownRepos $ (DCT.emptyRemoteRepo (DCT.RepoName name)) { DCT.remoteRepoURI = uri }-   where-    Just uri = NU.parseURI "https://hackage.haskell.org/"-    name     = "hackage.haskell.org"--withHackPortContext :: DV.Verbosity -> GlobalFlags -> (DCG.RepoContext -> IO a) -> IO a-withHackPortContext verbosity global_flags callback = do-    overlayPath <- Overlays.getOverlayPath verbosity (DSS.fromFlag $ globalPathToOverlay global_flags)-    let flags = DCG.defaultGlobalFlags {-                    DCG.globalRemoteRepos = DUN.toNubList [defaultRemoteRepo]-                  , DCG.globalCacheDir    = DSS.Flag $ overlayPath </> ".hackport"-                }-    DCG.withRepoContext verbosity flags callback
− Main.hs 
@@ -1,491 +0,0 @@-{-# LANGUAGE CPP #-}--module Main (main) where--import Control.Monad-import Data.Maybe-import Data.List-import qualified Data.Semigroup as S---- cabal-import Distribution.Simple.Setup-        ( Flag(..), fromFlag-        , trueArg-        , optionVerbosity-        )--import Distribution.Simple.Command -- commandsRun-import Distribution.Simple.Utils ( dieNoVerbosity, cabalVersion, warn )-import qualified Distribution.PackageDescription.Parsec as Cabal-import qualified Distribution.Package as Cabal-import Distribution.Verbosity (Verbosity, normal)--import Data.Version (showVersion)-import Distribution.Pretty (prettyShow)-import Distribution.Parsec (simpleParsec)--import qualified Distribution.Client.Setup as CabalInstall-import qualified Distribution.Client.Types as CabalInstall-import qualified Distribution.Client.Update as CabalInstall--import qualified Distribution.Client.IndexUtils as CabalInstall-import qualified Distribution.Solver.Types.SourcePackage as CabalInstall-import qualified Distribution.Solver.Types.PackageIndex as CabalInstall--import Portage.Overlay as Overlay ( loadLazy, inOverlay )-import Portage.Host as Host ( getInfo, portage_dir )-import Portage.PackageId ( normalizeCabalPackageId )--import System.Environment ( getArgs, getProgName )-import System.Directory ( doesDirectoryExist )-import System.Exit ( exitFailure )-{-# LANGUAGE CPP #-}--import System.FilePath ( (</>) )--import qualified HackPort.GlobalFlags as H--import Error-import Status-import Overlays-import Merge--import qualified Paths_cabal_install-import qualified Paths_hackport---------------------------------------------------------------------------- List--------------------------------------------------------------------------data ListFlags = ListFlags {-    listVerbosity :: Flag Verbosity-  }--instance S.Semigroup ListFlags where-  a <> b = ListFlags {-    listVerbosity = combine listVerbosity-  }-    where combine field = field a S.<> field b--instance Monoid ListFlags where-  mempty = ListFlags {-    listVerbosity = mempty-  }-#if !(MIN_VERSION_base(4,11,0))-  mappend a b = ListFlags {-    listVerbosity = combine listVerbosity-  }-    where combine field = field a `mappend` field b-#endif--defaultListFlags :: ListFlags-defaultListFlags = ListFlags {-    listVerbosity = Flag normal-  }--listCommand :: CommandUI ListFlags-listCommand = CommandUI {-    commandName = "list",-    commandSynopsis = "List package versions matching pattern",-    commandUsage = usagePackages "list",-    commandDescription = Nothing,-    commandNotes = Nothing,--    commandDefaultFlags = defaultListFlags,-    commandOptions = \_showOrParseArgs ->-      [ optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v })-      {--      , option [] ["overlay"]-         "Use cached packages list from specified overlay"-         listOverlayPath (\v flags -> flags { listOverlayPath = v })-         (reqArgFlag "PATH")-       -}-      ]-  }--listAction :: ListFlags -> [String] -> H.GlobalFlags -> IO ()-listAction flags extraArgs globalFlags = do- let verbosity = fromFlag (listVerbosity flags)- H.withHackPortContext verbosity globalFlags $ \repoContext -> do-  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)-  index <- fmap CabalInstall.packageIndex (CabalInstall.getSourcePackages verbosity repoContext)-  overlay <- Overlay.loadLazy overlayPath-  let pkgs | null extraArgs = CabalInstall.allPackages index-           | otherwise = concatMap (concatMap snd . CabalInstall.searchByNameSubstring index) extraArgs-      normalized = map (normalizeCabalPackageId . CabalInstall.srcpkgPackageId) pkgs-  let decorated = map (\p -> (Overlay.inOverlay overlay p, p)) normalized-  mapM_ (putStrLn . pretty) decorated-  where-  pretty :: (Bool, Cabal.PackageIdentifier) -> String-  pretty (isInOverlay, pkgId) =-      let dec | isInOverlay = " * "-              | otherwise   = "   "-      in dec ++ prettyShow pkgId----------------------------------------------------------------------------- Make Ebuild--------------------------------------------------------------------------data MakeEbuildFlags = MakeEbuildFlags {-    makeEbuildVerbosity :: Flag Verbosity-  , makeEbuildCabalFlags :: Flag (Maybe String)-  }--instance S.Semigroup MakeEbuildFlags where-  a <> b = MakeEbuildFlags {-    makeEbuildVerbosity = combine makeEbuildVerbosity-  , makeEbuildCabalFlags = makeEbuildCabalFlags b-  }-    where combine field = field a S.<> field b--instance Monoid MakeEbuildFlags where-  mempty = MakeEbuildFlags {-    makeEbuildVerbosity = mempty-  , makeEbuildCabalFlags = mempty-  }-#if !MIN_VERSION_base(4,11,0)-  mappend a b = MakeEbuildFlags {-    makeEbuildVerbosity = combine makeEbuildVerbosity-  , makeEbuildCabalFlags = makeEbuildCabalFlags b-  }-    where combine field = field a `mappend` field b-#endif--defaultMakeEbuildFlags :: MakeEbuildFlags-defaultMakeEbuildFlags = MakeEbuildFlags {-    makeEbuildVerbosity = Flag normal-  , makeEbuildCabalFlags = Flag Nothing-  }--makeEbuildAction :: MakeEbuildFlags -> [String] -> H.GlobalFlags -> IO ()-makeEbuildAction flags args globalFlags = do-  (catstr,cabals) <- case args of-                      (category:cabal1:cabaln) -> return (category, cabal1:cabaln)-                      _ -> throwEx (ArgumentError "make-ebuild needs at least two arguments. <category> <cabal-1> <cabal-n>")-  cat <- case simpleParsec catstr of-            Just c -> return c-            Nothing -> throwEx (ArgumentError ("could not parse category: " ++ catstr))-  let verbosity = fromFlag (makeEbuildVerbosity flags)-  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)-  forM_ cabals $ \cabalFileName -> do-    pkg <- Cabal.readGenericPackageDescription normal cabalFileName-    mergeGenericPackageDescription verbosity overlayPath cat pkg False (fromFlag $ makeEbuildCabalFlags flags)--makeEbuildCommand :: CommandUI MakeEbuildFlags-makeEbuildCommand = CommandUI {-    commandName = "make-ebuild",-    commandSynopsis = "Make an ebuild from a .cabal file",-    commandUsage = \_ -> [],-    commandDescription = Nothing,-    commandNotes = Nothing,--    commandDefaultFlags = defaultMakeEbuildFlags,-    commandOptions = \_showOrParseArgs ->-      [ optionVerbosity makeEbuildVerbosity (\v flags -> flags { makeEbuildVerbosity = v })--      , option "f" ["flags"]-        (unlines [ "Set cabal flags to certain state."-                 , "Example: --flags=-all_extensions"-                 ])-        makeEbuildCabalFlags-        (\cabal_flags v -> v{ makeEbuildCabalFlags = cabal_flags })-        (reqArg' "cabal_flags" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))-      ]-  }---------------------------------------------------------------------------- Update--------------------------------------------------------------------------data UpdateFlags = UpdateFlags {-    updateVerbosity :: Flag Verbosity-  }--instance S.Semigroup UpdateFlags where-  a <> b = UpdateFlags {-    updateVerbosity = combine updateVerbosity-  }-    where combine field = field a S.<> field b--instance Monoid UpdateFlags where-  mempty = UpdateFlags {-    updateVerbosity = mempty-  }-#if !(MIN_VERSION_base(4,11,0))-  mappend a b = UpdateFlags {-    updateVerbosity = combine updateVerbosity-  }-    where combine field = field a `mappend` field b-#endif--defaultUpdateFlags :: UpdateFlags-defaultUpdateFlags = UpdateFlags {-    updateVerbosity = Flag normal-  }--updateCommand :: CommandUI UpdateFlags-updateCommand = CommandUI {-    commandName = "update",-    commandSynopsis = "Update the local package database",-    commandUsage = usageFlags "update",-    commandDescription = Nothing,-    commandNotes = Nothing,--    commandDefaultFlags = defaultUpdateFlags,-    commandOptions = \_ ->-      [ optionVerbosity updateVerbosity (\v flags -> flags { updateVerbosity = v })--      {--      , option [] ["server"]-          "Set the server you'd like to update the cache from"-          updateServerURI (\v flags -> flags { updateServerURI = v} )-          (reqArgFlag "SERVER")-      -}-      ]-  }--updateAction :: UpdateFlags -> [String] -> H.GlobalFlags -> IO ()-updateAction flags extraArgs globalFlags = do-  unless (null extraArgs) $-    dieNoVerbosity $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs-  let verbosity = fromFlag (updateVerbosity flags)--  H.withHackPortContext verbosity globalFlags $ \repoContext ->-    -- TODO: parse user's flags as cabal-iinstall does.-    -- Currently I'm lazy to adapt new flag and user:-    --    defaultUpdateFlags-    let updateFlags = commandDefaultFlags CabalInstall.updateCommand-    in CabalInstall.update verbosity updateFlags repoContext---------------------------------------------------------------------------- Status--------------------------------------------------------------------------data StatusFlags = StatusFlags {-    statusVerbosity :: Flag Verbosity,-    statusDirection :: Flag StatusDirection-  }--defaultStatusFlags :: StatusFlags-defaultStatusFlags = StatusFlags {-    statusVerbosity = Flag normal,-    statusDirection = Flag PortagePlusOverlay-  }--statusCommand :: CommandUI StatusFlags-statusCommand = CommandUI {-    commandName = "status",-    commandSynopsis = "Show up-to-date status against other repos (hackage, ::gentoo)",-    commandUsage = usagePackages "status",-    commandDescription = Nothing,-    commandNotes = Nothing,--    commandDefaultFlags = defaultStatusFlags,-    commandOptions = \_ ->-      [ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })-      , option [] ["to-portage"]-          "Print only packages likely to be interesting to move to the portage tree."-          statusDirection (\v flags -> flags { statusDirection = v })-          (noArg (Flag OverlayToPortage))-      , option [] ["from-hackage"]-          "Print only packages likely to be interesting to move from hackage tree."-          statusDirection (\v flags -> flags { statusDirection = v })-          (noArg (Flag HackageToOverlay))-      ]-  }--statusAction :: StatusFlags -> [String] -> H.GlobalFlags -> IO ()-statusAction flags args globalFlags = do-  let verbosity = fromFlag (statusVerbosity flags)-      direction = fromFlag (statusDirection flags)-  portagePath <- getPortageDir verbosity globalFlags-  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)--  H.withHackPortContext verbosity globalFlags $ \repoContext ->-      runStatus verbosity portagePath overlayPath direction args repoContext---------------------------------------------------------------------------- Merge--------------------------------------------------------------------------data MergeFlags = MergeFlags {-    mergeVerbosity :: Flag Verbosity-  , mergeCabalFlags :: Flag (Maybe String)-  }--instance S.Semigroup MergeFlags where-  a <> b = MergeFlags {-    mergeVerbosity = combine mergeVerbosity-  , mergeCabalFlags = mergeCabalFlags b-  }-    where combine field = field a S.<> field b--instance Monoid MergeFlags where-  mempty = MergeFlags {-    mergeVerbosity = mempty-  , mergeCabalFlags = mempty-  }-#if !(MIN_VERSION_base(4,11,0))-  mappend a b = MergeFlags {-    mergeVerbosity = combine mergeVerbosity-  , mergeCabalFlags = mergeCabalFlags b-  }-    where combine field = field a `mappend` field b-#endif--defaultMergeFlags :: MergeFlags-defaultMergeFlags = MergeFlags {-    mergeVerbosity = Flag normal-  , mergeCabalFlags = Flag Nothing-  }--mergeCommand :: CommandUI MergeFlags-mergeCommand = CommandUI {-    commandName = "merge",-    commandSynopsis = "Make an ebuild out of hackage package",-    commandUsage = usagePackages "merge",-    commandDescription = Nothing,-    commandNotes = Nothing,--    commandDefaultFlags = defaultMergeFlags,-    commandOptions = \_showOrParseArgs ->-      [ optionVerbosity mergeVerbosity (\v flags -> flags { mergeVerbosity = v })--      , option "f" ["flags"]-        (unlines [ "Set cabal flags to certain state."-                 , "Example: --flags=-all_extensions"-                 ])-        mergeCabalFlags-        (\cabal_flags v -> v{ mergeCabalFlags = cabal_flags})-        (reqArg' "cabal_flags" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))-      ]-  }--mergeAction :: MergeFlags -> [String] -> H.GlobalFlags -> IO ()-mergeAction flags extraArgs globalFlags = do-  let verbosity = fromFlag (mergeVerbosity flags)-  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)--  H.withHackPortContext verbosity globalFlags $ \repoContext ->-    merge verbosity repoContext extraArgs overlayPath (fromFlag $ mergeCabalFlags flags)---------------------------------------------------------------------------- Utils--------------------------------------------------------------------------usagePackages :: String -> String -> String-usagePackages op_name pname =-  "Usage: " ++ pname ++ " " ++ op_name ++ " [FLAGS] [PACKAGE]\n\n"-  ++ "Flags for " ++ op_name ++ ":"--usageFlags :: String -> String -> String-usageFlags flag_name pname =-      "Usage: " ++ pname ++ " " ++ flag_name ++ " [FLAGS]\n\n"-      ++ "Flags for " ++ flag_name ++ ":"--getPortageDir :: Verbosity -> H.GlobalFlags -> IO FilePath-getPortageDir verbosity globalFlags = do-  let portagePathM =  fromFlag (H.globalPathToPortage globalFlags)-  portagePath <- case portagePathM of-                   Nothing -> Host.portage_dir <$> Host.getInfo-                   Just path -> return path-  exists <- doesDirectoryExist $ portagePath </> "dev-haskell"-  when (not exists) $-    warn verbosity $ "Looks like an invalid portage directory: " ++ portagePath-  return portagePath---------------------------------------------------------------------------- Main--------------------------------------------------------------------------globalCommand :: CommandUI H.GlobalFlags-globalCommand = CommandUI {-    commandName = "",-    commandSynopsis = "HackPort is an .ebuild generator from .cabal files with hackage index support",-    commandDescription = Just $ \pname ->-       let-         commands' = commands ++ [commandAddAction helpCommandUI undefined]-         cmdDescs = getNormalCommandDescriptions commands'-         maxlen    = maximum $ [length name | (name, _) <- cmdDescs]-         align str = str ++ replicate (maxlen - length str) ' '-       in-          "Commands:\n"-       ++ unlines [ "  " ++ align name ++ "    " ++ descr-                  | (name, descr) <- cmdDescs ]-       ++ "\n"-       ++ "For more information about a command use\n"-       ++ "  " ++ pname ++ " COMMAND --help\n\n"-       ++ "Typical steps for generating ebuilds from hackage packages:\n"-       ++ concat [ "  " ++ pname ++ " " ++ x ++ "\n"-                 | x <- ["update", "merge <package>"]]-       ++ "\n"-       ++ "Advanced usage:\n"-       ++ concat [ "  " ++ pname ++ " " ++ x ++ "\n"-                 | x <- ["update", "make-ebuild <CATEGORY> <ebuild.name>"]],--    commandNotes = Nothing,-    commandUsage = \pname -> "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",-    commandDefaultFlags = H.defaultGlobalFlags,-    commandOptions = \_showOrParseArgs ->-        [ option ['V'] ["version"]-            "Print version information"-            H.globalVersion (\v flags -> flags { H.globalVersion = v })-            trueArg-        , option [] ["numeric-version"]-            "Print just the version number"-            H.globalNumericVersion (\v flags -> flags { H.globalNumericVersion = v })-            trueArg-        , option ['p'] ["overlay-path"]-            "Override search path list where .hackport/ lives (default list: ['.', paludis-ovls or emerge-ovls])"-            H.globalPathToOverlay (\ovrl_path flags -> flags { H.globalPathToOverlay = ovrl_path })-            (reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))-        , option [] ["portage-path"]-            "Override path to your portage tree"-            H.globalPathToPortage (\port_path flags -> flags { H.globalPathToPortage = port_path })-            (reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))-        ]-    }--mainWorker :: [String] -> IO ()-mainWorker args =-  case commandsRun globalCommand commands args of-    CommandHelp help -> printHelp help-    CommandList opts -> printOptionsList opts-    CommandErrors errs -> printErrors errs-    CommandReadyToGo (globalflags, commandParse) -> do-      case commandParse of-        _ | fromFlag (H.globalVersion globalflags)        -> printVersion-          | fromFlag (H.globalNumericVersion globalflags) -> printNumericVersion-        CommandHelp help        -> printHelp help-        CommandList opts        -> printOptionsList opts-        CommandErrors errs      -> printErrors errs-        CommandReadyToGo action -> catchEx (action globalflags) errorHandler-    where-    printHelp help = getProgName >>= putStr . help-    printOptionsList = putStr . unlines-    printErrors errs = do-      putStr (concat (intersperse "\n" errs))-      exitFailure-    printNumericVersion = putStrLn $ showVersion Paths_hackport.version-    printVersion        = putStrLn $ "hackport version "-                                  ++ showVersion Paths_hackport.version-                                  ++ "\nusing cabal-install "-                                  ++ showVersion Paths_cabal_install.version-                                  ++ " and the Cabal library version "-                                  ++ prettyShow cabalVersion-    errorHandler :: HackPortError -> IO ()-    errorHandler e = do-      putStrLn (hackPortShowError e)--commands :: [Command (H.GlobalFlags -> IO ())]-commands =-      [ listCommand `commandAddAction` listAction-      , makeEbuildCommand `commandAddAction` makeEbuildAction-      , statusCommand `commandAddAction` statusAction-      , updateCommand `commandAddAction` updateAction-      , mergeCommand `commandAddAction` mergeAction-      ]--main :: IO ()-main = getArgs >>= mainWorker
− Merge.hs 
@@ -1,533 +0,0 @@-{-|-Module      : Merge-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Core functionality of the @merge@ command of @HackPort@.--}-module Merge-  ( merge-  , mergeGenericPackageDescription-  ) where--import           Control.Concurrent.Async-import           Control.Monad-import           Control.Exception-import qualified Data.Text as T-import qualified Data.Text.IO as T-import           Data.Function (on)-import qualified Data.Map.Strict as Map-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.Pretty (prettyShow)-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           Control.Parallel.Strategies-import qualified Data.List.Split as DLS-import           System.Directory ( getCurrentDirectory-                        , setCurrentDirectory-                        , createDirectoryIfMissing-                        , doesFileExist-                        , listDirectory-                        )-import           System.Process-import           System.FilePath ((</>),(<.>))-import           System.Exit---- hackport-import qualified AnsiColor as A-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-import qualified Merge.Utils        as Merge--{--Requested features:-  * Add files to git?--}---- | 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---- | 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.srcpkgPackageId)) avails-resolveVersion avails (Just ver) = listToMaybe (filter match avails)-  where-    match avail = ver == Cabal.pkgVersion (CabalInstall.srcpkgPackageId avail)---- | This function is executed by the @merge@ command of @HackPort@.--- Its functionality is as follows:------ 1. Feed user input to 'readPackageString'--- 2. Look for a matching package on the @hackage@ database--- 3. Run 'mergeGenericPackageDescription' with the supplied information--- 4. Generate a coloured diff between the old and new ebuilds.------ Various information is printed in between these steps depending on the--- 'Verbosity'.-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 Merge.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.srcpkgPackageId 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 (prettyShow . Cabal.pkgVersion . CabalInstall.srcpkgPackageId) 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 (prettyShow . CabalInstall.srcpkgPackageId $ 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.srcpkgPackageId avail == CabalInstall.srcpkgPackageId selectedPkg = "* "-                   | otherwise = "- "-    info verbosity $ match_text ++ (prettyShow . CabalInstall.srcpkgPackageId $ avail)--  let cabal_pkgId = CabalInstall.srcpkgPackageId 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.srcpkgDescription 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 Merge.getPreviousPackageId pkgDir newPkgId of-    Just validPkg -> do info verbosity "Generating a diff..."-                        diffEbuilds overlayPath validPkg newPkgId-    _ -> info verbosity "Nothing to diff!"---- used to be FlagAssignment in Cabal but now it's an opaque type-type CabalFlags = [(Cabal.FlagName, Bool)]---- | Generate an ebuild from a 'Cabal.GenericPackageDescription'.-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 = Merge.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 = prettyShow merged_cabal_pkg_name-                             cn = prettyShow 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-                                      (Merge.exeAndLibDeps pkgDesc0)--      pkgDesc = Merge.RetroPackageDescription pkgDesc0 accepted_deps-      cabal_flag_descs = Cabal.genPackageFlags pkgGenericDesc-      all_flags = map Cabal.flagName cabal_flag_descs-      make_fas  :: [Cabal.PackageFlag] -> [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  -> Merge.mangle_iuse 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-               , Right (pkgDesc1,fr) <- [GHCCore.finalizePD (Cabal.mkFlagAssignment f)-                                         GHCCore.defaultComponentRequestedSpec-                                         (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-                                 (Merge.exeAndLibDeps pkgDesc1)-               -- TODO: drop ghc libraries from tests depends as well-               -- (see deepseq in hackport-0.3.5 as an example)-               , let pkgDesc_filtered_bdeps = Merge.RetroPackageDescription pkgDesc1 ad-               ] `using` parList rdeepseq-          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 :: Merge.RetroPackageDescription -> Merge.EDep-      cabal_to_emerge_dep cabal_pkg = Merge.resolveDependencies overlay cabal_pkg compiler_info ghc_packages merged_cabal_pkg_name--  -- When there are lots of package flags, computation of every possible flag combination-  -- can take a while (e.g., 12 package flags = 2^12 possible flag combinations).-  -- Warn the user about this if there are at least 12 package flags. 'cabal_flag_descs'-  -- is usually an overestimation since it includes flags that hackport will strip out,-  -- but using it instead of 'active_flag_descs' avoids forcing the very computation we-  -- are trying to warn the user about.-  when (length cabal_flag_descs >= 12) $-    notice verbosity $ "There are up to " ++-    A.bold (show (2^(length cabal_flag_descs) :: Int)) ++-    " possible flag combinations.\n" ++-    A.inColor A.Yellow True A.Default "This may take a while."--  debug verbosity $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0-  debug verbosity $ "buildDepends pkgDesc0: " ++ show (map prettyShow (Merge.exeAndLibDeps pkgDesc0))-  debug verbosity $ "buildDepends pkgDesc:  " ++ show (map prettyShow (Merge.buildDepends pkgDesc))--  notice verbosity $ "Accepted depends: " ++ show (map prettyShow accepted_deps)-  notice verbosity $ "Skipped  depends: " ++ show (map prettyShow 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 (Merge.packageDescription pkgDesc)--  let active_flag_descs_renamed =-        (\f -> f { Cabal.flagName = Cabal.mkFlagName . cfn_to_iuse . Cabal.unFlagName-                   . Cabal.flagName $ f }) <$> active_flag_descs-  iuse_flag_descs <- Merge.dropIfUseExpands active_flag_descs_renamed-  mergeEbuild verbosity existing_meta pkgdir ebuild iuse_flag_descs--  when fetch $ do-    let cabal_pkgId = Cabal.packageId (Merge.packageDescription pkgDesc)-        norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)-    fetchDigestAndCheck verbosity (overlayPath </> prettyShow cat </> prettyShow norm_pkgName)-      $ Portage.fromCabalPackageId cat cabal_pkgId---- | Run @ebuild@, @pkgcheck@ and @repoman@ commands in the directory of the--- newly-generated ebuild.------ This will ensure well-formed ebuilds and @metadata.xml@, and will update (if possible)--- the @Manifest@ file.------ @pkgcheck@ and @repoman@ will run concurrently.-fetchDigestAndCheck :: Verbosity-                    -> FilePath -- ^ directory of ebuild-                    -> Portage.PackageId -- ^ newest ebuild-                    -> IO ()-fetchDigestAndCheck verbosity ebuildDir pkgId =-  let ebuild = prettyShow (Portage.cabalPkgName . Portage.packageId $ pkgId)-               ++ "-" ++ prettyShow (Portage.pkgVersion pkgId) <.> "ebuild"-  in withWorkingDirectory ebuildDir $ do-    notice verbosity "Recalculating digests..."-    emEx <- system $ "ebuild " ++ ebuild ++ " manifest > /dev/null 2>&1"-    when (emEx /= ExitSuccess) $-      notice verbosity "ebuild manifest failed horribly. Do something about it!"--    notice verbosity $ "Running " ++ A.bold "repoman full --include-dev " ++-      "and " ++ A.bold "pkgcheck scan" ++ "..."--    (rfEx,(psEx,psOut,_)) <- system "repoman full --include-dev"-      `concurrently`-      readCreateProcessWithExitCode (shell "pkgcheck scan --color True") ""-    -    when (rfEx /= ExitSuccess) $-      notice verbosity "repoman full --include-dev found an error. Do something about it!"-    when (psEx /= ExitSuccess) $ -- this should never be true, even with QA issues.-      notice verbosity $ A.inColor A.Red True A.Default "pkgcheck scan failed."-    notice verbosity psOut--    return ()--withWorkingDirectory :: FilePath -> IO a -> IO a-withWorkingDirectory newDir action = do-  oldDir <- getCurrentDirectory-  bracket-    (setCurrentDirectory newDir)-    (\_ -> setCurrentDirectory oldDir)-    (\_ -> action)---- | Write the ebuild (and sometimes a new @metadata.xml@) to its directory.-mergeEbuild :: Verbosity -> EM.EMeta -> FilePath -> E.EBuild -> [Cabal.PackageFlag] -> 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-  yet_meta <- doesFileExist mpath-  -- If there is an existing @metadata.xml@, read it in as a 'T.Text'.-  -- Otherwise return 'T.empty'. We only use this once more to directly-  -- compare to @default_meta@ before writing it.-  current_meta <- if yet_meta-                  then T.readFile mpath-                  else return T.empty-  -- Either create an object of the 'Portage.Metadata' type from a valid @current_meta@,-  -- or supply a default minimal metadata object. Note the difference to @current_meta@:-  -- @current_meta@ is of type 'T.Text', @current_meta'@ is of type 'Portage.Metadata'.-  let current_meta' = fromMaybe Portage.makeMinimalMetadata-                      (Portage.pureMetadataFromFile current_meta)-      -- Create the @metadata.xml@ string, adding new USE flags (if any) to those of-      -- the existing @metadata.xml@. If an existing flag has a new and old description,-      -- the new one takes precedence.-      default_meta = Portage.makeDefaultMetadata-                     $ Merge.metaFlags flags `Map.union`-                     Portage.metadataUseFlags current_meta'-      -- Create a 'Map.Map' of USE flags with updated descriptions.-      new_flags = Map.differenceWith (\new old -> if (new /= old)-                                                  then Just $ old ++ A.bold (" -> " ++ new)-                                                  else Nothing)-                  (Merge.metaFlags flags)-                  $ Portage.metadataUseFlags current_meta'--  createDirectoryIfMissing True edir-  now <- TC.getCurrentTime--  let (existing_keywords, existing_license) = (EM.keywords existing_meta, EM.license existing_meta)-      new_keywords = maybe (E.keywords ebuild) (map Merge.to_unstable) existing_keywords-      new_license  = either (\err -> maybe (Left err)-                                           Right-                                           existing_license)-                            Right-                            (E.license ebuild)-      ebuild'      = ebuild { E.keywords = new_keywords-                            , E.license = new_license-                            }-      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` T.writeFile epath (T.pack s_ebuild')--  when (current_meta /= default_meta) $ do-    when (current_meta /= T.empty) $ do-      notice verbosity $ A.bold $ "Default and current " ++ emeta ++ " differ."-      if (new_flags /= Map.empty)-        then notice verbosity $ "New or updated USE flags:\n" ++-             (unlines $ Portage.prettyPrintFlagsHuman new_flags)-        else notice verbosity "No new USE flags."--    notice verbosity $ "Writing " ++ emeta-    T.writeFile mpath default_meta
− Merge/Dependencies.hs 
@@ -1,583 +0,0 @@-{-|-Module      : Merge.Dependencies-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Merge a package from @hackage@ to an ebuild.--}-{-# LANGUAGE CPP #-}-module Merge.Dependencies-  ( EDep(..)-  , RetroPackageDescription(..)-  , exeAndLibDeps-  , mkRetroPD-  , resolveDependencies-  ) where--import           Control.DeepSeq (NFData(..))-import           Control.Parallel.Strategies-import           Data.Maybe ( isJust, isNothing )-import qualified Data.List as L-#if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup (Semigroup(..))-#endif-import qualified Data.Set  as S--import qualified Distribution.CabalSpecVersion as Cabal-import qualified Distribution.Compat.NonEmptySet as NES-import qualified Distribution.Package as Cabal-import qualified Distribution.PackageDescription as Cabal-import qualified Distribution.Version as Cabal-import qualified Distribution.Pretty as Cabal--import qualified Distribution.Compiler as Cabal--import qualified Portage.Cabal as Portage-import qualified Portage.Dependency as Portage-import qualified Portage.Dependency.Normalize as PN-import qualified Portage.Overlay as Portage-import qualified Portage.PackageId as Portage-import qualified Portage.Use as Portage-import qualified Portage.Tables as Portage-import qualified Cabal2Ebuild as C2E--import qualified Portage.GHCCore as GHCCore--import Debug.Trace ( trace )---- | Dependencies of an ebuild.-data EDep = EDep-  {-    rdep :: Portage.Dependency,-    rdep_e :: S.Set String,-    dep :: Portage.Dependency,-    dep_e :: S.Set String-  }-  deriving (Show, Eq, Ord)--instance NFData EDep where-  rnf (EDep rd rde d de) = rnf rd `seq` rnf rde `seq` rnf d `seq` rnf de---- | Cabal-1 style 'Cabal.PackageDescription', with a top-level 'buildDepends' function.-data RetroPackageDescription = RetroPackageDescription {-  packageDescription :: Cabal.PackageDescription,-  buildDepends :: [Cabal.Dependency]-  } deriving (Show)---- | Construct a 'RetroPackageDescription' using 'exeAndLibDeps' for the 'buildDepends'.-mkRetroPD :: Cabal.PackageDescription -> RetroPackageDescription-mkRetroPD pd = RetroPackageDescription { packageDescription = pd, buildDepends = exeAndLibDeps pd }---- | Extract only the build dependencies for libraries and executables for a given package.-exeAndLibDeps :: Cabal.PackageDescription -> [Cabal.Dependency]-exeAndLibDeps pkg = concatMap (Cabal.targetBuildDepends . Cabal.buildInfo)-                    (Cabal.executables pkg)-                    `L.union`-                    concatMap (Cabal.targetBuildDepends . Cabal.libBuildInfo)-                    (Cabal.allLibraries pkg)--instance Semigroup EDep where-  (EDep rdepA rdep_eA depA dep_eA) <> (EDep rdepB rdep_eB depB dep_eB) = EDep-    { rdep   = Portage.DependAllOf [rdepA, rdepB]-    , rdep_e = rdep_eA `S.union` rdep_eB-    , dep    = Portage.DependAllOf [depA, depB]-    , dep_e  = dep_eA  `S.union` dep_eB-    }-  -instance Monoid EDep where-  mempty = EDep-      {-        rdep = Portage.empty_dependency,-        rdep_e = S.empty,-        dep = Portage.empty_dependency,-        dep_e = S.empty-      }-#if !(MIN_VERSION_base(4,11,0))-  (EDep rdepA rdep_eA depA dep_eA) `mappend` (EDep rdepB rdep_eB depB dep_eB) = EDep-    { rdep   = Portage.DependAllOf [rdepA, rdepB]-    , rdep_e = rdep_eA `S.union` rdep_eB-    , dep    = Portage.DependAllOf [depA, depB]-    , dep_e  = dep_eA  `S.union` dep_eB-    }-#endif---- | Resolve package dependencies from a 'RetroPackageDescription' into an 'EDep'.-resolveDependencies :: Portage.Overlay -> RetroPackageDescription -> Cabal.CompilerInfo-                    -> [Cabal.PackageName] -> Cabal.PackageName-                    -> EDep-resolveDependencies overlay pkg compiler_info ghc_package_names merged_cabal_pkg_name = edeps-  where-    -- hasBuildableExes p = any (buildable . buildInfo) . executables $ p-    treatAsLibrary :: Bool-    treatAsLibrary = isJust (Cabal.library (packageDescription pkg))-    -- without slot business-    raw_haskell_deps :: Portage.Dependency-    raw_haskell_deps = PN.normalize_depend $ Portage.DependAllOf $ haskellDependencies overlay (buildDepends pkg)-    test_deps :: Portage.Dependency-    test_deps = Portage.mkUseDependency (True, Portage.Use "test") $-                    Portage.DependAllOf $-                    remove_raw_common $-                    testDependencies overlay (packageDescription pkg) ghc_package_names merged_cabal_pkg_name-    cabal_dep :: Portage.Dependency-    cabal_dep = cabalDependency overlay (packageDescription pkg) compiler_info-    ghc_dep :: Portage.Dependency-    ghc_dep = compilerInfoToDependency compiler_info-    extra_libs :: Portage.Dependency-    extra_libs = Portage.DependAllOf $ findCLibs (packageDescription pkg)-    pkg_config_libs :: [Portage.Dependency]-    pkg_config_libs = pkgConfigDependencies overlay (packageDescription pkg)-    pkg_config_tools :: Portage.Dependency-    pkg_config_tools = Portage.DependAllOf $ if L.null pkg_config_libs-                           then []-                           else [any_c_p "virtual" "pkgconfig"]-    build_tools :: Portage.Dependency-    build_tools = Portage.DependAllOf $ pkg_config_tools : legacyBuildToolsDependencies (packageDescription pkg)-                  ++ hackageBuildToolsDependencies overlay (packageDescription pkg)--    setup_deps :: Portage.Dependency-    setup_deps = PN.normalize_depend $ Portage.DependAllOf $-                     remove_raw_common $-                     setupDependencies overlay (packageDescription pkg) ghc_package_names merged_cabal_pkg_name--    edeps :: EDep-    edeps-        | treatAsLibrary = mempty-                  {-                    dep = Portage.DependAllOf-                              [ cabal_dep-                              , setup_deps-                              , build_tools-                              , test_deps-                              ],-                    dep_e = S.singleton "${RDEPEND}",-                    rdep = Portage.DependAllOf-                               [ Portage.set_build_slot ghc_dep-                               , Portage.set_build_slot $ add_profile $ raw_haskell_deps-                               , extra_libs-                               , Portage.DependAllOf pkg_config_libs-                               ]-                  }-        | otherwise = mempty-                  {-                    dep = Portage.DependAllOf-                              [ cabal_dep-                              , setup_deps-                              , build_tools-                              , test_deps-                              ],-                    dep_e = S.singleton "${RDEPEND}",-                    rdep = Portage.DependAllOf-                               [ Portage.set_build_slot ghc_dep-                               , Portage.set_build_slot $ raw_haskell_deps-                               , extra_libs-                               , Portage.DependAllOf pkg_config_libs-                               ]-                  }-    add_profile    = Portage.addDepUseFlag (Portage.mkQUse (Portage.Use "profile"))-    -- remove depends present in common section-    remove_raw_common = filter (\d -> not (Portage.dep_as_broad_as d raw_haskell_deps))-                        . map PN.normalize_depend-------------------------------------------------------------------- Custom-setup dependencies--- TODO: move partitioning part to Merge:mergeGenericPackageDescription------------------------------------------------------------------setupDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Cabal.PackageName] -> Cabal.PackageName -> [Portage.Dependency]-setupDependencies overlay pkg ghc_package_names merged_cabal_pkg_name = deps-    where cabalDeps = maybe [] id $ Cabal.setupDepends `fmap` Cabal.setupBuildInfo pkg-          cabalDeps' = fst $ Portage.partition_depends ghc_package_names merged_cabal_pkg_name cabalDeps-          deps = C2E.convertDependencies overlay (Portage.Category "dev-haskell") cabalDeps'-------------------------------------------------------------------- Test-suite dependencies--- TODO: move partitioning part to Merge:mergeGenericPackageDescription------------------------------------------------------------------testDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Cabal.PackageName] -> Cabal.PackageName -> [Portage.Dependency]-testDependencies overlay pkg ghc_package_names merged_cabal_pkg_name = deps-    where cabalDeps = concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) (Cabal.testSuites pkg)-          cabalDeps' = fst $ Portage.partition_depends ghc_package_names merged_cabal_pkg_name cabalDeps-          deps = C2E.convertDependencies overlay (Portage.Category "dev-haskell") cabalDeps'-------------------------------------------------------------------- Haskell packages------------------------------------------------------------------haskellDependencies :: Portage.Overlay -> [Cabal.Dependency] {- PackageDescription -} -> [Portage.Dependency]-haskellDependencies overlay deps =-    C2E.convertDependencies overlay (Portage.Category "dev-haskell") deps-------------------------------------------------------------------- Cabal Dependency-------------------------------------------------------------------- | Select the most restrictive dependency on Cabal, either the .cabal--- file's descCabalVersion, or the Cabal GHC shipped with.-cabalDependency :: Portage.Overlay -> Cabal.PackageDescription -> Cabal.CompilerInfo -> Portage.Dependency-cabalDependency overlay pkg ~(Cabal.CompilerInfo {-                                  Cabal.compilerInfoId =-                                      Cabal.CompilerId Cabal.GHC cabal_version-                              }) =-         C2E.convertDependency overlay-                               (Portage.Category "dev-haskell")-                               (Cabal.Dependency (Cabal.mkPackageName "Cabal")-                                                 finalCabalDep (NES.singleton Cabal.defaultLibName))-  where-    versionNumbers = Cabal.versionNumbers cabal_version-    userCabalVersion = Cabal.orLaterVersion $ Cabal.mkVersion-                       $ Cabal.cabalSpecToVersionDigits $ Cabal.specVersion pkg-    shippedCabalVersion = GHCCore.cabalFromGHC versionNumbers-    shippedCabalDep = maybe Cabal.anyVersion Cabal.orLaterVersion shippedCabalVersion-    finalCabalDep = Cabal.simplifyVersionRange-                                (Cabal.intersectVersionRanges-                                          userCabalVersion-                                          shippedCabalDep)-------------------------------------------------------------------- GHC Dependency------------------------------------------------------------------compilerInfoToDependency :: Cabal.CompilerInfo -> Portage.Dependency-compilerInfoToDependency ~(Cabal.CompilerInfo {-                               Cabal.compilerInfoId =-                                   Cabal.CompilerId Cabal.GHC cabal_version}) =-  at_least_c_p_v "dev-lang" "ghc" (Cabal.versionNumbers cabal_version)-------------------------------------------------------------------- C Libraries------------------------------------------------------------------findCLibs :: Cabal.PackageDescription -> [Portage.Dependency]-findCLibs (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) =-  [ trace ("WARNING: This package depends on a C library we don't know the portage name for: " ++ p ++ ". Check the generated ebuild.")-          (any_c_p "unknown-c-lib" p)-  | p <- notFound-  ] ++-  found-  where-  libE = concatMap (Cabal.extraLibs . Cabal.libBuildInfo) $ maybe [] return lib-  exeE = concatMap Cabal.extraLibs (filter Cabal.buildable (map Cabal.buildInfo exes))-  allE = libE ++ exeE--  notFound = [ p | p <- allE, isNothing (staticTranslateExtraLib p) ]-  found =    [ p | Just p <- map staticTranslateExtraLib allE ]--any_c_p_s_u :: String -> String -> Portage.SlotDepend -> [Portage.UseFlag] -> Portage.Dependency-any_c_p_s_u cat pn slot uses = Portage.DependAtom $-    Portage.Atom (Portage.mkPackageName cat pn)-                 (Portage.DRange Portage.ZeroB Portage.InfinityB)-                 (Portage.DAttr slot uses)--any_c_p :: String -> String -> Portage.Dependency-any_c_p cat pn = any_c_p_s_u cat pn Portage.AnySlot []--at_least_c_p_v :: String -> String -> [Int] -> Portage.Dependency-at_least_c_p_v cat pn v = Portage.DependAtom $-  Portage.Atom (Portage.mkPackageName cat pn)-               (Portage.DRange (Portage.NonstrictLB (Portage.Version v Nothing [] 0)) Portage.InfinityB)-               (Portage.DAttr Portage.AnySlot [])--staticTranslateExtraLib :: String -> Maybe Portage.Dependency-staticTranslateExtraLib lib = lookup lib m-  where-  m = [ ("z", any_c_p "sys-libs" "zlib")-      , ("bz2", any_c_p "app-arch" "bzip2")-      , ("mysqlclient", at_least_c_p_v "virtual" "mysql" [4,0])-      , ("pq", at_least_c_p_v "dev-db" "postgresql" [7])-      , ("ev", any_c_p "dev-libs" "libev")-      , ("expat", any_c_p "dev-libs" "expat")-      , ("curl", any_c_p "net-misc" "curl")-      , ("xml2", any_c_p "dev-libs" "libxml2")-      , ("mecab", any_c_p "app-text" "mecab")-      , ("zmq", any_c_p "net-libs" "zeromq")-      , ("SDL", any_c_p "media-libs" "libsdl")-      , ("adns", any_c_p "net-libs" "adns")-      , ("pcre", any_c_p "dev-libs" "libpcre")-      , ("GL", any_c_p "virtual" "opengl")-      , ("GLU", any_c_p "virtual" "glu")-      , ("glut", any_c_p "media-libs" "freeglut")-      , ("X11", any_c_p "x11-libs" "libX11")-      , ("libzip", any_c_p "dev-libs" "libzip")-      , ("ssl", any_c_p "dev-libs" "openssl")-      , ("Judy", any_c_p "dev-libs" "judy")-      , ("fcgi", any_c_p "dev-libs" "fcgi")-      , ("gnutls", any_c_p "net-libs" "gnutls")-      , ("idn", any_c_p "net-dns" "libidn")-      , ("tre", any_c_p "dev-libs" "tre")-      , ("m", any_c_p "virtual" "libc")-      , ("asound", any_c_p "media-libs" "alsa-lib")-      , ("sqlite3", at_least_c_p_v "dev-db" "sqlite" [3,0])-      , ("stdc++", any_c_p_s_u "sys-devel" "gcc" Portage.AnySlot [Portage.mkUse (Portage.Use "cxx")])-      , ("crack", any_c_p "sys-libs" "cracklib")-      , ("exif", any_c_p "media-libs" "libexif")-      , ("IL", any_c_p "media-libs" "devil")-      , ("Imlib2", any_c_p "media-libs" "imlib2")-      , ("pcap", any_c_p "net-libs" "libpcap")-      , ("lber", any_c_p "net-nds" "openldap")-      , ("ldap", any_c_p "net-nds" "openldap")-      , ("expect", any_c_p "dev-tcltk" "expect")-      , ("tcl", any_c_p "dev-lang" "tcl")-      , ("Xext", any_c_p "x11-libs" "libXext")-      , ("Xrandr", any_c_p "x11-libs" "libXrandr")-      , ("crypto", any_c_p "dev-libs" "openssl")-      , ("gmp", any_c_p "dev-libs" "gmp")-      , ("fuse", any_c_p "sys-fs" "fuse")-      , ("zip", any_c_p "dev-libs" "libzip")-      , ("QtCore", any_c_p "dev-qt" "qtcore")-      , ("QtDeclarative", any_c_p "dev-qt" "qtdeclarative")-      , ("QtGui", any_c_p "dev-qt" "qtgui")-      , ("QtOpenGL", any_c_p "dev-qt" "qtopengl")-      , ("QtScript", any_c_p "dev-qt" "qtscript")-      , ("gsl", any_c_p "sci-libs" "gsl")-      , ("gslcblas", any_c_p "sci-libs" "gsl")-      , ("mkl_core", any_c_p "sci-libs" "mkl")-      , ("mkl_intel_lp64", any_c_p "sci-libs" "mkl")-      , ("mkl_lapack", any_c_p "sci-libs" "mkl")-      , ("mkl_sequential", any_c_p "sci-libs" "mkl")-      , ("Xi", any_c_p "x11-libs" "libXi")-      , ("Xxf86vm", any_c_p "x11-libs" "libXxf86vm")-      , ("pthread", any_c_p "virtual" "libc")-      , ("panelw", any_c_p "sys-libs" "ncurses")-      , ("ncursesw", any_c_p "sys-libs" "ncurses")-      , ("ftgl", any_c_p "media-libs" "ftgl")-      , ("glpk", any_c_p "sci-mathematics" "glpk")-      , ("sndfile", any_c_p "media-libs" "libsndfile")-      , ("portaudio", any_c_p "media-libs" "portaudio")-      , ("icudata", any_c_p "dev-libs" "icu")-      , ("icui18n", any_c_p "dev-libs" "icu")-      , ("icuuc", any_c_p "dev-libs" "icu")-      , ("chipmunk", any_c_p "sci-physics" "chipmunk")-      , ("alut", any_c_p "media-libs" "freealut")-      , ("openal", any_c_p "media-libs" "openal")-      , ("iw", any_c_p "net-wireless" "wireless-tools")-      , ("attr", any_c_p "sys-apps" "attr")-      , ("ncurses", any_c_p "sys-libs" "ncurses")-      , ("panel", any_c_p "sys-libs" "ncurses")-      , ("nanomsg", any_c_p "dev-libs" "nanomsg")-      , ("pgf", any_c_p "media-libs" "libpgf")-      , ("ssh2", any_c_p "net-libs" "libssh2")-      , ("dl", any_c_p "virtual" "libc")-      , ("glfw", any_c_p "media-libs" "glfw")-      , ("nettle", any_c_p "dev-libs" "nettle")-      , ("Xpm",    any_c_p "x11-libs" "libXpm")-      , ("Xss",    any_c_p "x11-libs" "libXScrnSaver")-      , ("tag_c",  any_c_p "media-libs" "taglib")-      , ("magic",  any_c_p "sys-apps" "file")-      , ("crypt",  any_c_p_s_u "virtual" "libcrypt" Portage.AnyBuildTimeSlot [])-      , ("Xrender", any_c_p "x11-libs" "libXrender")-      , ("Xcursor", any_c_p "x11-libs" "libXcursor")-      , ("Xinerama", any_c_p "x11-libs" "libXinerama")-      , ("wayland-client", any_c_p "dev-libs" "wayland")-      , ("wayland-cursor", any_c_p "dev-libs" "wayland")-      , ("wayland-server", any_c_p "dev-libs" "wayland")-      , ("wayland-egl", any_c_p_s_u "media-libs" "mesa" Portage.AnySlot [Portage.mkUse (Portage.Use "wayland")])-      , ("xkbcommon", any_c_p "x11-libs" "libxkbcommon")-      , ("SDL_gfx", any_c_p "media-libs" "sdl-gfx")-      , ("SDL_image", any_c_p "media-libs" "sdl-image")-      , ("SDL_ttf", any_c_p "media-libs" "sdl-ttf")-      , ("odbc", any_c_p "dev-db" "unixODBC")-      , ("uuid", any_c_p "sys-apps" "util-linux")-      , ("notify", any_c_p "x11-libs" "libnotify")-      , ("SDL2", any_c_p " media-libs" "libsdl2")-      , ("SDL2_mixer", any_c_p "media-libs" "sdl2-mixer")-      , ("blas", any_c_p "virtual" "blas")-      , ("lapack", any_c_p "virtual" "lapack")-      ]-------------------------------------------------------------------- Build Tools (legacy, a list of well-known tools)------------------------------------------------------------------legacyBuildToolsDependencies :: Cabal.PackageDescription -> [Portage.Dependency]-legacyBuildToolsDependencies (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = L.nub $-  [ case pkg of-      Just p -> p-      Nothing -> trace ("WARNING: Unknown build tool '" ++ Cabal.prettyShow exe ++ "'. Check the generated ebuild.")-                       (any_c_p "unknown-build-tool" pn)-  | exe@(Cabal.LegacyExeDependency pn _range) <- cabalDeps-  , pkg <- return (lookup pn buildToolsTable)-  ]-  where-  cabalDeps = filter notProvided $ depL ++ depE-  depL = concatMap (Cabal.buildTools . Cabal.libBuildInfo) $ maybe [] return lib-  depE = concatMap Cabal.buildTools (filter Cabal.buildable (map Cabal.buildInfo exes))-  notProvided (Cabal.LegacyExeDependency pn _range) = pn `notElem` buildToolsProvided--buildToolsTable :: [(String, Portage.Dependency)]-buildToolsTable =-  [ ("happy", any_c_p "dev-haskell" "happy")-  , ("alex", any_c_p "dev-haskell" "alex")-  , ("c2hs", any_c_p "dev-haskell" "c2hs")-  , ("cabal",               any_c_p "dev-haskell" "cabal-install")-  , ("cabal-install", any_c_p "dev-haskell" "cabal-install")-  , ("cpphs",               any_c_p "dev-haskell" "cpphs")-  , ("ghc",                 any_c_p "dev-lang" "ghc")-  , ("gtk2hsTypeGen",       any_c_p "dev-haskell" "gtk2hs-buildtools")-  , ("gtk2hsHookGenerator", any_c_p "dev-haskell" "gtk2hs-buildtools")-  , ("gtk2hsC2hs",          any_c_p "dev-haskell" "gtk2hs-buildtools")-  , ("hsb2hs",              any_c_p "dev-haskell" "hsb2hs")-  , ("hsx2hs",              any_c_p "dev-haskell" "hsx2hs")-  , ("llvm-config",         any_c_p "sys-devel" "llvm")-  ]---- tools that are provided by ghc or some other existing program--- so we do not need dependencies on them-buildToolsProvided :: [String]-buildToolsProvided = ["hsc2hs"]-------------------------------------------------------------------- Hackage Build Tools (behind `build-tool-depends`)------------------------------------------------------------------hackageBuildToolsDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Portage.Dependency]-hackageBuildToolsDependencies overlay (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) =-  haskellDependencies overlay $ L.nub $-    [ Cabal.Dependency pn versionRange $ NES.singleton Cabal.defaultLibName-    | Cabal.ExeDependency pn _component versionRange <- cabalDeps-    ]-  where-    cabalDeps = depL ++ depE-    depL = concatMap (Cabal.buildToolDepends . Cabal.libBuildInfo) $ maybe [] return lib-    depE = concatMap Cabal.buildToolDepends (filter Cabal.buildable (map Cabal.buildInfo exes))-------------------------------------------------------------------- pkg-config------------------------------------------------------------------pkgConfigDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Portage.Dependency]-pkgConfigDependencies overlay (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = L.nub $ resolvePkgConfigs overlay cabalDeps-  where-  cabalDeps = depL ++ depE-  depL = concatMap (Cabal.pkgconfigDepends . Cabal.libBuildInfo) $ maybe [] return lib-  depE = concatMap Cabal.pkgconfigDepends (filter Cabal.buildable (map Cabal.buildInfo exes))--resolvePkgConfigs :: Portage.Overlay -> [Cabal.PkgconfigDependency] -> [Portage.Dependency]-resolvePkgConfigs overlay cdeps =-  [ case resolvePkgConfig overlay pkg of-      Just d -> d-      Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ Cabal.prettyShow pkg ++ ". Check generated ebuild.")-                       (any_c_p "unknown-pkg-config" pn)-  | pkg@(Cabal.PkgconfigDependency cabal_pn _range) <- cdeps-  , let pn = Cabal.unPkgconfigName cabal_pn-  ]--resolvePkgConfig :: Portage.Overlay -> Cabal.PkgconfigDependency -> Maybe Portage.Dependency-resolvePkgConfig _overlay (Cabal.PkgconfigDependency cabal_pn _cabalVersion) = do-  (cat,portname, slot) <- lookup (Cabal.unPkgconfigName cabal_pn) pkgconfig_table-  return $ any_c_p_s_u cat portname slot []--pkgconfig_table :: [(String, (String, String, Portage.SlotDepend))]-pkgconfig_table =-  [-   ("alsa",         ("media-libs", "alsa-lib", Portage.AnySlot))-  ,("atk",          ("dev-libs", "atk", Portage.AnySlot))-  ,("gconf-2.0",    ("gnome-base", "gconf", Portage.AnySlot))--  ,("gio-2.0",                ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gio-unix-2.0",           ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("glib-2.0",               ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gmodule-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gmodule-export-2.0",     ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gmodule-no-export-2.0",  ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gobject-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))-  ,("gobject-introspection-1.0", ("dev-libs", "gobject-introspection",-                                  Portage.AnySlot))-  ,("gthread-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))--  ,("gtk+-2.0",            ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gdk-2.0",             ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gdk-3.0",             ("x11-libs", "gtk+", Portage.GivenSlot "3"))-  ,("gdk-pixbuf-2.0",      ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gdk-pixbuf-xlib-2.0", ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gdk-x11-2.0",         ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gtk+-unix-print-2.0", ("x11-libs", "gtk+", Portage.GivenSlot "2"))-  ,("gtk+-x11-2.0",        ("x11-libs", "gtk+", Portage.GivenSlot "2"))--  ,("gtk+-3.0",            ("x11-libs", "gtk+", Portage.GivenSlot "3"))-  ,("webkitgtk-3.0",       ("net-libs", "webkit-gtk", Portage.GivenSlot "3"))--  ,("cairo",            ("x11-libs", "cairo", Portage.AnySlot)) -- need [svg] for dev-haskell/cairo-  ,("cairo-gobject",    ("x11-libs", "cairo", Portage.AnySlot)) -- need [glib] for dev-haskell/cairo-  ,("cairo-ft",         ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-ps",         ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-png",        ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-pdf",        ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-svg",        ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-xlib",         ("x11-libs", "cairo", Portage.AnySlot))-  ,("cairo-xlib-xrender", ("x11-libs", "cairo", Portage.AnySlot))--  ,("javascriptcoregtk-4.0",   ("net-libs", "webkit-gtk", Portage.GivenSlot "4"))-  ,("webkit2gtk-4.0",          ("net-libs", "webkit-gtk", Portage.GivenSlot "4"))--  ,("pangocairo",       ("x11-libs", "pango", Portage.AnySlot))-  ,("pangoft2",         ("x11-libs", "pango", Portage.AnySlot))-  ,("pango",            ("x11-libs", "pango", Portage.AnySlot))-  ,("pangoxft",         ("x11-libs", "pango", Portage.AnySlot))-  ,("pangox",           ("x11-libs", "pango", Portage.AnySlot))--  ,("libglade-2.0", ("gnome-base", "libglade", Portage.AnySlot))-  ,("libsoup-2.4",   ("net-libs", "libsoup", Portage.GivenSlot "2.4"))-  ,("gnome-vfs-2.0", ("gnome-base", "gnome-vfs", Portage.AnySlot))-  ,("gnome-vfs-module-2.0", ("gnome-base", "gnome-vfs", Portage.AnySlot))-  ,("webkit-1.0", ("net-libs","webkit-gtk", Portage.GivenSlot "2"))-  ,("gtksourceview-3.0", ("x11-libs", "gtksourceview", Portage.GivenSlot "3.0"))--  ,("gstreamer-0.10",              ("media-libs", "gstreamer", Portage.AnySlot))-  ,("gstreamer-base-0.10",         ("media-libs", "gstreamer", Portage.AnySlot))-  ,("gstreamer-check-0.10",        ("media-libs", "gstreamer", Portage.AnySlot))-  ,("gstreamer-controller-0.10",   ("media-libs", "gstreamer", Portage.AnySlot))-  ,("gstreamer-dataprotocol-0.10", ("media-libs", "gstreamer", Portage.AnySlot))-  ,("gstreamer-net-0.10",          ("media-libs", "gstreamer", Portage.AnySlot))--  ,("gstreamer-app-0.10",          ("media-libs", "gst-plugins-base", Portage.AnySlot))-  ,("gstreamer-audio-0.10",        ("media-libs", "gst-plugins-base", Portage.AnySlot))-  ,("gstreamer-video-0.10",        ("media-libs", "gst-plugins-base", Portage.AnySlot))-  ,("gstreamer-plugins-base-0.10", ("media-libs", "gst-plugins-base", Portage.AnySlot))--  ,("gtksourceview-2.0",           ("x11-libs", "gtksourceview", Portage.GivenSlot "2.0"))-  ,("librsvg-2.0",                 ("gnome-base","librsvg", Portage.AnySlot))-  ,("vte",                         ("x11-libs","vte", Portage.GivenSlot "0"))-  ,("gtkglext-1.0",                ("x11-libs","gtkglext", Portage.AnySlot))--  ,("curl",                        ("net-misc", "curl", Portage.AnySlot))-  ,("libxml2",                     ("dev-libs", "libxml2", Portage.AnySlot))-  ,("libgsasl",                    ("virtual", "gsasl", Portage.AnySlot))-  ,("libzip",                      ("dev-libs", "libzip", Portage.AnySlot))-  ,("gnutls",                      ("net-libs", "gnutls", Portage.AnySlot))-  ,("libidn",                      ("net-dns", "libidn", Portage.AnySlot))-  ,("libxml-2.0",                  ("dev-libs", "libxml2", Portage.AnySlot))-  ,("yaml-0.1",                    ("dev-libs", "libyaml", Portage.AnySlot))-  ,("QtCore",                      ("dev-qt", "qtcore", Portage.AnySlot))-  ,("lua",                         ("dev-lang", "lua", Portage.AnySlot))-  ,("QtDeclarative",               ("dev-qt", "qtdeclarative", Portage.AnySlot))-  ,("QtGui",                       ("dev-qt", "qtgui", Portage.AnySlot))-  ,("QtOpenGL",                    ("dev-qt", "qtopengl", Portage.AnySlot))-  ,("QtScript",                    ("dev-qt", "qtscript", Portage.AnySlot))-  ,("ImageMagick",                 ("media-gfx", "imagemagick", Portage.AnySlot))-  ,("MagickWand",                  ("media-gfx", "imagemagick", Portage.AnySlot))-  ,("ncurses",                     ("sys-libs", "ncurses", Portage.AnySlot))-  ,("ncursesw",                    ("sys-libs", "ncurses", Portage.AnySlot))-  ,("panel",                       ("sys-libs", "ncurses", Portage.AnySlot))-  ,("panelw",                      ("sys-libs", "ncurses", Portage.AnySlot))-  ,("libssh2",                     ("net-libs", "libssh2", Portage.AnySlot))-  ,("SDL_image",                   ("media-libs", "sdl-image", Portage.AnySlot))-  ,("libzmq",                      ("net-libs", "zeromq", Portage.AnySlot))-  ,("taglib_c",                    ("media-libs", "taglib", Portage.AnySlot))-  ,("libcurl",                     ("net-misc", "curl", Portage.AnySlot))-  ,("libpq",                       ("dev-db", "postgresql", Portage.AnySlot))-  ,("poppler-glib",                ("app-text", "poppler", Portage.AnySlot))-  ,("gsl",                         ("sci-libs", "gsl", Portage.AnySlot))-  ,("libvirt",                     ("app-emulation", "libvirt", Portage.AnySlot))--  ,("Qt5Core",                     ("dev-qt", "qtcore", Portage.GivenSlot "5"))-  ,("Qt5Gui",                      ("dev-qt", "qtgui", Portage.GivenSlot "5"))-  ,("Qt5Qml",                      ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))-  ,("Qt5Quick",                    ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))-  ,("Qt5Widgets",                  ("dev-qt", "qtwidgets", Portage.GivenSlot "5"))--  ,("sdl2",                        ("media-libs", "libsdl2", Portage.AnySlot))-  ,("SDL2_image",                  ("media-libs", "sdl2-image", Portage.AnySlot))-  ,("SDL2_mixer",                  ("media-libs", "sdl2-mixer", Portage.AnySlot))-  ,("zlib",                        ("sys-libs", "zlib", Portage.AnySlot))-  ]
− Merge/Utils.hs 
@@ -1,212 +0,0 @@-{-|-Module      : Merge.Utils-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Internal helper functions for "Merge".--}-module Merge.Utils-  ( readPackageString-  , getPreviousPackageId-  , first_just_of-  , drop_prefix-  , squash_debug-  , convert_underscores-  , mangle_iuse-  , to_unstable-  , metaFlags-  , dropIfUseExpands-  -- hspec exports-  , dropIfUseExpand-  ) where--import qualified Control.Applicative as A-import qualified Control.Monad as M-import qualified Data.Char as C-import           Data.Maybe (catMaybes, mapMaybe)-import qualified Data.List as L-import qualified Data.Map.Strict as Map-import qualified System.Directory as SD-import qualified System.FilePath as SF-import           System.FilePath ((</>))-import           System.Process (readCreateProcess, shell)-import           Error-import qualified Portage.PackageId as Portage--import qualified Distribution.Package            as Cabal-import qualified Distribution.PackageDescription as Cabal---- | Parse a ['String'] as a valid package string. E.g. @category\/name-1.0.0@.--- Return 'HackPortError' if the string to parse is invalid.------ When the ['String'] is valid:------ >>> readPackageString ["dev-haskell/packagename1-1.0.0"]--- Right (Just (Category {unCategory = "dev-haskell"}),PackageName "packagename1",Just (Version {versionNumber = [1,0,0], versionChar = Nothing, versionSuffix = [], versionRevision = 0}))------ When the ['String'] is empty:------ >>> readPackageString []--- Left ...-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-    Right v@(_,_,Nothing) -> return v-    -- we only allow versions we can convert into cabal versions-    Right v@(_,_,Just (Portage.Version _ Nothing [] 0)) -> return v-    Left e -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: "-              ++ packageString ++ "\nParsec error: " ++ e-    _ -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: "-         ++ packageString---- | Maybe return a 'Portage.PackageId' of the next highest version for a given---   package, relative to the provided 'Portage.PackageId'.------ For example:--- --- >>> let ebuildDir = ["foo-bar2-3.0.1.ebuild","metadata.xml"]--- >>> let newPkgId = Portage.PackageId (Portage.PackageName (Portage.Category "dev-haskell") (Cabal.mkPackageName "foo-bar2")) (Portage.Version [3,0,2] Nothing [] 0 )------ >>> getPreviousPackageId ebuildDir newPkgId--- Just (PackageId {packageId = PackageName {category = Category {unCategory = "dev-haskell"}, cabalPkgName = PackageName "foo-bar2"}, pkgVersion = Version {versionNumber = [3,0,1], versionChar = Nothing, versionSuffix = [], versionRevision = 0}})-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)-               $ mapMaybe (Portage.filePathToPackageId (Portage.category . Portage.packageId $ newPkgId))-               $ SF.dropExtension <$> filter (\fp -> SF.takeExtension fp == ".ebuild") pkgDir-  case pkgIds of-    x:_ -> Just x-    _ -> Nothing---- | Alias for 'msum'.--- --- prop> \a -> first_just_of a == M.msum a-first_just_of :: [Maybe a] -> Maybe a-first_just_of = M.msum---- | Remove @with@ or @use@ prefixes from flag names.------ >>> drop_prefix "with_conduit"--- "conduit"--- >>> drop_prefix "use-https"--- "https"--- >>> drop_prefix "no_examples"--- "no_examples"-drop_prefix :: String -> String-drop_prefix x =-  let prefixes = ["with","use"]-      separators = ["-","_"]-      combinations = A.liftA2 (++) prefixes separators-  in case catMaybes (A.liftA2 L.stripPrefix combinations [x]) of-    [z] -> z-    _ -> x---- | Squash debug-related @USE@ flags under the @debug@ global---   @USE@ flag.------ >>> squash_debug "use-debug-foo"--- "debug"--- >>> squash_debug "foo-bar"--- "foo-bar"-squash_debug :: String -> String-squash_debug flag = if "debug" `L.isInfixOf` (C.toLower <$> flag)-                         then "debug"-                         else flag---- | Gentoo allows underscore ('_') names in @IUSE@ only for--- @USE_EXPAND@ values. If it's not a user-specified rename mangle--- it into a hyphen ('-').--- --- >>> convert_underscores "remove_my_underscores"--- "remove-my-underscores"-convert_underscores :: String -> String-convert_underscores = map f-  where f '_' = '-'-        f c   = c---- | Perform all @IUSE@ mangling.------ >>> mangle_iuse "use_foo-bar_debug"--- "debug"--- >>> mangle_iuse "with-bar_quux"--- "bar-quux"-mangle_iuse :: String -> String-mangle_iuse = squash_debug . drop_prefix . convert_underscores---- | Convert all stable keywords to testing (unstable) keywords.--- Preserve arch masks (-).------ >>> to_unstable "amd64"--- "~amd64"--- >>> to_unstable "~amd64"--- "~amd64"--- >>> to_unstable "-amd64"--- "-amd64"-to_unstable :: String -> String-to_unstable kw =-    case kw of-        '~':_ -> kw-        '-':_ -> kw-        _     -> '~':kw---- | Generate a 'Map.Map' of 'Cabal.PackageFlag' names and their descriptions.------ For example, if we construct a singleton list holding a 'Cabal.PackageFlag' with--- 'Cabal.FlagName' @foo@ and 'Cabal.FlagDescription' @bar@, we should get--- a 'Map.Map' containing those values:------ >>> let flags = [(Cabal.emptyFlag (Cabal.mkFlagName "foo")) {Cabal.flagDescription = "bar"}]--- >>> metaFlags flags--- fromList [("foo","bar")]-metaFlags :: [Cabal.PackageFlag] -> Map.Map String String-metaFlags flags =-  Map.fromList $-  zip (mangle_iuse . Cabal.unFlagName . Cabal.flagName <$> flags)-  (Cabal.flagDescription <$> flags)---- | Return a list of @USE_EXPAND@s maintained by ::gentoo.------ First, 'getUseExpands' runs @portageq@ to determine the 'FilePath' of the--- directory containing valid @USE_EXPAND@s. If the 'FilePath' exists,--- it drops the filename extensions to return a list of @USE_EXPAND@s--- as Portage understands them. If the 'FilePath' does not exist, 'getUseExpands'--- supplies a bare-bones list of @USE_EXPAND@s.-getUseExpands :: IO [String]-getUseExpands = do-  portDir <- readCreateProcess (shell "portageq get_repo_path / gentoo") ""-  let use_expands_dir = (L.dropWhileEnd C.isSpace portDir) </> "profiles" </> "desc"-  path_exists <- SD.doesPathExist use_expands_dir-  if path_exists-    then do use_expands_contents <- SD.listDirectory use_expands_dir-            return (SF.dropExtension <$> use_expands_contents)-    -- Provide some sensible defaults if hackport cannot find ::gentoo-    else let use_expands_contents = ["cpu_flags_arm","cpu_flags_ppc","cpu_flags_x86"]-         in return use_expands_contents---- | Return a 'Cabal.PackageFlag' if it is not a @USE_EXPAND@.------ If the 'Cabal.flagName' has a prefix matching any valid @USE_EXPAND@,--- then return 'Nothing'. Otherwise return 'Just' 'Cabal.PackageFlag'.-dropIfUseExpand :: [String] -> Cabal.PackageFlag -> Maybe Cabal.PackageFlag-dropIfUseExpand use_expands flag =-  if or (A.liftA2 L.isPrefixOf use_expands [Cabal.unFlagName . Cabal.flagName $ flag])-  then Nothing else Just flag---- | Strip @USE_EXPAND@s from a ['Cabal.PackageFlag'].-dropIfUseExpands :: [Cabal.PackageFlag] -> IO [Cabal.PackageFlag]-dropIfUseExpands flags = do-  use_expands <- getUseExpands-  return $ catMaybes (dropIfUseExpand use_expands <$> flags)
− Overlays.hs 
@@ -1,69 +0,0 @@-module Overlays-    ( getOverlayPath-    ) where--import Control.Monad-import Data.List (nub, inits)-import Data.Maybe (maybeToList, listToMaybe, isJust, fromJust)-import qualified System.Directory as SD-import System.FilePath ((</>), splitPath, joinPath)--import Error-import Portage.Host---- cabal-import Distribution.Verbosity-import Distribution.Simple.Utils ( info )--getOverlayPath :: Verbosity -> Maybe FilePath -> IO String-getOverlayPath verbosity override_overlay = do-  overlays <- if isJust override_overlay-                  then do info verbosity $ "Forced " ++ fromJust override_overlay-                          return [fromJust override_overlay]-                  else getOverlays-  case overlays of-    [] -> throwEx NoOverlay-    [x] -> return x-    mul -> search mul-  where-  search :: [String] -> IO String-  search mul = do-    let loop [] = throwEx (MultipleOverlays mul)-        loop (x:xs) = do-          info verbosity $ "Checking '" ++ x ++ "'..."-          found <- SD.doesDirectoryExist (x </> ".hackport")-          if found-            then do-              info verbosity "OK!"-              return x-            else do-              info verbosity "Not ok."-              loop xs-    info verbosity "There are several overlays in your configuration."-    mapM_ (info verbosity . (" * " ++)) mul-    info verbosity "Looking for one with a HackPort cache..."-    overlay <- loop mul-    info verbosity $ "I choose " ++ overlay-    info verbosity "Override my decision with hackport --overlay /my/overlay"-    return overlay--getOverlays :: IO [String]-getOverlays = do-  local    <- getLocalOverlay-  overlays <- overlay_list `fmap` getInfo-  return $ nub $ map clean $-                 maybeToList local-              ++ overlays-  where-  clean path = case reverse path of-                '/':p -> reverse p-                _ -> path--getLocalOverlay :: IO (Maybe FilePath)-getLocalOverlay = do-  curDir <- SD.getCurrentDirectory-  let lookIn = map joinPath . reverse . inits . splitPath $ curDir-  fmap listToMaybe (filterM probe lookIn)--  where-    probe dir = SD.doesDirectoryExist (dir </> "dev-haskell")
− Portage/Cabal.hs 
@@ -1,79 +0,0 @@-{-|-Module      : Portage.Cabal-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Utilities to extract and manipulate information from a package's @.cabal@ file,-such as its license and dependencies.--}-module Portage.Cabal-  ( convertLicense-  , partition_depends-  ) where--import qualified Data.List as L--import qualified Distribution.License as Cabal-import qualified Distribution.SPDX    as SPDX-import qualified Distribution.Package as Cabal-import qualified Distribution.Pretty  as Cabal---- | Convert the Cabal 'SPDX.License' into the Gentoo format, as a 'String'.------ Generally, if the license is one of the common free-software or--- open-source licenses, 'convertLicense' should return the license--- as a 'Right' 'String':------ >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_or_later)--- Right "GPL-3+"------ >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_only)--- Right "GPL-3"------ If it is a more obscure license, this should alert the user by returning--- a 'Left' 'String':------ >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1)--- Left ...-convertLicense :: SPDX.License -> Either String String-convertLicense l =-    case Cabal.licenseFromSPDX l of-        --  good ones-        Cabal.AGPL mv      -> Right $ "AGPL-" ++ case Cabal.prettyShow <$> mv of-                                                  Just "3"   -> "3"-                                                  Just "3.0" -> "3+"-                                                  _          -> "3" -- almost certainly version 3-        Cabal.GPL mv       -> Right $ "GPL-" ++ case Cabal.prettyShow <$> mv of-                                                  Just "2"   -> "2"-                                                  Just "2.0" -> "2+"-                                                  Just "3"   -> "3"-                                                  Just "3.0" -> "3+"-                                                  _          -> "2" -- possibly version 2-        Cabal.LGPL mv      -> Right $ "LGPL-" ++ case Cabal.prettyShow <$> mv of-                                                   Just "2"   -> "2"-                                                   -- Cabal can't handle 2.0+ properly-                                                   Just "2.0" -> "2"-                                                   Just "3"   -> "3"-                                                   Just "3.0" -> "3+"-                                                   _          -> "2.1" -- probably version 2.1-        Cabal.BSD2         -> Right "BSD-2"-        Cabal.BSD3         -> Right "BSD"-        Cabal.BSD4         -> Right "BSD-4"-        Cabal.PublicDomain -> Right "public-domain"-        Cabal.MIT          -> Right "MIT"-        Cabal.Apache mv    -> Right $ "Apache-" ++-                              maybe "1.1" Cabal.prettyShow mv -- probably version 1.1-        Cabal.ISC          -> Right "ISC"-        Cabal.MPL v        -> Right $ "MPL-" ++ Cabal.prettyShow v -- probably version 1.0-        -- bad ones-        Cabal.AllRightsReserved -> Left "EULA-style licence. Please pick it manually."-        Cabal.UnknownLicense _  -> Left "license unknown to cabal. Please pick it manually."-        Cabal.OtherLicense      -> Left "(Other) Please look at license file of package and pick it manually."-        Cabal.UnspecifiedLicense -> Left "(Unspecified) Please look at license file of package and pick it manually."---- | Extract only the dependencies which are not bundled with @GHC@.-partition_depends :: [Cabal.PackageName] -> Cabal.PackageName -> [Cabal.Dependency] -> ([Cabal.Dependency], [Cabal.Dependency])-partition_depends ghc_package_names merged_cabal_pkg_name = L.partition (not . is_internal_depend)-    where is_internal_depend (Cabal.Dependency pn _vr _lib) = is_itself || is_ghc_package-              where is_itself = pn == merged_cabal_pkg_name-                    is_ghc_package = pn `elem` ghc_package_names
− Portage/Dependency.hs 
@@ -1,10 +0,0 @@-module Portage.Dependency-  (-    module Portage.Dependency.Builder-  , module Portage.Dependency.Print-  , module Portage.Dependency.Types-  ) where--import Portage.Dependency.Builder-import Portage.Dependency.Print-import Portage.Dependency.Types
− Portage/Dependency/Builder.hs 
@@ -1,32 +0,0 @@-{- | Basic helpers to build depend structures -}-module Portage.Dependency.Builder-  (-    empty_dependency-  , addDepUseFlag-  , setSlotDep-  , mkUseDependency-  , overAtom-  ) where--import Portage.Dependency.Types-import Portage.Use---- TODO: remove it and switch to 'SatisfiedDepend' instead-empty_dependency :: Dependency-empty_dependency = DependAllOf []--addDepUseFlag :: UseFlag -> Dependency -> Dependency-addDepUseFlag n = overAtom (\(Atom pn dr (DAttr s u)) -> Atom pn dr (DAttr s (n:u)))--setSlotDep :: SlotDepend -> Dependency -> Dependency-setSlotDep n = overAtom (\(Atom pn dr (DAttr _s u)) -> Atom pn dr (DAttr n u))--mkUseDependency :: (Bool, Use) -> Dependency -> Dependency-mkUseDependency (b, u) d =-  if b then DependIfUse u d empty_dependency else DependIfUse u empty_dependency d--overAtom :: (Atom -> Atom) -> Dependency -> Dependency-overAtom f (DependAllOf d) = DependAllOf $ map (overAtom f) d-overAtom f (DependAnyOf d) = DependAnyOf $ map (overAtom f) d-overAtom f (DependIfUse u d1 d2) = DependIfUse u (f `overAtom` d1) (f `overAtom` d2)-overAtom f (DependAtom a) = DependAtom (f a)
− Portage/Dependency/Normalize.hs 
@@ -1,398 +0,0 @@-module Portage.Dependency.Normalize-  (-    normalize_depend-  ) where--import qualified Control.Arrow as A-import           Control.Monad-import qualified Data.List as L-import qualified Data.Set as S-import           Data.Maybe--import Portage.Dependency.Builder-import Portage.Dependency.Types-import Portage.Use--import Debug.Trace--mergeDRanges :: DRange -> DRange -> DRange-mergeDRanges _ r@(DExact _) = r-mergeDRanges l@(DExact _) _ = l-mergeDRanges (DRange ll lu) (DRange rl ru) = DRange (max ll rl) (min lu ru)--stabilize_pass :: (Dependency -> Dependency) -> Dependency -> Dependency-stabilize_pass pass d-    | d == d' = d'-    | otherwise = go d'-    where go = stabilize_pass pass-          d' = pass d---- remove one layer of redundancy-normalization_step :: Int -> Dependency -> Dependency-normalization_step level =-      id-    . tp "PC2" (stabilize_pass (tp "PC2 step" propagate_context))-    . tp "F3" (stabilize_pass flatten)-    . tp "LC" lift_context-    . tp "PC1" (stabilize_pass (tp "PC1 step" propagate_context))-    . tp "F2" (stabilize_pass flatten)-    . tp "RD" (stabilize_pass remove_duplicates)-    . tp "RE" (stabilize_pass remove_empty)-    . tp "SD" sort_deps-    . tp "CUG" combine_use_guards-    . tp "F1" (stabilize_pass flatten)-    . tp "CAR" combine_atom_ranges-    where tp :: String -> (Dependency -> Dependency) -> Dependency -> Dependency-          tp pass_name pass d = t False d'-              where d' = pass d-                    t False = id-                    t True  =-                        trace (unwords [ "PASS"-                                       , show level-                                       , ":"-                                       , pass_name-                                       , show (length (show d))-                                       , "->"-                                       , show (length (show d'))-                                       ])--remove_empty :: Dependency -> Dependency-remove_empty d =-    case d of-        -- drop full empty nodes-        _ | is_empty_dependency d -> empty_dependency-        -- drop partial empty nodes-        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)-        DependAllOf deps        -> DependAllOf $ filter (not . is_empty_dependency) $ map go deps-        DependAnyOf deps        -> DependAnyOf $                                      map go deps-        -- no change-        DependAtom _            -> d-    where go = remove_empty--s_uniq :: [Dependency] -> [Dependency]-s_uniq = S.toList . S.fromList---- Ideally 'combine_atom_ranges' should handle those as well-remove_duplicates :: Dependency -> Dependency-remove_duplicates d =-    case d of-        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)-        DependAnyOf deps        -> DependAnyOf $ s_uniq $ map go deps-        DependAllOf deps        -> DependAllOf $ s_uniq $ map go deps-        DependAtom  _           -> d-    where go = remove_duplicates---- TODO: implement flattening AnyOf the same way it's done for AllOf---   DependAnyOf [DependAnyOf [something], rest] -> DependAnyOf $ something ++ rest-flatten :: Dependency -> Dependency-flatten d =-    case d of-        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)-        DependAnyOf [dep]       -> go dep-        DependAnyOf deps        -> DependAnyOf $ map go deps--        DependAllOf deps        -> case L.partition is_dall_of deps of-                                       ([], [])      -> empty_dependency-                                       ([], [dep])   -> dep-                                       ([], ndall)   -> DependAllOf $ map go ndall-                                       (dall, ndall) -> go $ DependAllOf $ s_uniq $ (concatMap undall dall) ++ ndall-        DependAtom _            -> d-  where go :: Dependency -> Dependency-        go = flatten--        is_dall_of :: Dependency -> Bool-        is_dall_of d' =-            case d' of-                DependAllOf _deps -> True-                _                 -> False-        undall :: Dependency -> [Dependency]-        undall ~(DependAllOf ds) = ds---- joins atoms with different version boundaries--- DependAllOf [ DRange ">=foo-1" Inf, Drange Zero "<foo-2" ] -> DRange ">=foo-1" "<foo-2"-combine_atom_ranges :: Dependency -> Dependency-combine_atom_ranges d =-    case d of-        DependIfUse use td fd -> DependIfUse use (go td) (go fd)-        DependAllOf deps      -> DependAllOf $ map go $ find_atom_intersections  deps-        DependAnyOf deps      -> DependAnyOf $ map go $ find_atom_concatenations deps-        DependAtom  _         -> d-    where go = combine_atom_ranges--find_atom_intersections :: [Dependency] -> [Dependency]-find_atom_intersections = map merge_depends . L.groupBy is_mergeable-    where is_mergeable :: Dependency -> Dependency -> Bool-          is_mergeable (DependAtom (Atom lpn _ldrange lattr)) (DependAtom (Atom rpn _rdrange rattr))-                          = (lpn, lattr) == (rpn, rattr)-          is_mergeable _                                       _-                          = False--          merge_depends :: [Dependency] -> Dependency-          merge_depends [x] = x-          merge_depends xs = L.foldl1' merge_pair xs--          merge_pair :: Dependency -> Dependency -> Dependency-          merge_pair (DependAtom (Atom lp ld la)) (DependAtom (Atom rp rd ra))-              | lp /= rp = error "merge_pair got different 'PackageName's"-              | la /= ra = error "merge_pair got different 'DAttr's"-              | otherwise = DependAtom (Atom lp (mergeDRanges ld rd) la)-          merge_pair l r = error $ unwords ["merge_pair can't merge non-atoms:", show l, show r]---- TODO-find_atom_concatenations :: [Dependency] -> [Dependency]-find_atom_concatenations = id---- Eliminate use guarded redundancy:---   a? ( foo )---   a? ( bar )--- gets translated to---   a? ( foo bar )----   a? ( foo bar )---   !a? ( foo baz )--- gets translated to---   foo---   a? ( bar )---   !a? ( baz )--combine_use_guards :: Dependency -> Dependency-combine_use_guards d =-    case d of-        DependIfUse use td fd -> pop_common $ DependIfUse use (go td) (go fd)-        DependAllOf deps      -> DependAllOf $ map go $ find_use_intersections  deps-        DependAnyOf deps      -> DependAnyOf $ map go $ find_use_concatenations deps-        DependAtom _          -> d-    where go = combine_use_guards--find_use_intersections :: [Dependency] -> [Dependency]-find_use_intersections = map merge_use_intersections . L.groupBy is_use_mergeable-    where-        is_use_mergeable :: Dependency -> Dependency -> Bool-        is_use_mergeable (DependIfUse lu _ltd _lfd) (DependIfUse ru _rtd _rfd)-            | lu == ru       = True-        is_use_mergeable _ _ = False--        merge_use_intersections :: [Dependency] -> Dependency-        merge_use_intersections [x] = x-        merge_use_intersections ds = pop_common $ DependIfUse u (DependAllOf tds) (DependAllOf fds)-            where DependIfUse u _tf _fd = head ds-                  tfdeps ~(DependIfUse _u td fd) = (td, fd)-                  (tds, fds) = unzip $ map tfdeps ds--pop_common :: Dependency -> Dependency--- depend---   a? ( x ) !a? ( x )--- gets translated to---   x-pop_common (DependIfUse _u td fd)-    | td == fd = fd-pop_common d'@(DependIfUse _u td fd) =-    case td_ctx `L.intersect` fd_ctx of-        [] -> d'-        common_ctx -> stabilize_pass flatten $ DependAllOf $ propagate_context' common_ctx d' : common_ctx-    where td_ctx = lift_context' td-          fd_ctx = lift_context' fd-pop_common x = x---- TODO-find_use_concatenations :: [Dependency] -> [Dependency]-find_use_concatenations = id---- Eliminate top-down redundancy:---   foo/bar---   u? ( foo/bar---        bar/baz )--- gets translated to---   foo/bar---   u? ( bar/baz )------ and more complex redundancy:---   v? ( foo/bar )---   u? ( !v? ( foo/bar ) )--- gets translated to---   v? ( foo/bar )---   u? ( foo/bar )-propagate_context :: Dependency -> Dependency-propagate_context = propagate_context' []---- very simple model: pick all sibling-atom deps and add them to context---                    for downward proparation and remove from 'all_of' part--- TODO: any-of part can benefit from it by removing unsatisfiable or satisfied alternative-propagate_context' :: [Dependency] -> Dependency -> Dependency-propagate_context' ctx d =-    case d of-        _ | d `elem` ctx      -> empty_dependency-        DependIfUse use td fd -> let (t_ctx_comp, t_refined_ctx) = refine_context (True,  use) ctx-                                     (f_ctx_comp, f_refined_ctx) = refine_context (False, use) ctx-                                     tdr = go t_refined_ctx td-                                     fdr = go f_refined_ctx fd-                                     ctx_comp = filter (not . is_empty_dependency) $-                                                concat [ (lift_context' tdr `L.intersect` (concatMap lift_context' t_ctx_comp))-                                                       , (lift_context' fdr `L.intersect` (concatMap lift_context' f_ctx_comp))-                                                       ]-                                     diu_refined = DependIfUse use tdr-                                                                   fdr-                                 in case ctx_comp of-                                    [] -> diu_refined-                                    _  -> go ctx $-                                              DependAllOf [ DependAllOf ctx_comp-                                                          , go ctx_comp diu_refined-                                                          ]-        DependAllOf deps      -> DependAllOf $ fromJust $ msum $-                                                   [ v-                                                   | (optimized_d, other_deps) <- slice_list deps-                                                   , let ctx' = ctx ++ other_deps-                                                         d'   = go ctx' optimized_d-                                                         d'ctx = d' : ctx-                                                         v    = case d' /= optimized_d of-                                                                    True  -> Just (d':map (go d'ctx) other_deps)-                                                                    False -> Nothing -- haven't managed to optimize anything-                                                   ] ++ [Just deps] -- unmodified-        DependAnyOf deps      -> DependAnyOf $ map (go ctx) deps-        DependAtom _          -> case any (dep_as_broad_as d) ctx of-                                     True  -> empty_dependency-                                     False -> d-  where go c = propagate_context' c---- returns (complement-dependencies, simplified-dependencies)-refine_context :: (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])-refine_context use_cond = unzip . map (A.second (stabilize_pass flatten) . refine_ctx_unit use_cond)-    where refine_ctx_unit :: (Bool, Use) -> Dependency -> (Dependency, Dependency)-          refine_ctx_unit uc@(bu, u) d =-              case d of-                DependIfUse u' td fd-                  -> case u == u' of-                         False -> ( empty_dependency-                                  , DependIfUse u' (snd $ refine_ctx_unit uc td)-                                                   (snd $ refine_ctx_unit uc fd)-                                  )-                         True  -> case bu of-                                      True  -> (fd, snd $ refine_ctx_unit uc td)-                                      False -> (td, snd $ refine_ctx_unit uc fd)-                _ -> (empty_dependency, d)---- generates all pairs of:--- (list_element, list_without_element)--- example:---   [1,2,3]--- yields---   [(1, [2,3]), (2,[1,3]), (3,[1,2])]-slice_list :: [e] -> [(e, [e])]-slice_list [] = []-slice_list (e:es) = (e, es) : map (\(v, vs) -> (v, e : vs)) (slice_list es)---- Eliminate bottom-up redundancy:---   || ( ( foo/bar bar/baz )---        ( foo/bar bar/quux ) )--- gets translated to---   foo/bar---   || ( ( foo/bar bar/baz )---        ( foo/bar bar/quux ) )--- It looks like became more gross,--- but 'propagate_context' phase--- cleanups it to the following state:---   foo/bar---   || ( bar/baz---        bar/quux )--- TODO: better add propagation in this exact place to keep tree shrinking only-lift_context :: Dependency -> Dependency-lift_context d =-    case d of-        DependIfUse _use _td _fd -> case L.delete d new_ctx of-                                        []       -> d-                                        new_ctx' -> propagate_context $ DependAllOf $ d : new_ctx'-        DependAllOf deps         -> case new_ctx L.\\ deps of-                                        []       -> d-                                        new_ctx' -> DependAllOf $ deps ++ new_ctx'-        -- the lift itself-        DependAnyOf _deps        -> case L.delete d new_ctx of-                                         []       -> d-                                         new_ctx' -> propagate_context $ DependAllOf $ d : new_ctx'-        DependAtom  _            -> d-  where new_ctx = lift_context' d---- lift everything that can be shared somewhere else--- propagate_context will then pick some bits from here--- and remove them deep inside.--- It's the most fragile and powerfull pass-lift_context' :: Dependency -> [Dependency]-lift_context' d =-    case d of-        DependIfUse _use td fd   -> d : extract_common_constraints (map lift_context' [td, fd])-        DependAllOf deps         -> L.nub $ concatMap lift_context' deps-        DependAnyOf deps         -> d : extract_common_constraints (map lift_context' deps)-        DependAtom  _            -> [d]---- it extracts common part of dependency comstraints.--- Some examples:---  'a b c' and 'b c d' have common 'b c'---  'u? ( a  b )' and 'u? ( b c )' have common 'u? ( b )' part---  'a? ( b? ( x y ) )' and !a? ( b? ( y z ) )' have common 'b? ( y )'-extract_common_constraints :: [[Dependency]] -> [Dependency]-extract_common_constraints [] = []-extract_common_constraints dss@(ds:dst) = common_atoms ++ common_use_guards-    where common_atoms :: [Dependency]-          common_atoms = L.foldl1' L.intersect dss-          common_use_guards :: [Dependency]-          common_use_guards = [ DependIfUse u (DependAllOf tdi) (DependAllOf fdi)-                              | DependIfUse u td fd <- ds-                              , Just (tds, fds) <- [find_matching_use_deps dst u ([lift_context' td], [lift_context' fd])]-                              , let tdi = extract_common_constraints tds-                                    fdi = extract_common_constraints fds-                              , not (null tdi && null fdi)-                              ]--find_matching_use_deps :: [[Dependency]] -> Use -> ([[Dependency]], [[Dependency]]) -> Maybe ([[Dependency]], [[Dependency]])-find_matching_use_deps dss u (tds, fds) =-    case dss of-        []       -> Just (tds, fds)-        (ds:dst) -> case [ (tc, fc)-                         | DependIfUse u' td fd <- ds-                         , u' == u-                         , let tc = lift_context' td-                               fc = lift_context' fd-                         , not (null tc && null fc)-                         ] of-                        []    -> Nothing-                        pairs -> find_matching_use_deps dst u (map fst pairs ++ tds, map snd pairs ++ fds)---- reorders depends to make them more attractive--- for other normalization algorithms--- and for final pretty-printer-sort_deps :: Dependency -> Dependency-sort_deps d =-    case d of-        DependIfUse lu lt lf-            | is_empty_dependency lf ->-                case lt of-                    DependIfUse ru rt rf-                        -- b? ( a? ( d ) )-                        | ru < lu && is_empty_dependency rf -> mkUseDependency (True,  ru) $ mkUseDependency (True, lu) (go rt)-                        -- b? ( !a? ( d ) )-                        | ru < lu && is_empty_dependency rt -> mkUseDependency (False, ru) $ mkUseDependency (True, lu) (go rf)-                    _ -> DependIfUse lu (go lt) (go lf)-            | is_empty_dependency lt ->-                case lf of-                    DependIfUse ru rt rf-                        -- !b? ( a? ( d ) )-                        | ru < lu && is_empty_dependency rf -> mkUseDependency (True,  ru) $ mkUseDependency (False, lu) (go rt)-                        -- !b? ( !a? ( d ) )-                        | ru < lu && is_empty_dependency rt -> mkUseDependency (False, ru) $ mkUseDependency (False, lu) (go rf)-                    _ -> DependIfUse lu (go lt) (go lf)-        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)-        DependAnyOf deps        -> DependAnyOf $ L.sort $ map go deps-        DependAllOf deps        -> DependAllOf $ L.sort $ map go deps-        DependAtom  _           -> d-    where go = sort_deps---- remove various types of redundancy-normalize_depend :: Dependency -> Dependency-normalize_depend = normalize_depend' 50 0 -- arbitrary limit--normalize_depend' :: Int -> Int -> Dependency -> Dependency-normalize_depend' max_level level d-    | level >= max_level = trace "WARNING: Normalize_depend hung up. Optimization is incomplete." d-normalize_depend' max_level level d = next_step next_d-    where next_d = normalization_step level d-          next_step | d == next_d = id-                    | otherwise   = normalize_depend' max_level (level + 1)
− Portage/Dependency/Print.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}--module Portage.Dependency.Print-  (-    dep2str-  , dep2str_noindent-  ) where--import Portage.Version-import Portage.Use--import Portage.PackageId--import qualified Distribution.Pretty as DP (Pretty(..))-import qualified Text.PrettyPrint as Disp-import Text.PrettyPrint ( vcat, nest, render )-import Text.PrettyPrint as PP ((<>))--import Portage.Dependency.Types--dispSlot :: SlotDepend -> Disp.Doc-dispSlot AnySlot          = Disp.empty-dispSlot AnyBuildTimeSlot = Disp.text ":="-dispSlot (GivenSlot slot) = Disp.text (':' : slot)--dispLBound :: PackageName -> LBound -> Disp.Doc-dispLBound pn (StrictLB    v) = Disp.char '>' PP.<> DP.pretty pn <-> DP.pretty v-dispLBound pn (NonstrictLB v) = Disp.text ">=" PP.<> DP.pretty pn <-> DP.pretty v-dispLBound _pn ZeroB = error "unhandled 'dispLBound ZeroB'"--dispUBound :: PackageName -> UBound -> Disp.Doc-dispUBound pn (StrictUB    v) = Disp.char '<' PP.<> DP.pretty pn <-> DP.pretty v-dispUBound pn (NonstrictUB v) = Disp.text "<=" PP.<> DP.pretty pn <-> DP.pretty v-dispUBound _pn InfinityB = error "unhandled 'dispUBound Infinity'"--dispDAttr :: DAttr -> Disp.Doc-dispDAttr (DAttr s u) = dispSlot s PP.<> dispUses u--dep2str :: Int -> Dependency -> String-dep2str start_indent = render . nest start_indent . showDepend--dep2str_noindent :: Dependency -> String-dep2str_noindent = render . showDepend--(<->) :: Disp.Doc -> Disp.Doc -> Disp.Doc-a <-> b = a PP.<> Disp.char '-' PP.<> b--sp :: Disp.Doc-sp = Disp.char ' '--sparens :: Disp.Doc -> Disp.Doc-sparens doc = Disp.parens (sp PP.<> valign doc PP.<> sp)--valign :: Disp.Doc -> Disp.Doc-valign d = nest 0 d--showDepend :: Dependency -> Disp.Doc-showDepend (DependAtom (Atom pn range dattr))-    = case range of-        -- any version-        DRange ZeroB InfinityB -> DP.pretty pn       PP.<> dispDAttr dattr-        DRange ZeroB ub        -> dispUBound pn ub PP.<> dispDAttr dattr-        DRange lb InfinityB    -> dispLBound pn lb PP.<> dispDAttr dattr-        -- TODO: handle >=foo-0    special case-        -- TODO: handle =foo-x.y.* special case-        DRange lb ub          ->    showDepend (DependAtom (Atom pn (DRange lb InfinityB) dattr))-                                 PP.<> Disp.char ' '-                                 PP.<> showDepend (DependAtom (Atom pn (DRange ZeroB ub)    dattr))-        DExact v              -> Disp.char '~' PP.<> DP.pretty pn <-> DP.pretty v { versionRevision = 0 } PP.<> dispDAttr dattr--showDepend (DependIfUse u td fd)  = valign $ vcat [td_doc, fd_doc]-    where td_doc-              | is_empty_dependency td = Disp.empty-              | otherwise =                  DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend td)-          fd_doc-              | is_empty_dependency fd = Disp.empty-              | otherwise = Disp.char '!' PP.<> DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend fd)-showDepend (DependAnyOf deps)   = Disp.text "||" PP.<> sp PP.<> sparens (vcat $ map showDependInAnyOf deps)-showDepend (DependAllOf deps)   = valign $ vcat $ map showDepend deps---- needs special grouping-showDependInAnyOf :: Dependency -> Disp.Doc-showDependInAnyOf d@(DependAllOf _deps) = sparens (showDepend d)--- both lower and upper bounds are present thus needs 2 atoms--- TODO: '=foo-x.y.*' will take only one atom, not two-showDependInAnyOf d@(DependAtom (Atom _pn (DRange lb ub) _dattr))-    | lb /= ZeroB && ub /= InfinityB-                                       = sparens (showDepend d)--- rest are fine-showDependInAnyOf d                    =          showDepend d
− Portage/Dependency/Types.hs 
@@ -1,168 +0,0 @@-{-|-Module      : Portage.Dependency.Types-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Functions and types related to processing Portage dependencies.--}-module Portage.Dependency.Types-  (-    SlotDepend(..)-  , LBound(..)-  , UBound(..)-  , DRange(..)-  , DAttr(..)-  , Dependency(..)-  , Atom(..)-  , dep_as_broad_as-  , is_empty_dependency-  , dep_is_case_of-  , range_is_case_of-  ) where--import           Portage.PackageId-import           Portage.Use--import           Control.DeepSeq (NFData(..))---- | Type of SLOT dependency of a dependency.-data SlotDepend = AnySlot          -- ^ nothing special-                | AnyBuildTimeSlot -- ^ ':='-                | GivenSlot String -- ^ ':slotno'-    deriving (Eq, Show, Ord)--instance NFData SlotDepend where-  rnf AnySlot = ()-  rnf AnyBuildTimeSlot = ()-  rnf (GivenSlot s) = rnf s---- | Type of lower bound of a dependency.-data LBound = StrictLB    Version -- ^ greater than (>)-            | NonstrictLB Version -- ^ greater than or equal to (>=)-            | ZeroB               -- ^ no lower bound-    deriving (Eq, Show)--instance NFData LBound where-  rnf (StrictLB v) = rnf v-  rnf (NonstrictLB v) = rnf v-  rnf ZeroB = ()--instance Ord LBound where-    compare ZeroB ZeroB = EQ-    compare ZeroB _     = LT-    compare _     ZeroB = GT-    compare (StrictLB lv)    (StrictLB rv)    = compare lv rv-    compare (NonstrictLB lv) (NonstrictLB rv) = compare lv rv-    compare (StrictLB lv)    (NonstrictLB rv) = case compare lv rv of-                                                    EQ -> GT-                                                    r  -> r-    compare (NonstrictLB lv) (StrictLB rv)    = case compare lv rv of-                                                    EQ -> LT-                                                    r  -> r--- | Type of upper bound of a dependency.-data UBound = StrictUB Version    -- ^ less than (<)-            | NonstrictUB Version -- ^ less than or equal to (<=)-            | InfinityB           -- ^ no upper bound-    deriving (Eq, Show)--instance NFData UBound where-  rnf (StrictUB v) = rnf v-  rnf (NonstrictUB v) = rnf v-  rnf InfinityB = ()--instance Ord UBound where-    compare InfinityB InfinityB = EQ-    compare InfinityB _     = GT-    compare _         InfinityB = LT-    compare (StrictUB lv)    (StrictUB rv)    = compare lv rv-    compare (NonstrictUB lv) (NonstrictUB rv) = compare lv rv-    compare (StrictUB lv)    (NonstrictUB rv) = case compare lv rv of-                                                    EQ -> LT-                                                    r  -> r-    compare (NonstrictUB lv) (StrictUB rv)    = case compare lv rv of-                                                    EQ -> GT-                                                    r  -> r---- | Type of dependency version.------ A dependency version may either be an exact 'Version' or a--- version range between a given 'LBound' and 'UBound'.-data DRange = DRange LBound UBound-            | DExact Version-    deriving (Eq, Show, Ord)--instance NFData DRange where-  rnf (DRange l u) = rnf l `seq` rnf u-  rnf (DExact v) = rnf v--range_is_case_of :: DRange -> DRange -> Bool-range_is_case_of (DRange llow lup) (DRange rlow rup)-   | llow >= rlow && lup <= rup = True-range_is_case_of _ _ = False---- | True if left 'DRange' covers at least as much as the right 'DRange'.-range_as_broad_as :: DRange -> DRange -> Bool-range_as_broad_as (DRange llow lup) (DRange rlow rup)-    | llow <= rlow && lup >= rup = True-range_as_broad_as _ _ = False--data DAttr = DAttr SlotDepend [UseFlag]-    deriving (Eq, Show, Ord)--instance NFData DAttr where-  rnf (DAttr sd uf) = rnf sd `seq` rnf uf--data Dependency = DependAtom Atom-                | DependAnyOf         [Dependency]-                | DependAllOf         [Dependency]-                | DependIfUse Use      Dependency Dependency -- u? ( td ) !u? ( fd )-    deriving (Eq, Show, Ord)--instance NFData Dependency where-  rnf (DependAtom a) = rnf a-  rnf (DependAnyOf ds) = rnf ds-  rnf (DependAllOf ds) = rnf ds-  rnf (DependIfUse u d d') = rnf u `seq` rnf d `seq` rnf d'--data Atom = Atom PackageName DRange DAttr deriving (Eq, Show, Ord)--instance NFData Atom where-  rnf (Atom pn dr da) = rnf pn `seq` rnf dr `seq` rnf da---- | True if left 'Dependency' constraint is the same as (or looser than) right--- 'Dependency' constraint.-dep_as_broad_as :: Dependency -> Dependency -> Bool-dep_as_broad_as l r-    -- very broad (not only on atoms) special case-    | l == r = True--- atoms-dep_as_broad_as (DependAtom (Atom lpn lr lda)) (DependAtom (Atom rpn rr rda))-    | lpn == rpn && lda == rda = lr `range_as_broad_as` rr--- AllOf (very common case in context propagation)-dep_as_broad_as d (DependAllOf deps)-    | any (dep_as_broad_as d) deps = True-dep_as_broad_as _ _ = False---- TODO: remove it and switch to 'SatisfiedDepend' instead-is_empty_dependency :: Dependency -> Bool-is_empty_dependency d =-    case d of-        DependIfUse _use td fd-            -> is_empty_dependency td && is_empty_dependency fd-        DependAnyOf []-            -> True -- 'any (const True) [] == False' and we don't want it-        DependAnyOf deps-            -> any is_empty_dependency deps-        DependAllOf deps-            -> all is_empty_dependency deps-        DependAtom _-            -> False--dep_is_case_of :: Dependency -> Dependency -> Bool-dep_is_case_of l r-    -- very broad (not only on atoms) special case-    | l == r = True--- only on atoms-dep_is_case_of (DependAtom (Atom lpn lr lda)) (DependAtom (Atom rpn rr rda))-    | lpn == rpn && lda == rda = lr `range_is_case_of` rr-dep_is_case_of _ _ = False
− Portage/EBuild.hs 
@@ -1,293 +0,0 @@-{-|-Module      : Portage.EBuild-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Functions and types related to interpreting and manipulating an ebuild,-as understood by the Portage package manager.--}-{-# LANGUAGE CPP #-}-module Portage.EBuild-        ( EBuild(..)-        , ebuildTemplate-        , showEBuild-        , src_uri-        -- hspec exports-        , sort_iuse-        , drop_tdot-        , quote-        , toHttps-        ) where--import           Portage.Dependency-import           Portage.EBuild.CabalFeature-import           Portage.EBuild.Render-import qualified Portage.Dependency.Normalize as PN--import qualified Data.Time.Clock as TC-import qualified Data.Time.Format as TC-import qualified Data.Function as F-import qualified Data.List as L-import qualified Data.List.Split as LS-import           Data.Version(Version(..))--import           Network.URI-import qualified Paths_hackport(version)--#if ! MIN_VERSION_time(1,5,0)-import qualified System.Locale as TC-#endif---- | Type representing the information contained in an @.ebuild@.-data EBuild = EBuild {-    name :: String,-    category :: String,-    hackage_name :: String, -- might differ a bit (we mangle case)-    version :: String,-    hackportVersion :: String,-    description :: String,-    homepage :: String,-    license :: Either String String,-    slot :: String,-    keywords :: [String],-    iuse :: [String],-    depend :: Dependency,-    depend_extra :: [String],-    rdepend :: Dependency,-    rdepend_extra :: [String]-    , features :: [CabalFeature]-    , my_pn :: Maybe String -- ^ Just 'myOldName' if the package name contains upper characters-    , src_prepare :: [String] -- ^ raw block for src_prepare() contents-    , src_configure :: [String] -- ^ raw block for src_configure() contents-    , used_options :: [(String, String)] -- ^ hints to ebuild writers/readers-                                         --   on what hackport options were used to produce an ebuild-  }--getHackportVersion :: Version -> String-getHackportVersion Version {versionBranch=(x:s)} = foldl (\y z -> y ++ "." ++ (show z)) (show x) s-getHackportVersion Version {versionBranch=[]} = ""---- | Generate a minimal 'EBuild' template.-ebuildTemplate :: EBuild-ebuildTemplate = EBuild {-    name = "foobar",-    category = "dev-haskell",-    hackage_name = "FooBar",-    version = "0.1",-    hackportVersion = getHackportVersion Paths_hackport.version,-    description = "",-    homepage = "https://hackage.haskell.org/package/${HACKAGE_N}",-    license = Left "unassigned license?",-    slot = "0",-    keywords = ["~amd64","~x86"],-    iuse = [],-    depend = empty_dependency,-    depend_extra = [],-    rdepend = empty_dependency,-    rdepend_extra = [],-    features = [],-    my_pn = Nothing-    , src_prepare = []-    , src_configure = []-    , used_options = []-  }---- | Given an EBuild, give the URI to the tarball of the source code.--- Assumes that the server is always hackage.haskell.org.--- --- >>> src_uri ebuild_template--- "https://hackage.haskell.org/package/${P}/${P}.tar.gz"-src_uri :: EBuild -> String-src_uri e =-  case my_pn e of-    -- use standard address given that the package name has no upper-    -- characters-    Nothing -> "https://hackage.haskell.org/package/${P}/${P}.tar.gz"-    -- use MY_X variables (defined in showEBuild) as we've renamed the-    -- package-    Just _  -> "https://hackage.haskell.org/package/${MY_P}/${MY_P}.tar.gz"---- | Pretty-print an 'EBuild' as a 'String'.-showEBuild :: TC.UTCTime -> EBuild -> String-showEBuild now ebuild =-  ss ("# Copyright 1999-" ++ this_year ++ " Gentoo Authors"). nl.-  ss "# Distributed under the terms of the GNU General Public License v2". nl.-  nl.-  ss "EAPI=8". nl.-  nl.-  ss ("# ebuild generated by hackport " ++ hackportVersion ebuild). nl.-  sconcat (map (\(k, v) -> ss "#hackport: " . ss k . ss ": " . ss v . nl) $ used_options ebuild).-  nl.-  ss "CABAL_FEATURES=". quote' (sepBy " " $ map render (features ebuild)). nl.-  ss "inherit haskell-cabal". nl.-  nl.-  (case my_pn ebuild of-     Nothing -> id-     Just pn -> ss "MY_PN=". quote pn. nl.-                ss "MY_P=". quote "${MY_PN}-${PV}". nl.-                ss "S=". quote ("${WORKDIR}/${MY_P}"). nl. nl).-  ss "DESCRIPTION=". quote (drop_tdot $ description ebuild). nl.-  ss "HOMEPAGE=". quote (toHttps $ expandVars (homepage ebuild)). nl.-  ss "SRC_URI=". quote (src_uri ebuild). nl.-  nl.-  ss "LICENSE=". (either (\err -> quote "" . ss ("\t# FIXME: " ++ err))-                         quote-                         (license ebuild)). nl.-  ss "SLOT=". quote (slot ebuild). nl.-  ss "KEYWORDS=". quote' (sepBy " " $ keywords ebuild).nl.-  (if null (iuse ebuild)-    then nl-    else ss "IUSE=". quote' (sepBy " " . sort_iuse $ L.nub $ iuse ebuild). nl. nl-    ) .-  dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild).-  dep_str "DEPEND"  ( depend_extra ebuild) ( depend ebuild).--  verbatim (nl . ss "src_prepare() {" . nl)-               (src_prepare ebuild)-           (ss "}" . nl).--  verbatim (nl. ss "src_configure() {" . nl)-               (src_configure ebuild)-           (ss "}" . nl).--  id $ []-  where-        expandVars = replaceMultiVars [ (        name ebuild, "${PN}")-                                      , (hackage_name ebuild, "${HACKAGE_N}")-                                      ]---        this_year :: String-        this_year = TC.formatTime TC.defaultTimeLocale "%Y" now---- | Convert http urls into https urls, unless whitelisted as http-only.------ >>> toHttps "http://darcs.net"--- "http://darcs.net"--- >>> toHttps "http://pandoc.org"--- "https://pandoc.org"--- >>> toHttps "https://github.com"--- "https://github.com"-toHttps :: String -> String-toHttps x =-  case parseURI x of-    Just uri -> if uriScheme uri == "http:" &&-                   (uriRegName <$> uriAuthority uri)-                   `notElem`-                   httpOnlyHomepages-                then replace "http" "https" x-                else x-    Nothing -> x-  where-    replace old new = L.intercalate new . LS.splitOn old-    -- add to this list with any non https-aware websites-    httpOnlyHomepages = Just <$> [ "leksah.org"-                                 , "darcs.net"-                                 , "khumba.net"-                                 ]---- | Sort IUSE alphabetically------ >>> sort_iuse ["+a","b"]--- ["+a","b"]-sort_iuse :: [String] -> [String]-sort_iuse = L.sortBy (compare `F.on` dropWhile ( `elem` "+"))---- | Drop trailing dot(s).------ >>> drop_tdot "foo."--- "foo"--- >>> drop_tdot "foo..."--- "foo"-drop_tdot :: String -> String-drop_tdot = reverse . dropWhile (== '.') . reverse--type DString = String -> String--ss :: String -> DString-ss = showString--sc :: Char -> DString-sc = showChar--nl :: DString-nl = sc '\n'--verbatim :: DString -> [String] -> DString -> DString-verbatim pre s post =-    if null s-        then id-        else pre .-            (foldl (\acc v -> acc . ss "\t" . ss v . nl) id s) .-            post--sconcat :: [DString] -> DString-sconcat = L.foldl' (.) id---- takes string and substitutes tabs to spaces--- ebuild's convention is 4 spaces for one tab,--- BUT! nested USE flags get moved too much to--- right. Thus 8 :]-tab_size :: Int-tab_size = 8--tabify_line :: String -> String-tabify_line l = replicate need_tabs '\t'  ++ nonsp-    where (sp, nonsp)       = break (/= ' ') l-          (full_tabs, t) = length sp `divMod` tab_size-          need_tabs = full_tabs + if t > 0 then 1 else 0--tabify :: String -> String-tabify = unlines . map tabify_line . lines--dep_str :: String -> [String] -> Dependency -> DString-dep_str var extra dep = ss var. sc '='. quote' (ss $ drop_leadings $ unlines extra ++ deps_s). nl-    where indent = 1 * tab_size-          deps_s = tabify (dep2str indent $ PN.normalize_depend dep)-          drop_leadings = dropWhile (== '\t')---- | Place a 'String' between quotes, and correctly handle special characters.-quote :: String -> DString-quote str = sc '"'. ss (esc str). sc '"'-  where-  esc = concatMap esc'-  esc' c =-      case c of-          '\\' -> "\\\\"-          '"'  -> "\\\""-          '\n' -> " "-          '`'  -> "'"-          _    -> [c]--quote' :: DString -> DString-quote' str = sc '"'. str. sc '"'--sepBy :: String -> [String] -> ShowS-sepBy _ []     = id-sepBy _ [x]    = ss x-sepBy s (x:xs) = ss x. ss s. sepBy s xs--getRestIfPrefix :: String       -- ^ the prefix-                -> String       -- ^ the string-                -> Maybe String-getRestIfPrefix (p:ps) (x:xs) = if p==x then getRestIfPrefix ps xs else Nothing-getRestIfPrefix [] rest = Just rest-getRestIfPrefix _ [] = Nothing--subStr :: String                -- ^ the search string-       -> String                -- ^ the string to be searched-       -> Maybe (String,String) -- ^ Just (pre,post) if string is found-subStr sstr str = case getRestIfPrefix sstr str of-    Nothing -> if null str then Nothing else case subStr sstr (tail str) of-        Nothing -> Nothing-        Just (pre,post) -> Just (head str:pre,post)-    Just rest -> Just ([],rest)--replaceMultiVars ::-    [(String,String)] -- ^ pairs of variable name and content-    -> String         -- ^ string to be searched-    -> String         -- ^ the result-replaceMultiVars [] str = str-replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of-    Nothing -> replaceMultiVars rest str-    Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
− Portage/EBuild/CabalFeature.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE LambdaCase #-}---- | Support for CABAL_FEATURES="..." in haskell-cabal .ebuild files.--- See haskell-cabal.eclass for details on each of those.-module Portage.EBuild.CabalFeature (CabalFeature(..)) where--import Portage.EBuild.Render---- | Type representing @CABAL_FEATURES@ in an ebuild.-data CabalFeature = Lib-                  | Profile-                  | Haddock-                  | Hoogle-                  | HsColour-                  | TestSuite-    deriving Eq--instance Render CabalFeature where-    render = \case-                 Lib        -> "lib"-                 Profile    -> "profile"-                 Haddock    -> "haddock"-                 Hoogle     -> "hoogle"-                 HsColour   -> "hscolour"-                 TestSuite  -> "test-suite"
− Portage/EBuild/Render.hs 
@@ -1,6 +0,0 @@--- CABAL_FEATURES="..." in haskell-cabal .ebuild files-module Portage.EBuild.Render (Render(..)) where--class Render a where-    render :: a -> String-
− Portage/EMeta.hs 
@@ -1,107 +0,0 @@-{-|-Module      : Portage.EMeta-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Functions to propagate existing ebuild information-(such as its licence, description, switched flags etc.) to-a new ebuild.--}-module Portage.EMeta-  ( EMeta(..)-  , findExistingMeta-  ) where--import Control.Monad-import Data.Char (isSpace)-import qualified Data.List as L--import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.FilePath ((</>))-import Text.Printf---- | Extract a value of variable in \'var=\"val\"\' format.--- There should be exactly one variable assignment in the ebuild.--- It's a bit of an artificial limitation, but it's common for \'if / else\' blocks.-extract_quoted_string :: FilePath -> String -> String -> Maybe String-extract_quoted_string ebuild_path s_ebuild var_name =-    case filter (L.isPrefixOf var_prefix . ltrim) $ lines s_ebuild of-        []        -> Nothing-        [kw_line] -> up_to_quote $ skip_prefix $ ltrim kw_line-        other     -> bail_out $ printf "strange '%s' assignments:\n%s" var_name (unlines other)--    where ltrim :: String -> String-          ltrim = dropWhile isSpace-          var_prefix = var_name ++ "=\""-          skip_prefix = drop (length var_prefix)-          up_to_quote l = case break (== '"') l of-                              ("", _)  -> Nothing -- empty line-                              (_, "")  -> bail_out $ printf "failed to find closing quote for '%s'" l-                              (val, _) -> Just val-          bail_out :: String -> e-          bail_out msg = error $ printf "%s:extract_quoted_string %s" ebuild_path msg---- | Extract a value of variable in \'#hackport: var: val\' format.--- There should be exactly one variable assignment in the ebuild.-extract_hackport_var :: FilePath -> String -> String -> Maybe String-extract_hackport_var ebuild_path s_ebuild var_name =-    case filter (L.isPrefixOf var_prefix) $ lines s_ebuild of-        []         -> Nothing-        [var_line] -> Just $ skip_prefix var_line-        other      -> bail_out $ printf "strange '%s' assignmets:\n%s" var_name (unlines other)--    where var_prefix = "#hackport: " ++ var_name ++ ": "-          skip_prefix = drop (length var_prefix)-          bail_out :: String -> e-          bail_out msg = error $ printf "%s:extract_hackport_var %s" ebuild_path msg---- | Extract the existing keywords from an ebuild.-extractKeywords :: FilePath -> String -> Maybe [String]-extractKeywords ebuild_path s_ebuild =-    words `fmap ` extract_quoted_string ebuild_path s_ebuild "KEYWORDS"---- | Extract the existing license from an ebuild.-extractLicense :: FilePath -> String -> Maybe String-extractLicense ebuild_path s_ebuild =-    extract_quoted_string ebuild_path s_ebuild "LICENSE"---- | Extract the existing Cabal flags from an ebuild.-extractCabalFlags :: FilePath -> String -> Maybe String-extractCabalFlags ebuild_path s_ebuild =-    extract_hackport_var ebuild_path s_ebuild "flags"---- | Extract the existing description from an ebuild.-extractDescription :: FilePath -> String -> Maybe String-extractDescription ebuild_path s_ebuild =-    extract_quoted_string ebuild_path s_ebuild "DESCRIPTION"---- | Type representing the aggregated (best inferred) metadata for a--- new ebuild of a package.-data EMeta = EMeta { keywords :: Maybe [String]-                   , license  :: Maybe String-                   , cabal_flags :: Maybe String-                   , description :: Maybe String-                   }---- | Find the existing package metadata from the last available ebuild.-findExistingMeta :: FilePath -> IO EMeta-findExistingMeta pkgdir =-    do ebuilds <- filter (L.isSuffixOf ".ebuild") `fmap` do b <- doesDirectoryExist pkgdir-                                                            if b then getDirectoryContents pkgdir-                                                                 else return []-       -- TODO: version sort-       e_metas <- forM ebuilds $ \e ->-                      do let e_path = pkgdir </> e-                         e_conts <- readFile e_path-                         return EMeta { keywords = extractKeywords e e_conts-                                      , license = extractLicense  e e_conts-                                      , cabal_flags = extractCabalFlags e e_conts-                                      , description = extractDescription e e_conts-                                      }-       let get_latest candidates = last (Nothing : filter (/= Nothing) candidates)-           aggregated_meta = EMeta { keywords = get_latest $ map keywords e_metas-                                   , license = get_latest $ map license e_metas-                                   , cabal_flags = get_latest $ map cabal_flags e_metas-                                   , description = get_latest $ map description e_metas-                                   }-       return aggregated_meta
− Portage/GHCCore.hs 
@@ -1,483 +0,0 @@-{-|-Module      : Portage.GHCCore-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Guess the appropriate GHC version from packages depended upon.--}-module Portage.GHCCore-        ( minimumGHCVersionToBuildPackage-        , cabalFromGHC-        , defaultComponentRequestedSpec-        , finalizePD-        , platform-        , dependencySatisfiable-        -- hspec exports-        , packageIsCoreInAnyGHC-        ) where--import qualified Distribution.Compiler as DC-import qualified Distribution.Package as Cabal-import qualified Distribution.Version as Cabal-import Distribution.Version-import Distribution.Simple.PackageIndex-import Distribution.InstalledPackageInfo as IPI--import Distribution.PackageDescription-import Distribution.PackageDescription.Configuration-import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))-import Distribution.System-import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)--import Distribution.Pretty (prettyShow)--import Data.Maybe-import Data.List ( nub )--import Debug.Trace---- | Try each @GHC@ version in the specified order, from left to right.--- The first @GHC@ version in this list is a minimum default.-ghcs :: [(DC.CompilerInfo, InstalledPackageIndex)]-ghcs = modern_ghcs-    where modern_ghcs  = [ghc843, ghc863, ghc865, ghc881, ghc883, ghc884, ghc8101, ghc8104, ghc902]---- | Maybe determine the appropriate 'Cabal.Version' of the @Cabal@ package--- from a given @GHC@ version.------ >>> cabalFromGHC [8,8,3]--- Just (mkVersion [3,0,1,0])--- >>> cabalFromGHC [9,9,9,9]--- Nothing-cabalFromGHC :: [Int] -> Maybe Cabal.Version-cabalFromGHC ver = lookup ver table-  where-  table = [ ([8,4,3],  Cabal.mkVersion [2,2,0,1])-          , ([8,6,3],  Cabal.mkVersion [2,4,0,1])-          , ([8,6,5],  Cabal.mkVersion [2,4,0,1])-          , ([8,8,1],  Cabal.mkVersion [3,0,0,0])-          , ([8,8,3],  Cabal.mkVersion [3,0,1,0])-          , ([8,8,4],  Cabal.mkVersion [3,0,1,0])-          , ([8,10,1], Cabal.mkVersion [3,2,0,0])-          , ([8,10,4], Cabal.mkVersion [3,2,1,0])-          , ([9,0,2], Cabal.mkVersion [3,4,1,0])          -          ]--platform :: Platform-platform = Platform X86_64 Linux---- | Is the package a core dependency of a specific version of @GHC@?------ >>> packageIsCore (mkIndex ghc883_pkgs) (Cabal.mkPackageName "binary")--- True--- >>> all (== True) ((packageIsCore (mkIndex ghc883_pkgs)) <$> (packageNamesFromPackageIndex (mkIndex ghc883_pkgs)))--- True-packageIsCore :: InstalledPackageIndex -> Cabal.PackageName -> Bool-packageIsCore index pn = not . null $ lookupPackageName index pn---- | Is the package a core dependency of any version of @GHC@?--- >>> packageIsCoreInAnyGHC (Cabal.mkPackageName "array")--- True-packageIsCoreInAnyGHC :: Cabal.PackageName -> Bool-packageIsCoreInAnyGHC pn = any (flip packageIsCore pn) (map snd ghcs)---- | Check if a dependency is satisfiable given a 'PackageIndex'--- representing the core packages in a GHC version.--- Packages that are not core will always be accepted, packages that are--- core in any ghc must be satisfied by the 'PackageIndex'.-dependencySatisfiable :: InstalledPackageIndex -> Cabal.Dependency -> Bool-dependencySatisfiable pindex dep@(Cabal.Dependency pn _rang _lib)-  | Cabal.unPackageName pn == "Win32" = False -- only exists on windows, not in linux-  | not . null $ lookupDependency pindex (Cabal.depPkgName dep) (Cabal.depVerRange dep) = True -- the package index satisfies the dep-  | packageIsCoreInAnyGHC pn = False -- some other ghcs support the dependency-  | otherwise = True -- the dep is not related with core packages, accept the dep--packageBuildableWithGHCVersion-  :: GenericPackageDescription-  -> FlagAssignment-  -> (DC.CompilerInfo, InstalledPackageIndex)-  -> Either [Cabal.Dependency] (PackageDescription, FlagAssignment)-packageBuildableWithGHCVersion pkg user_specified_fas (compiler_info, pkgIndex) = trace_failure $-  finalizePD user_specified_fas defaultComponentRequestedSpec (dependencySatisfiable pkgIndex) platform compiler_info [] pkg-    where trace_failure v = case v of-              (Left deps) -> trace (unwords ["rejecting dep:" , show_compiler compiler_info-                                            , "as", show_deps deps-                                            , "were not found."-                                            ]-                                   ) v-              _           -> trace (unwords ["accepting dep:" , show_compiler compiler_info-                                            ]-                                   ) v-          show_deps = show . map prettyShow-          show_compiler (DC.CompilerInfo { DC.compilerInfoId = CompilerId GHC v }) = "ghc-" ++ prettyShow v-          show_compiler c = show c---- | Given a 'GenericPackageDescription' it returns the miminum GHC version--- to build a package, and a list of core packages to that GHC version.-minimumGHCVersionToBuildPackage :: GenericPackageDescription -> FlagAssignment -> Maybe ( DC.CompilerInfo-                                                                                        , [Cabal.PackageName]-                                                                                        , PackageDescription-                                                                                        , FlagAssignment-                                                                                        , InstalledPackageIndex)-minimumGHCVersionToBuildPackage gpd user_specified_fas =-  listToMaybe [ (cinfo, packageNamesFromPackageIndex pix, pkg_desc, picked_flags, pix)-              | g@(cinfo, pix) <- ghcs-              , Right (pkg_desc, picked_flags) <- return (packageBuildableWithGHCVersion gpd user_specified_fas g)]---- | Create an 'InstalledPackageIndex' from a ['Cabal.PackageIdentifier'].--- This is used to generate an index of core @GHC@ packages from the provided--- ['Cabal.PackageIdentifier'] functions, e.g. 'ghc883_pkgs'.-mkIndex :: [Cabal.PackageIdentifier] -> InstalledPackageIndex-mkIndex pids = fromList-  [ emptyInstalledPackageInfo-      { sourcePackageId = pindex-      , exposed = True-      }-  | pindex@(Cabal.PackageIdentifier _name _version) <- pids ]--packageNamesFromPackageIndex :: InstalledPackageIndex -> [Cabal.PackageName]-packageNamesFromPackageIndex pix = nub $ map fst $ allPackagesByName pix--ghc :: [Int] -> DC.CompilerInfo-ghc nrs = DC.unknownCompilerInfo c_id DC.NoAbiTag-    where c_id = CompilerId GHC (mkVersion nrs)--ghc902 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc902 = (ghc [9,0,2], mkIndex ghc902_pkgs)--ghc8104 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc8104 = (ghc [8,10,4], mkIndex ghc8104_pkgs)--ghc8101 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc8101 = (ghc [8,10,1], mkIndex ghc8101_pkgs)--ghc884 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc884 = (ghc [8,8,4], mkIndex ghc884_pkgs)--ghc883 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc883 = (ghc [8,8,3], mkIndex ghc883_pkgs)--ghc881 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc881 = (ghc [8,8,1], mkIndex ghc881_pkgs)--ghc865 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc865 = (ghc [8,6,5], mkIndex ghc865_pkgs)--ghc863 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc863 = (ghc [8,6,3], mkIndex ghc863_pkgs)--ghc843 :: (DC.CompilerInfo, InstalledPackageIndex)-ghc843 = (ghc [8,4,3], mkIndex ghc843_pkgs)---- | Non-upgradeable core packages--- Sources:---  * release notes---      example: https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html---  * our binary tarballs (package.conf.d.initial subdir)---  * ancient: http://haskell.org/haskellwiki/Libraries_released_with_GHC-ghc902_pkgs :: [Cabal.PackageIdentifier]-ghc902_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,15,1,0]-  , p "binary" [0,8,8,0] -- used by libghc-  , p "bytestring" [0,10,12,1]---  , p "Cabal" [3,4,1,0]  package is upgradeable-  , p "containers" [0,6,4,1]-  , p "deepseq" [1,4,5,0] -- used by time-  , p "directory" [1,3,6,2]-  , p "filepath" [1,4,2,1]-  , p "exceptions" [0,10,4] -- used by libghc-  , p "ghc-bignum" [1,1]-  , p "ghc-boot" [9,0,2]-  , p "ghc-boot-th" [9,0,2]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,7,0]-  , p "ghc-heap" [9,0,2]-  , p "ghci" [9,0,2]---  , p "haskeline" [0,8,2]  package is upgradeable-  , p "hpc" [0,6,1,0] -- used by libghc-  , p "integer-gmp" [1,1]-  , p "mtl" [2,2,2]  -- used by exceptions-  , p "parsec" [3,1,14,0]  -- used by exceptions-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,13,2]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,17,0,0] -- used by libghc-  , p "terminfo" [0,4,1,5] -- used by libghc-  , p "text" [1,2,5,0] -- used by libghc-  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc8104_pkgs :: [Cabal.PackageIdentifier]-ghc8104_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,14,1,0]-  , p "binary" [0,8,8,0] -- used by libghc-  , p "bytestring" [0,10,12,0]---  , p "Cabal" [3,2,1,0]  package is upgradeable-  , p "containers" [0,6,2,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,6,0]-  , p "filepath" [1,4,2,1]-  , p "exceptions" [0,10,4] -- used by libghc in ghc-9.0.2-  , p "ghc-boot" [8,10,4]-  , p "ghc-boot-th" [8,10,4]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,6,1,0]-  , p "ghc-heap" [8,10,4]-  , p "ghci" [8,10,4]---  , p "haskeline" [0,8,0,1]  package is upgradeable-  , p "hpc" [0,6,1,0] -- used by libghc-  , p "integer-gmp" [1,0,3,0]-  , p "mtl" [2,2,2]  -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,14,0]  -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,9,0]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,16,0,0] -- used by libghc-  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,4,1] -- used by libghc in ghc-9.0.2-  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc8101_pkgs :: [Cabal.PackageIdentifier]-ghc8101_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,14,0,0]-  , p "binary" [0,8,8,0] -- used by libghc-  , p "bytestring" [0,10,10,0]---  , p "Cabal" [3,2,0,0]  package is upgradeable-  , p "containers" [0,6,2,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,6,0]-  , p "filepath" [1,4,2,1]-  , p "exceptions" [0,10,4] -- used by libghc in ghc-9.0.2-  , p "ghc-boot" [8,10,1]-  , p "ghc-boot-th" [8,10,1]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,6,1,0]-  , p "ghc-heap" [8,10,1]-  , p "ghci" [8,10,1]---  , p "haskeline" [0,8,0,0]  package is upgradeable-  , p "hpc" [0,6,1,0] -- used by libghc-  , p "integer-gmp" [1,0,3,0]-  , p "mtl" [2,2,2]  -- used by libghc in ghc-9.0.2 -  , p "parsec" [3,1,14,0]  -- used by libghc in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,8,2]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,16,0,0] -- used by libghc-  , p "terminfo" [0,4,1,4]  -- used by libghc in ghc-9.0.2-  , p "text" [1,2,3,2]  -- used by libghc in ghc-9.0.2-  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc884_pkgs :: [Cabal.PackageIdentifier]-ghc884_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,13,0,0]-  , p "binary" [0,8,7,0] -- used by libghc-  , p "bytestring" [0,10,10,1]---  , p "Cabal" [3,0,1,0]  package is upgradeable-  , p "containers" [0,6,2,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,6,0]-  , p "filepath" [1,4,2,1]-  , p "ghc-boot" [8,8,4]-  , p "ghc-boot-th" [8,8,4]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,3,0]-  , p "ghci" [8,8,4]---  , p "haskeline" [0,7,5,0]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2]  -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,9,0]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,15,0,0] -- used by libghc-  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2-  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc883_pkgs :: [Cabal.PackageIdentifier]-ghc883_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,13,0,0]-  , p "binary" [0,8,7,0] -- used by libghc-  , p "bytestring" [0,10,10,0]---  , p "Cabal" [3,0,1,0]  package is upgradeable-  , p "containers" [0,6,2,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,6,0]-  , p "filepath" [1,4,2,1]-  , p "ghc-boot" [8,8,3]-  , p "ghc-boot-th" [8,8,3]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,3,0]-  , p "ghci" [8,8,3]---  , p "haskeline" [0,7,5,0]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,8,0]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,15,0,0] -- used by libghc-  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2 -  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc881_pkgs :: [Cabal.PackageIdentifier]-ghc881_pkgs =-  [ p "array" [0,5,4,0]-  , p "base" [4,13,0,0]-  , p "binary" [0,8,7,0] -- used by libghc-  , p "bytestring" [0,10,9,0]---  , p "Cabal" [3,0,0,0]  package is upgradeable-  , p "containers" [0,6,2,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,3,2]-  , p "filepath" [1,4,2,1]-  , p "ghc-boot" [8,8,1]-  , p "ghc-boot-th" [8,8,1]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,3,0]-  , p "ghci" [8,8,1]---  , p "haskeline" [0,7,4,3]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,5,1]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,15,0,0] -- used by libghc-  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2-  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc865_pkgs :: [Cabal.PackageIdentifier]-ghc865_pkgs =-  [ p "array" [0,5,3,0]-  , p "base" [4,12,0,0]-  , p "binary" [0,8,6,0] -- used by libghc-  , p "bytestring" [0,10,8,2]---  , p "Cabal" [2,4,0,1]  package is upgradeable-  , p "containers" [0,6,0,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,3,0]-  , p "filepath" [1,4,2,1]-  , p "ghc-boot" [8,6,5]-  , p "ghc-boot-th" [8,6,5]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,3,0]-  , p "ghci" [8,6,5]---  , p "haskeline" [0,7,4,3]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,5,0]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,14,0,0] -- used by libghc-  , p "terminfo" [0,4,1,2] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,3,1] -- used by libghc in ghc-9.0.2-  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,6,2] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc863_pkgs :: [Cabal.PackageIdentifier]-ghc863_pkgs =-  [ p "array" [0,5,3,0]-  , p "base" [4,12,0,0]-  , p "binary" [0,8,6,0] -- used by libghc-  , p "bytestring" [0,10,8,2]---  , p "Cabal" [2,4,0,1]  package is upgradeable-  , p "containers" [0,6,0,1]-  , p "deepseq" [1,4,4,0] -- used by time-  , p "directory" [1,3,3,0]-  , p "filepath" [1,4,2,1]-  , p "ghc-boot" [8,6,3]-  , p "ghc-boot-th" [8,6,3]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,3,0]-  , p "ghci" [8,6,3]---  , p "haskeline" [0,7,4,3]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,3,0]-  --  , p "stm" [2,5,0,0]  package is upgradeable(?)-  , p "template-haskell" [2,14,0,0] -- used by libghc-  , p "terminfo" [0,4,1,2] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,3,1] -- used by libghc in ghc-9.0.2-  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,5,0] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--ghc843_pkgs :: [Cabal.PackageIdentifier]-ghc843_pkgs =-  [ p "array" [0,5,2,0]-  , p "base" [4,11,1,0]-  , p "binary" [0,8,5,1] -- used by libghc-  , p "bytestring" [0,10,8,2]---  , p "Cabal" [2,2,0,1]  package is upgradeable-  , p "containers" [0,5,11,2]-  , p "deepseq" [1,4,3,0] -- used by time-  , p "directory" [1,3,1,5]-  , p "filepath" [1,4,2]-  , p "ghc-boot" [8,4,3]-  , p "ghc-boot-th" [8,4,3]-  , p "ghc-compact" [0,1,0,0]-  , p "ghc-prim" [0,5,2,0]-  , p "ghci" [8,4,3]---  , p "haskeline" [0,7,4,2]  package is upgradeable-  , p "hpc" [0,6,0,3] -- used by libghc-  , p "integer-gmp" [1,0,2,0]-  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2-  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2-  , p "pretty" [1,1,3,6]-  , p "process" [1,6,3,0]-  --  , p "stm" [2,4,5,0]  package is upgradeable(?)-  , p "template-haskell" [2,13,0,0] -- used by libghc-  , p "terminfo" [0,4,1,1] -- used by libghc in ghc-9.0.2-  , p "text" [1,2,3,0] -- used by libghc in ghc-9.0.2-  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade-  , p "transformers" [0,5,5,0] -- used by libghc-  , p "unix" [2,7,2,2]---  , p "xhtml" [3000,2,2,1]-  ]--p :: String -> [Int] -> Cabal.PackageIdentifier-p pn vs = Cabal.PackageIdentifier (Cabal.mkPackageName pn) (mkVersion vs)
− Portage/Host.hs 
@@ -1,121 +0,0 @@-module Portage.Host-  ( getInfo -- :: IO [(String, String)]-  , LocalInfo(..)-  ) where--import Util (run_cmd)-import qualified Data.List.Split as DLS-import Data.Maybe (fromJust, isJust, mapMaybe)--import qualified System.Directory as D-import           System.FilePath ((</>))--import System.IO--data LocalInfo =-    LocalInfo { distfiles_dir :: String-              , overlay_list  :: [FilePath]-              , portage_dir   :: FilePath-              } deriving (Read, Show)--defaultInfo :: LocalInfo-defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"-                        , overlay_list  = []-                        , portage_dir   = "/usr/portage"-                        }---- query paludis and then emerge-getInfo :: IO LocalInfo-getInfo = fromJust `fmap`-    performMaybes [ readConfig-                  , performMaybes [ getPaludisInfo-                                  , askPortageq-                                  , return (Just defaultInfo)-                                  ] >>= showAnnoyingWarning-                  ]-    where performMaybes [] = return Nothing-          performMaybes (act:acts) =-              do r <- act-                 if isJust r-                     then return r-                     else performMaybes acts--showAnnoyingWarning :: Maybe LocalInfo -> IO (Maybe LocalInfo)-showAnnoyingWarning info = do-    hPutStr stderr $ unlines [ "-- Consider creating ~/" ++ hackport_config ++ " file with contents:"-                             , show info-                             , "-- It will speed hackport startup time a bit."-                             ]-    return info---- relative to home dir-hackport_config :: FilePath-hackport_config = ".hackport" </> "repositories"------------------------------- fastest: config reading----------------------------readConfig :: IO (Maybe LocalInfo)-readConfig =-    do home_dir <- D.getHomeDirectory-       let config_path  = home_dir </> hackport_config-       exists <- D.doesFileExist config_path-       if exists then read <$> readFile config_path else return Nothing--------------- Paludis-------------getPaludisInfo :: IO (Maybe LocalInfo)-getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info"--parsePaludisInfo :: String -> LocalInfo-parsePaludisInfo text =-  let chunks = DLS.splitOn [""] . lines $ text-      repositories = mapMaybe parseRepository chunks-  in  fromJust (mkLocalInfo repositories)-  where-  parseRepository :: [String] -> Maybe (String, (String, String))-  parseRepository [] = Nothing-  parseRepository (firstLine:lns) = do-    name <- case words firstLine of-                ["Repository", nm] -> return (init nm)-                _ -> fail "not a repository chunk"-    let dict = [ (head ln, unwords (tail ln)) | ln <- map words lns ]-    location <- lookup "location" dict-    distfiles <- lookup "distdir" dict-    return (name, (location, distfiles))--  mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo-  mkLocalInfo repos = do-    (gentooLocation, gentooDistfiles) <- lookup "gentoo" repos-    let overlays = [ loc | (_, (loc, _dist)) <- repos ]-    return (LocalInfo-              { distfiles_dir = gentooDistfiles-              , portage_dir = gentooLocation-              , overlay_list = overlays-              })-------------- Emerge------------askPortageq :: IO (Maybe LocalInfo)-askPortageq = do-    distdir <- run_cmd "portageq distdir"-    portdir <- run_cmd "portageq get_repo_path / gentoo"-    hsRepo  <- run_cmd "portageq get_repo_path / haskell"-    --There really ought to be both distdir and portdir,-    --but maybe no hsRepo defined yet.-    let info = if Nothing `elem` [distdir,portdir]-               then Nothing-               else Just LocalInfo-                      { distfiles_dir = grab distdir-                      , portage_dir = grab portdir-                      , overlay_list = iffy hsRepo-                      }-                 --init: kill newline char-                 where grab = init . fromJust-                       iffy Nothing     = []-                       iffy (Just repo) = [init repo]-    return info
− Portage/Metadata.hs 
@@ -1,129 +0,0 @@-{-|-Module      : Portage.Metadata-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Functions and types related to @metadata.xml@ processing--}-module Portage.Metadata-        ( Metadata(..)-        , metadataFromFile-        , pureMetadataFromFile-        , stripGlobalUseFlags -- exported for hspec-        , prettyPrintFlags -- exported for hspec-        , prettyPrintFlagsHuman-        , makeDefaultMetadata-        , makeMinimalMetadata-        ) where--import qualified AnsiColor as A--import qualified Data.List       as L-import qualified Data.Map.Strict as Map-import qualified Data.Text       as T-import qualified Data.Text.IO    as T--import Text.XML.Light---- | A data type for the Gentoo-specific @metadata.xml@ file.--- Currently defines functions for the maintainer email and--- USE flags and their descriptions.-data Metadata = Metadata-      { metadataEmails :: [String] -- ^ This should /always/ be [\"haskell@gentoo.org\"].-      , metadataUseFlags :: Map.Map String String -- ^ Only /active/ USE flags, if any.-      } deriving (Eq, Show)---- | Maybe return a 'Metadata' from a 'T.Text'.------ Trying to parse an empty 'T.Text' should return 'Nothing':------ >>> pureMetadataFromFile T.empty--- Nothing------ Parsing a @metadata.xml@ /without/ USE flags should /always/ be equivalent--- to 'makeMinimalMetadata':------ >>> pureMetadataFromFile (makeDefaultMetadata Map.empty) == Just makeMinimalMetadata--- True------ Parsing a @metadata.xml@ /with/ USE flags should /always/ be equivalent--- to 'makeMinimalMetadata' /plus/ the supplied USE flags:------ >>> pureMetadataFromFile (makeDefaultMetadata (Map.fromList [("name","description")])) == Just (makeMinimalMetadata {metadataUseFlags = Map.fromList [("name","description")] } )--- True-pureMetadataFromFile :: T.Text -> Maybe Metadata-pureMetadataFromFile file = parseXMLDoc file >>= \doc -> parseMetadata doc---- | Apply 'pureMetadataFromFile' to a 'FilePath'.-metadataFromFile :: FilePath -> IO (Maybe Metadata)-metadataFromFile fp = pureMetadataFromFile <$> T.readFile fp---- | Extract the maintainer email and USE flags from a supplied XML 'Element'.--- --- If we're parsing a blank 'Element' or otherwise empty @metadata.xml@:--- >>> parseMetadata blank_element--- Just (Metadata {metadataEmails = [], metadataUseFlags = fromList []})-parseMetadata :: Element -> Maybe Metadata-parseMetadata xml =-  return Metadata { metadataEmails = strContent <$> findElements (unqual "email") xml-                  , metadataUseFlags =-                      -- find the flag name-                      let x = findElement (unqual "use") xml-                          y = onlyElems $ concatMap elContent x-                          z = attrVal <$> concatMap elAttribs y-                      -- find the flag description-                          a = concatMap elContent y-                          b = cdData <$> onlyText a-                      in Map.fromList $ zip z b-                  }---- | Remove global @USE@ flags from the flags 'Map.Map', as these should not be--- within the local @metadata.xml@. For now, this is manually specified rather than--- parsing @use.desc@.-stripGlobalUseFlags :: Map.Map String String -> Map.Map String String-stripGlobalUseFlags m = foldr1 Map.intersection (Map.delete <$> globals <*> [m])-  where-    globals = [ "debug"-              , "examples"-              , "static"-              ]---- | Pretty print as valid XML a list of flags and their descriptions--- from a given 'Map.Map'.-prettyPrintFlags :: Map.Map String String -> [String]-prettyPrintFlags m = (\(name,description) ->-                        "\t\t" ++-                        (showElement-                         . add_attr (Attr (blank_name { qName = "name" }) name)-                         . unode "flag" $ description))-                     <$> (Map.toAscList . stripGlobalUseFlags $ m)---- | Pretty print a human-readable list of flags and their descriptions--- from a given 'Map.Map'.-prettyPrintFlagsHuman :: Map.Map String String -> [String]-prettyPrintFlagsHuman m = (\(name,description) -> A.bold (name ++ ": ") ++-                            (L.intercalate " " . lines $ description))-                          <$> (Map.toAscList . stripGlobalUseFlags $ m)-                          --- | A minimal metadata for use as a fallback value.-makeMinimalMetadata :: Metadata-makeMinimalMetadata = Metadata { metadataEmails = ["haskell@gentoo.org"]-                               , metadataUseFlags = Map.empty-                               }---- don't use Text.XML.Light as we like our own pretty printer--- | Pretty print the @metadata.xml@ string.-makeDefaultMetadata :: Map.Map String String -> T.Text-makeDefaultMetadata flags = T.pack $-  unlines [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"-          , "<!DOCTYPE pkgmetadata SYSTEM \"http://www.gentoo.org/dtd/metadata.dtd\">"-          , "<pkgmetadata>"-          , "\t<maintainer type=\"project\">"-          , "\t\t<email>haskell@gentoo.org</email>"-          , "\t\t<name>Gentoo Haskell</name>"-          , "\t</maintainer>"-            ++ if flags == Map.empty-               then ""-               else "\n\t<use>\n" ++ (unlines $ prettyPrintFlags flags) ++ "\t</use>"-          , "</pkgmetadata>"-          ]
− Portage/Overlay.hs 
@@ -1,189 +0,0 @@-module Portage.Overlay-  ( ExistingEbuild(..)-  , Overlay(..)-  , loadLazy-  , readOverlay, readOverlayByPackage-  , getDirectoryTree, DirectoryTree--  , reduceOverlay-  , filterByEmail-  , inOverlay-  )-  where--import qualified Portage.PackageId as Portage-import qualified Portage.Metadata as Portage--import qualified Distribution.Package as Cabal--import Distribution.Parsec (simpleParsec)-import Distribution.Simple.Utils ( comparing, equating )--import Data.List as List-import qualified Data.Map as Map-import Data.Map (Map)-import System.Directory (getDirectoryContents, doesDirectoryExist)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.FilePath  ((</>), splitExtension)--data ExistingEbuild = ExistingEbuild {-    ebuildId      :: Portage.PackageId,-    ebuildCabalId :: Cabal.PackageIdentifier,-    ebuildPath    :: FilePath-  } deriving (Show,Ord,Eq)--instance Cabal.Package ExistingEbuild where-    packageId = ebuildCabalId--instance Cabal.HasUnitId ExistingEbuild where-    installedUnitId _ = error "Portage.Cabal.installedUnitId: FIXME: should not be used"---- | Type describing an overlay.-data Overlay = Overlay {-    overlayPath  :: FilePath,-    overlayMap :: Map Portage.PackageName [ExistingEbuild],-    overlayMetadata :: Map Portage.PackageName Portage.Metadata-  } deriving Show---- | Is 'Cabal.PackageId' found in 'Overlay'?-inOverlay :: Overlay -> Cabal.PackageId -> Bool-inOverlay overlay pkgId = not (Map.null packages)-  where-    packages = Map.filterWithKey-                (\(Portage.PackageName _cat overlay_pn) ebuilds -> -                    let cabal_pn = Cabal.pkgName pkgId-                        ebs = [ ()-                                  | e <- ebuilds-                                  , let ebuild_cabal_id = ebuildCabalId e-                                  , ebuild_cabal_id == pkgId-                                  ]-                    in cabal_pn == overlay_pn && (not (null ebs))) om-    om = overlayMap overlay--loadLazy :: FilePath -> IO Overlay-loadLazy path = do-  dir <- getDirectoryTree path-  metadata <- unsafeInterleaveIO $ mkMetadataMap path dir-  return $ mkOverlay metadata $ readOverlayByPackage dir-  where-    allowed v = case v of-      (Portage.Version _ Nothing [] _) -> True-      _                                -> False--    mkOverlay :: Map Portage.PackageName Portage.Metadata-              -> [(Portage.PackageName, [Portage.Version])]-              -> Overlay-    mkOverlay meta packages = Overlay {-      overlayPath  = path,-      overlayMetadata = meta,-      overlayMap =-          Map.fromList-            [ (pkgName, [ ExistingEbuild portageId cabalId filepath-                        | version <- allowedVersions-                        , let portageId = Portage.PackageId pkgName version-                        , Just cabalId <- [ Portage.toCabalPackageId portageId ]-                        , let filepath = path </> Portage.packageIdToFilePath portageId-                        ])-            | (pkgName, allVersions) <- packages-            , let allowedVersions = filter allowed allVersions-           ]-    }--mkMetadataMap :: FilePath -> DirectoryTree -> IO (Map Portage.PackageName Portage.Metadata)-mkMetadataMap root dir =-  fmap (Map.mapMaybe id) $-    traverse Portage.metadataFromFile $-      Map.fromList-        [ (Portage.mkPackageName category package, root </> category </> package </> "metadata.xml")-        | Directory category packages <- dir-        , Directory package files <- packages-        , File "metadata.xml" <- files-        ]--filterByEmail :: ([String] -> Bool) -> Overlay -> Overlay-filterByEmail p overlay = overlay-                            { overlayMetadata = metadataMap'-                            , overlayMap = pkgMap'-                            }-  where-    metadataMap' = Map.filter (p . Portage.metadataEmails) (overlayMetadata overlay)-    pkgMap' = Map.intersection (overlayMap overlay) metadataMap'----- | Make sure there is only one ebuild for each version number (by selecting--- the highest ebuild version revision)-reduceOverlay :: Overlay -> Overlay-reduceOverlay overlay = overlay { overlayMap = Map.map reduceVersions (overlayMap overlay) }-  where-  versionNumbers (Portage.Version nums _ _ _) = nums-  reduceVersions :: [ExistingEbuild] -> [ExistingEbuild]-  reduceVersions = -- gah!-          map (maximumBy (comparing (Portage.pkgVersion . ebuildId)))-          . groupBy (equating (versionNumbers . Portage.pkgVersion . ebuildId))-          . sortOn (Portage.pkgVersion . ebuildId)--readOverlayByPackage :: DirectoryTree -> [(Portage.PackageName, [Portage.Version])]-readOverlayByPackage tree =-  [ (name, versions name pkgTree)-  | (category, catTree) <- categories        tree-  , (name,     pkgTree) <- packages category catTree-  ]--  where-    categories :: DirectoryTree -> [(Portage.Category, DirectoryTree)]-    categories entries =-      [ (category, entries')-      | Directory dir entries' <- entries-      , Just category <- [simpleParsec dir] ]--    packages :: Portage.Category -> DirectoryTree-             -> [(Portage.PackageName, DirectoryTree)]-    packages category entries =-      [ (Portage.PackageName category name, entries')-      | Directory dir entries' <- entries-      , Just name <- [simpleParsec dir] ]--    versions :: Portage.PackageName -> DirectoryTree -> [Portage.Version]-    versions name@(Portage.PackageName (Portage.Category category) _) entries =-      [ version-      | File fileName <- entries-      , let (baseName, ext) = splitExtension fileName-      , ext == ".ebuild"-      , let fullName = category ++ '/' : baseName-      , Just (Portage.PackageId name' version) <- [simpleParsec fullName]-      , name == name' ]--readOverlay :: DirectoryTree -> [Portage.PackageId]-readOverlay tree = [ Portage.PackageId pkgId version-                   | (pkgId, versions) <- readOverlayByPackage tree-                   , version <- versions-                   ]--type DirectoryTree  = [DirectoryEntry]-data DirectoryEntry = File FilePath | Directory FilePath [DirectoryEntry]--getDirectoryTree :: FilePath -> IO DirectoryTree-getDirectoryTree = dirEntries--  where-    dirEntries :: FilePath -> IO [DirectoryEntry]-    dirEntries dir = do-      names <- getDirectoryContents dir-      sequence-        [ do isDirectory <- doesDirectoryExist path-             if isDirectory-               then do entries <- unsafeInterleaveIO (dirEntries path)-                       return (Directory name entries)-               else    return (File      name)-        | name <- names-        , not (ignore name)-        , let path = dir </> name ]--    ignore path = path `elem` [ "."-                              , ".."-                              -- those speed things up a bit-                              -- and reduse memory consumption-                              -- (as we store it in RAM for the whole run)-                              , ".git"-                              , "CVS"-                              ]
− Portage/PackageId.hs 
@@ -1,203 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-Module      : Portage.PackageId-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Portage package identifiers, which unlike Cabal ones include a category.--}-module Portage.PackageId (-    Category(..),-    PackageName(..),-    PackageId(..),-    Portage.Version(..),-    mkPackageName,-    fromCabalPackageId,-    toCabalPackageId,-    parseFriendlyPackage,-    normalizeCabalPackageName,-    normalizeCabalPackageId,-    filePathToPackageId,-    packageIdToFilePath,-    cabal_pn_to_PN-  ) where--import qualified Distribution.Compat.CharParsing as P-import qualified Distribution.Package as Cabal-import           Distribution.Parsec (CabalParsing(..), Parsec(..), explicitEitherParsec)-import           Distribution.Pretty (Pretty(..), prettyShow)--import qualified Portage.Version as Portage--import           Control.DeepSeq (NFData(..))-import qualified Data.Char as Char-import qualified Text.PrettyPrint as Disp-import           Text.PrettyPrint ((<>))-import           System.FilePath ((</>))--#if MIN_VERSION_base(4,11,0)-import Prelude hiding ((<>))-#endif--newtype Category = Category { unCategory :: String }-  deriving (Eq, Ord, Show, Read)---- | Portage-style 'PackageName', containing a 'Category' and a 'Cabal.PackageName'.-data PackageName = PackageName { category :: Category, cabalPkgName :: Cabal.PackageName }-  deriving (Eq, Ord, Show, Read)---- | Portage-style 'PackageId', containing a 'PackageName' and a 'Portage.Version'.-data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version }-  deriving (Eq, Ord, Show, Read)--instance NFData Category where-  rnf (Category c) = rnf c--instance Pretty Category where-  pretty (Category c) = Disp.text c--instance Parsec Category where-  parsec = Category <$> P.munch1 categoryChar-    where-      categoryChar c = Char.isAlphaNum c || c == '-'--instance NFData PackageName where-  rnf (PackageName c pn) = rnf c `seq` rnf pn--instance Pretty PackageName where-  pretty (PackageName cat name) =-    pretty cat <> Disp.char '/' <> pretty name--instance Parsec PackageName where-  parsec = do-    cat <- parsec-    _ <- P.char '/'-    name <- parseCabalPackageName-    return $ PackageName cat name--instance NFData PackageId where-  rnf (PackageId pId pv) = rnf pId `seq` rnf pv--instance Pretty PackageId where-  pretty (PackageId name version) =-    pretty name <> Disp.char '-' <> pretty version--instance Parsec PackageId where-  parsec = do-    name <- parsec-    _ <- P.char '-'-    version <- parsec-    return $ PackageId name version---- | Transform a 'PackageId' into a 'FilePath'.--- --- >>> packageIdToFilePath (PackageId (PackageName (Category "dev-haskell") (Cabal.mkPackageName "foo-bar2")) (Portage.Version [3,0,0] (Just 'b') [Portage.RC 2] 1 ))--- "dev-haskell/foo-bar2/foo-bar2-3.0.0b_rc2-r1.ebuild"-packageIdToFilePath :: PackageId -> FilePath-packageIdToFilePath (PackageId (PackageName cat pn) version) =-  prettyShow cat </> prettyShow pn </> prettyShow pn <-> prettyShow version <.> "ebuild"-  where-    a <-> b = a ++ '-':b-    a <.> b = a ++ '.':b---- | Maybe generate a 'PackageId' from a 'FilePath'. Note that the 'FilePath' must have its--- file extension stripped before being passed to 'filePathToPackageId'.--- --- >>> filePathToPackageId (Category "dev-haskell") "foo-bar2-3.0.0b_rc2-r1"--- Just (PackageId {packageId = PackageName {category = Category {unCategory = "dev-haskell"}, cabalPkgName = PackageName "foo-bar2"}, pkgVersion = Version {versionNumber = [3,0,0], versionChar = Just 'b', versionSuffix = [RC 2], versionRevision = 1}})-filePathToPackageId :: Category -> FilePath -> Maybe PackageId-filePathToPackageId cat fp =-  case explicitEitherParsec parser fp of-    Right x -> Just x-    _ -> Nothing-  where-    parser = do-      pn <- parseCabalPackageName-      _ <- P.char '-'-      v <- parsec-      return $ PackageId (PackageName cat pn) v---- | Create a 'PackageName' from supplied category and package name 'String's.-mkPackageName :: String -> String -> PackageName-mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName package)---- | Create a 'PackageId' from a 'Category' and 'Cabal.PackageIdentifier'.-fromCabalPackageId :: Category -> Cabal.PackageIdentifier -> PackageId-fromCabalPackageId cat (Cabal.PackageIdentifier name version) =-  PackageId (PackageName cat (normalizeCabalPackageName name))-            (Portage.fromCabalVersion version)---- | Convert a 'Cabal.PackageName' into lowercase. Internally uses--- 'cabal_pn_to_PN'.------ >>> normalizeCabalPackageName (Cabal.mkPackageName "FooBar1")--- PackageName "foobar1"-normalizeCabalPackageName :: Cabal.PackageName -> Cabal.PackageName-normalizeCabalPackageName =-  Cabal.mkPackageName . cabal_pn_to_PN---- | Apply 'normalizeCabalPackageName' to the 'Cabal.PackageName' of--- a supplied 'Cabal.PackageIdentifier'.-normalizeCabalPackageId :: Cabal.PackageIdentifier -> Cabal.PackageIdentifier-normalizeCabalPackageId (Cabal.PackageIdentifier name version) =-  Cabal.PackageIdentifier (normalizeCabalPackageName name) version---- | Convert a 'PackageId' into a 'Maybe' 'Cabal.PackageIdentifier'.-toCabalPackageId :: PackageId -> Maybe Cabal.PackageIdentifier-toCabalPackageId (PackageId (PackageName _cat name) version) =-  fmap (Cabal.PackageIdentifier name)-           (Portage.toCabalVersion version)---- | Parse a 'String' as a package in the form of @[category\/]name[-version]@:------ Note that we /cannot/ use the 'parsec' function to parse the 'Cabal.PackageName',--- since it fails the entire parse if it tries to parse a 'Version'.--- See 'parseCabalPackageName' below.------ If parsing a valid package string:--- --- >>> parseFriendlyPackage "category-name/package-name1-0.0.0.1a_beta2-r4"--- Right (Just (Category {unCategory = "category-name"}),PackageName "package-name1",Just (Version {versionNumber = [0,0,0,1], versionChar = Just 'a', versionSuffix = [Beta 2], versionRevision = 4}))------ If malformed, return an error string:------ >>> parseFriendlyPackage "category-name/package-name-1-0.0.0.1a_beta2-r4"--- Left ...-parseFriendlyPackage :: String -> Either String (Maybe Category, Cabal.PackageName, Maybe Portage.Version)-parseFriendlyPackage str = explicitEitherParsec parser str-  where-  parser = do-    mc <- P.optional . P.try $ do-      c <- parsec-      _ <- P.char '/'-      return c-    p <- parseCabalPackageName-    mv <- P.optional $ do-      _ <- P.char '-'-      v <- parsec-      return v-    return (mc, p, mv)---- | Parse a 'Cabal.PackageName'.------ This parser is a replacement for 'parsecUnqualComponentName' which fails when--- trying to parse a 'Version'.-parseCabalPackageName :: CabalParsing m => m Cabal.PackageName-parseCabalPackageName = do-  pn <- P.some . P.try $-    P.choice-    [ P.alphaNum-    , P.char '+'-    , P.char '-' <* P.notFollowedBy (P.some P.digit <* P.notFollowedBy P.letter)-    ]-  return $ Cabal.mkPackageName pn---- | Pretty-print a lowercase 'Cabal.PackageName'.------ Note the difference between this function and 'normalizeCabalPackageName':--- this function returns a 'String', the other a 'Cabal.PackageName'.------ >>> cabal_pn_to_PN (Cabal.mkPackageName "FooBar1")--- "foobar1"-cabal_pn_to_PN :: Cabal.PackageName -> String-cabal_pn_to_PN = map Char.toLower . prettyShow
− Portage/Resolve.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module Portage.Resolve-    ( resolveCategory-    , resolveCategories-    , resolveFullPortageName-    ) where--import qualified Portage.Overlay as Overlay-import qualified Portage.PackageId as Portage--import Distribution.Verbosity-import Distribution.Pretty (prettyShow)-import qualified Distribution.Package as Cabal-import Distribution.Simple.Utils--import qualified Data.Map as Map--import Error--import Debug.Trace (trace)---- | If a package already exist in the overlay, find which category it has.--- If it does not exist, we default to \'dev-haskell\'.-resolveCategory :: Verbosity -> Overlay.Overlay -> Cabal.PackageName -> IO Portage.Category-resolveCategory verbosity overlay pn = do-  info verbosity "Searching for which category to use..."-  case resolveCategories overlay pn of-    [] -> do-      info verbosity "No previous version of this package, defaulting category to dev-haskell."-      return devhaskell-    [cat] -> do-      info verbosity $ "Exact match of already existing package, using category: "-                         ++ prettyShow cat-      return cat-    cats -> do-      warn verbosity $ "Multiple matches of categories: " ++ unwords (map prettyShow cats)-      if devhaskell `elem` cats-        then do notice verbosity "Defaulting to dev-haskell"-                return devhaskell-        else do warn verbosity "Multiple matches and no known default. Override by specifying "-                warn verbosity "package category like so  'hackport merge categoryname/package[-version]."-                throwEx (ArgumentError "Specify package category and try again.")-  where-  devhaskell = Portage.Category "dev-haskell"--resolveCategories :: Overlay.Overlay -> Cabal.PackageName -> [Portage.Category]-resolveCategories overlay pn =-  [ cat -  | (Portage.PackageName cat pn') <- Map.keys om-  , Portage.normalizeCabalPackageName pn == pn'-  ]-  where-    om = Overlay.overlayMap overlay--resolveFullPortageName :: Overlay.Overlay -> Cabal.PackageName -> Maybe Portage.PackageName-resolveFullPortageName overlay pn =-  case resolveCategories overlay pn of-    [] -> Nothing-    [cat] -> ret cat-    cats | (cat:_) <- (filter (`elem` cats) priority) -> ret cat-         | otherwise -> trace ("Ambiguous package name: " ++ show pn ++ ", hits: " ++ show cats) Nothing-  where-  ret c = return (Portage.PackageName c (Portage.normalizeCabalPackageName pn))-  mkC = Portage.Category-  -- if any of these categories show up in the result list, the match isn't-  -- ambiguous, pick the first match in the list-  priority = [ mkC "dev-haskell"-             , mkC "sys-libs"-             , mkC "dev-libs"-             , mkC "x11-libs"-             , mkC "media-libs"-             , mkC "net-libs"-             , mkC "sci-libs"-             ]
− Portage/Tables.hs 
@@ -1,37 +0,0 @@-{-|-Module      : Portage.Tables-License     : GPL-3+-Maintainer  : haskell@gentoo.org--Tables of Portage-specific conversions.--}-module Portage.Tables-  ( set_build_slot-  ) where--import Portage.Dependency.Builder-import Portage.Dependency.Types-import Portage.PackageId--import Data.Monoid---- | Set the @SLOT@ for a given 'Dependency'.-set_build_slot :: Dependency -> Dependency-set_build_slot = -  overAtom $ \a@(Atom pn dr (DAttr _ u)) -> -      case mconcat $ map (First . matches a) slottedPkgs of-          First (Just s) -> Atom pn dr (DAttr s u)-          First Nothing  -> Atom pn dr (DAttr AnyBuildTimeSlot u)-    where-      matches (Atom pn _ _) (nm,s) -        | pn == nm  = Just s-        | otherwise = Nothing---- | List of 'PackageName's with their corresponding default 'SlotDepend's.------ For example, dependency @QuickCheck@ has its @SLOT@ always set to @2@.-slottedPkgs :: [(PackageName, SlotDepend)]-slottedPkgs =-  [ (mkPackageName "dev-haskell" "quickcheck", GivenSlot "2=")-  , (mkPackageName "dev-haskell" "hdbc", GivenSlot "2=")-  ]
− Portage/Use.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}--module Portage.Use (-  -- * main structures-  UseFlag(..),-  Use(..),-  dispUses,-  -- * helpers-  mkUse,-  mkNotUse,-  mkQUse-  ) where--import qualified Text.PrettyPrint as Disp-import Text.PrettyPrint ((<>))-import Distribution.Pretty (Pretty(..))--import           Control.DeepSeq (NFData(..))--#if MIN_VERSION_base(4,11,0)-import Prelude hiding ((<>))-#endif---- | Use variable modificator-data UseFlag = UseFlag Use           -- ^ no modificator-             | E UseFlag             -- ^ = modificator (Equiv    mark)-             | Q UseFlag             -- ^ ? modificator (Question mark)-             | X UseFlag             -- ^ ! modificator (eXclamation mark)-             | N UseFlag             -- ^ - modificator -             deriving (Eq,Show,Ord,Read)--instance NFData UseFlag where-  rnf (UseFlag u) = rnf u-  rnf (E f) = rnf f-  rnf (Q f) = rnf f-  rnf (X f) = rnf f-  rnf (N f) = rnf f--instance Pretty UseFlag where-  pretty = showModificator--mkUse :: Use -> UseFlag-mkUse  = UseFlag --mkNotUse :: Use -> UseFlag-mkNotUse = N . UseFlag--mkQUse :: Use -> UseFlag-mkQUse = Q . UseFlag--showModificator :: UseFlag -> Disp.Doc-showModificator (UseFlag u) = pretty u-showModificator (X u)     = Disp.char '!' <> pretty u-showModificator (Q u)     = pretty u <> Disp.char '?'-showModificator (E u)     = pretty u <> Disp.char '='-showModificator (N u)     = Disp.char '-' <> pretty u--dispUses :: [UseFlag] -> Disp.Doc-dispUses [] = Disp.empty-dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map pretty us--newtype Use = Use String-    deriving (Eq, Read, Show)--instance NFData Use where-  rnf (Use s) = rnf s--instance Pretty Use where-  pretty (Use u) = Disp.text u--instance Ord Use where-    compare (Use a) (Use b) = case (a,b) of-        ("test", "test") -> EQ-        ("test", _)      -> LT-        (_, "test")      -> GT-        (_, _)           -> a `compare` b
− Portage/Version.hs 
@@ -1,146 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-    Author      :  Andres Loeh <kosmikus@gentoo.org>-    Stability   :  provisional-    Portability :  haskell98--    Version parser, according to Portage spec.--    Shamelessly borrowed from exi, ported from Parsec to ReadP---}-module Portage.Version (-    Version(..),-    Suffix(..),-    fromCabalVersion,-    toCabalVersion,-    is_live-  ) where--import qualified Distribution.Version as Cabal--import           Distribution.Pretty (Pretty(..))--import           Distribution.Parsec (Parsec(..))-import qualified Distribution.Compat.CharParsing as P-import qualified Text.PrettyPrint as Disp-import           Text.PrettyPrint ((<>))-import qualified Data.List.NonEmpty as NE--import           Control.DeepSeq (NFData(..))--#if MIN_VERSION_base(4,11,0)-import Prelude hiding ((<>))-#endif---- | Portage-style version type.-data Version = Version { versionNumber   :: [Int]        -- ^ @[1,42,3]@ ~= 1.42.3-                       , versionChar     :: (Maybe Char) -- ^ optional letter-                       , versionSuffix   :: [Suffix]-                       , versionRevision :: Int          -- ^ revision, 0 means none-                       }-  deriving (Eq, Ord, Show, Read)--instance NFData Version where-  rnf (Version n c s r) = rnf n `seq` rnf c `seq` rnf s `seq` rnf r---- | Prints a valid Portage 'Version' string.-instance Pretty Version where-  pretty (Version ver c suf rev) =-    dispVer ver <> dispC c <> dispSuf suf <> dispRev rev-    where-      dispVer   = Disp.hcat . Disp.punctuate (Disp.char '.') . map Disp.int-      dispC     = maybe Disp.empty Disp.char-      dispSuf   = Disp.hcat . map pretty-      dispRev 0 = Disp.empty-      dispRev n = Disp.text "-r" <> Disp.int n---- | 'Version' parser using 'Parsec'.-instance Parsec Version where-  parsec = do-    ver <- P.sepByNonEmpty digits (P.char '.')-    c   <- P.optional P.lower-    suf <- P.many parsec-    rev <- P.option 0 $ P.string "-r" *> digits-    return $ Version (NE.toList ver) c suf rev---- | Check if the ebuild is a live ebuild, i.e. if its 'Version' is @9999@.------ foo-9999* is treated as live ebuild--- Cabal-1.17.9999* as well------ >>> let (c,s,r) = (Nothing,[],0)--- >>> is_live (Version [1,0,0] c s r)--- False--- >>> is_live (Version [999] c s r)--- False--- >>> is_live (Version [1,0,0,9999] c s r)--- True--- >>> is_live (Version [9999] c s r)--- True------ $--- prop> \verNum char rev -> is_live (Version verNum char [] rev) == if length verNum >= 1 && last verNum >= 9999 then True else False-is_live :: Version -> Bool-is_live v =-    case vs of-        -- nonempty-        (_:_) | many_nines (last vs) -> True-        _                            -> False-  where vs = versionNumber v-        many_nines n = is_big n && all_nines n-        is_big n     = n >= 9999-        all_nines n  = (all (== '9') . show) n---- | Various allowed suffixes in Portage versions.-data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int-  deriving (Eq, Ord, Show, Read)--instance NFData Suffix where-  rnf (Alpha n) = rnf n-  rnf (Beta n)  = rnf n-  rnf (Pre n)   = rnf n-  rnf (RC n)    = rnf n-  rnf (P n)     = rnf n--instance Pretty Suffix where-  pretty suf = case suf of-    Alpha n -> Disp.text "_alpha" <> dispPos n-    Beta n  -> Disp.text "_beta"  <> dispPos n-    Pre n   -> Disp.text "_pre"   <> dispPos n-    RC n    -> Disp.text "_rc"    <> dispPos n-    P  n    -> Disp.text "_p"     <> dispPos n--    where-      dispPos :: Int -> Disp.Doc-      dispPos 0 = Disp.empty-      dispPos n = Disp.int n--instance Parsec Suffix where-  parsec = P.char '_'-       *> P.choice-    [ P.string "alpha"       >> fmap Alpha maybeDigits-    , P.string "beta"        >> fmap Beta  maybeDigits-    , P.try (P.string "pre") >> fmap Pre   maybeDigits-    , P.string "rc"          >> fmap RC    maybeDigits-    , P.string "p"           >> fmap P     maybeDigits-    ]-    where-      maybeDigits = P.option 0 digits---- | Convert from a 'Cabal.Version' to a Portage 'Version'.--- --- prop> \verNum -> fromCabalVersion (Cabal.mkVersion verNum) == Version verNum Nothing [] 0-fromCabalVersion :: Cabal.Version -> Version-fromCabalVersion cabal_version = Version (Cabal.versionNumbers cabal_version) Nothing [] 0---- | Convert from a Portage 'Version' to a 'Cabal.Version'.--- $--- prop> \verNum char rev -> toCabalVersion (Version verNum char [] rev) == if char == Nothing then Just (Cabal.mkVersion verNum) else Nothing-toCabalVersion :: Version -> Maybe Cabal.Version-toCabalVersion (Version nums Nothing [] _) = Just (Cabal.mkVersion nums)-toCabalVersion _                           = Nothing---- | Parser which munches digits.-digits :: P.CharParsing m => m Int-digits = read <$> P.some P.digit
Setup.hs view
@@ -1,7 +1,6 @@-#!/usr/bin/runhaskell module Main (main) where -import Distribution.Simple+import Distribution.Extra.Doctest ( defaultMainWithDoctests )  main :: IO ()-main = defaultMain+main = defaultMainWithDoctests "doctests"
− Status.hs 
@@ -1,258 +0,0 @@-module Status-    ( FileStatus(..)-    , StatusDirection(..)-    , fromStatus-    , status-    , runStatus-    ) where--import AnsiColor--import qualified Portage.Version as V (is_live)--import Portage.Overlay-import Portage.PackageId-import Portage.Resolve--import qualified Data.List as List--import qualified Data.ByteString.Char8 as BS--import Data.Char-import Data.Function (on)-import qualified Data.Map as Map-import Data.Map as Map (Map)--import qualified Data.Traversable as T-import Control.Monad---- cabal-import qualified Distribution.Verbosity as Cabal-import qualified Distribution.Package as Cabal (pkgName)-import qualified Distribution.Simple.Utils as Cabal (comparing, die', equating)-import Distribution.Pretty (prettyShow)-import Distribution.Parsec (simpleParsec)--import qualified Distribution.Client.GlobalFlags as CabalInstall-import qualified Distribution.Client.IndexUtils as CabalInstall-import qualified Distribution.Client.Types as CabalInstall ( SourcePackageDb(..) )-import qualified Distribution.Solver.Types.PackageIndex as CabalInstall-import qualified Distribution.Solver.Types.SourcePackage as CabalInstall ( SourcePackage(..) )--data StatusDirection-    = PortagePlusOverlay-    | OverlayToPortage-    | HackageToOverlay-    deriving Eq--data FileStatus a-        = Same a-        | Differs a a-        | OverlayOnly a-        | PortageOnly a-        | HackageOnly a-        deriving (Show,Eq)--instance Ord a => Ord (FileStatus a) where-    compare = Cabal.comparing fromStatus--instance Functor FileStatus where-    fmap f st =-        case st of-            Same a -> Same (f a)-            Differs a b -> Differs (f a) (f b)-            OverlayOnly a -> OverlayOnly (f a)-            PortageOnly a -> PortageOnly (f a)-            HackageOnly a -> HackageOnly (f a)--fromStatus :: FileStatus a -> a-fromStatus fs =-    case fs of-        Same a -> a-        Differs a _ -> a -- second status is lost-        OverlayOnly a -> a-        PortageOnly a -> a-        HackageOnly a -> a----loadHackage :: Cabal.Verbosity -> CabalInstall.RepoContext -> Overlay -> IO [[PackageId]]-loadHackage verbosity repoContext overlay = do-    CabalInstall.SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity repoContext-    let get_cat cabal_pkg = case resolveCategories overlay (Cabal.pkgName cabal_pkg) of-                                []    -> Category "dev-haskell"-                                [cat] -> cat-                                _     -> {- ambig -} Category "dev-haskell"-        pkg_infos = map ( reverse . take 3 . reverse -- hackage usually has a ton of older versions-                        . map ((\p -> fromCabalPackageId (get_cat p) p)-                              . CabalInstall.srcpkgPackageId))-                        (CabalInstall.allPackagesByName pindex)-    return pkg_infos--status :: Cabal.Verbosity -> FilePath -> FilePath -> CabalInstall.RepoContext -> IO (Map PackageName [FileStatus ExistingEbuild])-status verbosity portdir overlaydir repoContext = do-    overlay <- loadLazy overlaydir-    hackage <- loadHackage verbosity repoContext overlay-    portage <- filterByEmail ("haskell@gentoo.org" `elem`) <$> loadLazy portdir-    let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)--    both' <- T.forM both $ mapM $ \e -> do-            -- can't fail, we know the ebuild exists in both portagedirs-            -- also, one of them is already bound to 'e'-            let (Just e1) = lookupEbuildWith (overlayMap portage) (ebuildId e)-                (Just e2) = lookupEbuildWith (overlayMap overlay) (ebuildId e)-            eq <- equals (ebuildPath e1) (ebuildPath e2)-            return $ if eq-                        then Same e1-                        else Differs e1 e2--    let p_to_ee :: PackageId -> ExistingEbuild-        p_to_ee p = ExistingEbuild p cabal_p ebuild_path-            where Just cabal_p = toCabalPackageId p -- lame doubleconv-                  ebuild_path = packageIdToFilePath p-        mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])-        mk_fake_ee ~pkgs@(p:_) = (packageId p, map p_to_ee pkgs)--        map_diff = Map.differenceWith (\le re -> Just $ foldr (List.deleteBy (Cabal.equating ebuildId)) le re)-        hack = (( -- We merge package names as we do case-insensitive match.-                  -- Hackage contains the following 2 package names:-                  --   ... Cabal-1.24.0.0 Cabal-1.24.1.0-                  --   cabal-0.0.0.0-                  -- We need to pick both lists of versions, not the first.-                  -- TODO: have a way to distict between them in the output.-                  Map.fromListWith (++) $-                      map mk_fake_ee hackage) `map_diff` overlayMap overlay) `map_diff` overlayMap portage--        meld = Map.unionsWith (\a b -> List.sort (a++b))-                [ Map.map (map PortageOnly) port-                , both'-                , Map.map (map OverlayOnly) over-                , Map.map (map HackageOnly) hack-                ]-    return meld--type EMap = Map PackageName [ExistingEbuild]--lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild-lookupEbuildWith overlay pkgid = do-  ebuilds <- Map.lookup (packageId pkgid) overlay-  List.find (\e -> ebuildId e == pkgid) ebuilds--runStatus :: Cabal.Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> CabalInstall.RepoContext -> IO ()-runStatus verbosity portdir overlaydir direction pkgs repoContext = do-  let pkgFilter = case direction of-                      OverlayToPortage   -> toPortageFilter-                      PortagePlusOverlay -> id-                      HackageToOverlay   -> fromHackageFilter-  pkgs' <- forM pkgs $ \p ->-            case simpleParsec p of-              Nothing -> Cabal.die' verbosity ("Could not parse package name: " ++ p ++ ". Format cat/pkg")-              Just pn -> return pn-  tree0 <- status verbosity portdir overlaydir repoContext-  let tree = pkgFilter tree0-  if (null pkgs')-    then statusPrinter tree-    else forM_ pkgs' $ \pkg -> statusPrinter (Map.filterWithKey (\k _ -> k == pkg) tree)---- |Only return packages that seems interesting to sync to portage;------   * Ebuild differs, or---   * Newer version in overlay than in portage-toPortageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]-toPortageFilter = Map.mapMaybe $ \ sts ->-    let filter_out_lives = filter (not . V.is_live . pkgVersion . ebuildId . fromStatus)-        inPortage = flip filter sts $ \st ->-                        case st of-                            OverlayOnly _ -> False-                            HackageOnly _ -> False-                            _ -> True-        latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage-        interestingPackages = flip filter sts $ \st ->-            case st of-                HackageOnly _ -> False-                Differs _ _ -> True-                _ | pkgVersion (ebuildId (fromStatus st)) > latestPortageVersion -> True-                  | otherwise -> False-    in if not (null inPortage) && not (null $ filter_out_lives interestingPackages)-        then Just sts-        else Nothing---- |Only return packages that exist in overlay or portage but look outdated-fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]-fromHackageFilter = Map.mapMaybe $ \ sts ->-    let inEbuilds = flip filter sts $ \st ->-                        case st of-                            HackageOnly _ -> False-                            _ -> True-        -- treat live as oldest version not avoid masking hackage releases-        mangle_live_versions v-            | V.is_live v = v {versionNumber=[-1]}-            | otherwise   = v-        latestVersion = List.maximumBy (compare `on` mangle_live_versions . pkgVersion . ebuildId . fromStatus) sts-    in case latestVersion of-            HackageOnly _ | not (null inEbuilds) -> Just sts-            _                                    -> Nothing--statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()-statusPrinter packages = do-    putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"-    putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"-    putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"-    putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"-    putStrLn $ toColor (HackageOnly "Cyan") ++ ": package only exist on hackage"-    forM_ (zip [(1 :: Int) ..] $ Map.toAscList packages) $ \(ix, (pkg, ebuilds)) -> do-        let (PackageName c p) = pkg-        putStr (bold (show ix))-        putStr " "-        putStr $ prettyShow c ++ '/' : bold (prettyShow p)-        putStr " "-        forM_ ebuilds $ \e -> do-            putStr $ toColor (fmap (prettyShow . pkgVersion . ebuildId) e)-            putChar ' '-        putStrLn ""--toColor :: FileStatus String -> String-toColor st = inColor c False Default (fromStatus st)-    where-    c = case st of-        (Same _) -> Green-        (Differs _ _) -> Yellow-        (OverlayOnly _) -> Red-        (PortageOnly _) -> Magenta-        (HackageOnly _) -> Cyan--portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)-portageDiff p1 p2 = (in1, ins, in2)-    where ins = Map.filter (not . null) $ Map.intersectionWith (List.intersectBy $ Cabal.equating ebuildId) p1 p2-          in1 = difference p1 p2-          in2 = difference p2 p1-          difference x y = Map.filter (not . null) $-                       Map.differenceWith (\xs ys ->-                        let lst = foldr (List.deleteBy (Cabal.equating ebuildId)) xs ys in-                        if null lst-                            then Nothing-                            else Just lst-                            ) x y---- | Compares two ebuilds, returns True if they are equal.---   Disregards comments.-equals :: FilePath -> FilePath -> IO Bool-equals fp1 fp2 = do-    -- don't leave halfopenfiles-    f1 <- BS.readFile fp1-    f2 <- BS.readFile fp2-    return (equal' f1 f2)--equal' :: BS.ByteString -> BS.ByteString -> Bool-equal' = Cabal.equating essence-    where-    essence = filter (not . isEmpty)-            . filter (not . isComment)-            . filter (not . isHOMEPAGE)-            . BS.lines-    isComment = BS.isPrefixOf (BS.pack "#") . BS.dropWhile isSpace-    -- HOMEPAGE= frequently gets updated for http:// / https://.-    -- It's to much noise usually and should really be fixed-    -- in upstream Cabal definition.-    isHOMEPAGE = BS.isPrefixOf (BS.pack "HOMEPAGE=") . BS.dropWhile isSpace-    isEmpty = BS.null . BS.dropWhile isSpace
− Util.hs 
@@ -1,31 +0,0 @@-{-|-    Author      :  Sergei Trofimovich <slyfox@inbox.ru>-    Stability   :  experimental-    Portability :  haskell98--    Ungrouped utilitary stuff lays here until someone finds better place for it :]--}--module Util-    ( run_cmd -- :: String -> IO (Maybe String)-    ) where--import System.IO-import System.Process-import System.Exit (ExitCode(..))---- 'run_cmd' executes command and returns it's standard output--- as 'String'.--run_cmd :: String -> IO (Maybe String)-run_cmd cmd = do (hI, hO, hE, hProcess) <- runInteractiveCommand cmd-                 hClose hI-                 output <- hGetContents hO-                 errors <- hGetContents hE -- TODO: propagate error to caller-                 length output `seq` hClose hO-                 length errors `seq` hClose hE--                 exitCode <- waitForProcess hProcess-                 return $ if (output == "" || exitCode /= ExitSuccess)-                          then Nothing-                          else Just output
+ exe/Main.hs view
@@ -0,0 +1,491 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Control.Monad+import Data.Maybe+import Data.List+import qualified Data.Semigroup as S++-- cabal+import Distribution.Simple.Setup+        ( Flag(..), fromFlag+        , trueArg+        , optionVerbosity+        )++import Distribution.Simple.Command -- commandsRun+import Distribution.Simple.Utils ( dieNoVerbosity, cabalVersion, warn )+import qualified Distribution.PackageDescription.Parsec as Cabal+import qualified Distribution.Package as Cabal+import Distribution.Verbosity (Verbosity, normal)++import Data.Version (showVersion)+import Distribution.Pretty (prettyShow)+import Distribution.Parsec (simpleParsec)++import qualified Distribution.Client.Setup as CabalInstall+import qualified Distribution.Client.Types as CabalInstall+import qualified Distribution.Client.Update as CabalInstall++import qualified Distribution.Client.IndexUtils as CabalInstall+import qualified Distribution.Solver.Types.SourcePackage as CabalInstall+import qualified Distribution.Solver.Types.PackageIndex as CabalInstall++import Portage.Overlay as Overlay ( loadLazy, inOverlay )+import Portage.Host as Host ( getInfo, portage_dir )+import Portage.PackageId ( normalizeCabalPackageId )++import System.Environment ( getArgs, getProgName )+import System.Directory ( doesDirectoryExist )+import System.Exit ( exitFailure )+{-# LANGUAGE CPP #-}++import System.FilePath ( (</>) )++import qualified HackPort.GlobalFlags as H++import Error+import Status+import Overlays+import Merge++import qualified Paths_cabal_install+import qualified Paths_hackport++-----------------------------------------------------------------------+-- List+-----------------------------------------------------------------------++data ListFlags = ListFlags {+    listVerbosity :: Flag Verbosity+  }++instance S.Semigroup ListFlags where+  a <> b = ListFlags {+    listVerbosity = combine listVerbosity+  }+    where combine field = field a S.<> field b++instance Monoid ListFlags where+  mempty = ListFlags {+    listVerbosity = mempty+  }+#if !(MIN_VERSION_base(4,11,0))+  mappend a b = ListFlags {+    listVerbosity = combine listVerbosity+  }+    where combine field = field a `mappend` field b+#endif++defaultListFlags :: ListFlags+defaultListFlags = ListFlags {+    listVerbosity = Flag normal+  }++listCommand :: CommandUI ListFlags+listCommand = CommandUI {+    commandName = "list",+    commandSynopsis = "List package versions matching pattern",+    commandUsage = usagePackages "list",+    commandDescription = Nothing,+    commandNotes = Nothing,++    commandDefaultFlags = defaultListFlags,+    commandOptions = \_showOrParseArgs ->+      [ optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v })+      {-+      , option [] ["overlay"]+         "Use cached packages list from specified overlay"+         listOverlayPath (\v flags -> flags { listOverlayPath = v })+         (reqArgFlag "PATH")+       -}+      ]+  }++listAction :: ListFlags -> [String] -> H.GlobalFlags -> IO ()+listAction flags extraArgs globalFlags = do+ let verbosity = fromFlag (listVerbosity flags)+ H.withHackPortContext verbosity globalFlags $ \repoContext -> do+  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)+  index <- fmap CabalInstall.packageIndex (CabalInstall.getSourcePackages verbosity repoContext)+  overlay <- Overlay.loadLazy overlayPath+  let pkgs | null extraArgs = CabalInstall.allPackages index+           | otherwise = concatMap (concatMap snd . CabalInstall.searchByNameSubstring index) extraArgs+      normalized = map (normalizeCabalPackageId . CabalInstall.srcpkgPackageId) pkgs+  let decorated = map (\p -> (Overlay.inOverlay overlay p, p)) normalized+  mapM_ (putStrLn . pretty) decorated+  where+  pretty :: (Bool, Cabal.PackageIdentifier) -> String+  pretty (isInOverlay, pkgId) =+      let dec | isInOverlay = " * "+              | otherwise   = "   "+      in dec ++ prettyShow pkgId+++-----------------------------------------------------------------------+-- Make Ebuild+-----------------------------------------------------------------------++data MakeEbuildFlags = MakeEbuildFlags {+    makeEbuildVerbosity :: Flag Verbosity+  , makeEbuildCabalFlags :: Flag (Maybe String)+  }++instance S.Semigroup MakeEbuildFlags where+  a <> b = MakeEbuildFlags {+    makeEbuildVerbosity = combine makeEbuildVerbosity+  , makeEbuildCabalFlags = makeEbuildCabalFlags b+  }+    where combine field = field a S.<> field b++instance Monoid MakeEbuildFlags where+  mempty = MakeEbuildFlags {+    makeEbuildVerbosity = mempty+  , makeEbuildCabalFlags = mempty+  }+#if !MIN_VERSION_base(4,11,0)+  mappend a b = MakeEbuildFlags {+    makeEbuildVerbosity = combine makeEbuildVerbosity+  , makeEbuildCabalFlags = makeEbuildCabalFlags b+  }+    where combine field = field a `mappend` field b+#endif++defaultMakeEbuildFlags :: MakeEbuildFlags+defaultMakeEbuildFlags = MakeEbuildFlags {+    makeEbuildVerbosity = Flag normal+  , makeEbuildCabalFlags = Flag Nothing+  }++makeEbuildAction :: MakeEbuildFlags -> [String] -> H.GlobalFlags -> IO ()+makeEbuildAction flags args globalFlags = do+  (catstr,cabals) <- case args of+                      (category:cabal1:cabaln) -> return (category, cabal1:cabaln)+                      _ -> throwEx (ArgumentError "make-ebuild needs at least two arguments. <category> <cabal-1> <cabal-n>")+  cat <- case simpleParsec catstr of+            Just c -> return c+            Nothing -> throwEx (ArgumentError ("could not parse category: " ++ catstr))+  let verbosity = fromFlag (makeEbuildVerbosity flags)+  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)+  forM_ cabals $ \cabalFileName -> do+    pkg <- Cabal.readGenericPackageDescription normal cabalFileName+    mergeGenericPackageDescription verbosity overlayPath cat pkg False (fromFlag $ makeEbuildCabalFlags flags)++makeEbuildCommand :: CommandUI MakeEbuildFlags+makeEbuildCommand = CommandUI {+    commandName = "make-ebuild",+    commandSynopsis = "Make an ebuild from a .cabal file",+    commandUsage = \_ -> [],+    commandDescription = Nothing,+    commandNotes = Nothing,++    commandDefaultFlags = defaultMakeEbuildFlags,+    commandOptions = \_showOrParseArgs ->+      [ optionVerbosity makeEbuildVerbosity (\v flags -> flags { makeEbuildVerbosity = v })++      , option "f" ["flags"]+        (unlines [ "Set cabal flags to certain state."+                 , "Example: --flags=-all_extensions"+                 ])+        makeEbuildCabalFlags+        (\cabal_flags v -> v{ makeEbuildCabalFlags = cabal_flags })+        (reqArg' "cabal_flags" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))+      ]+  }++-----------------------------------------------------------------------+-- Update+-----------------------------------------------------------------------++data UpdateFlags = UpdateFlags {+    updateVerbosity :: Flag Verbosity+  }++instance S.Semigroup UpdateFlags where+  a <> b = UpdateFlags {+    updateVerbosity = combine updateVerbosity+  }+    where combine field = field a S.<> field b++instance Monoid UpdateFlags where+  mempty = UpdateFlags {+    updateVerbosity = mempty+  }+#if !(MIN_VERSION_base(4,11,0))+  mappend a b = UpdateFlags {+    updateVerbosity = combine updateVerbosity+  }+    where combine field = field a `mappend` field b+#endif++defaultUpdateFlags :: UpdateFlags+defaultUpdateFlags = UpdateFlags {+    updateVerbosity = Flag normal+  }++updateCommand :: CommandUI UpdateFlags+updateCommand = CommandUI {+    commandName = "update",+    commandSynopsis = "Update the local package database",+    commandUsage = usageFlags "update",+    commandDescription = Nothing,+    commandNotes = Nothing,++    commandDefaultFlags = defaultUpdateFlags,+    commandOptions = \_ ->+      [ optionVerbosity updateVerbosity (\v flags -> flags { updateVerbosity = v })++      {-+      , option [] ["server"]+          "Set the server you'd like to update the cache from"+          updateServerURI (\v flags -> flags { updateServerURI = v} )+          (reqArgFlag "SERVER")+      -}+      ]+  }++updateAction :: UpdateFlags -> [String] -> H.GlobalFlags -> IO ()+updateAction flags extraArgs globalFlags = do+  unless (null extraArgs) $+    dieNoVerbosity $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs+  let verbosity = fromFlag (updateVerbosity flags)++  H.withHackPortContext verbosity globalFlags $ \repoContext ->+    -- TODO: parse user's flags as cabal-iinstall does.+    -- Currently I'm lazy to adapt new flag and user:+    --    defaultUpdateFlags+    let updateFlags = commandDefaultFlags CabalInstall.updateCommand+    in CabalInstall.update verbosity updateFlags repoContext++-----------------------------------------------------------------------+-- Status+-----------------------------------------------------------------------++data StatusFlags = StatusFlags {+    statusVerbosity :: Flag Verbosity,+    statusDirection :: Flag StatusDirection+  }++defaultStatusFlags :: StatusFlags+defaultStatusFlags = StatusFlags {+    statusVerbosity = Flag normal,+    statusDirection = Flag PortagePlusOverlay+  }++statusCommand :: CommandUI StatusFlags+statusCommand = CommandUI {+    commandName = "status",+    commandSynopsis = "Show up-to-date status against other repos (hackage, ::gentoo)",+    commandUsage = usagePackages "status",+    commandDescription = Nothing,+    commandNotes = Nothing,++    commandDefaultFlags = defaultStatusFlags,+    commandOptions = \_ ->+      [ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })+      , option [] ["to-portage"]+          "Print only packages likely to be interesting to move to the portage tree."+          statusDirection (\v flags -> flags { statusDirection = v })+          (noArg (Flag OverlayToPortage))+      , option [] ["from-hackage"]+          "Print only packages likely to be interesting to move from hackage tree."+          statusDirection (\v flags -> flags { statusDirection = v })+          (noArg (Flag HackageToOverlay))+      ]+  }++statusAction :: StatusFlags -> [String] -> H.GlobalFlags -> IO ()+statusAction flags args globalFlags = do+  let verbosity = fromFlag (statusVerbosity flags)+      direction = fromFlag (statusDirection flags)+  portagePath <- getPortageDir verbosity globalFlags+  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)++  H.withHackPortContext verbosity globalFlags $ \repoContext ->+      runStatus verbosity portagePath overlayPath direction args repoContext++-----------------------------------------------------------------------+-- Merge+-----------------------------------------------------------------------++data MergeFlags = MergeFlags {+    mergeVerbosity :: Flag Verbosity+  , mergeCabalFlags :: Flag (Maybe String)+  }++instance S.Semigroup MergeFlags where+  a <> b = MergeFlags {+    mergeVerbosity = combine mergeVerbosity+  , mergeCabalFlags = mergeCabalFlags b+  }+    where combine field = field a S.<> field b++instance Monoid MergeFlags where+  mempty = MergeFlags {+    mergeVerbosity = mempty+  , mergeCabalFlags = mempty+  }+#if !(MIN_VERSION_base(4,11,0))+  mappend a b = MergeFlags {+    mergeVerbosity = combine mergeVerbosity+  , mergeCabalFlags = mergeCabalFlags b+  }+    where combine field = field a `mappend` field b+#endif++defaultMergeFlags :: MergeFlags+defaultMergeFlags = MergeFlags {+    mergeVerbosity = Flag normal+  , mergeCabalFlags = Flag Nothing+  }++mergeCommand :: CommandUI MergeFlags+mergeCommand = CommandUI {+    commandName = "merge",+    commandSynopsis = "Make an ebuild out of hackage package",+    commandUsage = usagePackages "merge",+    commandDescription = Nothing,+    commandNotes = Nothing,++    commandDefaultFlags = defaultMergeFlags,+    commandOptions = \_showOrParseArgs ->+      [ optionVerbosity mergeVerbosity (\v flags -> flags { mergeVerbosity = v })++      , option "f" ["flags"]+        (unlines [ "Set cabal flags to certain state."+                 , "Example: --flags=-all_extensions"+                 ])+        mergeCabalFlags+        (\cabal_flags v -> v{ mergeCabalFlags = cabal_flags})+        (reqArg' "cabal_flags" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))+      ]+  }++mergeAction :: MergeFlags -> [String] -> H.GlobalFlags -> IO ()+mergeAction flags extraArgs globalFlags = do+  let verbosity = fromFlag (mergeVerbosity flags)+  overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)++  H.withHackPortContext verbosity globalFlags $ \repoContext ->+    merge verbosity repoContext extraArgs overlayPath (fromFlag $ mergeCabalFlags flags)++-----------------------------------------------------------------------+-- Utils+-----------------------------------------------------------------------++usagePackages :: String -> String -> String+usagePackages op_name pname =+  "Usage: " ++ pname ++ " " ++ op_name ++ " [FLAGS] [PACKAGE]\n\n"+  ++ "Flags for " ++ op_name ++ ":"++usageFlags :: String -> String -> String+usageFlags flag_name pname =+      "Usage: " ++ pname ++ " " ++ flag_name ++ " [FLAGS]\n\n"+      ++ "Flags for " ++ flag_name ++ ":"++getPortageDir :: Verbosity -> H.GlobalFlags -> IO FilePath+getPortageDir verbosity globalFlags = do+  let portagePathM =  fromFlag (H.globalPathToPortage globalFlags)+  portagePath <- case portagePathM of+                   Nothing -> Host.portage_dir <$> Host.getInfo+                   Just path -> return path+  exists <- doesDirectoryExist $ portagePath </> "dev-haskell"+  when (not exists) $+    warn verbosity $ "Looks like an invalid portage directory: " ++ portagePath+  return portagePath++-----------------------------------------------------------------------+-- Main+-----------------------------------------------------------------------++globalCommand :: CommandUI H.GlobalFlags+globalCommand = CommandUI {+    commandName = "",+    commandSynopsis = "HackPort is an .ebuild generator from .cabal files with hackage index support",+    commandDescription = Just $ \pname ->+       let+         commands' = commands ++ [commandAddAction helpCommandUI undefined]+         cmdDescs = getNormalCommandDescriptions commands'+         maxlen    = maximum $ [length name | (name, _) <- cmdDescs]+         align str = str ++ replicate (maxlen - length str) ' '+       in+          "Commands:\n"+       ++ unlines [ "  " ++ align name ++ "    " ++ descr+                  | (name, descr) <- cmdDescs ]+       ++ "\n"+       ++ "For more information about a command use\n"+       ++ "  " ++ pname ++ " COMMAND --help\n\n"+       ++ "Typical steps for generating ebuilds from hackage packages:\n"+       ++ concat [ "  " ++ pname ++ " " ++ x ++ "\n"+                 | x <- ["update", "merge <package>"]]+       ++ "\n"+       ++ "Advanced usage:\n"+       ++ concat [ "  " ++ pname ++ " " ++ x ++ "\n"+                 | x <- ["update", "make-ebuild <CATEGORY> <ebuild.name>"]],++    commandNotes = Nothing,+    commandUsage = \pname -> "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",+    commandDefaultFlags = H.defaultGlobalFlags,+    commandOptions = \_showOrParseArgs ->+        [ option ['V'] ["version"]+            "Print version information"+            H.globalVersion (\v flags -> flags { H.globalVersion = v })+            trueArg+        , option [] ["numeric-version"]+            "Print just the version number"+            H.globalNumericVersion (\v flags -> flags { H.globalNumericVersion = v })+            trueArg+        , option ['p'] ["overlay-path"]+            "Override search path list where .hackport/ lives (default list: ['.', paludis-ovls or emerge-ovls])"+            H.globalPathToOverlay (\ovrl_path flags -> flags { H.globalPathToOverlay = ovrl_path })+            (reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))+        , option [] ["portage-path"]+            "Override path to your portage tree"+            H.globalPathToPortage (\port_path flags -> flags { H.globalPathToPortage = port_path })+            (reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))+        ]+    }++mainWorker :: [String] -> IO ()+mainWorker args =+  case commandsRun globalCommand commands args of+    CommandHelp help -> printHelp help+    CommandList opts -> printOptionsList opts+    CommandErrors errs -> printErrors errs+    CommandReadyToGo (globalflags, commandParse) -> do+      case commandParse of+        _ | fromFlag (H.globalVersion globalflags)        -> printVersion+          | fromFlag (H.globalNumericVersion globalflags) -> printNumericVersion+        CommandHelp help        -> printHelp help+        CommandList opts        -> printOptionsList opts+        CommandErrors errs      -> printErrors errs+        CommandReadyToGo action -> catchEx (action globalflags) errorHandler+    where+    printHelp help = getProgName >>= putStr . help+    printOptionsList = putStr . unlines+    printErrors errs = do+      putStr (concat (intersperse "\n" errs))+      exitFailure+    printNumericVersion = putStrLn $ showVersion Paths_hackport.version+    printVersion        = putStrLn $ "hackport version "+                                  ++ showVersion Paths_hackport.version+                                  ++ "\nusing cabal-install "+                                  ++ showVersion Paths_cabal_install.version+                                  ++ " and the Cabal library version "+                                  ++ prettyShow cabalVersion+    errorHandler :: HackPortError -> IO ()+    errorHandler e = do+      putStrLn (hackPortShowError e)++commands :: [Command (H.GlobalFlags -> IO ())]+commands =+      [ listCommand `commandAddAction` listAction+      , makeEbuildCommand `commandAddAction` makeEbuildAction+      , statusCommand `commandAddAction` statusAction+      , updateCommand `commandAddAction` updateAction+      , mergeCommand `commandAddAction` mergeAction+      ]++main :: IO ()+main = getArgs >>= mainWorker
hackport.cabal view
@@ -1,6 +1,6 @@ Cabal-Version:  2.2 Name:           hackport-Version:        0.7.1.1+Version:        0.7.1.2 License:        GPL-3.0-or-later License-file:   LICENSE Author:         Henning Günther, Duncan Coutts, Lennart Kolmodin@@ -15,128 +15,134 @@   type: git   location: git://github.com/gentoo-haskell/hackport.git -Executable    hackport-  ghc-options: -Wall -threaded +RTS -N -RTS -with-rtsopts=-N-  ghc-prof-options: -caf-all -auto-all -rtsopts-  Main-Is:    Main.hs+flag cabal-v1+  description: Build for cabal-v1 (Setup.hs/gentoo-haskell) compatibility+  manual: True+  default: False++library hackport-external-libs-Cabal   Default-Language: Haskell2010-  Hs-Source-Dirs:-      .,-      cabal,-      cabal/Cabal,-      cabal/cabal-install,-      hackage-security/hackage-security/src+  Hs-Source-Dirs: cabal, cabal/Cabal+   Build-Depends:-    array >= 0.4.0.1,-    base >= 4.9 && < 5,-    bytestring >= 0.10,-    containers >= 0.5,-    deepseq >= 1.3.0.1,-    directory >= 1.2,-    extensible-exceptions,-    filepath >= 1.3.0.1,-    HTTP >= 4000.1.5,-    network >= 2.6, network-uri >= 2.6,-    parallel >= 3.2.1.0,-    parsec >= 3.1.13,-    pretty >= 1.1.1,-    process >= 1.1.0.2,-    old-locale >= 1.0,-    split,-    tar >= 0.5,-    time >= 1.4.0.1,-    zlib >= 0.5.3,-    xml >= 1.3.7,-    -- cabal depends-    binary >= 0.5.1.1,-    text >= 1.2.3.0,-    transformers >= 0.3,-    unix >= 2.5,-    -- cabal-install depends-    async >= 2.0,-    hashable >= 1.0,-    random >= 1.0,-    stm >= 2.0,-    --  hackage-security depends-    base16-bytestring >= 0.1.1 && < 1.1,-    base64-bytestring >= 1.0,-    cryptohash-sha256 >= 0.11,-    ed25519,-    ghc-prim,-    lukko >= 0.1,-    mtl >= 2.1,-    template-haskell+    array         >= 0.4.0.1,+    base          >= 4.6 && <5,+    bytestring    >= 0.10.0.0,+    containers    >= 0.5.0.0,+    deepseq       >= 1.3.0.1,+    directory     >= 1.2,+    filepath      >= 1.3.0.1,+    pretty        >= 1.1.1,+    process       >= 1.1.0.2,+    time          >= 1.4.0.1,+    binary        >= 0.7,+    unix          >= 2.6,+    transformers  >=0.4.1.0,+    mtl           >= 2.1,+    text          >= 1.2.3.0,+    parsec        >= 3.1.13.0 -  default-extensions:-    -- hackage-security-    DefaultSignatures,-    DeriveDataTypeable,-    DoAndIfThenElse,-    EmptyDataDecls,-    ExistentialQuantification,-    ForeignFunctionInterface,-    FlexibleContexts,-    FlexibleInstances,-    GADTs,-    GeneralizedNewtypeDeriving,-    KindSignatures,-    MultiParamTypeClasses,-    -- cabal-    PatternGuards,-    RankNTypes,-    RecordWildCards,-    ScopedTypeVariables,-    StandaloneDeriving,-    TypeFamilies,-    TypeOperators,-    ViewPatterns   other-extensions:-    DeriveDataTypeable,-    -- extensions due to bundled cabal-install-    CPP,-    ForeignFunctionInterface,-    --  hackage-security extensions-    DefaultSignatures,-    GeneralizedNewtypeDeriving,-    GADTs,-    KindSignatures,-    RankNTypes,-    RecordWildCards,+    BangPatterns+    CPP+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    GeneralizedNewtypeDeriving+    ImplicitParams+    KindSignatures+    NondecreasingIndentation+    OverloadedStrings+    PatternSynonyms+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    Trustworthy+    TypeFamilies     TypeOperators+    TypeSynonymInstances+    UndecidableInstances +  exposed-modules:+    Distribution.CabalSpecVersion+    Distribution.Compat.Binary+    Distribution.Compat.CharParsing+    Distribution.Compat.Directory+    Distribution.Compat.Environment+    Distribution.Compat.Graph+    Distribution.Compat.Lens+    Distribution.Compat.NonEmptySet+    Distribution.Compat.Prelude.Internal+    Distribution.Compat.Time+    Distribution.Compat.Typeable+    Distribution.Compiler+    Distribution.FieldGrammar+    Distribution.FieldGrammar.Newtypes+    Distribution.Fields+    Distribution.Fields.ParseResult+    Distribution.InstalledPackageInfo+    Distribution.License+    Distribution.ModuleName+    Distribution.Package+    Distribution.PackageDescription+    Distribution.PackageDescription.Configuration+    Distribution.PackageDescription.Parsec+    Distribution.PackageDescription.PrettyPrint+    Distribution.Parsec+    Distribution.Parsec.Error+    Distribution.Parsec.Position+    Distribution.Parsec.Warning+    Distribution.Pretty+    Distribution.ReadE+    Distribution.SPDX+    Distribution.Simple.Command+    Distribution.Simple.Compiler+    Distribution.Simple.Configure+    Distribution.Simple.Flag+    Distribution.Simple.InstallDirs+    Distribution.Simple.PackageIndex+    Distribution.Simple.Program+    Distribution.Simple.Program.Db+    Distribution.Simple.Program.Run+    Distribution.Simple.Setup+    Distribution.Simple.Utils+    Distribution.SPDX.License+    Distribution.System+    Distribution.Text+    Distribution.Types.AnnotatedId+    Distribution.Types.ComponentId+    Distribution.Types.ComponentRequestedSpec+    Distribution.Types.ComponentName+    Distribution.Types.Dependency+    Distribution.Types.Flag+    Distribution.Types.GivenComponent+    Distribution.Types.InstalledPackageInfo+    Distribution.Types.LibraryName+    Distribution.Types.MungedPackageId+    Distribution.Types.PackageId+    Distribution.Types.PackageName+    Distribution.Types.PackageVersionConstraint+    Distribution.Types.SourceRepo+    Distribution.Types.UnitId+    Distribution.Types.UnqualComponentName+    Distribution.Types.Version+    Distribution.Types.VersionRange+    Distribution.Utils.Generic+    Distribution.Utils.NubList+    Distribution.Utils.ShortText+    Distribution.Utils.Structured+    Distribution.Verbosity+    Distribution.Version+    Language.Haskell.Extension+   other-modules:-    -- hackport modules-    AnsiColor-    Cabal2Ebuild-    Error-    HackPort.GlobalFlags-    Merge-    Merge.Dependencies-    Merge.Utils-    Overlays-    Paths_hackport-    Portage.Cabal-    Portage.Dependency-    Portage.Dependency.Builder-    Portage.Dependency.Normalize-    Portage.Dependency.Print-    Portage.Dependency.Types-    Portage.EBuild-    Portage.EBuild.CabalFeature-    Portage.EBuild.Render-    Portage.EMeta-    Portage.GHCCore-    Portage.Host-    Portage.Metadata-    Portage.Overlay-    Portage.PackageId-    Portage.Resolve-    Portage.Tables-    Portage.Use-    Portage.Version-    Status-    Util-    -- cabal modules      Distribution.Backpack     Distribution.Backpack.ComponentsGraph     Distribution.Backpack.Configure@@ -153,119 +159,37 @@     Distribution.Backpack.PreModuleShape     Distribution.Backpack.ReadyComponent     Distribution.Backpack.UnifyM-    Distribution.CabalSpecVersion-    Distribution.Client.BuildReports.Types-    Distribution.Client.CmdInstall.ClientInstallFlags-    Distribution.Client.Compat.Directory-    Distribution.Client.Compat.Orphans-    Distribution.Client.Compat.Prelude-    Distribution.Client.Compat.Semaphore-    Distribution.Client.Config-    Distribution.Client.Dependency.Types-    Distribution.Client.FetchUtils-    Distribution.Client.GZipUtils-    Distribution.Client.GlobalFlags-    Distribution.Client.HashValue-    Distribution.Client.HttpUtils-    Distribution.Client.IndexUtils-    Distribution.Client.IndexUtils.ActiveRepos-    Distribution.Client.IndexUtils.IndexState-    Distribution.Client.IndexUtils.Timestamp-    Distribution.Client.Init.Defaults-    Distribution.Client.Init.Types-    Distribution.Client.JobControl-    Distribution.Client.ManpageFlags-    Distribution.Client.ParseUtils-    Distribution.Client.ProjectFlags-    Distribution.Client.Security.DNS-    Distribution.Client.Security.HTTP-    Distribution.Client.Setup-    Distribution.Client.Tar-    Distribution.Client.Targets-    Distribution.Client.Types-    Distribution.Client.Types.AllowNewer-    Distribution.Client.Types.BuildResults-    Distribution.Client.Types.ConfiguredId-    Distribution.Client.Types.ConfiguredPackage-    Distribution.Client.Types.Credentials-    Distribution.Client.Types.InstallMethod-    Distribution.Client.Types.OverwritePolicy-    Distribution.Client.Types.PackageLocation-    Distribution.Client.Types.PackageSpecifier-    Distribution.Client.Types.ReadyPackage-    Distribution.Client.Types.Repo-    Distribution.Client.Types.RepoName-    Distribution.Client.Types.SourcePackageDb-    Distribution.Client.Types.SourceRepo-    Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy-    Distribution.Client.Update-    Distribution.Client.Utils-    Distribution.Client.World     Distribution.Compat.Async-    Distribution.Compat.Binary-    Distribution.Compat.CharParsing     Distribution.Compat.CopyFile     Distribution.Compat.CreatePipe     Distribution.Compat.DList-    Distribution.Compat.Directory-    Distribution.Compat.Environment     Distribution.Compat.Exception     Distribution.Compat.FilePath-    Distribution.Compat.Graph     Distribution.Compat.Internal.TempFile-    Distribution.Compat.Lens     Distribution.Compat.MonadFail     Distribution.Compat.Newtype-    Distribution.Compat.NonEmptySet     Distribution.Compat.Parsing     Distribution.Compat.Prelude-    Distribution.Compat.Prelude.Internal     Distribution.Compat.Process     Distribution.Compat.Semigroup     Distribution.Compat.Stack-    Distribution.Compat.Time-    Distribution.Compat.Typeable-    Distribution.Compiler-    Distribution.Deprecated.ParseUtils-    Distribution.Deprecated.ReadP-    Distribution.Deprecated.ViewAsFieldDescr-    Distribution.FieldGrammar     Distribution.FieldGrammar.Class     Distribution.FieldGrammar.FieldDescrs-    Distribution.FieldGrammar.Newtypes     Distribution.FieldGrammar.Parsec     Distribution.FieldGrammar.Pretty-    Distribution.Fields     Distribution.Fields.ConfVar     Distribution.Fields.Field     Distribution.Fields.Lexer     Distribution.Fields.LexerMonad-    Distribution.Fields.ParseResult     Distribution.Fields.Parser     Distribution.Fields.Pretty     Distribution.GetOpt-    Distribution.InstalledPackageInfo     Distribution.Lex-    Distribution.License-    Distribution.ModuleName-    Distribution.Package-    Distribution.PackageDescription     Distribution.PackageDescription.Check-    Distribution.PackageDescription.Configuration     Distribution.PackageDescription.FieldGrammar-    Distribution.PackageDescription.Parsec-    Distribution.PackageDescription.PrettyPrint     Distribution.PackageDescription.Quirks     Distribution.PackageDescription.Utils-    Distribution.Parsec-    Distribution.Parsec.Error     Distribution.Parsec.FieldLineStream-    Distribution.Parsec.Position-    Distribution.Parsec.Warning-    Distribution.Pretty-    Distribution.ReadE-    Distribution.SPDX-    Distribution.SPDX.License     Distribution.SPDX.LicenseExceptionId     Distribution.SPDX.LicenseExpression     Distribution.SPDX.LicenseId@@ -276,10 +200,6 @@     Distribution.Simple.BuildTarget     Distribution.Simple.BuildToolDepends     Distribution.Simple.CCompiler-    Distribution.Simple.Command-    Distribution.Simple.Compiler-    Distribution.Simple.Configure-    Distribution.Simple.Flag     Distribution.Simple.GHC     Distribution.Simple.GHC.EnvironmentParser     Distribution.Simple.GHC.ImplInfo@@ -288,16 +208,12 @@     Distribution.Simple.Glob     Distribution.Simple.HaskellSuite     Distribution.Simple.Hpc-    Distribution.Simple.InstallDirs     Distribution.Simple.InstallDirs.Internal     Distribution.Simple.LocalBuildInfo-    Distribution.Simple.PackageIndex     Distribution.Simple.PreProcess     Distribution.Simple.PreProcess.Unlit-    Distribution.Simple.Program     Distribution.Simple.Program.Ar     Distribution.Simple.Program.Builtin-    Distribution.Simple.Program.Db     Distribution.Simple.Program.Find     Distribution.Simple.Program.GHC     Distribution.Simple.Program.HcPkg@@ -305,31 +221,14 @@     Distribution.Simple.Program.Internal     Distribution.Simple.Program.Ld     Distribution.Simple.Program.ResponseFile-    Distribution.Simple.Program.Run     Distribution.Simple.Program.Strip     Distribution.Simple.Program.Types-    Distribution.Simple.Setup     Distribution.Simple.Test.LibV09     Distribution.Simple.Test.Log     Distribution.Simple.UHC-    Distribution.Simple.Utils-    Distribution.Solver.Compat.Prelude-    Distribution.Solver.Types.ComponentDeps-    Distribution.Solver.Types.ConstraintSource-    Distribution.Solver.Types.LabeledPackageConstraint-    Distribution.Solver.Types.OptionalStanza-    Distribution.Solver.Types.PackageConstraint-    Distribution.Solver.Types.PackageFixedDeps-    Distribution.Solver.Types.PackageIndex-    Distribution.Solver.Types.PackagePath-    Distribution.Solver.Types.Settings-    Distribution.Solver.Types.SourcePackage-    Distribution.System     Distribution.TestSuite-    Distribution.Text     Distribution.Types.AbiDependency     Distribution.Types.AbiHash-    Distribution.Types.AnnotatedId     Distribution.Types.Benchmark     Distribution.Types.Benchmark.Lens     Distribution.Types.BenchmarkInterface@@ -338,98 +237,135 @@     Distribution.Types.BuildInfo.Lens     Distribution.Types.BuildType     Distribution.Types.Component-    Distribution.Types.ComponentId     Distribution.Types.ComponentInclude     Distribution.Types.ComponentLocalBuildInfo-    Distribution.Types.ComponentName-    Distribution.Types.ComponentRequestedSpec     Distribution.Types.CondTree     Distribution.Types.Condition     Distribution.Types.ConfVar-    Distribution.Types.Dependency     Distribution.Types.DependencyMap     Distribution.Types.ExeDependency     Distribution.Types.Executable     Distribution.Types.Executable.Lens     Distribution.Types.ExecutableScope     Distribution.Types.ExposedModule-    Distribution.Types.Flag     Distribution.Types.ForeignLib     Distribution.Types.ForeignLib.Lens     Distribution.Types.ForeignLibOption     Distribution.Types.ForeignLibType     Distribution.Types.GenericPackageDescription     Distribution.Types.GenericPackageDescription.Lens-    Distribution.Types.GivenComponent     Distribution.Types.HookedBuildInfo     Distribution.Types.IncludeRenaming-    Distribution.Types.InstalledPackageInfo     Distribution.Types.InstalledPackageInfo.FieldGrammar     Distribution.Types.InstalledPackageInfo.Lens     Distribution.Types.LegacyExeDependency     Distribution.Types.Lens     Distribution.Types.Library     Distribution.Types.Library.Lens-    Distribution.Types.LibraryName     Distribution.Types.LibraryVisibility     Distribution.Types.LocalBuildInfo     Distribution.Types.Mixin     Distribution.Types.Module     Distribution.Types.ModuleReexport     Distribution.Types.ModuleRenaming-    Distribution.Types.MungedPackageId     Distribution.Types.MungedPackageName     Distribution.Types.PackageDescription     Distribution.Types.PackageDescription.Lens-    Distribution.Types.PackageId     Distribution.Types.PackageId.Lens-    Distribution.Types.PackageName     Distribution.Types.PackageName.Magic-    Distribution.Types.PackageVersionConstraint     Distribution.Types.PkgconfigDependency     Distribution.Types.PkgconfigName     Distribution.Types.PkgconfigVersion     Distribution.Types.PkgconfigVersionRange     Distribution.Types.SetupBuildInfo     Distribution.Types.SetupBuildInfo.Lens-    Distribution.Types.SourceRepo     Distribution.Types.SourceRepo.Lens     Distribution.Types.TargetInfo     Distribution.Types.TestSuite     Distribution.Types.TestSuite.Lens     Distribution.Types.TestSuiteInterface     Distribution.Types.TestType-    Distribution.Types.UnitId-    Distribution.Types.UnqualComponentName-    Distribution.Types.Version     Distribution.Types.VersionInterval-    Distribution.Types.VersionRange     Distribution.Types.VersionRange.Internal     Distribution.Utils.Base62-    Distribution.Utils.Generic     Distribution.Utils.IOData     Distribution.Utils.LogProgress     Distribution.Utils.MD5     Distribution.Utils.MapAccum-    Distribution.Utils.NubList     Distribution.Utils.Progress-    Distribution.Utils.ShortText     Distribution.Utils.String-    Distribution.Utils.Structured     Distribution.Utils.UnionFind-    Distribution.Verbosity     Distribution.Verbosity.Internal-    Distribution.Version-    Language.Haskell.Extension-    Paths_cabal_install-    -- hackage-security modules+    Paths_Cabal++library hackport-external-libs-hackage-security+  Default-Language: Haskell2010+  Hs-Source-Dirs: hackage-security/hackage-security/src++  build-depends:+    hackport-external-libs-Cabal,+    base              >= 4.10,+    base16-bytestring >= 0.1.1,+    base64-bytestring >= 1.0,+    bytestring        >= 0.9,+    containers        >= 0.4,+    directory         >= 1.2,+    ed25519           >= 0.0,+    filepath          >= 1.2,+    mtl               >= 2.2,+    network           >= 3.0,+    network-uri       >= 2.5,+    parsec            >= 3.1,+    pretty            >= 1.0,+    cryptohash-sha256 >= 0.11,+    tar               >= 0.5,+    template-haskell  >= 2.7,+    time              >= 1.2,+    transformers      >= 0.3,+    zlib              >= 0.5,+    ghc-prim++  default-extensions:+    DefaultSignatures+    DeriveDataTypeable+    DeriveFunctor+    FlexibleContexts+    FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving+    KindSignatures+    MultiParamTypeClasses+    NamedFieldPuns+    NoMonomorphismRestriction+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TupleSections+    TypeFamilies+    TypeOperators+    ViewPatterns+  other-extensions:+    BangPatterns+    CPP+    OverlappingInstances+    PackageImports+    UndecidableInstances++  exposed-modules:     Hackage.Security.Client-    Hackage.Security.Client.Formats-    Hackage.Security.Client.Repository     Hackage.Security.Client.Repository.Cache     Hackage.Security.Client.Repository.HttpLib     Hackage.Security.Client.Repository.Local     Hackage.Security.Client.Repository.Remote+    Hackage.Security.Util.Checked+    Hackage.Security.Util.Path+    Hackage.Security.Util.Pretty+    Hackage.Security.Util.Some++  other-modules:+    Hackage.Security.Client.Formats+    Hackage.Security.Client.Repository     Hackage.Security.Client.Verify     Hackage.Security.JSON     Hackage.Security.Key@@ -453,32 +389,211 @@     Hackage.Security.Trusted     Hackage.Security.Trusted.TCB     Hackage.Security.Util.Base64-    Hackage.Security.Util.Checked     Hackage.Security.Util.Exit     Hackage.Security.Util.IO     Hackage.Security.Util.JSON     Hackage.Security.Util.Lens-    Hackage.Security.Util.Path-    Hackage.Security.Util.Pretty-    Hackage.Security.Util.Some     Hackage.Security.Util.Stack     Hackage.Security.Util.TypedEmbedded     Prelude     Text.JSON.Canonical -  autogen-modules:+library hackport-external-libs-cabal-install+  Default-Language: Haskell2010+  Hs-Source-Dirs: cabal, cabal/cabal-install++  build-depends:+    hackport-external-libs-Cabal,+    hackport-external-libs-hackage-security,+    async             >= 2.0,+    array             >= 0.4,+    base              >= 4.8,+    base16-bytestring >= 0.1.1,+    binary            >= 0.7.3,+    bytestring        >= 0.10.6.0,+    containers        >= 0.5.6.2,+    cryptohash-sha256 >= 0.11,+    deepseq           >= 1.4.1.1,+    directory         >= 1.2.2.0,+    echo              >= 0.1.3,+    edit-distance     >= 0.2.2,+    filepath          >= 1.4.0.0,+    hashable          >= 1.0,+    HTTP              >= 4000.1.5,+    mtl               >= 2.0,+    network-uri       >= 2.6.0.2,+    network           >= 2.6,+    pretty            >= 1.1,+    process           >= 1.2.3.0,+    random            >= 1,+    stm               >= 2.0,+    tar               >= 0.5.0.3,+    time              >= 1.5.0.1,+    transformers      >= 0.4.2.0,+    zlib              >= 0.5.3,+    text              >= 1.2.3,+    parsec            >= 3.1.13.0,+    regex-base        >= 0.94.0.0,+    regex-posix       >= 0.96.0.0,+    resolv            >= 0.1.1++  exposed-modules:+    Distribution.Client.Config+    Distribution.Client.GlobalFlags+    Distribution.Client.IndexUtils+    Distribution.Client.Setup+    Distribution.Client.Types+    Distribution.Client.Update+    Distribution.Solver.Types.PackageIndex+    Distribution.Solver.Types.SourcePackage     Paths_cabal_install++  other-modules:+    Distribution.Client.BuildReports.Types+    Distribution.Client.CmdInstall.ClientInstallFlags+    Distribution.Client.Compat.Directory+    Distribution.Client.Compat.Orphans+    Distribution.Client.Compat.Prelude+    Distribution.Client.Compat.Semaphore+    Distribution.Client.Dependency.Types+    Distribution.Client.FetchUtils+    Distribution.Client.GZipUtils+    Distribution.Client.HashValue+    Distribution.Client.HttpUtils+    Distribution.Client.IndexUtils.ActiveRepos+    Distribution.Client.IndexUtils.IndexState+    Distribution.Client.IndexUtils.Timestamp+    Distribution.Client.Init.Defaults+    Distribution.Client.Init.Types+    Distribution.Client.JobControl+    Distribution.Client.ManpageFlags+    Distribution.Client.ParseUtils+    Distribution.Client.ProjectFlags+    Distribution.Client.Security.DNS+    Distribution.Client.Security.HTTP+    Distribution.Client.Tar+    Distribution.Client.Targets+    Distribution.Client.Types.AllowNewer+    Distribution.Client.Types.BuildResults+    Distribution.Client.Types.ConfiguredId+    Distribution.Client.Types.ConfiguredPackage+    Distribution.Client.Types.Credentials+    Distribution.Client.Types.InstallMethod+    Distribution.Client.Types.OverwritePolicy+    Distribution.Client.Types.PackageLocation+    Distribution.Client.Types.PackageSpecifier+    Distribution.Client.Types.ReadyPackage+    Distribution.Client.Types.Repo+    Distribution.Client.Types.RepoName+    Distribution.Client.Types.SourcePackageDb+    Distribution.Client.Types.SourceRepo+    Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy+    Distribution.Client.Utils+    Distribution.Client.World+    Distribution.Deprecated.ParseUtils+    Distribution.Deprecated.ReadP+    Distribution.Deprecated.ViewAsFieldDescr+    Distribution.Solver.Compat.Prelude+    Distribution.Solver.Types.ComponentDeps+    Distribution.Solver.Types.ConstraintSource+    Distribution.Solver.Types.LabeledPackageConstraint+    Distribution.Solver.Types.OptionalStanza+    Distribution.Solver.Types.PackageConstraint+    Distribution.Solver.Types.PackageFixedDeps+    Distribution.Solver.Types.PackagePath+    Distribution.Solver.Types.Settings++library hackport-internal+  Default-Language: Haskell2010+  Hs-Source-Dirs: src+  Build-Depends:+    hackport-external-libs-Cabal,+    hackport-external-libs-cabal-install,+    async,+    base,+    bytestring,+    containers,+    deepseq,+    directory,+    extensible-exceptions,+    filepath,+    network-uri,+    parallel >= 3.2.1.0,+    pretty,+    process,+    split,+    text,+    time,+    xml,+    -- Needed for doctests-v2 to work+    QuickCheck,+    template-haskell++  other-extensions:+    DeriveDataTypeable++  exposed-modules:+    Error+    Merge+    Overlays+    Status+    HackPort.GlobalFlags+    Portage.Host+    Portage.Overlay+    Portage.PackageId     Paths_hackport +  other-modules:+    AnsiColor+    Cabal2Ebuild+    Merge.Dependencies+    Merge.Utils+    Portage.Cabal+    Portage.Dependency+    Portage.Dependency.Builder+    Portage.Dependency.Normalize+    Portage.Dependency.Print+    Portage.Dependency.Types+    Portage.EBuild+    Portage.EBuild.CabalFeature+    Portage.EBuild.Render+    Portage.EMeta+    Portage.GHCCore+    Portage.Metadata+    Portage.Resolve+    Portage.Tables+    Portage.Use+    Portage.Version+    Util++  autogen-modules:+    Paths_hackport++Executable hackport+  ghc-options: -Wall -threaded +RTS -N -RTS -with-rtsopts=-N+  ghc-prof-options: -caf-all -auto-all -rtsopts+  Main-Is:    Main.hs+  Default-Language: Haskell2010+  Hs-Source-Dirs: exe+  Build-Depends:+    hackport-external-libs-Cabal,+    hackport-external-libs-cabal-install,+    hackport-internal,+    base,+    directory,+    filepath+  other-modules: Paths_hackport+ Test-Suite test-resolve-category   -- requires a local Portage overlay, thus fails in a sandboxed test.   buildable: False   ghc-options: -Wall   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell98-  Main-Is:              tests/resolveCat.hs-  Hs-Source-Dirs:       ., cabal, cabal/Cabal, cabal/cabal-install, tests-  Build-Depends:        array,+  Main-Is:              resolveCat.hs+  Hs-Source-Dirs:       src, tests+  Build-Depends:        hackport-external-libs,+                        array,                         base,                         binary,                         deepseq,@@ -509,9 +624,10 @@   ghc-options: -Wall   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell98-  Main-Is:              tests/print_deps.hs-  Hs-Source-Dirs:       ., cabal, cabal/Cabal, cabal/cabal-install, tests-  Build-Depends:        array,+  Main-Is:              print_deps.hs+  Hs-Source-Dirs:       src, tests+  Build-Depends:        hackport-external-libs,+                        array,                         base,                         binary,                         deepseq,@@ -541,9 +657,10 @@   ghc-options: -Wall   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell98-  Main-Is:              tests/normalize_deps.hs-  Hs-Source-Dirs:       ., cabal, cabal/Cabal, cabal/cabal-install, tests-  Build-Depends:        array,+  Main-Is:              normalize_deps.hs+  Hs-Source-Dirs:       src, tests+  Build-Depends:        hackport-external-libs,+                        array,                         base,                         binary,                         deepseq,@@ -568,213 +685,112 @@     DoAndIfThenElse  test-suite doctests+  x-doctest-components: lib:hackport-internal exe:hackport   type:             exitcode-stdio-1.0+  Hs-Source-Dirs:   tests   ghc-options:      -threaded   default-language: Haskell98-  main-is:          tests/doctests.hs+  main-is:          doctests.hs   build-depends:    base,                     doctest >= 0.8,+                    cabal-doctest,                     template-haskell,-                    QuickCheck+                    QuickCheck,+                    directory,+                    filepath,+                    base-compat,+                    Glob+  other-modules:    Paths_hackport+  if !flag(cabal-v1)+    buildable: False +test-suite doctests-v2+  type:             exitcode-stdio-1.0+  default-language: Haskell98+  main-is:          tests/doctests-v2.hs+  build-depends:    base, process+  build-tool-depends:+    cabal-install:cabal >= 3.2,+    doctest:doctest >= 0.8++  other-extensions:+    CPP++  if flag(cabal-v1)+    buildable: False+ test-suite spec   ghc-options: -Wall   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell2010-  Main-Is:              tests/Spec.hs-  Hs-Source-Dirs:       ., cabal, cabal/Cabal, cabal/cabal-install, tests-  other-modules:        Merge.UtilsSpec-                        Portage.CabalSpec-                        Portage.Dependency.PrintSpec-                        Portage.EBuildSpec-                        Portage.GHCCoreSpec-                        Portage.MetadataSpec-                        Portage.PackageIdSpec-                        Portage.VersionSpec-                        QuickCheck.Instances-                        -- cabal:-                        Distribution.Backpack-                        Distribution.CabalSpecVersion-                        Distribution.Compat.Async-                        Distribution.Compat.Binary-                        Distribution.Compat.CharParsing-                        Distribution.Compat.CopyFile-                        Distribution.Compat.DList-                        Distribution.Compat.Exception-                        Distribution.Compat.FilePath-                        Distribution.Compat.Graph-                        Distribution.Compat.Internal.TempFile-                        Distribution.Compat.Lens-                        Distribution.Compat.MonadFail-                        Distribution.Compat.Newtype-                        Distribution.Compat.NonEmptySet-                        Distribution.Compat.Parsing-                        Distribution.Compat.Prelude-                        Distribution.Compat.Process-                        Distribution.Compat.Semigroup-                        Distribution.Compat.Stack-                        Distribution.Compat.Typeable-                        Distribution.Compiler-                        Distribution.FieldGrammar-                        Distribution.FieldGrammar.Class-                        Distribution.FieldGrammar.FieldDescrs-                        Distribution.FieldGrammar.Newtypes-                        Distribution.FieldGrammar.Parsec-                        Distribution.FieldGrammar.Pretty-                        Distribution.Fields-                        Distribution.Fields.Field-                        Distribution.Fields.Lexer-                        Distribution.Fields.LexerMonad-                        Distribution.Fields.ParseResult-                        Distribution.Fields.Parser-                        Distribution.Fields.Pretty-                        Distribution.InstalledPackageInfo-                        Distribution.License-                        Distribution.ModuleName-                        Distribution.Package-                        Distribution.PackageDescription-                        Distribution.PackageDescription.Configuration-                        Distribution.PackageDescription.Utils-                        Distribution.Parsec-                        Distribution.Parsec.Error-                        Distribution.Parsec.FieldLineStream-                        Distribution.Parsec.Position-                        Distribution.Parsec.Warning-                        Distribution.Pretty-                        Distribution.ReadE-                        Distribution.SPDX-                        Distribution.SPDX.License-                        Distribution.SPDX.LicenseExceptionId-                        Distribution.SPDX.LicenseExpression-                        Distribution.SPDX.LicenseId-                        Distribution.SPDX.LicenseListVersion-                        Distribution.SPDX.LicenseReference-                        Distribution.Simple.PackageIndex-                        Distribution.Simple.Utils-                        Distribution.System-                        Distribution.Types.AbiDependency-                        Distribution.Types.AbiHash-                        Distribution.Types.Benchmark-                        Distribution.Types.Benchmark.Lens-                        Distribution.Types.BenchmarkInterface-                        Distribution.Types.BenchmarkType-                        Distribution.Types.BuildInfo-                        Distribution.Types.BuildInfo.Lens-                        Distribution.Types.BuildType-                        Distribution.Types.Component-                        Distribution.Types.ComponentId-                        Distribution.Types.ComponentName-                        Distribution.Types.ComponentRequestedSpec-                        Distribution.Types.CondTree-                        Distribution.Types.Condition-                        Distribution.Types.ConfVar-                        Distribution.Types.Dependency-                        Distribution.Types.DependencyMap-                        Distribution.Types.ExeDependency-                        Distribution.Types.Executable-                        Distribution.Types.Executable.Lens-                        Distribution.Types.ExecutableScope-                        Distribution.Types.ExposedModule-                        Distribution.Types.Flag-                        Distribution.Types.ForeignLib-                        Distribution.Types.ForeignLib.Lens-                        Distribution.Types.ForeignLibOption-                        Distribution.Types.ForeignLibType-                        Distribution.Types.GenericPackageDescription-                        Distribution.Types.GenericPackageDescription.Lens-                        Distribution.Types.HookedBuildInfo-                        Distribution.Types.IncludeRenaming-                        Distribution.Types.InstalledPackageInfo-                        Distribution.Types.InstalledPackageInfo.FieldGrammar-                        Distribution.Types.InstalledPackageInfo.Lens-                        Distribution.Types.LegacyExeDependency-                        Distribution.Types.Library-                        Distribution.Types.Library.Lens-                        Distribution.Types.LibraryName-                        Distribution.Types.LibraryVisibility-                        Distribution.Types.Mixin-                        Distribution.Types.Module-                        Distribution.Types.ModuleReexport-                        Distribution.Types.ModuleRenaming-                        Distribution.Types.MungedPackageId-                        Distribution.Types.MungedPackageName-                        Distribution.Types.PackageDescription-                        Distribution.Types.PackageDescription.Lens-                        Distribution.Types.PackageId-                        Distribution.Types.PackageId.Lens-                        Distribution.Types.PackageName-                        Distribution.Types.PackageVersionConstraint-                        Distribution.Types.PkgconfigDependency-                        Distribution.Types.PkgconfigName-                        Distribution.Types.PkgconfigVersion-                        Distribution.Types.PkgconfigVersionRange-                        Distribution.Types.SetupBuildInfo-                        Distribution.Types.SetupBuildInfo.Lens-                        Distribution.Types.SourceRepo-                        Distribution.Types.TestSuite-                        Distribution.Types.TestSuite.Lens-                        Distribution.Types.TestSuiteInterface-                        Distribution.Types.TestType-                        Distribution.Types.UnitId-                        Distribution.Types.UnqualComponentName-                        Distribution.Types.Version-                        Distribution.Types.VersionInterval-                        Distribution.Types.VersionRange-                        Distribution.Types.VersionRange.Internal-                        Distribution.Utils.Base62-                        Distribution.Utils.Generic-                        Distribution.Utils.IOData-                        Distribution.Utils.MD5-                        Distribution.Utils.ShortText-                        Distribution.Utils.String-                        Distribution.Utils.Structured-                        Distribution.Verbosity-                        Distribution.Verbosity.Internal-                        Distribution.Version-                        Language.Haskell.Extension-                        -- hackport:-                        AnsiColor-                        Error-                        Merge.Utils-                        Paths_hackport-                        Portage.Cabal-                        Portage.Dependency-                        Portage.Dependency.Builder-                        Portage.Dependency.Normalize-                        Portage.Dependency.Print-                        Portage.Dependency.Types-                        Portage.EBuild-                        Portage.EBuild.CabalFeature-                        Portage.EBuild.Render-                        Portage.GHCCore-                        Portage.Metadata-                        Portage.PackageId-                        Portage.Use-                        Portage.Version-  build-tool-depends:   hspec-discover:hspec-discover == 2.*-  Build-Depends:        array,-                        base,-                        binary,-                        deepseq,-                        bytestring,-                        containers,-                        directory,-                        extensible-exceptions,-                        filepath,-                        hspec >= 2.0,-                        mtl,-                        network-uri,-                        parsec,-                        pretty,-                        process,-                        QuickCheck >= 2.0,-                        split,-                        text,-                        time,-                        transformers,-                        unix,-                        xml-  default-extensions:-    -- cabal-    PatternGuards,-    DoAndIfThenElse+  Main-Is:              Spec.hs+  Hs-Source-Dirs:       src, tests+  other-modules:+    Merge.UtilsSpec+    Portage.CabalSpec+    Portage.Dependency.PrintSpec+    Portage.EBuildSpec+    Portage.GHCCoreSpec+    Portage.MetadataSpec+    Portage.PackageIdSpec+    Portage.VersionSpec+    QuickCheck.Instances++    -- hackport-internal+    Error+    Merge+    Overlays+    Status+    HackPort.GlobalFlags+    Portage.Host+    Portage.Overlay+    Portage.PackageId+    Paths_hackport+    AnsiColor+    Cabal2Ebuild+    Merge.Dependencies+    Merge.Utils+    Portage.Cabal+    Portage.Dependency+    Portage.Dependency.Builder+    Portage.Dependency.Normalize+    Portage.Dependency.Print+    Portage.Dependency.Types+    Portage.EBuild+    Portage.EBuild.CabalFeature+    Portage.EBuild.Render+    Portage.EMeta+    Portage.GHCCore+    Portage.Metadata+    Portage.Resolve+    Portage.Tables+    Portage.Use+    Portage.Version+    Util++  Build-Depends:+    hackport-external-libs-Cabal,+    hackport-external-libs-cabal-install,+    async,+    base,+    bytestring,+    containers,+    deepseq,+    directory,+    extensible-exceptions,+    filepath,+    hspec >= 2.0,+    network-uri,+    parallel,+    pretty,+    process,+    QuickCheck >= 2.0,+    split,+    text,+    time,+    xml++  build-tool-depends:   hspec-discover:hspec-discover >= 2.0++  other-extensions:+    DeriveDataTypeable
+ src/AnsiColor.hs view
@@ -0,0 +1,46 @@+{-|+    Stability   :  provisional+    Portability :  haskell98++    Simplistic ANSI color support.+-}++module AnsiColor+  ( Color(..)+  , bold+  , inColor+  ) where++import Data.List++data Color  =  Black+            |  Red+            |  Green+            |  Yellow+            |  Blue+            |  Magenta+            |  Cyan+            |  White+            |  Default+  deriving Enum++esc :: [String] -> String+esc []  =  ""+esc xs  =  "\ESC[" ++ (intercalate ";" xs) ++ "m"++col :: Color -> Bool -> Color -> [String]+col fg bf bg = show (fromEnum fg + 30) : bf' [show (fromEnum bg + 40)]+  where bf' | bf         =  ("01" :)+            | otherwise  =  id++inColor :: Color -> Bool -> Color -> String -> String+inColor c bf bg txt = esc (col c bf bg) ++ txt ++ esc ["00"]++bold :: String -> String+bold = ansi "1" "22"+-- italic    = ansi "3" "23"+-- underline = ansi "4" "24"+-- inverse   = ansi "7" "27"++ansi :: String -> String -> String -> String+ansi on off txt = esc [on] ++ txt ++ esc [off]
+ src/Cabal2Ebuild.hs view
@@ -0,0 +1,114 @@+{-|+Module      : Cabal2Ebuild+Copyright   : (C) 2005, Duncan Coutts+License     : GPL-2++Maintainer  : haskell@gentoo.org++A program for generating a Gentoo ebuild from a .cabal file+-}+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU General Public License+-- as published by the Free Software Foundation; either version 2+-- of the License, or (at your option) any later version.++-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+-- General Public License for more details.+--+module Cabal2Ebuild+        (cabal2ebuild+        ,convertDependencies+        ,convertDependency) where++import qualified Distribution.PackageDescription as Cabal+                                                ( PackageDescription(..), license)+import qualified Distribution.Package as Cabal  ( PackageIdentifier(..)+                                                , Dependency(..))+import qualified Distribution.Version as Cabal  ( VersionRange+                                                , cataVersionRange, normaliseVersionRange+                                                , majorUpperBound, mkVersion )+import Distribution.Version (VersionRangeF(..))+import Distribution.Pretty (prettyShow)++import qualified Distribution.Utils.ShortText as ST++import Data.Char          (isUpper)+import Data.Maybe++import Portage.Dependency+import qualified Portage.Cabal as Portage+import qualified Portage.PackageId as Portage+import qualified Portage.EBuild as Portage+import qualified Portage.EBuild.CabalFeature as Portage+import qualified Portage.Resolve as Portage+import qualified Portage.EBuild as E+import qualified Portage.Overlay as O+import Portage.Version++-- | Generate a 'Portage.EBuild' from a 'Portage.Category' and a 'Cabal.PackageDescription'.+cabal2ebuild :: Portage.Category -> Cabal.PackageDescription -> Portage.EBuild+cabal2ebuild cat pkg = Portage.ebuildTemplate {+    E.name        = Portage.cabal_pn_to_PN cabal_pn,+    E.category    = prettyShow cat,+    E.hackage_name= cabalPkgName,+    E.version     = prettyShow (Cabal.pkgVersion (Cabal.package pkg)),+    E.description = ST.fromShortText $ if ST.null (Cabal.synopsis pkg)+                                          then Cabal.description pkg+                                          else Cabal.synopsis pkg,+    E.homepage        = thisHomepage,+    E.license         = Portage.convertLicense $ Cabal.license pkg,+    E.slot            = (E.slot E.ebuildTemplate) ++ (if hasLibs then "/${PV}" else ""),+    E.my_pn           = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,+    E.features        = E.features E.ebuildTemplate+                   ++ (if hasLibs then ([ Portage.Lib+                                        , Portage.Profile+                                        , Portage.Haddock+                                        , Portage.Hoogle+                                        ]+                                        ++ if cabalPkgName == "hscolour"+                                                then []+                                                else [Portage.HsColour])+                                  else [])+                   ++ (if hasTests then [Portage.TestSuite]+                                   else [])+  } where+        cabal_pn = Cabal.pkgName $ Cabal.package pkg+        cabalPkgName = prettyShow cabal_pn+        hasLibs = isJust (Cabal.library pkg)+        hasTests = (not . null) (Cabal.testSuites pkg)+        thisHomepage = if (ST.null $ Cabal.homepage pkg)+                         then E.homepage E.ebuildTemplate+                         else ST.fromShortText $ Cabal.homepage pkg++-- | Map 'convertDependency' over ['Cabal.Dependency'].+convertDependencies :: O.Overlay -> Portage.Category -> [Cabal.Dependency] -> [Dependency]+convertDependencies overlay category = map (convertDependency overlay category)++-- | Convert 'Cabal.Dependency' into 'Dependency'.+convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> Dependency+convertDependency overlay category (Cabal.Dependency pname versionRange _lib)+  = convert versionRange+  where+    pn = case Portage.resolveFullPortageName overlay pname of+            Just r  -> r+            Nothing -> Portage.PackageName category (Portage.normalizeCabalPackageName pname)+    mk_p :: DRange -> Dependency+    mk_p dr = DependAtom (Atom pn dr (DAttr AnySlot []))+    p_v v   = fromCabalVersion v++    convert :: Cabal.VersionRange -> Dependency+    convert = Cabal.cataVersionRange alg . Cabal.normaliseVersionRange+              where+                alg (ThisVersionF v)                = mk_p $ DExact $ p_v v+                alg (LaterVersionF v)               = mk_p $ DRange (StrictLB $ p_v v) InfinityB+                alg (EarlierVersionF v)             = mk_p $ DRange ZeroB $ StrictUB $ p_v v+                alg (OrLaterVersionF v)             = if v == Cabal.mkVersion [0] -- any version+                                                      then mk_p $ DRange ZeroB InfinityB+                                                      else mk_p $ DRange (NonstrictLB $ p_v v)+                                                           InfinityB+                alg (OrEarlierVersionF v)           = mk_p $ DRange ZeroB $ NonstrictUB $ p_v v+                alg (MajorBoundVersionF v)          = mk_p $ DRange (NonstrictLB $ p_v v)+                                                      $ StrictUB $ p_v $ Cabal.majorUpperBound v+                alg (UnionVersionRangesF v1 v2)     = DependAnyOf [v1, v2]+                alg (IntersectVersionRangesF v1 v2) = DependAllOf [v1, v2]
+ src/Error.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Error (HackPortError(..), throwEx, catchEx, hackPortShowError) where++import Data.Typeable+import Control.Exception.Extensible as EE++-- | Type holding all of the 'HackPortError' constructors.+data HackPortError+    = ArgumentError String+    | ConnectionFailed String String+    | PackageNotFound String+    | InvalidTarballURL String String+    | InvalidSignatureURL String String+    | VerificationFailed String String+    | DownloadFailed String String+    | UnknownCompression String+    | UnpackingFailed String Int+    | NoCabalFound String+    | ExtractionFailed String String Int+    | CabalParseFailed String String+    | BashNotFound+    | BashError String+    | NoOverlay+    | MultipleOverlays [String]+    | UnknownVerbosityLevel String+    -- | WrongCacheVersion+    -- | InvalidCache+    | InvalidServer String+    deriving (Typeable+             , Show+             , Eq -- ^ needed for spec test-suite+             )++instance Exception HackPortError where++-- | Throw a 'HackPortError'.+throwEx :: HackPortError -> IO a+throwEx = EE.throw++-- | Catch a 'HackPortError'.+catchEx :: IO a -> (HackPortError -> IO a) -> IO a+catchEx = EE.catch++-- | Show the error string for a given 'HackPortError'.+hackPortShowError :: HackPortError -> String+hackPortShowError err = case err of+    ArgumentError str -> "Argument error: "++str+    ConnectionFailed server reason -> "Connection to hackage server '"++server++"' failed: "++reason+    PackageNotFound pkg -> "Package '"++ pkg ++"' not found on server. Try 'hackport update'?"+    InvalidTarballURL url reason -> "Error while downloading tarball '"++url++"': "++reason+    InvalidSignatureURL url reason -> "Error while downloading signature '"++url++"': "++reason+    VerificationFailed file signature -> "Error while checking signature('"++signature++"') of '"++file++"'"+    DownloadFailed url reason -> "Error while downloading '"++url++"': "++reason+    UnknownCompression tarball -> "Couldn't guess compression type of '"++tarball++"'"+    UnpackingFailed tarball code -> "Unpacking '"++tarball++"' failed with exit code '"++show code++"'"+    NoCabalFound tarball -> "Tarball '"++tarball++"' doesn't contain a cabal file"+    ExtractionFailed tarball file code -> "Extracting '"++file++"' from '"++tarball++"' failed with '"++show code++"'"+    CabalParseFailed file reason -> "Error while parsing cabal file '"++file++"': "++reason+    BashNotFound -> "The 'bash' executable was not found. It is required to figure out your portage-overlay. If you don't want to install bash, use '-p path-to-overlay'"+    BashError str -> "Error while guessing your repository's location. Either set a repository 'haskell' in '/etc/portage/repos.conf' or use '-p path-to-overlay'.\nThe error was: \""++str++"\""+    MultipleOverlays overlays -> "You have the following overlays available: '"++unwords overlays++"'. Please choose one by using 'hackport -p path-to-overlay' <command>"+    NoOverlay -> "Unable to find a repository 'haskell'. Consider defining it in '/etc/portage/repos.conf' and verify '~/.hackport/repositories' (in overlay_list) or use '-p path-to-overlay'"+    UnknownVerbosityLevel str -> "The verbosity level '"++str++"' is invalid. Please use debug,normal or silent"+    InvalidServer srv -> "Invalid server address, could not parse: " ++ srv+    --WrongCacheVersion -> "The version of the cache is too old. Please update the cache using 'hackport update'"+    --InvalidCache -> "Could not read the cache. Please ensure that it's up to date using 'hackport update'"
+ src/HackPort/GlobalFlags.hs view
@@ -0,0 +1,51 @@+module HackPort.GlobalFlags+    ( GlobalFlags(..)+    , defaultGlobalFlags+    , withHackPortContext+    ) where++import qualified Distribution.Verbosity as DV+import qualified Distribution.Simple.Setup as DSS+import qualified Distribution.Client.Config as DCC+import qualified Distribution.Client.GlobalFlags as DCG+import qualified Distribution.Client.Types as DCT+import qualified Distribution.Utils.NubList as DUN++import qualified Network.URI as NU++import System.FilePath ((</>))++import qualified Overlays++-- | Type containing global flags.+data GlobalFlags =+    GlobalFlags { globalVersion :: DSS.Flag Bool+                , globalNumericVersion :: DSS.Flag Bool+                , globalPathToOverlay :: DSS.Flag (Maybe FilePath)+                , globalPathToPortage :: DSS.Flag (Maybe FilePath)+                }++-- | Default 'GlobalFlags'.+defaultGlobalFlags :: GlobalFlags+defaultGlobalFlags =+    GlobalFlags { globalVersion = DSS.Flag False+                , globalNumericVersion = DSS.Flag False+                , globalPathToOverlay = DSS.Flag Nothing+                , globalPathToPortage = DSS.Flag Nothing+                }++-- | Default remote repository. Defaults to [hackage](hackage.haskell.org).+defaultRemoteRepo :: DCT.RemoteRepo+defaultRemoteRepo = DCC.addInfoForKnownRepos $ (DCT.emptyRemoteRepo (DCT.RepoName name)) { DCT.remoteRepoURI = uri }+   where+    Just uri = NU.parseURI "https://hackage.haskell.org/"+    name     = "hackage.haskell.org"++withHackPortContext :: DV.Verbosity -> GlobalFlags -> (DCG.RepoContext -> IO a) -> IO a+withHackPortContext verbosity global_flags callback = do+    overlayPath <- Overlays.getOverlayPath verbosity (DSS.fromFlag $ globalPathToOverlay global_flags)+    let flags = DCG.defaultGlobalFlags {+                    DCG.globalRemoteRepos = DUN.toNubList [defaultRemoteRepo]+                  , DCG.globalCacheDir    = DSS.Flag $ overlayPath </> ".hackport"+                }+    DCG.withRepoContext verbosity flags callback
+ src/Merge.hs view
@@ -0,0 +1,525 @@+{-|+Module      : Merge+License     : GPL-3++Maintainer  : haskell@gentoo.org++Core functionality of the @merge@ command of @HackPort@.+-}+module Merge+  ( merge+  , mergeGenericPackageDescription+  ) where++import           Control.Monad+import           Control.Exception+import qualified Data.Text as T+import qualified Data.Text.IO as T+import           Data.Function (on)+import qualified Data.Map.Strict as Map+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.Pretty (prettyShow)+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           Control.Parallel.Strategies+import qualified Data.List.Split as DLS+import           System.Directory ( getCurrentDirectory+                        , setCurrentDirectory+                        , createDirectoryIfMissing+                        , doesFileExist+                        , listDirectory+                        )+import           System.Process+import           System.FilePath ((</>),(<.>))+import           System.Exit++-- hackport+import qualified AnsiColor as A+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+import qualified Merge.Utils        as Merge++{-+Requested features:+  * Add files to git?+-}++-- | 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++-- | 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.srcpkgPackageId)) avails+resolveVersion avails (Just ver) = listToMaybe (filter match avails)+  where+    match avail = ver == Cabal.pkgVersion (CabalInstall.srcpkgPackageId avail)++-- | This function is executed by the @merge@ command of @HackPort@.+-- Its functionality is as follows:+--+-- 1. Feed user input to 'readPackageString'+-- 2. Look for a matching package on the @hackage@ database+-- 3. Run 'mergeGenericPackageDescription' with the supplied information+-- 4. Generate a coloured diff between the old and new ebuilds.+--+-- Various information is printed in between these steps depending on the+-- 'Verbosity'.+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 Merge.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.srcpkgPackageId 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 (prettyShow . Cabal.pkgVersion . CabalInstall.srcpkgPackageId) 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 (prettyShow . CabalInstall.srcpkgPackageId $ 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.srcpkgPackageId avail == CabalInstall.srcpkgPackageId selectedPkg = "* "+                   | otherwise = "- "+    info verbosity $ match_text ++ (prettyShow . CabalInstall.srcpkgPackageId $ avail)++  let cabal_pkgId = CabalInstall.srcpkgPackageId 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.srcpkgDescription 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 Merge.getPreviousPackageId pkgDir newPkgId of+    Just validPkg -> do info verbosity "Generating a diff..."+                        diffEbuilds overlayPath validPkg newPkgId+    _ -> info verbosity "Nothing to diff!"++-- used to be FlagAssignment in Cabal but now it's an opaque type+type CabalFlags = [(Cabal.FlagName, Bool)]++-- | Generate an ebuild from a 'Cabal.GenericPackageDescription'.+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 = Merge.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 = prettyShow merged_cabal_pkg_name+                             cn = prettyShow 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+                                      (Merge.exeAndLibDeps pkgDesc0)++      pkgDesc = Merge.RetroPackageDescription pkgDesc0 accepted_deps+      cabal_flag_descs = Cabal.genPackageFlags pkgGenericDesc+      all_flags = map Cabal.flagName cabal_flag_descs+      make_fas  :: [Cabal.PackageFlag] -> [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  -> Merge.mangle_iuse 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+               , Right (pkgDesc1,fr) <- [GHCCore.finalizePD (Cabal.mkFlagAssignment f)+                                         GHCCore.defaultComponentRequestedSpec+                                         (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+                                 (Merge.exeAndLibDeps pkgDesc1)+               -- TODO: drop ghc libraries from tests depends as well+               -- (see deepseq in hackport-0.3.5 as an example)+               , let pkgDesc_filtered_bdeps = Merge.RetroPackageDescription pkgDesc1 ad+               ] `using` parList rdeepseq+          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 :: Merge.RetroPackageDescription -> Merge.EDep+      cabal_to_emerge_dep cabal_pkg = Merge.resolveDependencies overlay cabal_pkg compiler_info ghc_packages merged_cabal_pkg_name++  -- When there are lots of package flags, computation of every possible flag combination+  -- can take a while (e.g., 12 package flags = 2^12 possible flag combinations).+  -- Warn the user about this if there are at least 12 package flags. 'cabal_flag_descs'+  -- is usually an overestimation since it includes flags that hackport will strip out,+  -- but using it instead of 'active_flag_descs' avoids forcing the very computation we+  -- are trying to warn the user about.+  when (length cabal_flag_descs >= 12) $+    notice verbosity $ "There are up to " +++    A.bold (show (2^(length cabal_flag_descs) :: Int)) +++    " possible flag combinations.\n" +++    A.inColor A.Yellow True A.Default "This may take a while."++  debug verbosity $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0+  debug verbosity $ "buildDepends pkgDesc0: " ++ show (map prettyShow (Merge.exeAndLibDeps pkgDesc0))+  debug verbosity $ "buildDepends pkgDesc:  " ++ show (map prettyShow (Merge.buildDepends pkgDesc))++  notice verbosity $ "Accepted depends: " ++ show (map prettyShow accepted_deps)+  notice verbosity $ "Skipped  depends: " ++ show (map prettyShow 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 (Merge.packageDescription pkgDesc)++  let active_flag_descs_renamed =+        (\f -> f { Cabal.flagName = Cabal.mkFlagName . cfn_to_iuse . Cabal.unFlagName+                   . Cabal.flagName $ f }) <$> active_flag_descs+  iuse_flag_descs <- Merge.dropIfUseExpands active_flag_descs_renamed+  mergeEbuild verbosity existing_meta pkgdir ebuild iuse_flag_descs++  when fetch $ do+    let cabal_pkgId = Cabal.packageId (Merge.packageDescription pkgDesc)+        norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)+    fetchDigestAndCheck verbosity (overlayPath </> prettyShow cat </> prettyShow norm_pkgName)+      $ Portage.fromCabalPackageId cat cabal_pkgId++-- | Run @ebuild@ and @pkgcheck@ commands in the directory of the+-- newly-generated ebuild.+--+-- This will ensure well-formed ebuilds and @metadata.xml@, and will update (if possible)+-- the @Manifest@ file.+fetchDigestAndCheck :: Verbosity+                    -> FilePath -- ^ directory of ebuild+                    -> Portage.PackageId -- ^ newest ebuild+                    -> IO ()+fetchDigestAndCheck verbosity ebuildDir pkgId =+  let ebuild = prettyShow (Portage.cabalPkgName . Portage.packageId $ pkgId)+               ++ "-" ++ prettyShow (Portage.pkgVersion pkgId) <.> "ebuild"+  in withWorkingDirectory ebuildDir $ do+    notice verbosity "Recalculating digests..."+    emEx <- system $ "ebuild " ++ ebuild ++ " manifest > /dev/null 2>&1"+    when (emEx /= ExitSuccess) $+      notice verbosity "ebuild manifest failed horribly. Do something about it!"++    notice verbosity $ "Running " ++ A.bold "pkgcheck scan..."++    (psEx,psOut,_) <- readCreateProcessWithExitCode (shell "pkgcheck scan --color True") ""+    +    when (psEx /= ExitSuccess) $ -- this should never be true, even with QA issues.+      notice verbosity $ A.inColor A.Red True A.Default "pkgcheck scan failed."+    notice verbosity psOut++    return ()++withWorkingDirectory :: FilePath -> IO a -> IO a+withWorkingDirectory newDir action = do+  oldDir <- getCurrentDirectory+  bracket+    (setCurrentDirectory newDir)+    (\_ -> setCurrentDirectory oldDir)+    (\_ -> action)++-- | Write the ebuild (and sometimes a new @metadata.xml@) to its directory.+mergeEbuild :: Verbosity -> EM.EMeta -> FilePath -> E.EBuild -> [Cabal.PackageFlag] -> 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+  yet_meta <- doesFileExist mpath+  -- If there is an existing @metadata.xml@, read it in as a 'T.Text'.+  -- Otherwise return 'T.empty'. We only use this once more to directly+  -- compare to @default_meta@ before writing it.+  current_meta <- if yet_meta+                  then T.readFile mpath+                  else return T.empty+  -- Either create an object of the 'Portage.Metadata' type from a valid @current_meta@,+  -- or supply a default minimal metadata object. Note the difference to @current_meta@:+  -- @current_meta@ is of type 'T.Text', @current_meta'@ is of type 'Portage.Metadata'.+  let current_meta' = fromMaybe Portage.makeMinimalMetadata+                      (Portage.pureMetadataFromFile current_meta)+      -- Create the @metadata.xml@ string, adding new USE flags (if any) to those of+      -- the existing @metadata.xml@. If an existing flag has a new and old description,+      -- the new one takes precedence.+      default_meta = Portage.makeDefaultMetadata+                     $ Merge.metaFlags flags `Map.union`+                     Portage.metadataUseFlags current_meta'+      -- Create a 'Map.Map' of USE flags with updated descriptions.+      new_flags = Map.differenceWith (\new old -> if (new /= old)+                                                  then Just $ old ++ A.bold (" -> " ++ new)+                                                  else Nothing)+                  (Merge.metaFlags flags)+                  $ Portage.metadataUseFlags current_meta'++  createDirectoryIfMissing True edir+  now <- TC.getCurrentTime++  let (existing_keywords, existing_license) = (EM.keywords existing_meta, EM.license existing_meta)+      new_keywords = maybe (E.keywords ebuild) (map Merge.to_unstable) existing_keywords+      new_license  = either (\err -> maybe (Left err)+                                           Right+                                           existing_license)+                            Right+                            (E.license ebuild)+      ebuild'      = ebuild { E.keywords = new_keywords+                            , E.license = new_license+                            }+      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` T.writeFile epath (T.pack s_ebuild')++  when (current_meta /= default_meta) $ do+    when (current_meta /= T.empty) $ do+      notice verbosity $ A.bold $ "Default and current " ++ emeta ++ " differ."+      if (new_flags /= Map.empty)+        then notice verbosity $ "New or updated USE flags:\n" +++             (unlines $ Portage.prettyPrintFlagsHuman new_flags)+        else notice verbosity "No new USE flags."++    notice verbosity $ "Writing " ++ emeta+    T.writeFile mpath default_meta
+ src/Merge/Dependencies.hs view
@@ -0,0 +1,583 @@+{-|+Module      : Merge.Dependencies+License     : GPL-3++Maintainer  : haskell@gentoo.org++Merge a package from @hackage@ to an ebuild.+-}+{-# LANGUAGE CPP #-}+module Merge.Dependencies+  ( EDep(..)+  , RetroPackageDescription(..)+  , exeAndLibDeps+  , mkRetroPD+  , resolveDependencies+  ) where++import           Control.DeepSeq (NFData(..))+import           Control.Parallel.Strategies+import           Data.Maybe ( isJust, isNothing )+import qualified Data.List as L+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup (Semigroup(..))+#endif+import qualified Data.Set  as S++import qualified Distribution.CabalSpecVersion as Cabal+import qualified Distribution.Compat.NonEmptySet as NES+import qualified Distribution.Package as Cabal+import qualified Distribution.PackageDescription as Cabal+import qualified Distribution.Version as Cabal+import qualified Distribution.Pretty as Cabal++import qualified Distribution.Compiler as Cabal++import qualified Portage.Cabal as Portage+import qualified Portage.Dependency as Portage+import qualified Portage.Dependency.Normalize as PN+import qualified Portage.Overlay as Portage+import qualified Portage.PackageId as Portage+import qualified Portage.Use as Portage+import qualified Portage.Tables as Portage+import qualified Cabal2Ebuild as C2E++import qualified Portage.GHCCore as GHCCore++import Debug.Trace ( trace )++-- | Dependencies of an ebuild.+data EDep = EDep+  {+    rdep :: Portage.Dependency,+    rdep_e :: S.Set String,+    dep :: Portage.Dependency,+    dep_e :: S.Set String+  }+  deriving (Show, Eq, Ord)++instance NFData EDep where+  rnf (EDep rd rde d de) = rnf rd `seq` rnf rde `seq` rnf d `seq` rnf de++-- | Cabal-1 style 'Cabal.PackageDescription', with a top-level 'buildDepends' function.+data RetroPackageDescription = RetroPackageDescription {+  packageDescription :: Cabal.PackageDescription,+  buildDepends :: [Cabal.Dependency]+  } deriving (Show)++-- | Construct a 'RetroPackageDescription' using 'exeAndLibDeps' for the 'buildDepends'.+mkRetroPD :: Cabal.PackageDescription -> RetroPackageDescription+mkRetroPD pd = RetroPackageDescription { packageDescription = pd, buildDepends = exeAndLibDeps pd }++-- | Extract only the build dependencies for libraries and executables for a given package.+exeAndLibDeps :: Cabal.PackageDescription -> [Cabal.Dependency]+exeAndLibDeps pkg = concatMap (Cabal.targetBuildDepends . Cabal.buildInfo)+                    (Cabal.executables pkg)+                    `L.union`+                    concatMap (Cabal.targetBuildDepends . Cabal.libBuildInfo)+                    (Cabal.allLibraries pkg)++instance Semigroup EDep where+  (EDep rdepA rdep_eA depA dep_eA) <> (EDep rdepB rdep_eB depB dep_eB) = EDep+    { rdep   = Portage.DependAllOf [rdepA, rdepB]+    , rdep_e = rdep_eA `S.union` rdep_eB+    , dep    = Portage.DependAllOf [depA, depB]+    , dep_e  = dep_eA  `S.union` dep_eB+    }+  +instance Monoid EDep where+  mempty = EDep+      {+        rdep = Portage.empty_dependency,+        rdep_e = S.empty,+        dep = Portage.empty_dependency,+        dep_e = S.empty+      }+#if !(MIN_VERSION_base(4,11,0))+  (EDep rdepA rdep_eA depA dep_eA) `mappend` (EDep rdepB rdep_eB depB dep_eB) = EDep+    { rdep   = Portage.DependAllOf [rdepA, rdepB]+    , rdep_e = rdep_eA `S.union` rdep_eB+    , dep    = Portage.DependAllOf [depA, depB]+    , dep_e  = dep_eA  `S.union` dep_eB+    }+#endif++-- | Resolve package dependencies from a 'RetroPackageDescription' into an 'EDep'.+resolveDependencies :: Portage.Overlay -> RetroPackageDescription -> Cabal.CompilerInfo+                    -> [Cabal.PackageName] -> Cabal.PackageName+                    -> EDep+resolveDependencies overlay pkg compiler_info ghc_package_names merged_cabal_pkg_name = edeps+  where+    -- hasBuildableExes p = any (buildable . buildInfo) . executables $ p+    treatAsLibrary :: Bool+    treatAsLibrary = isJust (Cabal.library (packageDescription pkg))+    -- without slot business+    raw_haskell_deps :: Portage.Dependency+    raw_haskell_deps = PN.normalize_depend $ Portage.DependAllOf $ haskellDependencies overlay (buildDepends pkg)+    test_deps :: Portage.Dependency+    test_deps = Portage.mkUseDependency (True, Portage.Use "test") $+                    Portage.DependAllOf $+                    remove_raw_common $+                    testDependencies overlay (packageDescription pkg) ghc_package_names merged_cabal_pkg_name+    cabal_dep :: Portage.Dependency+    cabal_dep = cabalDependency overlay (packageDescription pkg) compiler_info+    ghc_dep :: Portage.Dependency+    ghc_dep = compilerInfoToDependency compiler_info+    extra_libs :: Portage.Dependency+    extra_libs = Portage.DependAllOf $ findCLibs (packageDescription pkg)+    pkg_config_libs :: [Portage.Dependency]+    pkg_config_libs = pkgConfigDependencies overlay (packageDescription pkg)+    pkg_config_tools :: Portage.Dependency+    pkg_config_tools = Portage.DependAllOf $ if L.null pkg_config_libs+                           then []+                           else [any_c_p "virtual" "pkgconfig"]+    build_tools :: Portage.Dependency+    build_tools = Portage.DependAllOf $ pkg_config_tools : legacyBuildToolsDependencies (packageDescription pkg)+                  ++ hackageBuildToolsDependencies overlay (packageDescription pkg)++    setup_deps :: Portage.Dependency+    setup_deps = PN.normalize_depend $ Portage.DependAllOf $+                     remove_raw_common $+                     setupDependencies overlay (packageDescription pkg) ghc_package_names merged_cabal_pkg_name++    edeps :: EDep+    edeps+        | treatAsLibrary = mempty+                  {+                    dep = Portage.DependAllOf+                              [ cabal_dep+                              , setup_deps+                              , build_tools+                              , test_deps+                              ],+                    dep_e = S.singleton "${RDEPEND}",+                    rdep = Portage.DependAllOf+                               [ Portage.set_build_slot ghc_dep+                               , Portage.set_build_slot $ add_profile $ raw_haskell_deps+                               , extra_libs+                               , Portage.DependAllOf pkg_config_libs+                               ]+                  }+        | otherwise = mempty+                  {+                    dep = Portage.DependAllOf+                              [ cabal_dep+                              , setup_deps+                              , build_tools+                              , test_deps+                              ],+                    dep_e = S.singleton "${RDEPEND}",+                    rdep = Portage.DependAllOf+                               [ Portage.set_build_slot ghc_dep+                               , Portage.set_build_slot $ raw_haskell_deps+                               , extra_libs+                               , Portage.DependAllOf pkg_config_libs+                               ]+                  }+    add_profile    = Portage.addDepUseFlag (Portage.mkQUse (Portage.Use "profile"))+    -- remove depends present in common section+    remove_raw_common = filter (\d -> not (Portage.dep_as_broad_as d raw_haskell_deps))+                        . map PN.normalize_depend++---------------------------------------------------------------+-- Custom-setup dependencies+-- TODO: move partitioning part to Merge:mergeGenericPackageDescription+---------------------------------------------------------------++setupDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Cabal.PackageName] -> Cabal.PackageName -> [Portage.Dependency]+setupDependencies overlay pkg ghc_package_names merged_cabal_pkg_name = deps+    where cabalDeps = maybe [] id $ Cabal.setupDepends `fmap` Cabal.setupBuildInfo pkg+          cabalDeps' = fst $ Portage.partition_depends ghc_package_names merged_cabal_pkg_name cabalDeps+          deps = C2E.convertDependencies overlay (Portage.Category "dev-haskell") cabalDeps'++---------------------------------------------------------------+-- Test-suite dependencies+-- TODO: move partitioning part to Merge:mergeGenericPackageDescription+---------------------------------------------------------------++testDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Cabal.PackageName] -> Cabal.PackageName -> [Portage.Dependency]+testDependencies overlay pkg ghc_package_names merged_cabal_pkg_name = deps+    where cabalDeps = concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) (Cabal.testSuites pkg)+          cabalDeps' = fst $ Portage.partition_depends ghc_package_names merged_cabal_pkg_name cabalDeps+          deps = C2E.convertDependencies overlay (Portage.Category "dev-haskell") cabalDeps'++---------------------------------------------------------------+-- Haskell packages+---------------------------------------------------------------++haskellDependencies :: Portage.Overlay -> [Cabal.Dependency] {- PackageDescription -} -> [Portage.Dependency]+haskellDependencies overlay deps =+    C2E.convertDependencies overlay (Portage.Category "dev-haskell") deps++---------------------------------------------------------------+-- Cabal Dependency+---------------------------------------------------------------++-- | Select the most restrictive dependency on Cabal, either the .cabal+-- file's descCabalVersion, or the Cabal GHC shipped with.+cabalDependency :: Portage.Overlay -> Cabal.PackageDescription -> Cabal.CompilerInfo -> Portage.Dependency+cabalDependency overlay pkg ~(Cabal.CompilerInfo {+                                  Cabal.compilerInfoId =+                                      Cabal.CompilerId Cabal.GHC cabal_version+                              }) =+         C2E.convertDependency overlay+                               (Portage.Category "dev-haskell")+                               (Cabal.Dependency (Cabal.mkPackageName "Cabal")+                                                 finalCabalDep (NES.singleton Cabal.defaultLibName))+  where+    versionNumbers = Cabal.versionNumbers cabal_version+    userCabalVersion = Cabal.orLaterVersion $ Cabal.mkVersion+                       $ Cabal.cabalSpecToVersionDigits $ Cabal.specVersion pkg+    shippedCabalVersion = GHCCore.cabalFromGHC versionNumbers+    shippedCabalDep = maybe Cabal.anyVersion Cabal.orLaterVersion shippedCabalVersion+    finalCabalDep = Cabal.simplifyVersionRange+                                (Cabal.intersectVersionRanges+                                          userCabalVersion+                                          shippedCabalDep)++---------------------------------------------------------------+-- GHC Dependency+---------------------------------------------------------------++compilerInfoToDependency :: Cabal.CompilerInfo -> Portage.Dependency+compilerInfoToDependency ~(Cabal.CompilerInfo {+                               Cabal.compilerInfoId =+                                   Cabal.CompilerId Cabal.GHC cabal_version}) =+  at_least_c_p_v "dev-lang" "ghc" (Cabal.versionNumbers cabal_version)++---------------------------------------------------------------+-- C Libraries+---------------------------------------------------------------++findCLibs :: Cabal.PackageDescription -> [Portage.Dependency]+findCLibs (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) =+  [ trace ("WARNING: This package depends on a C library we don't know the portage name for: " ++ p ++ ". Check the generated ebuild.")+          (any_c_p "unknown-c-lib" p)+  | p <- notFound+  ] +++  found+  where+  libE = concatMap (Cabal.extraLibs . Cabal.libBuildInfo) $ maybe [] return lib+  exeE = concatMap Cabal.extraLibs (filter Cabal.buildable (map Cabal.buildInfo exes))+  allE = libE ++ exeE++  notFound = [ p | p <- allE, isNothing (staticTranslateExtraLib p) ]+  found =    [ p | Just p <- map staticTranslateExtraLib allE ]++any_c_p_s_u :: String -> String -> Portage.SlotDepend -> [Portage.UseFlag] -> Portage.Dependency+any_c_p_s_u cat pn slot uses = Portage.DependAtom $+    Portage.Atom (Portage.mkPackageName cat pn)+                 (Portage.DRange Portage.ZeroB Portage.InfinityB)+                 (Portage.DAttr slot uses)++any_c_p :: String -> String -> Portage.Dependency+any_c_p cat pn = any_c_p_s_u cat pn Portage.AnySlot []++at_least_c_p_v :: String -> String -> [Int] -> Portage.Dependency+at_least_c_p_v cat pn v = Portage.DependAtom $+  Portage.Atom (Portage.mkPackageName cat pn)+               (Portage.DRange (Portage.NonstrictLB (Portage.Version v Nothing [] 0)) Portage.InfinityB)+               (Portage.DAttr Portage.AnySlot [])++staticTranslateExtraLib :: String -> Maybe Portage.Dependency+staticTranslateExtraLib lib = lookup lib m+  where+  m = [ ("z", any_c_p "sys-libs" "zlib")+      , ("bz2", any_c_p "app-arch" "bzip2")+      , ("mysqlclient", at_least_c_p_v "virtual" "mysql" [4,0])+      , ("pq", at_least_c_p_v "dev-db" "postgresql" [7])+      , ("ev", any_c_p "dev-libs" "libev")+      , ("expat", any_c_p "dev-libs" "expat")+      , ("curl", any_c_p "net-misc" "curl")+      , ("xml2", any_c_p "dev-libs" "libxml2")+      , ("mecab", any_c_p "app-text" "mecab")+      , ("zmq", any_c_p "net-libs" "zeromq")+      , ("SDL", any_c_p "media-libs" "libsdl")+      , ("adns", any_c_p "net-libs" "adns")+      , ("pcre", any_c_p "dev-libs" "libpcre")+      , ("GL", any_c_p "virtual" "opengl")+      , ("GLU", any_c_p "virtual" "glu")+      , ("glut", any_c_p "media-libs" "freeglut")+      , ("X11", any_c_p "x11-libs" "libX11")+      , ("libzip", any_c_p "dev-libs" "libzip")+      , ("ssl", any_c_p "dev-libs" "openssl")+      , ("Judy", any_c_p "dev-libs" "judy")+      , ("fcgi", any_c_p "dev-libs" "fcgi")+      , ("gnutls", any_c_p "net-libs" "gnutls")+      , ("idn", any_c_p "net-dns" "libidn")+      , ("tre", any_c_p "dev-libs" "tre")+      , ("m", any_c_p "virtual" "libc")+      , ("asound", any_c_p "media-libs" "alsa-lib")+      , ("sqlite3", at_least_c_p_v "dev-db" "sqlite" [3,0])+      , ("stdc++", any_c_p_s_u "sys-devel" "gcc" Portage.AnySlot [Portage.mkUse (Portage.Use "cxx")])+      , ("crack", any_c_p "sys-libs" "cracklib")+      , ("exif", any_c_p "media-libs" "libexif")+      , ("IL", any_c_p "media-libs" "devil")+      , ("Imlib2", any_c_p "media-libs" "imlib2")+      , ("pcap", any_c_p "net-libs" "libpcap")+      , ("lber", any_c_p "net-nds" "openldap")+      , ("ldap", any_c_p "net-nds" "openldap")+      , ("expect", any_c_p "dev-tcltk" "expect")+      , ("tcl", any_c_p "dev-lang" "tcl")+      , ("Xext", any_c_p "x11-libs" "libXext")+      , ("Xrandr", any_c_p "x11-libs" "libXrandr")+      , ("crypto", any_c_p "dev-libs" "openssl")+      , ("gmp", any_c_p "dev-libs" "gmp")+      , ("fuse", any_c_p "sys-fs" "fuse")+      , ("zip", any_c_p "dev-libs" "libzip")+      , ("QtCore", any_c_p "dev-qt" "qtcore")+      , ("QtDeclarative", any_c_p "dev-qt" "qtdeclarative")+      , ("QtGui", any_c_p "dev-qt" "qtgui")+      , ("QtOpenGL", any_c_p "dev-qt" "qtopengl")+      , ("QtScript", any_c_p "dev-qt" "qtscript")+      , ("gsl", any_c_p "sci-libs" "gsl")+      , ("gslcblas", any_c_p "sci-libs" "gsl")+      , ("mkl_core", any_c_p "sci-libs" "mkl")+      , ("mkl_intel_lp64", any_c_p "sci-libs" "mkl")+      , ("mkl_lapack", any_c_p "sci-libs" "mkl")+      , ("mkl_sequential", any_c_p "sci-libs" "mkl")+      , ("Xi", any_c_p "x11-libs" "libXi")+      , ("Xxf86vm", any_c_p "x11-libs" "libXxf86vm")+      , ("pthread", any_c_p "virtual" "libc")+      , ("panelw", any_c_p "sys-libs" "ncurses")+      , ("ncursesw", any_c_p "sys-libs" "ncurses")+      , ("ftgl", any_c_p "media-libs" "ftgl")+      , ("glpk", any_c_p "sci-mathematics" "glpk")+      , ("sndfile", any_c_p "media-libs" "libsndfile")+      , ("portaudio", any_c_p "media-libs" "portaudio")+      , ("icudata", any_c_p "dev-libs" "icu")+      , ("icui18n", any_c_p "dev-libs" "icu")+      , ("icuuc", any_c_p "dev-libs" "icu")+      , ("chipmunk", any_c_p "sci-physics" "chipmunk")+      , ("alut", any_c_p "media-libs" "freealut")+      , ("openal", any_c_p "media-libs" "openal")+      , ("iw", any_c_p "net-wireless" "wireless-tools")+      , ("attr", any_c_p "sys-apps" "attr")+      , ("ncurses", any_c_p "sys-libs" "ncurses")+      , ("panel", any_c_p "sys-libs" "ncurses")+      , ("nanomsg", any_c_p "dev-libs" "nanomsg")+      , ("pgf", any_c_p "media-libs" "libpgf")+      , ("ssh2", any_c_p "net-libs" "libssh2")+      , ("dl", any_c_p "virtual" "libc")+      , ("glfw", any_c_p "media-libs" "glfw")+      , ("nettle", any_c_p "dev-libs" "nettle")+      , ("Xpm",    any_c_p "x11-libs" "libXpm")+      , ("Xss",    any_c_p "x11-libs" "libXScrnSaver")+      , ("tag_c",  any_c_p "media-libs" "taglib")+      , ("magic",  any_c_p "sys-apps" "file")+      , ("crypt",  any_c_p_s_u "virtual" "libcrypt" Portage.AnyBuildTimeSlot [])+      , ("Xrender", any_c_p "x11-libs" "libXrender")+      , ("Xcursor", any_c_p "x11-libs" "libXcursor")+      , ("Xinerama", any_c_p "x11-libs" "libXinerama")+      , ("wayland-client", any_c_p "dev-libs" "wayland")+      , ("wayland-cursor", any_c_p "dev-libs" "wayland")+      , ("wayland-server", any_c_p "dev-libs" "wayland")+      , ("wayland-egl", any_c_p_s_u "media-libs" "mesa" Portage.AnySlot [Portage.mkUse (Portage.Use "wayland")])+      , ("xkbcommon", any_c_p "x11-libs" "libxkbcommon")+      , ("SDL_gfx", any_c_p "media-libs" "sdl-gfx")+      , ("SDL_image", any_c_p "media-libs" "sdl-image")+      , ("SDL_ttf", any_c_p "media-libs" "sdl-ttf")+      , ("odbc", any_c_p "dev-db" "unixODBC")+      , ("uuid", any_c_p "sys-apps" "util-linux")+      , ("notify", any_c_p "x11-libs" "libnotify")+      , ("SDL2", any_c_p " media-libs" "libsdl2")+      , ("SDL2_mixer", any_c_p "media-libs" "sdl2-mixer")+      , ("blas", any_c_p "virtual" "blas")+      , ("lapack", any_c_p "virtual" "lapack")+      ]++---------------------------------------------------------------+-- Build Tools (legacy, a list of well-known tools)+---------------------------------------------------------------++legacyBuildToolsDependencies :: Cabal.PackageDescription -> [Portage.Dependency]+legacyBuildToolsDependencies (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = L.nub $+  [ case pkg of+      Just p -> p+      Nothing -> trace ("WARNING: Unknown build tool '" ++ Cabal.prettyShow exe ++ "'. Check the generated ebuild.")+                       (any_c_p "unknown-build-tool" pn)+  | exe@(Cabal.LegacyExeDependency pn _range) <- cabalDeps+  , pkg <- return (lookup pn buildToolsTable)+  ]+  where+  cabalDeps = filter notProvided $ depL ++ depE+  depL = concatMap (Cabal.buildTools . Cabal.libBuildInfo) $ maybe [] return lib+  depE = concatMap Cabal.buildTools (filter Cabal.buildable (map Cabal.buildInfo exes))+  notProvided (Cabal.LegacyExeDependency pn _range) = pn `notElem` buildToolsProvided++buildToolsTable :: [(String, Portage.Dependency)]+buildToolsTable =+  [ ("happy", any_c_p "dev-haskell" "happy")+  , ("alex", any_c_p "dev-haskell" "alex")+  , ("c2hs", any_c_p "dev-haskell" "c2hs")+  , ("cabal",               any_c_p "dev-haskell" "cabal-install")+  , ("cabal-install", any_c_p "dev-haskell" "cabal-install")+  , ("cpphs",               any_c_p "dev-haskell" "cpphs")+  , ("ghc",                 any_c_p "dev-lang" "ghc")+  , ("gtk2hsTypeGen",       any_c_p "dev-haskell" "gtk2hs-buildtools")+  , ("gtk2hsHookGenerator", any_c_p "dev-haskell" "gtk2hs-buildtools")+  , ("gtk2hsC2hs",          any_c_p "dev-haskell" "gtk2hs-buildtools")+  , ("hsb2hs",              any_c_p "dev-haskell" "hsb2hs")+  , ("hsx2hs",              any_c_p "dev-haskell" "hsx2hs")+  , ("llvm-config",         any_c_p "sys-devel" "llvm")+  ]++-- tools that are provided by ghc or some other existing program+-- so we do not need dependencies on them+buildToolsProvided :: [String]+buildToolsProvided = ["hsc2hs"]++---------------------------------------------------------------+-- Hackage Build Tools (behind `build-tool-depends`)+---------------------------------------------------------------++hackageBuildToolsDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Portage.Dependency]+hackageBuildToolsDependencies overlay (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) =+  haskellDependencies overlay $ L.nub $+    [ Cabal.Dependency pn versionRange $ NES.singleton Cabal.defaultLibName+    | Cabal.ExeDependency pn _component versionRange <- cabalDeps+    ]+  where+    cabalDeps = depL ++ depE+    depL = concatMap (Cabal.buildToolDepends . Cabal.libBuildInfo) $ maybe [] return lib+    depE = concatMap Cabal.buildToolDepends (filter Cabal.buildable (map Cabal.buildInfo exes))++---------------------------------------------------------------+-- pkg-config+---------------------------------------------------------------++pkgConfigDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Portage.Dependency]+pkgConfigDependencies overlay (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = L.nub $ resolvePkgConfigs overlay cabalDeps+  where+  cabalDeps = depL ++ depE+  depL = concatMap (Cabal.pkgconfigDepends . Cabal.libBuildInfo) $ maybe [] return lib+  depE = concatMap Cabal.pkgconfigDepends (filter Cabal.buildable (map Cabal.buildInfo exes))++resolvePkgConfigs :: Portage.Overlay -> [Cabal.PkgconfigDependency] -> [Portage.Dependency]+resolvePkgConfigs overlay cdeps =+  [ case resolvePkgConfig overlay pkg of+      Just d -> d+      Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ Cabal.prettyShow pkg ++ ". Check generated ebuild.")+                       (any_c_p "unknown-pkg-config" pn)+  | pkg@(Cabal.PkgconfigDependency cabal_pn _range) <- cdeps+  , let pn = Cabal.unPkgconfigName cabal_pn+  ]++resolvePkgConfig :: Portage.Overlay -> Cabal.PkgconfigDependency -> Maybe Portage.Dependency+resolvePkgConfig _overlay (Cabal.PkgconfigDependency cabal_pn _cabalVersion) = do+  (cat,portname, slot) <- lookup (Cabal.unPkgconfigName cabal_pn) pkgconfig_table+  return $ any_c_p_s_u cat portname slot []++pkgconfig_table :: [(String, (String, String, Portage.SlotDepend))]+pkgconfig_table =+  [+   ("alsa",         ("media-libs", "alsa-lib", Portage.AnySlot))+  ,("atk",          ("dev-libs", "atk", Portage.AnySlot))+  ,("gconf-2.0",    ("gnome-base", "gconf", Portage.AnySlot))++  ,("gio-2.0",                ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gio-unix-2.0",           ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("glib-2.0",               ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gmodule-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gmodule-export-2.0",     ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gmodule-no-export-2.0",  ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gobject-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))+  ,("gobject-introspection-1.0", ("dev-libs", "gobject-introspection",+                                  Portage.AnySlot))+  ,("gthread-2.0",            ("dev-libs", "glib", Portage.GivenSlot "2"))++  ,("gtk+-2.0",            ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gdk-2.0",             ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gdk-3.0",             ("x11-libs", "gtk+", Portage.GivenSlot "3"))+  ,("gdk-pixbuf-2.0",      ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gdk-pixbuf-xlib-2.0", ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gdk-x11-2.0",         ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gtk+-unix-print-2.0", ("x11-libs", "gtk+", Portage.GivenSlot "2"))+  ,("gtk+-x11-2.0",        ("x11-libs", "gtk+", Portage.GivenSlot "2"))++  ,("gtk+-3.0",            ("x11-libs", "gtk+", Portage.GivenSlot "3"))+  ,("webkitgtk-3.0",       ("net-libs", "webkit-gtk", Portage.GivenSlot "3"))++  ,("cairo",            ("x11-libs", "cairo", Portage.AnySlot)) -- need [svg] for dev-haskell/cairo+  ,("cairo-gobject",    ("x11-libs", "cairo", Portage.AnySlot)) -- need [glib] for dev-haskell/cairo+  ,("cairo-ft",         ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-ps",         ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-png",        ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-pdf",        ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-svg",        ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-xlib",         ("x11-libs", "cairo", Portage.AnySlot))+  ,("cairo-xlib-xrender", ("x11-libs", "cairo", Portage.AnySlot))++  ,("javascriptcoregtk-4.0",   ("net-libs", "webkit-gtk", Portage.GivenSlot "4"))+  ,("webkit2gtk-4.0",          ("net-libs", "webkit-gtk", Portage.GivenSlot "4"))++  ,("pangocairo",       ("x11-libs", "pango", Portage.AnySlot))+  ,("pangoft2",         ("x11-libs", "pango", Portage.AnySlot))+  ,("pango",            ("x11-libs", "pango", Portage.AnySlot))+  ,("pangoxft",         ("x11-libs", "pango", Portage.AnySlot))+  ,("pangox",           ("x11-libs", "pango", Portage.AnySlot))++  ,("libglade-2.0", ("gnome-base", "libglade", Portage.AnySlot))+  ,("libsoup-2.4",   ("net-libs", "libsoup", Portage.GivenSlot "2.4"))+  ,("gnome-vfs-2.0", ("gnome-base", "gnome-vfs", Portage.AnySlot))+  ,("gnome-vfs-module-2.0", ("gnome-base", "gnome-vfs", Portage.AnySlot))+  ,("webkit-1.0", ("net-libs","webkit-gtk", Portage.GivenSlot "2"))+  ,("gtksourceview-3.0", ("x11-libs", "gtksourceview", Portage.GivenSlot "3.0"))++  ,("gstreamer-0.10",              ("media-libs", "gstreamer", Portage.AnySlot))+  ,("gstreamer-base-0.10",         ("media-libs", "gstreamer", Portage.AnySlot))+  ,("gstreamer-check-0.10",        ("media-libs", "gstreamer", Portage.AnySlot))+  ,("gstreamer-controller-0.10",   ("media-libs", "gstreamer", Portage.AnySlot))+  ,("gstreamer-dataprotocol-0.10", ("media-libs", "gstreamer", Portage.AnySlot))+  ,("gstreamer-net-0.10",          ("media-libs", "gstreamer", Portage.AnySlot))++  ,("gstreamer-app-0.10",          ("media-libs", "gst-plugins-base", Portage.AnySlot))+  ,("gstreamer-audio-0.10",        ("media-libs", "gst-plugins-base", Portage.AnySlot))+  ,("gstreamer-video-0.10",        ("media-libs", "gst-plugins-base", Portage.AnySlot))+  ,("gstreamer-plugins-base-0.10", ("media-libs", "gst-plugins-base", Portage.AnySlot))++  ,("gtksourceview-2.0",           ("x11-libs", "gtksourceview", Portage.GivenSlot "2.0"))+  ,("librsvg-2.0",                 ("gnome-base","librsvg", Portage.AnySlot))+  ,("vte",                         ("x11-libs","vte", Portage.GivenSlot "0"))+  ,("gtkglext-1.0",                ("x11-libs","gtkglext", Portage.AnySlot))++  ,("curl",                        ("net-misc", "curl", Portage.AnySlot))+  ,("libxml2",                     ("dev-libs", "libxml2", Portage.AnySlot))+  ,("libgsasl",                    ("virtual", "gsasl", Portage.AnySlot))+  ,("libzip",                      ("dev-libs", "libzip", Portage.AnySlot))+  ,("gnutls",                      ("net-libs", "gnutls", Portage.AnySlot))+  ,("libidn",                      ("net-dns", "libidn", Portage.AnySlot))+  ,("libxml-2.0",                  ("dev-libs", "libxml2", Portage.AnySlot))+  ,("yaml-0.1",                    ("dev-libs", "libyaml", Portage.AnySlot))+  ,("QtCore",                      ("dev-qt", "qtcore", Portage.AnySlot))+  ,("lua",                         ("dev-lang", "lua", Portage.AnySlot))+  ,("QtDeclarative",               ("dev-qt", "qtdeclarative", Portage.AnySlot))+  ,("QtGui",                       ("dev-qt", "qtgui", Portage.AnySlot))+  ,("QtOpenGL",                    ("dev-qt", "qtopengl", Portage.AnySlot))+  ,("QtScript",                    ("dev-qt", "qtscript", Portage.AnySlot))+  ,("ImageMagick",                 ("media-gfx", "imagemagick", Portage.AnySlot))+  ,("MagickWand",                  ("media-gfx", "imagemagick", Portage.AnySlot))+  ,("ncurses",                     ("sys-libs", "ncurses", Portage.AnySlot))+  ,("ncursesw",                    ("sys-libs", "ncurses", Portage.AnySlot))+  ,("panel",                       ("sys-libs", "ncurses", Portage.AnySlot))+  ,("panelw",                      ("sys-libs", "ncurses", Portage.AnySlot))+  ,("libssh2",                     ("net-libs", "libssh2", Portage.AnySlot))+  ,("SDL_image",                   ("media-libs", "sdl-image", Portage.AnySlot))+  ,("libzmq",                      ("net-libs", "zeromq", Portage.AnySlot))+  ,("taglib_c",                    ("media-libs", "taglib", Portage.AnySlot))+  ,("libcurl",                     ("net-misc", "curl", Portage.AnySlot))+  ,("libpq",                       ("dev-db", "postgresql", Portage.AnySlot))+  ,("poppler-glib",                ("app-text", "poppler", Portage.AnySlot))+  ,("gsl",                         ("sci-libs", "gsl", Portage.AnySlot))+  ,("libvirt",                     ("app-emulation", "libvirt", Portage.AnySlot))++  ,("Qt5Core",                     ("dev-qt", "qtcore", Portage.GivenSlot "5"))+  ,("Qt5Gui",                      ("dev-qt", "qtgui", Portage.GivenSlot "5"))+  ,("Qt5Qml",                      ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))+  ,("Qt5Quick",                    ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))+  ,("Qt5Widgets",                  ("dev-qt", "qtwidgets", Portage.GivenSlot "5"))++  ,("sdl2",                        ("media-libs", "libsdl2", Portage.AnySlot))+  ,("SDL2_image",                  ("media-libs", "sdl2-image", Portage.AnySlot))+  ,("SDL2_mixer",                  ("media-libs", "sdl2-mixer", Portage.AnySlot))+  ,("zlib",                        ("sys-libs", "zlib", Portage.AnySlot))+  ]
+ src/Merge/Utils.hs view
@@ -0,0 +1,212 @@+{-|+Module      : Merge.Utils+License     : GPL-3++Maintainer  : haskell@gentoo.org++Internal helper functions for "Merge".+-}+module Merge.Utils+  ( readPackageString+  , getPreviousPackageId+  , first_just_of+  , drop_prefix+  , squash_debug+  , convert_underscores+  , mangle_iuse+  , to_unstable+  , metaFlags+  , dropIfUseExpands+  -- hspec exports+  , dropIfUseExpand+  ) where++import qualified Control.Applicative as A+import qualified Control.Monad as M+import qualified Data.Char as C+import           Data.Maybe (catMaybes, mapMaybe)+import qualified Data.List as L+import qualified Data.Map.Strict as Map+import qualified System.Directory as SD+import qualified System.FilePath as SF+import           System.FilePath ((</>))+import           System.Process (readCreateProcess, shell)+import           Error+import qualified Portage.PackageId as Portage++import qualified Distribution.Package            as Cabal+import qualified Distribution.PackageDescription as Cabal++-- | Parse a ['String'] as a valid package string. E.g. @category\/name-1.0.0@.+-- Return 'HackPortError' if the string to parse is invalid.+--+-- When the ['String'] is valid:+--+-- >>> readPackageString ["dev-haskell/packagename1-1.0.0"]+-- Right (Just (Category {unCategory = "dev-haskell"}),PackageName "packagename1",Just (Version {versionNumber = [1,0,0], versionChar = Nothing, versionSuffix = [], versionRevision = 0}))+--+-- When the ['String'] is empty:+--+-- >>> readPackageString []+-- Left ...+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+    Right v@(_,_,Nothing) -> return v+    -- we only allow versions we can convert into cabal versions+    Right v@(_,_,Just (Portage.Version _ Nothing [] 0)) -> return v+    Left e -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: "+              ++ packageString ++ "\nParsec error: " ++ e+    _ -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: "+         ++ packageString++-- | Maybe return a 'Portage.PackageId' of the next highest version for a given+--   package, relative to the provided 'Portage.PackageId'.+--+-- For example:+-- +-- >>> let ebuildDir = ["foo-bar2-3.0.1.ebuild","metadata.xml"]+-- >>> let newPkgId = Portage.PackageId (Portage.PackageName (Portage.Category "dev-haskell") (Cabal.mkPackageName "foo-bar2")) (Portage.Version [3,0,2] Nothing [] 0 )+--+-- >>> getPreviousPackageId ebuildDir newPkgId+-- Just (PackageId {packageId = PackageName {category = Category {unCategory = "dev-haskell"}, cabalPkgName = PackageName "foo-bar2"}, pkgVersion = Version {versionNumber = [3,0,1], versionChar = Nothing, versionSuffix = [], versionRevision = 0}})+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)+               $ mapMaybe (Portage.filePathToPackageId (Portage.category . Portage.packageId $ newPkgId))+               $ SF.dropExtension <$> filter (\fp -> SF.takeExtension fp == ".ebuild") pkgDir+  case pkgIds of+    x:_ -> Just x+    _ -> Nothing++-- | Alias for 'msum'.+-- +-- prop> \a -> first_just_of a == M.msum a+first_just_of :: [Maybe a] -> Maybe a+first_just_of = M.msum++-- | Remove @with@ or @use@ prefixes from flag names.+--+-- >>> drop_prefix "with_conduit"+-- "conduit"+-- >>> drop_prefix "use-https"+-- "https"+-- >>> drop_prefix "no_examples"+-- "no_examples"+drop_prefix :: String -> String+drop_prefix x =+  let prefixes = ["with","use"]+      separators = ["-","_"]+      combinations = A.liftA2 (++) prefixes separators+  in case catMaybes (A.liftA2 L.stripPrefix combinations [x]) of+    [z] -> z+    _ -> x++-- | Squash debug-related @USE@ flags under the @debug@ global+--   @USE@ flag.+--+-- >>> squash_debug "use-debug-foo"+-- "debug"+-- >>> squash_debug "foo-bar"+-- "foo-bar"+squash_debug :: String -> String+squash_debug flag = if "debug" `L.isInfixOf` (C.toLower <$> flag)+                         then "debug"+                         else flag++-- | Gentoo allows underscore ('_') names in @IUSE@ only for+-- @USE_EXPAND@ values. If it's not a user-specified rename mangle+-- it into a hyphen ('-').+-- +-- >>> convert_underscores "remove_my_underscores"+-- "remove-my-underscores"+convert_underscores :: String -> String+convert_underscores = map f+  where f '_' = '-'+        f c   = c++-- | Perform all @IUSE@ mangling.+--+-- >>> mangle_iuse "use_foo-bar_debug"+-- "debug"+-- >>> mangle_iuse "with-bar_quux"+-- "bar-quux"+mangle_iuse :: String -> String+mangle_iuse = squash_debug . drop_prefix . convert_underscores++-- | Convert all stable keywords to testing (unstable) keywords.+-- Preserve arch masks (-).+--+-- >>> to_unstable "amd64"+-- "~amd64"+-- >>> to_unstable "~amd64"+-- "~amd64"+-- >>> to_unstable "-amd64"+-- "-amd64"+to_unstable :: String -> String+to_unstable kw =+    case kw of+        '~':_ -> kw+        '-':_ -> kw+        _     -> '~':kw++-- | Generate a 'Map.Map' of 'Cabal.PackageFlag' names and their descriptions.+--+-- For example, if we construct a singleton list holding a 'Cabal.PackageFlag' with+-- 'Cabal.FlagName' @foo@ and 'Cabal.FlagDescription' @bar@, we should get+-- a 'Map.Map' containing those values:+--+-- >>> let flags = [(Cabal.emptyFlag (Cabal.mkFlagName "foo")) {Cabal.flagDescription = "bar"}]+-- >>> metaFlags flags+-- fromList [("foo","bar")]+metaFlags :: [Cabal.PackageFlag] -> Map.Map String String+metaFlags flags =+  Map.fromList $+  zip (mangle_iuse . Cabal.unFlagName . Cabal.flagName <$> flags)+  (Cabal.flagDescription <$> flags)++-- | Return a list of @USE_EXPAND@s maintained by ::gentoo.+--+-- First, 'getUseExpands' runs @portageq@ to determine the 'FilePath' of the+-- directory containing valid @USE_EXPAND@s. If the 'FilePath' exists,+-- it drops the filename extensions to return a list of @USE_EXPAND@s+-- as Portage understands them. If the 'FilePath' does not exist, 'getUseExpands'+-- supplies a bare-bones list of @USE_EXPAND@s.+getUseExpands :: IO [String]+getUseExpands = do+  portDir <- readCreateProcess (shell "portageq get_repo_path / gentoo") ""+  let use_expands_dir = (L.dropWhileEnd C.isSpace portDir) </> "profiles" </> "desc"+  path_exists <- SD.doesPathExist use_expands_dir+  if path_exists+    then do use_expands_contents <- SD.listDirectory use_expands_dir+            return (SF.dropExtension <$> use_expands_contents)+    -- Provide some sensible defaults if hackport cannot find ::gentoo+    else let use_expands_contents = ["cpu_flags_arm","cpu_flags_ppc","cpu_flags_x86"]+         in return use_expands_contents++-- | Return a 'Cabal.PackageFlag' if it is not a @USE_EXPAND@.+--+-- If the 'Cabal.flagName' has a prefix matching any valid @USE_EXPAND@,+-- then return 'Nothing'. Otherwise return 'Just' 'Cabal.PackageFlag'.+dropIfUseExpand :: [String] -> Cabal.PackageFlag -> Maybe Cabal.PackageFlag+dropIfUseExpand use_expands flag =+  if or (A.liftA2 L.isPrefixOf use_expands [Cabal.unFlagName . Cabal.flagName $ flag])+  then Nothing else Just flag++-- | Strip @USE_EXPAND@s from a ['Cabal.PackageFlag'].+dropIfUseExpands :: [Cabal.PackageFlag] -> IO [Cabal.PackageFlag]+dropIfUseExpands flags = do+  use_expands <- getUseExpands+  return $ catMaybes (dropIfUseExpand use_expands <$> flags)
+ src/Overlays.hs view
@@ -0,0 +1,69 @@+module Overlays+    ( getOverlayPath+    ) where++import Control.Monad+import Data.List (nub, inits)+import Data.Maybe (maybeToList, listToMaybe, isJust, fromJust)+import qualified System.Directory as SD+import System.FilePath ((</>), splitPath, joinPath)++import Error+import Portage.Host++-- cabal+import Distribution.Verbosity+import Distribution.Simple.Utils ( info )++getOverlayPath :: Verbosity -> Maybe FilePath -> IO String+getOverlayPath verbosity override_overlay = do+  overlays <- if isJust override_overlay+                  then do info verbosity $ "Forced " ++ fromJust override_overlay+                          return [fromJust override_overlay]+                  else getOverlays+  case overlays of+    [] -> throwEx NoOverlay+    [x] -> return x+    mul -> search mul+  where+  search :: [String] -> IO String+  search mul = do+    let loop [] = throwEx (MultipleOverlays mul)+        loop (x:xs) = do+          info verbosity $ "Checking '" ++ x ++ "'..."+          found <- SD.doesDirectoryExist (x </> ".hackport")+          if found+            then do+              info verbosity "OK!"+              return x+            else do+              info verbosity "Not ok."+              loop xs+    info verbosity "There are several overlays in your configuration."+    mapM_ (info verbosity . (" * " ++)) mul+    info verbosity "Looking for one with a HackPort cache..."+    overlay <- loop mul+    info verbosity $ "I choose " ++ overlay+    info verbosity "Override my decision with hackport --overlay /my/overlay"+    return overlay++getOverlays :: IO [String]+getOverlays = do+  local    <- getLocalOverlay+  overlays <- overlay_list `fmap` getInfo+  return $ nub $ map clean $+                 maybeToList local+              ++ overlays+  where+  clean path = case reverse path of+                '/':p -> reverse p+                _ -> path++getLocalOverlay :: IO (Maybe FilePath)+getLocalOverlay = do+  curDir <- SD.getCurrentDirectory+  let lookIn = map joinPath . reverse . inits . splitPath $ curDir+  fmap listToMaybe (filterM probe lookIn)++  where+    probe dir = SD.doesDirectoryExist (dir </> "dev-haskell")
+ src/Portage/Cabal.hs view
@@ -0,0 +1,79 @@+{-|+Module      : Portage.Cabal+License     : GPL-3++Maintainer  : haskell@gentoo.org++Utilities to extract and manipulate information from a package's @.cabal@ file,+such as its license and dependencies.+-}+module Portage.Cabal+  ( convertLicense+  , partition_depends+  ) where++import qualified Data.List as L++import qualified Distribution.License as Cabal+import qualified Distribution.SPDX    as SPDX+import qualified Distribution.Package as Cabal+import qualified Distribution.Pretty  as Cabal++-- | Convert the Cabal 'SPDX.License' into the Gentoo format, as a 'String'.+--+-- Generally, if the license is one of the common free-software or+-- open-source licenses, 'convertLicense' should return the license+-- as a 'Right' 'String':+--+-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_or_later)+-- Right "GPL-3+"+--+-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_only)+-- Right "GPL-3"+--+-- If it is a more obscure license, this should alert the user by returning+-- a 'Left' 'String':+--+-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1)+-- Left ...+convertLicense :: SPDX.License -> Either String String+convertLicense l =+    case Cabal.licenseFromSPDX l of+        --  good ones+        Cabal.AGPL mv      -> Right $ "AGPL-" ++ case Cabal.prettyShow <$> mv of+                                                  Just "3"   -> "3"+                                                  Just "3.0" -> "3+"+                                                  _          -> "3" -- almost certainly version 3+        Cabal.GPL mv       -> Right $ "GPL-" ++ case Cabal.prettyShow <$> mv of+                                                  Just "2"   -> "2"+                                                  Just "2.0" -> "2+"+                                                  Just "3"   -> "3"+                                                  Just "3.0" -> "3+"+                                                  _          -> "2" -- possibly version 2+        Cabal.LGPL mv      -> Right $ "LGPL-" ++ case Cabal.prettyShow <$> mv of+                                                   Just "2"   -> "2"+                                                   -- Cabal can't handle 2.0+ properly+                                                   Just "2.0" -> "2"+                                                   Just "3"   -> "3"+                                                   Just "3.0" -> "3+"+                                                   _          -> "2.1" -- probably version 2.1+        Cabal.BSD2         -> Right "BSD-2"+        Cabal.BSD3         -> Right "BSD"+        Cabal.BSD4         -> Right "BSD-4"+        Cabal.PublicDomain -> Right "public-domain"+        Cabal.MIT          -> Right "MIT"+        Cabal.Apache mv    -> Right $ "Apache-" +++                              maybe "1.1" Cabal.prettyShow mv -- probably version 1.1+        Cabal.ISC          -> Right "ISC"+        Cabal.MPL v        -> Right $ "MPL-" ++ Cabal.prettyShow v -- probably version 1.0+        -- bad ones+        Cabal.AllRightsReserved -> Left "EULA-style licence. Please pick it manually."+        Cabal.UnknownLicense _  -> Left "license unknown to cabal. Please pick it manually."+        Cabal.OtherLicense      -> Left "(Other) Please look at license file of package and pick it manually."+        Cabal.UnspecifiedLicense -> Left "(Unspecified) Please look at license file of package and pick it manually."++-- | Extract only the dependencies which are not bundled with @GHC@.+partition_depends :: [Cabal.PackageName] -> Cabal.PackageName -> [Cabal.Dependency] -> ([Cabal.Dependency], [Cabal.Dependency])+partition_depends ghc_package_names merged_cabal_pkg_name = L.partition (not . is_internal_depend)+    where is_internal_depend (Cabal.Dependency pn _vr _lib) = is_itself || is_ghc_package+              where is_itself = pn == merged_cabal_pkg_name+                    is_ghc_package = pn `elem` ghc_package_names
+ src/Portage/Dependency.hs view
@@ -0,0 +1,10 @@+module Portage.Dependency+  (+    module Portage.Dependency.Builder+  , module Portage.Dependency.Print+  , module Portage.Dependency.Types+  ) where++import Portage.Dependency.Builder+import Portage.Dependency.Print+import Portage.Dependency.Types
+ src/Portage/Dependency/Builder.hs view
@@ -0,0 +1,32 @@+{- | Basic helpers to build depend structures -}+module Portage.Dependency.Builder+  (+    empty_dependency+  , addDepUseFlag+  , setSlotDep+  , mkUseDependency+  , overAtom+  ) where++import Portage.Dependency.Types+import Portage.Use++-- TODO: remove it and switch to 'SatisfiedDepend' instead+empty_dependency :: Dependency+empty_dependency = DependAllOf []++addDepUseFlag :: UseFlag -> Dependency -> Dependency+addDepUseFlag n = overAtom (\(Atom pn dr (DAttr s u)) -> Atom pn dr (DAttr s (n:u)))++setSlotDep :: SlotDepend -> Dependency -> Dependency+setSlotDep n = overAtom (\(Atom pn dr (DAttr _s u)) -> Atom pn dr (DAttr n u))++mkUseDependency :: (Bool, Use) -> Dependency -> Dependency+mkUseDependency (b, u) d =+  if b then DependIfUse u d empty_dependency else DependIfUse u empty_dependency d++overAtom :: (Atom -> Atom) -> Dependency -> Dependency+overAtom f (DependAllOf d) = DependAllOf $ map (overAtom f) d+overAtom f (DependAnyOf d) = DependAnyOf $ map (overAtom f) d+overAtom f (DependIfUse u d1 d2) = DependIfUse u (f `overAtom` d1) (f `overAtom` d2)+overAtom f (DependAtom a) = DependAtom (f a)
+ src/Portage/Dependency/Normalize.hs view
@@ -0,0 +1,398 @@+module Portage.Dependency.Normalize+  (+    normalize_depend+  ) where++import qualified Control.Arrow as A+import           Control.Monad+import qualified Data.List as L+import qualified Data.Set as S+import           Data.Maybe++import Portage.Dependency.Builder+import Portage.Dependency.Types+import Portage.Use++import Debug.Trace++mergeDRanges :: DRange -> DRange -> DRange+mergeDRanges _ r@(DExact _) = r+mergeDRanges l@(DExact _) _ = l+mergeDRanges (DRange ll lu) (DRange rl ru) = DRange (max ll rl) (min lu ru)++stabilize_pass :: (Dependency -> Dependency) -> Dependency -> Dependency+stabilize_pass pass d+    | d == d' = d'+    | otherwise = go d'+    where go = stabilize_pass pass+          d' = pass d++-- remove one layer of redundancy+normalization_step :: Int -> Dependency -> Dependency+normalization_step level =+      id+    . tp "PC2" (stabilize_pass (tp "PC2 step" propagate_context))+    . tp "F3" (stabilize_pass flatten)+    . tp "LC" lift_context+    . tp "PC1" (stabilize_pass (tp "PC1 step" propagate_context))+    . tp "F2" (stabilize_pass flatten)+    . tp "RD" (stabilize_pass remove_duplicates)+    . tp "RE" (stabilize_pass remove_empty)+    . tp "SD" sort_deps+    . tp "CUG" combine_use_guards+    . tp "F1" (stabilize_pass flatten)+    . tp "CAR" combine_atom_ranges+    where tp :: String -> (Dependency -> Dependency) -> Dependency -> Dependency+          tp pass_name pass d = t False d'+              where d' = pass d+                    t False = id+                    t True  =+                        trace (unwords [ "PASS"+                                       , show level+                                       , ":"+                                       , pass_name+                                       , show (length (show d))+                                       , "->"+                                       , show (length (show d'))+                                       ])++remove_empty :: Dependency -> Dependency+remove_empty d =+    case d of+        -- drop full empty nodes+        _ | is_empty_dependency d -> empty_dependency+        -- drop partial empty nodes+        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)+        DependAllOf deps        -> DependAllOf $ filter (not . is_empty_dependency) $ map go deps+        DependAnyOf deps        -> DependAnyOf $                                      map go deps+        -- no change+        DependAtom _            -> d+    where go = remove_empty++s_uniq :: [Dependency] -> [Dependency]+s_uniq = S.toList . S.fromList++-- Ideally 'combine_atom_ranges' should handle those as well+remove_duplicates :: Dependency -> Dependency+remove_duplicates d =+    case d of+        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)+        DependAnyOf deps        -> DependAnyOf $ s_uniq $ map go deps+        DependAllOf deps        -> DependAllOf $ s_uniq $ map go deps+        DependAtom  _           -> d+    where go = remove_duplicates++-- TODO: implement flattening AnyOf the same way it's done for AllOf+--   DependAnyOf [DependAnyOf [something], rest] -> DependAnyOf $ something ++ rest+flatten :: Dependency -> Dependency+flatten d =+    case d of+        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)+        DependAnyOf [dep]       -> go dep+        DependAnyOf deps        -> DependAnyOf $ map go deps++        DependAllOf deps        -> case L.partition is_dall_of deps of+                                       ([], [])      -> empty_dependency+                                       ([], [dep])   -> dep+                                       ([], ndall)   -> DependAllOf $ map go ndall+                                       (dall, ndall) -> go $ DependAllOf $ s_uniq $ (concatMap undall dall) ++ ndall+        DependAtom _            -> d+  where go :: Dependency -> Dependency+        go = flatten++        is_dall_of :: Dependency -> Bool+        is_dall_of d' =+            case d' of+                DependAllOf _deps -> True+                _                 -> False+        undall :: Dependency -> [Dependency]+        undall ~(DependAllOf ds) = ds++-- joins atoms with different version boundaries+-- DependAllOf [ DRange ">=foo-1" Inf, Drange Zero "<foo-2" ] -> DRange ">=foo-1" "<foo-2"+combine_atom_ranges :: Dependency -> Dependency+combine_atom_ranges d =+    case d of+        DependIfUse use td fd -> DependIfUse use (go td) (go fd)+        DependAllOf deps      -> DependAllOf $ map go $ find_atom_intersections  deps+        DependAnyOf deps      -> DependAnyOf $ map go $ find_atom_concatenations deps+        DependAtom  _         -> d+    where go = combine_atom_ranges++find_atom_intersections :: [Dependency] -> [Dependency]+find_atom_intersections = map merge_depends . L.groupBy is_mergeable+    where is_mergeable :: Dependency -> Dependency -> Bool+          is_mergeable (DependAtom (Atom lpn _ldrange lattr)) (DependAtom (Atom rpn _rdrange rattr))+                          = (lpn, lattr) == (rpn, rattr)+          is_mergeable _                                       _+                          = False++          merge_depends :: [Dependency] -> Dependency+          merge_depends [x] = x+          merge_depends xs = L.foldl1' merge_pair xs++          merge_pair :: Dependency -> Dependency -> Dependency+          merge_pair (DependAtom (Atom lp ld la)) (DependAtom (Atom rp rd ra))+              | lp /= rp = error "merge_pair got different 'PackageName's"+              | la /= ra = error "merge_pair got different 'DAttr's"+              | otherwise = DependAtom (Atom lp (mergeDRanges ld rd) la)+          merge_pair l r = error $ unwords ["merge_pair can't merge non-atoms:", show l, show r]++-- TODO+find_atom_concatenations :: [Dependency] -> [Dependency]+find_atom_concatenations = id++-- Eliminate use guarded redundancy:+--   a? ( foo )+--   a? ( bar )+-- gets translated to+--   a? ( foo bar )++--   a? ( foo bar )+--   !a? ( foo baz )+-- gets translated to+--   foo+--   a? ( bar )+--   !a? ( baz )++combine_use_guards :: Dependency -> Dependency+combine_use_guards d =+    case d of+        DependIfUse use td fd -> pop_common $ DependIfUse use (go td) (go fd)+        DependAllOf deps      -> DependAllOf $ map go $ find_use_intersections  deps+        DependAnyOf deps      -> DependAnyOf $ map go $ find_use_concatenations deps+        DependAtom _          -> d+    where go = combine_use_guards++find_use_intersections :: [Dependency] -> [Dependency]+find_use_intersections = map merge_use_intersections . L.groupBy is_use_mergeable+    where+        is_use_mergeable :: Dependency -> Dependency -> Bool+        is_use_mergeable (DependIfUse lu _ltd _lfd) (DependIfUse ru _rtd _rfd)+            | lu == ru       = True+        is_use_mergeable _ _ = False++        merge_use_intersections :: [Dependency] -> Dependency+        merge_use_intersections [x] = x+        merge_use_intersections ds = pop_common $ DependIfUse u (DependAllOf tds) (DependAllOf fds)+            where DependIfUse u _tf _fd = head ds+                  tfdeps ~(DependIfUse _u td fd) = (td, fd)+                  (tds, fds) = unzip $ map tfdeps ds++pop_common :: Dependency -> Dependency+-- depend+--   a? ( x ) !a? ( x )+-- gets translated to+--   x+pop_common (DependIfUse _u td fd)+    | td == fd = fd+pop_common d'@(DependIfUse _u td fd) =+    case td_ctx `L.intersect` fd_ctx of+        [] -> d'+        common_ctx -> stabilize_pass flatten $ DependAllOf $ propagate_context' common_ctx d' : common_ctx+    where td_ctx = lift_context' td+          fd_ctx = lift_context' fd+pop_common x = x++-- TODO+find_use_concatenations :: [Dependency] -> [Dependency]+find_use_concatenations = id++-- Eliminate top-down redundancy:+--   foo/bar+--   u? ( foo/bar+--        bar/baz )+-- gets translated to+--   foo/bar+--   u? ( bar/baz )+--+-- and more complex redundancy:+--   v? ( foo/bar )+--   u? ( !v? ( foo/bar ) )+-- gets translated to+--   v? ( foo/bar )+--   u? ( foo/bar )+propagate_context :: Dependency -> Dependency+propagate_context = propagate_context' []++-- very simple model: pick all sibling-atom deps and add them to context+--                    for downward proparation and remove from 'all_of' part+-- TODO: any-of part can benefit from it by removing unsatisfiable or satisfied alternative+propagate_context' :: [Dependency] -> Dependency -> Dependency+propagate_context' ctx d =+    case d of+        _ | d `elem` ctx      -> empty_dependency+        DependIfUse use td fd -> let (t_ctx_comp, t_refined_ctx) = refine_context (True,  use) ctx+                                     (f_ctx_comp, f_refined_ctx) = refine_context (False, use) ctx+                                     tdr = go t_refined_ctx td+                                     fdr = go f_refined_ctx fd+                                     ctx_comp = filter (not . is_empty_dependency) $+                                                concat [ (lift_context' tdr `L.intersect` (concatMap lift_context' t_ctx_comp))+                                                       , (lift_context' fdr `L.intersect` (concatMap lift_context' f_ctx_comp))+                                                       ]+                                     diu_refined = DependIfUse use tdr+                                                                   fdr+                                 in case ctx_comp of+                                    [] -> diu_refined+                                    _  -> go ctx $+                                              DependAllOf [ DependAllOf ctx_comp+                                                          , go ctx_comp diu_refined+                                                          ]+        DependAllOf deps      -> DependAllOf $ fromJust $ msum $+                                                   [ v+                                                   | (optimized_d, other_deps) <- slice_list deps+                                                   , let ctx' = ctx ++ other_deps+                                                         d'   = go ctx' optimized_d+                                                         d'ctx = d' : ctx+                                                         v    = case d' /= optimized_d of+                                                                    True  -> Just (d':map (go d'ctx) other_deps)+                                                                    False -> Nothing -- haven't managed to optimize anything+                                                   ] ++ [Just deps] -- unmodified+        DependAnyOf deps      -> DependAnyOf $ map (go ctx) deps+        DependAtom _          -> case any (dep_as_broad_as d) ctx of+                                     True  -> empty_dependency+                                     False -> d+  where go c = propagate_context' c++-- returns (complement-dependencies, simplified-dependencies)+refine_context :: (Bool, Use) -> [Dependency] -> ([Dependency], [Dependency])+refine_context use_cond = unzip . map (A.second (stabilize_pass flatten) . refine_ctx_unit use_cond)+    where refine_ctx_unit :: (Bool, Use) -> Dependency -> (Dependency, Dependency)+          refine_ctx_unit uc@(bu, u) d =+              case d of+                DependIfUse u' td fd+                  -> case u == u' of+                         False -> ( empty_dependency+                                  , DependIfUse u' (snd $ refine_ctx_unit uc td)+                                                   (snd $ refine_ctx_unit uc fd)+                                  )+                         True  -> case bu of+                                      True  -> (fd, snd $ refine_ctx_unit uc td)+                                      False -> (td, snd $ refine_ctx_unit uc fd)+                _ -> (empty_dependency, d)++-- generates all pairs of:+-- (list_element, list_without_element)+-- example:+--   [1,2,3]+-- yields+--   [(1, [2,3]), (2,[1,3]), (3,[1,2])]+slice_list :: [e] -> [(e, [e])]+slice_list [] = []+slice_list (e:es) = (e, es) : map (\(v, vs) -> (v, e : vs)) (slice_list es)++-- Eliminate bottom-up redundancy:+--   || ( ( foo/bar bar/baz )+--        ( foo/bar bar/quux ) )+-- gets translated to+--   foo/bar+--   || ( ( foo/bar bar/baz )+--        ( foo/bar bar/quux ) )+-- It looks like became more gross,+-- but 'propagate_context' phase+-- cleanups it to the following state:+--   foo/bar+--   || ( bar/baz+--        bar/quux )+-- TODO: better add propagation in this exact place to keep tree shrinking only+lift_context :: Dependency -> Dependency+lift_context d =+    case d of+        DependIfUse _use _td _fd -> case L.delete d new_ctx of+                                        []       -> d+                                        new_ctx' -> propagate_context $ DependAllOf $ d : new_ctx'+        DependAllOf deps         -> case new_ctx L.\\ deps of+                                        []       -> d+                                        new_ctx' -> DependAllOf $ deps ++ new_ctx'+        -- the lift itself+        DependAnyOf _deps        -> case L.delete d new_ctx of+                                         []       -> d+                                         new_ctx' -> propagate_context $ DependAllOf $ d : new_ctx'+        DependAtom  _            -> d+  where new_ctx = lift_context' d++-- lift everything that can be shared somewhere else+-- propagate_context will then pick some bits from here+-- and remove them deep inside.+-- It's the most fragile and powerfull pass+lift_context' :: Dependency -> [Dependency]+lift_context' d =+    case d of+        DependIfUse _use td fd   -> d : extract_common_constraints (map lift_context' [td, fd])+        DependAllOf deps         -> L.nub $ concatMap lift_context' deps+        DependAnyOf deps         -> d : extract_common_constraints (map lift_context' deps)+        DependAtom  _            -> [d]++-- it extracts common part of dependency comstraints.+-- Some examples:+--  'a b c' and 'b c d' have common 'b c'+--  'u? ( a  b )' and 'u? ( b c )' have common 'u? ( b )' part+--  'a? ( b? ( x y ) )' and !a? ( b? ( y z ) )' have common 'b? ( y )'+extract_common_constraints :: [[Dependency]] -> [Dependency]+extract_common_constraints [] = []+extract_common_constraints dss@(ds:dst) = common_atoms ++ common_use_guards+    where common_atoms :: [Dependency]+          common_atoms = L.foldl1' L.intersect dss+          common_use_guards :: [Dependency]+          common_use_guards = [ DependIfUse u (DependAllOf tdi) (DependAllOf fdi)+                              | DependIfUse u td fd <- ds+                              , Just (tds, fds) <- [find_matching_use_deps dst u ([lift_context' td], [lift_context' fd])]+                              , let tdi = extract_common_constraints tds+                                    fdi = extract_common_constraints fds+                              , not (null tdi && null fdi)+                              ]++find_matching_use_deps :: [[Dependency]] -> Use -> ([[Dependency]], [[Dependency]]) -> Maybe ([[Dependency]], [[Dependency]])+find_matching_use_deps dss u (tds, fds) =+    case dss of+        []       -> Just (tds, fds)+        (ds:dst) -> case [ (tc, fc)+                         | DependIfUse u' td fd <- ds+                         , u' == u+                         , let tc = lift_context' td+                               fc = lift_context' fd+                         , not (null tc && null fc)+                         ] of+                        []    -> Nothing+                        pairs -> find_matching_use_deps dst u (map fst pairs ++ tds, map snd pairs ++ fds)++-- reorders depends to make them more attractive+-- for other normalization algorithms+-- and for final pretty-printer+sort_deps :: Dependency -> Dependency+sort_deps d =+    case d of+        DependIfUse lu lt lf+            | is_empty_dependency lf ->+                case lt of+                    DependIfUse ru rt rf+                        -- b? ( a? ( d ) )+                        | ru < lu && is_empty_dependency rf -> mkUseDependency (True,  ru) $ mkUseDependency (True, lu) (go rt)+                        -- b? ( !a? ( d ) )+                        | ru < lu && is_empty_dependency rt -> mkUseDependency (False, ru) $ mkUseDependency (True, lu) (go rf)+                    _ -> DependIfUse lu (go lt) (go lf)+            | is_empty_dependency lt ->+                case lf of+                    DependIfUse ru rt rf+                        -- !b? ( a? ( d ) )+                        | ru < lu && is_empty_dependency rf -> mkUseDependency (True,  ru) $ mkUseDependency (False, lu) (go rt)+                        -- !b? ( !a? ( d ) )+                        | ru < lu && is_empty_dependency rt -> mkUseDependency (False, ru) $ mkUseDependency (False, lu) (go rf)+                    _ -> DependIfUse lu (go lt) (go lf)+        DependIfUse use td fd   -> DependIfUse use (go td) (go fd)+        DependAnyOf deps        -> DependAnyOf $ L.sort $ map go deps+        DependAllOf deps        -> DependAllOf $ L.sort $ map go deps+        DependAtom  _           -> d+    where go = sort_deps++-- remove various types of redundancy+normalize_depend :: Dependency -> Dependency+normalize_depend = normalize_depend' 50 0 -- arbitrary limit++normalize_depend' :: Int -> Int -> Dependency -> Dependency+normalize_depend' max_level level d+    | level >= max_level = trace "WARNING: Normalize_depend hung up. Optimization is incomplete." d+normalize_depend' max_level level d = next_step next_d+    where next_d = normalization_step level d+          next_step | d == next_d = id+                    | otherwise   = normalize_depend' max_level (level + 1)
+ src/Portage/Dependency/Print.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}++module Portage.Dependency.Print+  (+    dep2str+  , dep2str_noindent+  ) where++import Portage.Version+import Portage.Use++import Portage.PackageId++import qualified Distribution.Pretty as DP (Pretty(..))+import qualified Text.PrettyPrint as Disp+import Text.PrettyPrint ( vcat, nest, render )+import Text.PrettyPrint as PP ((<>))++import Portage.Dependency.Types++dispSlot :: SlotDepend -> Disp.Doc+dispSlot AnySlot          = Disp.empty+dispSlot AnyBuildTimeSlot = Disp.text ":="+dispSlot (GivenSlot slot) = Disp.text (':' : slot)++dispLBound :: PackageName -> LBound -> Disp.Doc+dispLBound pn (StrictLB    v) = Disp.char '>' PP.<> DP.pretty pn <-> DP.pretty v+dispLBound pn (NonstrictLB v) = Disp.text ">=" PP.<> DP.pretty pn <-> DP.pretty v+dispLBound _pn ZeroB = error "unhandled 'dispLBound ZeroB'"++dispUBound :: PackageName -> UBound -> Disp.Doc+dispUBound pn (StrictUB    v) = Disp.char '<' PP.<> DP.pretty pn <-> DP.pretty v+dispUBound pn (NonstrictUB v) = Disp.text "<=" PP.<> DP.pretty pn <-> DP.pretty v+dispUBound _pn InfinityB = error "unhandled 'dispUBound Infinity'"++dispDAttr :: DAttr -> Disp.Doc+dispDAttr (DAttr s u) = dispSlot s PP.<> dispUses u++dep2str :: Int -> Dependency -> String+dep2str start_indent = render . nest start_indent . showDepend++dep2str_noindent :: Dependency -> String+dep2str_noindent = render . showDepend++(<->) :: Disp.Doc -> Disp.Doc -> Disp.Doc+a <-> b = a PP.<> Disp.char '-' PP.<> b++sp :: Disp.Doc+sp = Disp.char ' '++sparens :: Disp.Doc -> Disp.Doc+sparens doc = Disp.parens (sp PP.<> valign doc PP.<> sp)++valign :: Disp.Doc -> Disp.Doc+valign d = nest 0 d++showDepend :: Dependency -> Disp.Doc+showDepend (DependAtom (Atom pn range dattr))+    = case range of+        -- any version+        DRange ZeroB InfinityB -> DP.pretty pn       PP.<> dispDAttr dattr+        DRange ZeroB ub        -> dispUBound pn ub PP.<> dispDAttr dattr+        DRange lb InfinityB    -> dispLBound pn lb PP.<> dispDAttr dattr+        -- TODO: handle >=foo-0    special case+        -- TODO: handle =foo-x.y.* special case+        DRange lb ub          ->    showDepend (DependAtom (Atom pn (DRange lb InfinityB) dattr))+                                 PP.<> Disp.char ' '+                                 PP.<> showDepend (DependAtom (Atom pn (DRange ZeroB ub)    dattr))+        DExact v              -> Disp.char '~' PP.<> DP.pretty pn <-> DP.pretty v { versionRevision = 0 } PP.<> dispDAttr dattr++showDepend (DependIfUse u td fd)  = valign $ vcat [td_doc, fd_doc]+    where td_doc+              | is_empty_dependency td = Disp.empty+              | otherwise =                  DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend td)+          fd_doc+              | is_empty_dependency fd = Disp.empty+              | otherwise = Disp.char '!' PP.<> DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend fd)+showDepend (DependAnyOf deps)   = Disp.text "||" PP.<> sp PP.<> sparens (vcat $ map showDependInAnyOf deps)+showDepend (DependAllOf deps)   = valign $ vcat $ map showDepend deps++-- needs special grouping+showDependInAnyOf :: Dependency -> Disp.Doc+showDependInAnyOf d@(DependAllOf _deps) = sparens (showDepend d)+-- both lower and upper bounds are present thus needs 2 atoms+-- TODO: '=foo-x.y.*' will take only one atom, not two+showDependInAnyOf d@(DependAtom (Atom _pn (DRange lb ub) _dattr))+    | lb /= ZeroB && ub /= InfinityB+                                       = sparens (showDepend d)+-- rest are fine+showDependInAnyOf d                    =          showDepend d
+ src/Portage/Dependency/Types.hs view
@@ -0,0 +1,168 @@+{-|+Module      : Portage.Dependency.Types+License     : GPL-3++Maintainer  : haskell@gentoo.org++Functions and types related to processing Portage dependencies.+-}+module Portage.Dependency.Types+  (+    SlotDepend(..)+  , LBound(..)+  , UBound(..)+  , DRange(..)+  , DAttr(..)+  , Dependency(..)+  , Atom(..)+  , dep_as_broad_as+  , is_empty_dependency+  , dep_is_case_of+  , range_is_case_of+  ) where++import           Portage.PackageId+import           Portage.Use++import           Control.DeepSeq (NFData(..))++-- | Type of SLOT dependency of a dependency.+data SlotDepend = AnySlot          -- ^ nothing special+                | AnyBuildTimeSlot -- ^ ':='+                | GivenSlot String -- ^ ':slotno'+    deriving (Eq, Show, Ord)++instance NFData SlotDepend where+  rnf AnySlot = ()+  rnf AnyBuildTimeSlot = ()+  rnf (GivenSlot s) = rnf s++-- | Type of lower bound of a dependency.+data LBound = StrictLB    Version -- ^ greater than (>)+            | NonstrictLB Version -- ^ greater than or equal to (>=)+            | ZeroB               -- ^ no lower bound+    deriving (Eq, Show)++instance NFData LBound where+  rnf (StrictLB v) = rnf v+  rnf (NonstrictLB v) = rnf v+  rnf ZeroB = ()++instance Ord LBound where+    compare ZeroB ZeroB = EQ+    compare ZeroB _     = LT+    compare _     ZeroB = GT+    compare (StrictLB lv)    (StrictLB rv)    = compare lv rv+    compare (NonstrictLB lv) (NonstrictLB rv) = compare lv rv+    compare (StrictLB lv)    (NonstrictLB rv) = case compare lv rv of+                                                    EQ -> GT+                                                    r  -> r+    compare (NonstrictLB lv) (StrictLB rv)    = case compare lv rv of+                                                    EQ -> LT+                                                    r  -> r+-- | Type of upper bound of a dependency.+data UBound = StrictUB Version    -- ^ less than (<)+            | NonstrictUB Version -- ^ less than or equal to (<=)+            | InfinityB           -- ^ no upper bound+    deriving (Eq, Show)++instance NFData UBound where+  rnf (StrictUB v) = rnf v+  rnf (NonstrictUB v) = rnf v+  rnf InfinityB = ()++instance Ord UBound where+    compare InfinityB InfinityB = EQ+    compare InfinityB _     = GT+    compare _         InfinityB = LT+    compare (StrictUB lv)    (StrictUB rv)    = compare lv rv+    compare (NonstrictUB lv) (NonstrictUB rv) = compare lv rv+    compare (StrictUB lv)    (NonstrictUB rv) = case compare lv rv of+                                                    EQ -> LT+                                                    r  -> r+    compare (NonstrictUB lv) (StrictUB rv)    = case compare lv rv of+                                                    EQ -> GT+                                                    r  -> r++-- | Type of dependency version.+--+-- A dependency version may either be an exact 'Version' or a+-- version range between a given 'LBound' and 'UBound'.+data DRange = DRange LBound UBound+            | DExact Version+    deriving (Eq, Show, Ord)++instance NFData DRange where+  rnf (DRange l u) = rnf l `seq` rnf u+  rnf (DExact v) = rnf v++range_is_case_of :: DRange -> DRange -> Bool+range_is_case_of (DRange llow lup) (DRange rlow rup)+   | llow >= rlow && lup <= rup = True+range_is_case_of _ _ = False++-- | True if left 'DRange' covers at least as much as the right 'DRange'.+range_as_broad_as :: DRange -> DRange -> Bool+range_as_broad_as (DRange llow lup) (DRange rlow rup)+    | llow <= rlow && lup >= rup = True+range_as_broad_as _ _ = False++data DAttr = DAttr SlotDepend [UseFlag]+    deriving (Eq, Show, Ord)++instance NFData DAttr where+  rnf (DAttr sd uf) = rnf sd `seq` rnf uf++data Dependency = DependAtom Atom+                | DependAnyOf         [Dependency]+                | DependAllOf         [Dependency]+                | DependIfUse Use      Dependency Dependency -- u? ( td ) !u? ( fd )+    deriving (Eq, Show, Ord)++instance NFData Dependency where+  rnf (DependAtom a) = rnf a+  rnf (DependAnyOf ds) = rnf ds+  rnf (DependAllOf ds) = rnf ds+  rnf (DependIfUse u d d') = rnf u `seq` rnf d `seq` rnf d'++data Atom = Atom PackageName DRange DAttr deriving (Eq, Show, Ord)++instance NFData Atom where+  rnf (Atom pn dr da) = rnf pn `seq` rnf dr `seq` rnf da++-- | True if left 'Dependency' constraint is the same as (or looser than) right+-- 'Dependency' constraint.+dep_as_broad_as :: Dependency -> Dependency -> Bool+dep_as_broad_as l r+    -- very broad (not only on atoms) special case+    | l == r = True+-- atoms+dep_as_broad_as (DependAtom (Atom lpn lr lda)) (DependAtom (Atom rpn rr rda))+    | lpn == rpn && lda == rda = lr `range_as_broad_as` rr+-- AllOf (very common case in context propagation)+dep_as_broad_as d (DependAllOf deps)+    | any (dep_as_broad_as d) deps = True+dep_as_broad_as _ _ = False++-- TODO: remove it and switch to 'SatisfiedDepend' instead+is_empty_dependency :: Dependency -> Bool+is_empty_dependency d =+    case d of+        DependIfUse _use td fd+            -> is_empty_dependency td && is_empty_dependency fd+        DependAnyOf []+            -> True -- 'any (const True) [] == False' and we don't want it+        DependAnyOf deps+            -> any is_empty_dependency deps+        DependAllOf deps+            -> all is_empty_dependency deps+        DependAtom _+            -> False++dep_is_case_of :: Dependency -> Dependency -> Bool+dep_is_case_of l r+    -- very broad (not only on atoms) special case+    | l == r = True+-- only on atoms+dep_is_case_of (DependAtom (Atom lpn lr lda)) (DependAtom (Atom rpn rr rda))+    | lpn == rpn && lda == rda = lr `range_is_case_of` rr+dep_is_case_of _ _ = False
+ src/Portage/EBuild.hs view
@@ -0,0 +1,293 @@+{-|+Module      : Portage.EBuild+License     : GPL-3++Maintainer  : haskell@gentoo.org++Functions and types related to interpreting and manipulating an ebuild,+as understood by the Portage package manager.+-}+{-# LANGUAGE CPP #-}+module Portage.EBuild+        ( EBuild(..)+        , ebuildTemplate+        , showEBuild+        , src_uri+        -- hspec exports+        , sort_iuse+        , drop_tdot+        , quote+        , toHttps+        ) where++import           Portage.Dependency+import           Portage.EBuild.CabalFeature+import           Portage.EBuild.Render+import qualified Portage.Dependency.Normalize as PN++import qualified Data.Time.Clock as TC+import qualified Data.Time.Format as TC+import qualified Data.Function as F+import qualified Data.List as L+import qualified Data.List.Split as LS+import           Data.Version(Version(..))++import           Network.URI+import qualified Paths_hackport(version)++#if ! MIN_VERSION_time(1,5,0)+import qualified System.Locale as TC+#endif++-- | Type representing the information contained in an @.ebuild@.+data EBuild = EBuild {+    name :: String,+    category :: String,+    hackage_name :: String, -- might differ a bit (we mangle case)+    version :: String,+    hackportVersion :: String,+    description :: String,+    homepage :: String,+    license :: Either String String,+    slot :: String,+    keywords :: [String],+    iuse :: [String],+    depend :: Dependency,+    depend_extra :: [String],+    rdepend :: Dependency,+    rdepend_extra :: [String]+    , features :: [CabalFeature]+    , my_pn :: Maybe String -- ^ Just 'myOldName' if the package name contains upper characters+    , src_prepare :: [String] -- ^ raw block for src_prepare() contents+    , src_configure :: [String] -- ^ raw block for src_configure() contents+    , used_options :: [(String, String)] -- ^ hints to ebuild writers/readers+                                         --   on what hackport options were used to produce an ebuild+  }++getHackportVersion :: Version -> String+getHackportVersion Version {versionBranch=(x:s)} = foldl (\y z -> y ++ "." ++ (show z)) (show x) s+getHackportVersion Version {versionBranch=[]} = ""++-- | Generate a minimal 'EBuild' template.+ebuildTemplate :: EBuild+ebuildTemplate = EBuild {+    name = "foobar",+    category = "dev-haskell",+    hackage_name = "FooBar",+    version = "0.1",+    hackportVersion = getHackportVersion Paths_hackport.version,+    description = "",+    homepage = "https://hackage.haskell.org/package/${HACKAGE_N}",+    license = Left "unassigned license?",+    slot = "0",+    keywords = ["~amd64","~x86"],+    iuse = [],+    depend = empty_dependency,+    depend_extra = [],+    rdepend = empty_dependency,+    rdepend_extra = [],+    features = [],+    my_pn = Nothing+    , src_prepare = []+    , src_configure = []+    , used_options = []+  }++-- | Given an EBuild, give the URI to the tarball of the source code.+-- Assumes that the server is always hackage.haskell.org.+-- +-- >>> src_uri ebuildTemplate+-- "https://hackage.haskell.org/package/${P}/${P}.tar.gz"+src_uri :: EBuild -> String+src_uri e =+  case my_pn e of+    -- use standard address given that the package name has no upper+    -- characters+    Nothing -> "https://hackage.haskell.org/package/${P}/${P}.tar.gz"+    -- use MY_X variables (defined in showEBuild) as we've renamed the+    -- package+    Just _  -> "https://hackage.haskell.org/package/${MY_P}/${MY_P}.tar.gz"++-- | Pretty-print an 'EBuild' as a 'String'.+showEBuild :: TC.UTCTime -> EBuild -> String+showEBuild now ebuild =+  ss ("# Copyright 1999-" ++ this_year ++ " Gentoo Authors"). nl.+  ss "# Distributed under the terms of the GNU General Public License v2". nl.+  nl.+  ss "EAPI=8". nl.+  nl.+  ss ("# ebuild generated by hackport " ++ hackportVersion ebuild). nl.+  sconcat (map (\(k, v) -> ss "#hackport: " . ss k . ss ": " . ss v . nl) $ used_options ebuild).+  nl.+  ss "CABAL_FEATURES=". quote' (sepBy " " $ map render (features ebuild)). nl.+  ss "inherit haskell-cabal". nl.+  nl.+  (case my_pn ebuild of+     Nothing -> id+     Just pn -> ss "MY_PN=". quote pn. nl.+                ss "MY_P=". quote "${MY_PN}-${PV}". nl.+                ss "S=". quote ("${WORKDIR}/${MY_P}"). nl. nl).+  ss "DESCRIPTION=". quote (drop_tdot $ description ebuild). nl.+  ss "HOMEPAGE=". quote (toHttps $ expandVars (homepage ebuild)). nl.+  ss "SRC_URI=". quote (src_uri ebuild). nl.+  nl.+  ss "LICENSE=". (either (\err -> quote "" . ss ("\t# FIXME: " ++ err))+                         quote+                         (license ebuild)). nl.+  ss "SLOT=". quote (slot ebuild). nl.+  ss "KEYWORDS=". quote' (sepBy " " $ keywords ebuild).nl.+  (if null (iuse ebuild)+    then nl+    else ss "IUSE=". quote' (sepBy " " . sort_iuse $ L.nub $ iuse ebuild). nl. nl+    ) .+  dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild).+  dep_str "DEPEND"  ( depend_extra ebuild) ( depend ebuild).++  verbatim (nl . ss "src_prepare() {" . nl)+               (src_prepare ebuild)+           (ss "}" . nl).++  verbatim (nl. ss "src_configure() {" . nl)+               (src_configure ebuild)+           (ss "}" . nl).++  id $ []+  where+        expandVars = replaceMultiVars [ (        name ebuild, "${PN}")+                                      , (hackage_name ebuild, "${HACKAGE_N}")+                                      ]+++        this_year :: String+        this_year = TC.formatTime TC.defaultTimeLocale "%Y" now++-- | Convert http urls into https urls, unless whitelisted as http-only.+--+-- >>> toHttps "http://darcs.net"+-- "http://darcs.net"+-- >>> toHttps "http://pandoc.org"+-- "https://pandoc.org"+-- >>> toHttps "https://github.com"+-- "https://github.com"+toHttps :: String -> String+toHttps x =+  case parseURI x of+    Just uri -> if uriScheme uri == "http:" &&+                   (uriRegName <$> uriAuthority uri)+                   `notElem`+                   httpOnlyHomepages+                then replace "http" "https" x+                else x+    Nothing -> x+  where+    replace old new = L.intercalate new . LS.splitOn old+    -- add to this list with any non https-aware websites+    httpOnlyHomepages = Just <$> [ "leksah.org"+                                 , "darcs.net"+                                 , "khumba.net"+                                 ]++-- | Sort IUSE alphabetically+--+-- >>> sort_iuse ["+a","b"]+-- ["+a","b"]+sort_iuse :: [String] -> [String]+sort_iuse = L.sortBy (compare `F.on` dropWhile ( `elem` "+"))++-- | Drop trailing dot(s).+--+-- >>> drop_tdot "foo."+-- "foo"+-- >>> drop_tdot "foo..."+-- "foo"+drop_tdot :: String -> String+drop_tdot = reverse . dropWhile (== '.') . reverse++type DString = String -> String++ss :: String -> DString+ss = showString++sc :: Char -> DString+sc = showChar++nl :: DString+nl = sc '\n'++verbatim :: DString -> [String] -> DString -> DString+verbatim pre s post =+    if null s+        then id+        else pre .+            (foldl (\acc v -> acc . ss "\t" . ss v . nl) id s) .+            post++sconcat :: [DString] -> DString+sconcat = L.foldl' (.) id++-- takes string and substitutes tabs to spaces+-- ebuild's convention is 4 spaces for one tab,+-- BUT! nested USE flags get moved too much to+-- right. Thus 8 :]+tab_size :: Int+tab_size = 8++tabify_line :: String -> String+tabify_line l = replicate need_tabs '\t'  ++ nonsp+    where (sp, nonsp)       = break (/= ' ') l+          (full_tabs, t) = length sp `divMod` tab_size+          need_tabs = full_tabs + if t > 0 then 1 else 0++tabify :: String -> String+tabify = unlines . map tabify_line . lines++dep_str :: String -> [String] -> Dependency -> DString+dep_str var extra dep = ss var. sc '='. quote' (ss $ drop_leadings $ unlines extra ++ deps_s). nl+    where indent = 1 * tab_size+          deps_s = tabify (dep2str indent $ PN.normalize_depend dep)+          drop_leadings = dropWhile (== '\t')++-- | Place a 'String' between quotes, and correctly handle special characters.+quote :: String -> DString+quote str = sc '"'. ss (esc str). sc '"'+  where+  esc = concatMap esc'+  esc' c =+      case c of+          '\\' -> "\\\\"+          '"'  -> "\\\""+          '\n' -> " "+          '`'  -> "'"+          _    -> [c]++quote' :: DString -> DString+quote' str = sc '"'. str. sc '"'++sepBy :: String -> [String] -> ShowS+sepBy _ []     = id+sepBy _ [x]    = ss x+sepBy s (x:xs) = ss x. ss s. sepBy s xs++getRestIfPrefix :: String       -- ^ the prefix+                -> String       -- ^ the string+                -> Maybe String+getRestIfPrefix (p:ps) (x:xs) = if p==x then getRestIfPrefix ps xs else Nothing+getRestIfPrefix [] rest = Just rest+getRestIfPrefix _ [] = Nothing++subStr :: String                -- ^ the search string+       -> String                -- ^ the string to be searched+       -> Maybe (String,String) -- ^ Just (pre,post) if string is found+subStr sstr str = case getRestIfPrefix sstr str of+    Nothing -> if null str then Nothing else case subStr sstr (tail str) of+        Nothing -> Nothing+        Just (pre,post) -> Just (head str:pre,post)+    Just rest -> Just ([],rest)++replaceMultiVars ::+    [(String,String)] -- ^ pairs of variable name and content+    -> String         -- ^ string to be searched+    -> String         -- ^ the result+replaceMultiVars [] str = str+replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of+    Nothing -> replaceMultiVars rest str+    Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
+ src/Portage/EBuild/CabalFeature.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE LambdaCase #-}++-- | Support for CABAL_FEATURES="..." in haskell-cabal .ebuild files.+-- See haskell-cabal.eclass for details on each of those.+module Portage.EBuild.CabalFeature (CabalFeature(..)) where++import Portage.EBuild.Render++-- | Type representing @CABAL_FEATURES@ in an ebuild.+data CabalFeature = Lib+                  | Profile+                  | Haddock+                  | Hoogle+                  | HsColour+                  | TestSuite+    deriving Eq++instance Render CabalFeature where+    render = \case+                 Lib        -> "lib"+                 Profile    -> "profile"+                 Haddock    -> "haddock"+                 Hoogle     -> "hoogle"+                 HsColour   -> "hscolour"+                 TestSuite  -> "test-suite"
+ src/Portage/EBuild/Render.hs view
@@ -0,0 +1,6 @@+-- CABAL_FEATURES="..." in haskell-cabal .ebuild files+module Portage.EBuild.Render (Render(..)) where++class Render a where+    render :: a -> String+
+ src/Portage/EMeta.hs view
@@ -0,0 +1,107 @@+{-|+Module      : Portage.EMeta+License     : GPL-3++Maintainer  : haskell@gentoo.org++Functions to propagate existing ebuild information+(such as its licence, description, switched flags etc.) to+a new ebuild.+-}+module Portage.EMeta+  ( EMeta(..)+  , findExistingMeta+  ) where++import Control.Monad+import Data.Char (isSpace)+import qualified Data.List as L++import System.Directory (doesDirectoryExist, getDirectoryContents)+import System.FilePath ((</>))+import Text.Printf++-- | Extract a value of variable in \'var=\"val\"\' format.+-- There should be exactly one variable assignment in the ebuild.+-- It's a bit of an artificial limitation, but it's common for \'if / else\' blocks.+extract_quoted_string :: FilePath -> String -> String -> Maybe String+extract_quoted_string ebuild_path s_ebuild var_name =+    case filter (L.isPrefixOf var_prefix . ltrim) $ lines s_ebuild of+        []        -> Nothing+        [kw_line] -> up_to_quote $ skip_prefix $ ltrim kw_line+        other     -> bail_out $ printf "strange '%s' assignments:\n%s" var_name (unlines other)++    where ltrim :: String -> String+          ltrim = dropWhile isSpace+          var_prefix = var_name ++ "=\""+          skip_prefix = drop (length var_prefix)+          up_to_quote l = case break (== '"') l of+                              ("", _)  -> Nothing -- empty line+                              (_, "")  -> bail_out $ printf "failed to find closing quote for '%s'" l+                              (val, _) -> Just val+          bail_out :: String -> e+          bail_out msg = error $ printf "%s:extract_quoted_string %s" ebuild_path msg++-- | Extract a value of variable in \'#hackport: var: val\' format.+-- There should be exactly one variable assignment in the ebuild.+extract_hackport_var :: FilePath -> String -> String -> Maybe String+extract_hackport_var ebuild_path s_ebuild var_name =+    case filter (L.isPrefixOf var_prefix) $ lines s_ebuild of+        []         -> Nothing+        [var_line] -> Just $ skip_prefix var_line+        other      -> bail_out $ printf "strange '%s' assignmets:\n%s" var_name (unlines other)++    where var_prefix = "#hackport: " ++ var_name ++ ": "+          skip_prefix = drop (length var_prefix)+          bail_out :: String -> e+          bail_out msg = error $ printf "%s:extract_hackport_var %s" ebuild_path msg++-- | Extract the existing keywords from an ebuild.+extractKeywords :: FilePath -> String -> Maybe [String]+extractKeywords ebuild_path s_ebuild =+    words `fmap ` extract_quoted_string ebuild_path s_ebuild "KEYWORDS"++-- | Extract the existing license from an ebuild.+extractLicense :: FilePath -> String -> Maybe String+extractLicense ebuild_path s_ebuild =+    extract_quoted_string ebuild_path s_ebuild "LICENSE"++-- | Extract the existing Cabal flags from an ebuild.+extractCabalFlags :: FilePath -> String -> Maybe String+extractCabalFlags ebuild_path s_ebuild =+    extract_hackport_var ebuild_path s_ebuild "flags"++-- | Extract the existing description from an ebuild.+extractDescription :: FilePath -> String -> Maybe String+extractDescription ebuild_path s_ebuild =+    extract_quoted_string ebuild_path s_ebuild "DESCRIPTION"++-- | Type representing the aggregated (best inferred) metadata for a+-- new ebuild of a package.+data EMeta = EMeta { keywords :: Maybe [String]+                   , license  :: Maybe String+                   , cabal_flags :: Maybe String+                   , description :: Maybe String+                   }++-- | Find the existing package metadata from the last available ebuild.+findExistingMeta :: FilePath -> IO EMeta+findExistingMeta pkgdir =+    do ebuilds <- filter (L.isSuffixOf ".ebuild") `fmap` do b <- doesDirectoryExist pkgdir+                                                            if b then getDirectoryContents pkgdir+                                                                 else return []+       -- TODO: version sort+       e_metas <- forM ebuilds $ \e ->+                      do let e_path = pkgdir </> e+                         e_conts <- readFile e_path+                         return EMeta { keywords = extractKeywords e e_conts+                                      , license = extractLicense  e e_conts+                                      , cabal_flags = extractCabalFlags e e_conts+                                      , description = extractDescription e e_conts+                                      }+       let get_latest candidates = last (Nothing : filter (/= Nothing) candidates)+           aggregated_meta = EMeta { keywords = get_latest $ map keywords e_metas+                                   , license = get_latest $ map license e_metas+                                   , cabal_flags = get_latest $ map cabal_flags e_metas+                                   , description = get_latest $ map description e_metas+                                   }+       return aggregated_meta
+ src/Portage/GHCCore.hs view
@@ -0,0 +1,483 @@+{-|+Module      : Portage.GHCCore+License     : GPL-3++Maintainer  : haskell@gentoo.org++Guess the appropriate GHC version from packages depended upon.+-}+module Portage.GHCCore+        ( minimumGHCVersionToBuildPackage+        , cabalFromGHC+        , defaultComponentRequestedSpec+        , finalizePD+        , platform+        , dependencySatisfiable+        -- hspec exports+        , packageIsCoreInAnyGHC+        ) where++import qualified Distribution.Compiler as DC+import qualified Distribution.Package as Cabal+import qualified Distribution.Version as Cabal+import Distribution.Version+import Distribution.Simple.PackageIndex+import Distribution.InstalledPackageInfo as IPI++import Distribution.PackageDescription+import Distribution.PackageDescription.Configuration+import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))+import Distribution.System+import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)++import Distribution.Pretty (prettyShow)++import Data.Maybe+import Data.List ( nub )++import Debug.Trace++-- | Try each @GHC@ version in the specified order, from left to right.+-- The first @GHC@ version in this list is a minimum default.+ghcs :: [(DC.CompilerInfo, InstalledPackageIndex)]+ghcs = modern_ghcs+    where modern_ghcs  = [ghc843, ghc863, ghc865, ghc881, ghc883, ghc884, ghc8101, ghc8104, ghc902]++-- | Maybe determine the appropriate 'Cabal.Version' of the @Cabal@ package+-- from a given @GHC@ version.+--+-- >>> cabalFromGHC [8,8,3]+-- Just (mkVersion [3,0,1,0])+-- >>> cabalFromGHC [9,9,9,9]+-- Nothing+cabalFromGHC :: [Int] -> Maybe Cabal.Version+cabalFromGHC ver = lookup ver table+  where+  table = [ ([8,4,3],  Cabal.mkVersion [2,2,0,1])+          , ([8,6,3],  Cabal.mkVersion [2,4,0,1])+          , ([8,6,5],  Cabal.mkVersion [2,4,0,1])+          , ([8,8,1],  Cabal.mkVersion [3,0,0,0])+          , ([8,8,3],  Cabal.mkVersion [3,0,1,0])+          , ([8,8,4],  Cabal.mkVersion [3,0,1,0])+          , ([8,10,1], Cabal.mkVersion [3,2,0,0])+          , ([8,10,4], Cabal.mkVersion [3,2,1,0])+          , ([9,0,2], Cabal.mkVersion [3,4,1,0])          +          ]++platform :: Platform+platform = Platform X86_64 Linux++-- | Is the package a core dependency of a specific version of @GHC@?+--+-- >>> packageIsCore (mkIndex ghc883_pkgs) (Cabal.mkPackageName "binary")+-- True+-- >>> all (== True) ((packageIsCore (mkIndex ghc883_pkgs)) <$> (packageNamesFromPackageIndex (mkIndex ghc883_pkgs)))+-- True+packageIsCore :: InstalledPackageIndex -> Cabal.PackageName -> Bool+packageIsCore index pn = not . null $ lookupPackageName index pn++-- | Is the package a core dependency of any version of @GHC@?+-- >>> packageIsCoreInAnyGHC (Cabal.mkPackageName "array")+-- True+packageIsCoreInAnyGHC :: Cabal.PackageName -> Bool+packageIsCoreInAnyGHC pn = any (flip packageIsCore pn) (map snd ghcs)++-- | Check if a dependency is satisfiable given a 'PackageIndex'+-- representing the core packages in a GHC version.+-- Packages that are not core will always be accepted, packages that are+-- core in any ghc must be satisfied by the 'PackageIndex'.+dependencySatisfiable :: InstalledPackageIndex -> Cabal.Dependency -> Bool+dependencySatisfiable pindex dep@(Cabal.Dependency pn _rang _lib)+  | Cabal.unPackageName pn == "Win32" = False -- only exists on windows, not in linux+  | not . null $ lookupDependency pindex (Cabal.depPkgName dep) (Cabal.depVerRange dep) = True -- the package index satisfies the dep+  | packageIsCoreInAnyGHC pn = False -- some other ghcs support the dependency+  | otherwise = True -- the dep is not related with core packages, accept the dep++packageBuildableWithGHCVersion+  :: GenericPackageDescription+  -> FlagAssignment+  -> (DC.CompilerInfo, InstalledPackageIndex)+  -> Either [Cabal.Dependency] (PackageDescription, FlagAssignment)+packageBuildableWithGHCVersion pkg user_specified_fas (compiler_info, pkgIndex) = trace_failure $+  finalizePD user_specified_fas defaultComponentRequestedSpec (dependencySatisfiable pkgIndex) platform compiler_info [] pkg+    where trace_failure v = case v of+              (Left deps) -> trace (unwords ["rejecting dep:" , show_compiler compiler_info+                                            , "as", show_deps deps+                                            , "were not found."+                                            ]+                                   ) v+              _           -> trace (unwords ["accepting dep:" , show_compiler compiler_info+                                            ]+                                   ) v+          show_deps = show . map prettyShow+          show_compiler (DC.CompilerInfo { DC.compilerInfoId = CompilerId GHC v }) = "ghc-" ++ prettyShow v+          show_compiler c = show c++-- | Given a 'GenericPackageDescription' it returns the miminum GHC version+-- to build a package, and a list of core packages to that GHC version.+minimumGHCVersionToBuildPackage :: GenericPackageDescription -> FlagAssignment -> Maybe ( DC.CompilerInfo+                                                                                        , [Cabal.PackageName]+                                                                                        , PackageDescription+                                                                                        , FlagAssignment+                                                                                        , InstalledPackageIndex)+minimumGHCVersionToBuildPackage gpd user_specified_fas =+  listToMaybe [ (cinfo, packageNamesFromPackageIndex pix, pkg_desc, picked_flags, pix)+              | g@(cinfo, pix) <- ghcs+              , Right (pkg_desc, picked_flags) <- return (packageBuildableWithGHCVersion gpd user_specified_fas g)]++-- | Create an 'InstalledPackageIndex' from a ['Cabal.PackageIdentifier'].+-- This is used to generate an index of core @GHC@ packages from the provided+-- ['Cabal.PackageIdentifier'] functions, e.g. 'ghc883_pkgs'.+mkIndex :: [Cabal.PackageIdentifier] -> InstalledPackageIndex+mkIndex pids = fromList+  [ emptyInstalledPackageInfo+      { sourcePackageId = pindex+      , exposed = True+      }+  | pindex@(Cabal.PackageIdentifier _name _version) <- pids ]++packageNamesFromPackageIndex :: InstalledPackageIndex -> [Cabal.PackageName]+packageNamesFromPackageIndex pix = nub $ map fst $ allPackagesByName pix++ghc :: [Int] -> DC.CompilerInfo+ghc nrs = DC.unknownCompilerInfo c_id DC.NoAbiTag+    where c_id = CompilerId GHC (mkVersion nrs)++ghc902 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc902 = (ghc [9,0,2], mkIndex ghc902_pkgs)++ghc8104 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc8104 = (ghc [8,10,4], mkIndex ghc8104_pkgs)++ghc8101 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc8101 = (ghc [8,10,1], mkIndex ghc8101_pkgs)++ghc884 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc884 = (ghc [8,8,4], mkIndex ghc884_pkgs)++ghc883 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc883 = (ghc [8,8,3], mkIndex ghc883_pkgs)++ghc881 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc881 = (ghc [8,8,1], mkIndex ghc881_pkgs)++ghc865 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc865 = (ghc [8,6,5], mkIndex ghc865_pkgs)++ghc863 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc863 = (ghc [8,6,3], mkIndex ghc863_pkgs)++ghc843 :: (DC.CompilerInfo, InstalledPackageIndex)+ghc843 = (ghc [8,4,3], mkIndex ghc843_pkgs)++-- | Non-upgradeable core packages+-- Sources:+--  * release notes+--      example: https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html+--  * our binary tarballs (package.conf.d.initial subdir)+--  * ancient: http://haskell.org/haskellwiki/Libraries_released_with_GHC+ghc902_pkgs :: [Cabal.PackageIdentifier]+ghc902_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,15,1,0]+  , p "binary" [0,8,8,0] -- used by libghc+  , p "bytestring" [0,10,12,1]+--  , p "Cabal" [3,4,1,0]  package is upgradeable+  , p "containers" [0,6,4,1]+  , p "deepseq" [1,4,5,0] -- used by time+  , p "directory" [1,3,6,2]+  , p "filepath" [1,4,2,1]+  , p "exceptions" [0,10,4] -- used by libghc+  , p "ghc-bignum" [1,1]+  , p "ghc-boot" [9,0,2]+  , p "ghc-boot-th" [9,0,2]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,7,0]+  , p "ghc-heap" [9,0,2]+  , p "ghci" [9,0,2]+--  , p "haskeline" [0,8,2]  package is upgradeable+  , p "hpc" [0,6,1,0] -- used by libghc+  , p "integer-gmp" [1,1]+  , p "mtl" [2,2,2]  -- used by exceptions+  , p "parsec" [3,1,14,0]  -- used by exceptions+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,13,2]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,17,0,0] -- used by libghc+  , p "terminfo" [0,4,1,5] -- used by libghc+  , p "text" [1,2,5,0] -- used by libghc+  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc8104_pkgs :: [Cabal.PackageIdentifier]+ghc8104_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,14,1,0]+  , p "binary" [0,8,8,0] -- used by libghc+  , p "bytestring" [0,10,12,0]+--  , p "Cabal" [3,2,1,0]  package is upgradeable+  , p "containers" [0,6,2,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,6,0]+  , p "filepath" [1,4,2,1]+  , p "exceptions" [0,10,4] -- used by libghc in ghc-9.0.2+  , p "ghc-boot" [8,10,4]+  , p "ghc-boot-th" [8,10,4]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,6,1,0]+  , p "ghc-heap" [8,10,4]+  , p "ghci" [8,10,4]+--  , p "haskeline" [0,8,0,1]  package is upgradeable+  , p "hpc" [0,6,1,0] -- used by libghc+  , p "integer-gmp" [1,0,3,0]+  , p "mtl" [2,2,2]  -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,14,0]  -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,9,0]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,16,0,0] -- used by libghc+  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,4,1] -- used by libghc in ghc-9.0.2+  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc8101_pkgs :: [Cabal.PackageIdentifier]+ghc8101_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,14,0,0]+  , p "binary" [0,8,8,0] -- used by libghc+  , p "bytestring" [0,10,10,0]+--  , p "Cabal" [3,2,0,0]  package is upgradeable+  , p "containers" [0,6,2,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,6,0]+  , p "filepath" [1,4,2,1]+  , p "exceptions" [0,10,4] -- used by libghc in ghc-9.0.2+  , p "ghc-boot" [8,10,1]+  , p "ghc-boot-th" [8,10,1]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,6,1,0]+  , p "ghc-heap" [8,10,1]+  , p "ghci" [8,10,1]+--  , p "haskeline" [0,8,0,0]  package is upgradeable+  , p "hpc" [0,6,1,0] -- used by libghc+  , p "integer-gmp" [1,0,3,0]+  , p "mtl" [2,2,2]  -- used by libghc in ghc-9.0.2 +  , p "parsec" [3,1,14,0]  -- used by libghc in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,8,2]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,16,0,0] -- used by libghc+  , p "terminfo" [0,4,1,4]  -- used by libghc in ghc-9.0.2+  , p "text" [1,2,3,2]  -- used by libghc in ghc-9.0.2+  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc884_pkgs :: [Cabal.PackageIdentifier]+ghc884_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,13,0,0]+  , p "binary" [0,8,7,0] -- used by libghc+  , p "bytestring" [0,10,10,1]+--  , p "Cabal" [3,0,1,0]  package is upgradeable+  , p "containers" [0,6,2,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,6,0]+  , p "filepath" [1,4,2,1]+  , p "ghc-boot" [8,8,4]+  , p "ghc-boot-th" [8,8,4]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,3,0]+  , p "ghci" [8,8,4]+--  , p "haskeline" [0,7,5,0]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2]  -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,9,0]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,15,0,0] -- used by libghc+  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2+  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc883_pkgs :: [Cabal.PackageIdentifier]+ghc883_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,13,0,0]+  , p "binary" [0,8,7,0] -- used by libghc+  , p "bytestring" [0,10,10,0]+--  , p "Cabal" [3,0,1,0]  package is upgradeable+  , p "containers" [0,6,2,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,6,0]+  , p "filepath" [1,4,2,1]+  , p "ghc-boot" [8,8,3]+  , p "ghc-boot-th" [8,8,3]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,3,0]+  , p "ghci" [8,8,3]+--  , p "haskeline" [0,7,5,0]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,8,0]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,15,0,0] -- used by libghc+  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2 +  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc881_pkgs :: [Cabal.PackageIdentifier]+ghc881_pkgs =+  [ p "array" [0,5,4,0]+  , p "base" [4,13,0,0]+  , p "binary" [0,8,7,0] -- used by libghc+  , p "bytestring" [0,10,9,0]+--  , p "Cabal" [3,0,0,0]  package is upgradeable+  , p "containers" [0,6,2,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,3,2]+  , p "filepath" [1,4,2,1]+  , p "ghc-boot" [8,8,1]+  , p "ghc-boot-th" [8,8,1]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,3,0]+  , p "ghci" [8,8,1]+--  , p "haskeline" [0,7,4,3]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,14,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,5,1]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,15,0,0] -- used by libghc+  , p "terminfo" [0,4,1,4] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,4,0] -- used by libghc in ghc-9.0.2+  , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc865_pkgs :: [Cabal.PackageIdentifier]+ghc865_pkgs =+  [ p "array" [0,5,3,0]+  , p "base" [4,12,0,0]+  , p "binary" [0,8,6,0] -- used by libghc+  , p "bytestring" [0,10,8,2]+--  , p "Cabal" [2,4,0,1]  package is upgradeable+  , p "containers" [0,6,0,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,3,0]+  , p "filepath" [1,4,2,1]+  , p "ghc-boot" [8,6,5]+  , p "ghc-boot-th" [8,6,5]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,3,0]+  , p "ghci" [8,6,5]+--  , p "haskeline" [0,7,4,3]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,5,0]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,14,0,0] -- used by libghc+  , p "terminfo" [0,4,1,2] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,3,1] -- used by libghc in ghc-9.0.2+  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,6,2] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc863_pkgs :: [Cabal.PackageIdentifier]+ghc863_pkgs =+  [ p "array" [0,5,3,0]+  , p "base" [4,12,0,0]+  , p "binary" [0,8,6,0] -- used by libghc+  , p "bytestring" [0,10,8,2]+--  , p "Cabal" [2,4,0,1]  package is upgradeable+  , p "containers" [0,6,0,1]+  , p "deepseq" [1,4,4,0] -- used by time+  , p "directory" [1,3,3,0]+  , p "filepath" [1,4,2,1]+  , p "ghc-boot" [8,6,3]+  , p "ghc-boot-th" [8,6,3]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,3,0]+  , p "ghci" [8,6,3]+--  , p "haskeline" [0,7,4,3]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,3,0]+  --  , p "stm" [2,5,0,0]  package is upgradeable(?)+  , p "template-haskell" [2,14,0,0] -- used by libghc+  , p "terminfo" [0,4,1,2] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,3,1] -- used by libghc in ghc-9.0.2+  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,5,0] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++ghc843_pkgs :: [Cabal.PackageIdentifier]+ghc843_pkgs =+  [ p "array" [0,5,2,0]+  , p "base" [4,11,1,0]+  , p "binary" [0,8,5,1] -- used by libghc+  , p "bytestring" [0,10,8,2]+--  , p "Cabal" [2,2,0,1]  package is upgradeable+  , p "containers" [0,5,11,2]+  , p "deepseq" [1,4,3,0] -- used by time+  , p "directory" [1,3,1,5]+  , p "filepath" [1,4,2]+  , p "ghc-boot" [8,4,3]+  , p "ghc-boot-th" [8,4,3]+  , p "ghc-compact" [0,1,0,0]+  , p "ghc-prim" [0,5,2,0]+  , p "ghci" [8,4,3]+--  , p "haskeline" [0,7,4,2]  package is upgradeable+  , p "hpc" [0,6,0,3] -- used by libghc+  , p "integer-gmp" [1,0,2,0]+  , p "mtl" [2,2,2] -- used by exceptions in ghc-9.0.2+  , p "parsec" [3,1,13,0] -- used by exceptions in ghc-9.0.2+  , p "pretty" [1,1,3,6]+  , p "process" [1,6,3,0]+  --  , p "stm" [2,4,5,0]  package is upgradeable(?)+  , p "template-haskell" [2,13,0,0] -- used by libghc+  , p "terminfo" [0,4,1,1] -- used by libghc in ghc-9.0.2+  , p "text" [1,2,3,0] -- used by libghc in ghc-9.0.2+  , p "time" [1,8,0,2] -- used by unix, directory, hpc, ghc. unsafe to upgrade+  , p "transformers" [0,5,5,0] -- used by libghc+  , p "unix" [2,7,2,2]+--  , p "xhtml" [3000,2,2,1]+  ]++p :: String -> [Int] -> Cabal.PackageIdentifier+p pn vs = Cabal.PackageIdentifier (Cabal.mkPackageName pn) (mkVersion vs)
+ src/Portage/Host.hs view
@@ -0,0 +1,121 @@+module Portage.Host+  ( getInfo -- :: IO [(String, String)]+  , LocalInfo(..)+  ) where++import Util (run_cmd)+import qualified Data.List.Split as DLS+import Data.Maybe (fromJust, isJust, mapMaybe)++import qualified System.Directory as D+import           System.FilePath ((</>))++import System.IO++data LocalInfo =+    LocalInfo { distfiles_dir :: String+              , overlay_list  :: [FilePath]+              , portage_dir   :: FilePath+              } deriving (Read, Show)++defaultInfo :: LocalInfo+defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"+                        , overlay_list  = []+                        , portage_dir   = "/usr/portage"+                        }++-- query paludis and then emerge+getInfo :: IO LocalInfo+getInfo = fromJust `fmap`+    performMaybes [ readConfig+                  , performMaybes [ getPaludisInfo+                                  , askPortageq+                                  , return (Just defaultInfo)+                                  ] >>= showAnnoyingWarning+                  ]+    where performMaybes [] = return Nothing+          performMaybes (act:acts) =+              do r <- act+                 if isJust r+                     then return r+                     else performMaybes acts++showAnnoyingWarning :: Maybe LocalInfo -> IO (Maybe LocalInfo)+showAnnoyingWarning info = do+    hPutStr stderr $ unlines [ "-- Consider creating ~/" ++ hackport_config ++ " file with contents:"+                             , show info+                             , "-- It will speed hackport startup time a bit."+                             ]+    return info++-- relative to home dir+hackport_config :: FilePath+hackport_config = ".hackport" </> "repositories"++--------------------------+-- fastest: config reading+--------------------------+readConfig :: IO (Maybe LocalInfo)+readConfig =+    do home_dir <- D.getHomeDirectory+       let config_path  = home_dir </> hackport_config+       exists <- D.doesFileExist config_path+       if exists then read <$> readFile config_path else return Nothing++----------+-- Paludis+----------++getPaludisInfo :: IO (Maybe LocalInfo)+getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info"++parsePaludisInfo :: String -> LocalInfo+parsePaludisInfo text =+  let chunks = DLS.splitOn [""] . lines $ text+      repositories = mapMaybe parseRepository chunks+  in  fromJust (mkLocalInfo repositories)+  where+  parseRepository :: [String] -> Maybe (String, (String, String))+  parseRepository [] = Nothing+  parseRepository (firstLine:lns) = do+    name <- case words firstLine of+                ["Repository", nm] -> return (init nm)+                _ -> fail "not a repository chunk"+    let dict = [ (head ln, unwords (tail ln)) | ln <- map words lns ]+    location <- lookup "location" dict+    distfiles <- lookup "distdir" dict+    return (name, (location, distfiles))++  mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo+  mkLocalInfo repos = do+    (gentooLocation, gentooDistfiles) <- lookup "gentoo" repos+    let overlays = [ loc | (_, (loc, _dist)) <- repos ]+    return (LocalInfo+              { distfiles_dir = gentooDistfiles+              , portage_dir = gentooLocation+              , overlay_list = overlays+              })++---------+-- Emerge+---------++askPortageq :: IO (Maybe LocalInfo)+askPortageq = do+    distdir <- run_cmd "portageq distdir"+    portdir <- run_cmd "portageq get_repo_path / gentoo"+    hsRepo  <- run_cmd "portageq get_repo_path / haskell"+    --There really ought to be both distdir and portdir,+    --but maybe no hsRepo defined yet.+    let info = if Nothing `elem` [distdir,portdir]+               then Nothing+               else Just LocalInfo+                      { distfiles_dir = grab distdir+                      , portage_dir = grab portdir+                      , overlay_list = iffy hsRepo+                      }+                 --init: kill newline char+                 where grab = init . fromJust+                       iffy Nothing     = []+                       iffy (Just repo) = [init repo]+    return info
+ src/Portage/Metadata.hs view
@@ -0,0 +1,129 @@+{-|+Module      : Portage.Metadata+License     : GPL-3++Maintainer  : haskell@gentoo.org++Functions and types related to @metadata.xml@ processing+-}+module Portage.Metadata+        ( Metadata(..)+        , metadataFromFile+        , pureMetadataFromFile+        , stripGlobalUseFlags -- exported for hspec+        , prettyPrintFlags -- exported for hspec+        , prettyPrintFlagsHuman+        , makeDefaultMetadata+        , makeMinimalMetadata+        ) where++import qualified AnsiColor as A++import qualified Data.List       as L+import qualified Data.Map.Strict as Map+import qualified Data.Text       as T+import qualified Data.Text.IO    as T++import Text.XML.Light++-- | A data type for the Gentoo-specific @metadata.xml@ file.+-- Currently defines functions for the maintainer email and+-- USE flags and their descriptions.+data Metadata = Metadata+      { metadataEmails :: [String] -- ^ This should /always/ be [\"haskell@gentoo.org\"].+      , metadataUseFlags :: Map.Map String String -- ^ Only /active/ USE flags, if any.+      } deriving (Eq, Show)++-- | Maybe return a 'Metadata' from a 'T.Text'.+--+-- Trying to parse an empty 'T.Text' should return 'Nothing':+--+-- >>> pureMetadataFromFile T.empty+-- Nothing+--+-- Parsing a @metadata.xml@ /without/ USE flags should /always/ be equivalent+-- to 'makeMinimalMetadata':+--+-- >>> pureMetadataFromFile (makeDefaultMetadata Map.empty) == Just makeMinimalMetadata+-- True+--+-- Parsing a @metadata.xml@ /with/ USE flags should /always/ be equivalent+-- to 'makeMinimalMetadata' /plus/ the supplied USE flags:+--+-- >>> pureMetadataFromFile (makeDefaultMetadata (Map.fromList [("name","description")])) == Just (makeMinimalMetadata {metadataUseFlags = Map.fromList [("name","description")] } )+-- True+pureMetadataFromFile :: T.Text -> Maybe Metadata+pureMetadataFromFile file = parseXMLDoc file >>= \doc -> parseMetadata doc++-- | Apply 'pureMetadataFromFile' to a 'FilePath'.+metadataFromFile :: FilePath -> IO (Maybe Metadata)+metadataFromFile fp = pureMetadataFromFile <$> T.readFile fp++-- | Extract the maintainer email and USE flags from a supplied XML 'Element'.+-- +-- If we're parsing a blank 'Element' or otherwise empty @metadata.xml@:+-- >>> parseMetadata blank_element+-- Just (Metadata {metadataEmails = [], metadataUseFlags = fromList []})+parseMetadata :: Element -> Maybe Metadata+parseMetadata xml =+  return Metadata { metadataEmails = strContent <$> findElements (unqual "email") xml+                  , metadataUseFlags =+                      -- find the flag name+                      let x = findElement (unqual "use") xml+                          y = onlyElems $ concatMap elContent x+                          z = attrVal <$> concatMap elAttribs y+                      -- find the flag description+                          a = concatMap elContent y+                          b = cdData <$> onlyText a+                      in Map.fromList $ zip z b+                  }++-- | Remove global @USE@ flags from the flags 'Map.Map', as these should not be+-- within the local @metadata.xml@. For now, this is manually specified rather than+-- parsing @use.desc@.+stripGlobalUseFlags :: Map.Map String String -> Map.Map String String+stripGlobalUseFlags m = foldr1 Map.intersection (Map.delete <$> globals <*> [m])+  where+    globals = [ "debug"+              , "examples"+              , "static"+              ]++-- | Pretty print as valid XML a list of flags and their descriptions+-- from a given 'Map.Map'.+prettyPrintFlags :: Map.Map String String -> [String]+prettyPrintFlags m = (\(name,description) ->+                        "\t\t" +++                        (showElement+                         . add_attr (Attr (blank_name { qName = "name" }) name)+                         . unode "flag" $ description))+                     <$> (Map.toAscList . stripGlobalUseFlags $ m)++-- | Pretty print a human-readable list of flags and their descriptions+-- from a given 'Map.Map'.+prettyPrintFlagsHuman :: Map.Map String String -> [String]+prettyPrintFlagsHuman m = (\(name,description) -> A.bold (name ++ ": ") +++                            (L.intercalate " " . lines $ description))+                          <$> (Map.toAscList . stripGlobalUseFlags $ m)+                          +-- | A minimal metadata for use as a fallback value.+makeMinimalMetadata :: Metadata+makeMinimalMetadata = Metadata { metadataEmails = ["haskell@gentoo.org"]+                               , metadataUseFlags = Map.empty+                               }++-- don't use Text.XML.Light as we like our own pretty printer+-- | Pretty print the @metadata.xml@ string.+makeDefaultMetadata :: Map.Map String String -> T.Text+makeDefaultMetadata flags = T.pack $+  unlines [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+          , "<!DOCTYPE pkgmetadata SYSTEM \"http://www.gentoo.org/dtd/metadata.dtd\">"+          , "<pkgmetadata>"+          , "\t<maintainer type=\"project\">"+          , "\t\t<email>haskell@gentoo.org</email>"+          , "\t\t<name>Gentoo Haskell</name>"+          , "\t</maintainer>"+            ++ if flags == Map.empty+               then ""+               else "\n\t<use>\n" ++ (unlines $ prettyPrintFlags flags) ++ "\t</use>"+          , "</pkgmetadata>"+          ]
+ src/Portage/Overlay.hs view
@@ -0,0 +1,189 @@+module Portage.Overlay+  ( ExistingEbuild(..)+  , Overlay(..)+  , loadLazy+  , readOverlay, readOverlayByPackage+  , getDirectoryTree, DirectoryTree++  , reduceOverlay+  , filterByEmail+  , inOverlay+  )+  where++import qualified Portage.PackageId as Portage+import qualified Portage.Metadata as Portage++import qualified Distribution.Package as Cabal++import Distribution.Parsec (simpleParsec)+import Distribution.Simple.Utils ( comparing, equating )++import Data.List as List+import qualified Data.Map as Map+import Data.Map (Map)+import System.Directory (getDirectoryContents, doesDirectoryExist)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.FilePath  ((</>), splitExtension)++data ExistingEbuild = ExistingEbuild {+    ebuildId      :: Portage.PackageId,+    ebuildCabalId :: Cabal.PackageIdentifier,+    ebuildPath    :: FilePath+  } deriving (Show,Ord,Eq)++instance Cabal.Package ExistingEbuild where+    packageId = ebuildCabalId++instance Cabal.HasUnitId ExistingEbuild where+    installedUnitId _ = error "Portage.Cabal.installedUnitId: FIXME: should not be used"++-- | Type describing an overlay.+data Overlay = Overlay {+    overlayPath  :: FilePath,+    overlayMap :: Map Portage.PackageName [ExistingEbuild],+    overlayMetadata :: Map Portage.PackageName Portage.Metadata+  } deriving Show++-- | Is 'Cabal.PackageId' found in 'Overlay'?+inOverlay :: Overlay -> Cabal.PackageId -> Bool+inOverlay overlay pkgId = not (Map.null packages)+  where+    packages = Map.filterWithKey+                (\(Portage.PackageName _cat overlay_pn) ebuilds -> +                    let cabal_pn = Cabal.pkgName pkgId+                        ebs = [ ()+                                  | e <- ebuilds+                                  , let ebuild_cabal_id = ebuildCabalId e+                                  , ebuild_cabal_id == pkgId+                                  ]+                    in cabal_pn == overlay_pn && (not (null ebs))) om+    om = overlayMap overlay++loadLazy :: FilePath -> IO Overlay+loadLazy path = do+  dir <- getDirectoryTree path+  metadata <- unsafeInterleaveIO $ mkMetadataMap path dir+  return $ mkOverlay metadata $ readOverlayByPackage dir+  where+    allowed v = case v of+      (Portage.Version _ Nothing [] _) -> True+      _                                -> False++    mkOverlay :: Map Portage.PackageName Portage.Metadata+              -> [(Portage.PackageName, [Portage.Version])]+              -> Overlay+    mkOverlay meta packages = Overlay {+      overlayPath  = path,+      overlayMetadata = meta,+      overlayMap =+          Map.fromList+            [ (pkgName, [ ExistingEbuild portageId cabalId filepath+                        | version <- allowedVersions+                        , let portageId = Portage.PackageId pkgName version+                        , Just cabalId <- [ Portage.toCabalPackageId portageId ]+                        , let filepath = path </> Portage.packageIdToFilePath portageId+                        ])+            | (pkgName, allVersions) <- packages+            , let allowedVersions = filter allowed allVersions+           ]+    }++mkMetadataMap :: FilePath -> DirectoryTree -> IO (Map Portage.PackageName Portage.Metadata)+mkMetadataMap root dir =+  fmap (Map.mapMaybe id) $+    traverse Portage.metadataFromFile $+      Map.fromList+        [ (Portage.mkPackageName category package, root </> category </> package </> "metadata.xml")+        | Directory category packages <- dir+        , Directory package files <- packages+        , File "metadata.xml" <- files+        ]++filterByEmail :: ([String] -> Bool) -> Overlay -> Overlay+filterByEmail p overlay = overlay+                            { overlayMetadata = metadataMap'+                            , overlayMap = pkgMap'+                            }+  where+    metadataMap' = Map.filter (p . Portage.metadataEmails) (overlayMetadata overlay)+    pkgMap' = Map.intersection (overlayMap overlay) metadataMap'+++-- | Make sure there is only one ebuild for each version number (by selecting+-- the highest ebuild version revision)+reduceOverlay :: Overlay -> Overlay+reduceOverlay overlay = overlay { overlayMap = Map.map reduceVersions (overlayMap overlay) }+  where+  versionNumbers (Portage.Version nums _ _ _) = nums+  reduceVersions :: [ExistingEbuild] -> [ExistingEbuild]+  reduceVersions = -- gah!+          map (maximumBy (comparing (Portage.pkgVersion . ebuildId)))+          . groupBy (equating (versionNumbers . Portage.pkgVersion . ebuildId))+          . sortOn (Portage.pkgVersion . ebuildId)++readOverlayByPackage :: DirectoryTree -> [(Portage.PackageName, [Portage.Version])]+readOverlayByPackage tree =+  [ (name, versions name pkgTree)+  | (category, catTree) <- categories        tree+  , (name,     pkgTree) <- packages category catTree+  ]++  where+    categories :: DirectoryTree -> [(Portage.Category, DirectoryTree)]+    categories entries =+      [ (category, entries')+      | Directory dir entries' <- entries+      , Just category <- [simpleParsec dir] ]++    packages :: Portage.Category -> DirectoryTree+             -> [(Portage.PackageName, DirectoryTree)]+    packages category entries =+      [ (Portage.PackageName category name, entries')+      | Directory dir entries' <- entries+      , Just name <- [simpleParsec dir] ]++    versions :: Portage.PackageName -> DirectoryTree -> [Portage.Version]+    versions name@(Portage.PackageName (Portage.Category category) _) entries =+      [ version+      | File fileName <- entries+      , let (baseName, ext) = splitExtension fileName+      , ext == ".ebuild"+      , let fullName = category ++ '/' : baseName+      , Just (Portage.PackageId name' version) <- [simpleParsec fullName]+      , name == name' ]++readOverlay :: DirectoryTree -> [Portage.PackageId]+readOverlay tree = [ Portage.PackageId pkgId version+                   | (pkgId, versions) <- readOverlayByPackage tree+                   , version <- versions+                   ]++type DirectoryTree  = [DirectoryEntry]+data DirectoryEntry = File FilePath | Directory FilePath [DirectoryEntry]++getDirectoryTree :: FilePath -> IO DirectoryTree+getDirectoryTree = dirEntries++  where+    dirEntries :: FilePath -> IO [DirectoryEntry]+    dirEntries dir = do+      names <- getDirectoryContents dir+      sequence+        [ do isDirectory <- doesDirectoryExist path+             if isDirectory+               then do entries <- unsafeInterleaveIO (dirEntries path)+                       return (Directory name entries)+               else    return (File      name)+        | name <- names+        , not (ignore name)+        , let path = dir </> name ]++    ignore path = path `elem` [ "."+                              , ".."+                              -- those speed things up a bit+                              -- and reduse memory consumption+                              -- (as we store it in RAM for the whole run)+                              , ".git"+                              , "CVS"+                              ]
+ src/Portage/PackageId.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE CPP #-}+{-|+Module      : Portage.PackageId+License     : GPL-3++Maintainer  : haskell@gentoo.org++Portage package identifiers, which unlike Cabal ones include a category.+-}+module Portage.PackageId (+    Category(..),+    PackageName(..),+    PackageId(..),+    Portage.Version(..),+    mkPackageName,+    fromCabalPackageId,+    toCabalPackageId,+    parseFriendlyPackage,+    normalizeCabalPackageName,+    normalizeCabalPackageId,+    filePathToPackageId,+    packageIdToFilePath,+    cabal_pn_to_PN+  ) where++import qualified Distribution.Compat.CharParsing as P+import qualified Distribution.Package as Cabal+import           Distribution.Parsec (CabalParsing(..), Parsec(..), explicitEitherParsec)+import           Distribution.Pretty (Pretty(..), prettyShow)++import qualified Portage.Version as Portage++import           Control.DeepSeq (NFData(..))+import qualified Data.Char as Char+import qualified Text.PrettyPrint as Disp+import           Text.PrettyPrint ((<>))+import           System.FilePath ((</>))++#if MIN_VERSION_base(4,11,0)+import Prelude hiding ((<>))+#endif++newtype Category = Category { unCategory :: String }+  deriving (Eq, Ord, Show, Read)++-- | Portage-style 'PackageName', containing a 'Category' and a 'Cabal.PackageName'.+data PackageName = PackageName { category :: Category, cabalPkgName :: Cabal.PackageName }+  deriving (Eq, Ord, Show, Read)++-- | Portage-style 'PackageId', containing a 'PackageName' and a 'Portage.Version'.+data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version }+  deriving (Eq, Ord, Show, Read)++instance NFData Category where+  rnf (Category c) = rnf c++instance Pretty Category where+  pretty (Category c) = Disp.text c++instance Parsec Category where+  parsec = Category <$> P.munch1 categoryChar+    where+      categoryChar c = Char.isAlphaNum c || c == '-'++instance NFData PackageName where+  rnf (PackageName c pn) = rnf c `seq` rnf pn++instance Pretty PackageName where+  pretty (PackageName cat name) =+    pretty cat <> Disp.char '/' <> pretty name++instance Parsec PackageName where+  parsec = do+    cat <- parsec+    _ <- P.char '/'+    name <- parseCabalPackageName+    return $ PackageName cat name++instance NFData PackageId where+  rnf (PackageId pId pv) = rnf pId `seq` rnf pv++instance Pretty PackageId where+  pretty (PackageId name version) =+    pretty name <> Disp.char '-' <> pretty version++instance Parsec PackageId where+  parsec = do+    name <- parsec+    _ <- P.char '-'+    version <- parsec+    return $ PackageId name version++-- | Transform a 'PackageId' into a 'FilePath'.+-- +-- >>> packageIdToFilePath (PackageId (PackageName (Category "dev-haskell") (Cabal.mkPackageName "foo-bar2")) (Portage.Version [3,0,0] (Just 'b') [Portage.RC 2] 1 ))+-- "dev-haskell/foo-bar2/foo-bar2-3.0.0b_rc2-r1.ebuild"+packageIdToFilePath :: PackageId -> FilePath+packageIdToFilePath (PackageId (PackageName cat pn) version) =+  prettyShow cat </> prettyShow pn </> prettyShow pn <-> prettyShow version <.> "ebuild"+  where+    a <-> b = a ++ '-':b+    a <.> b = a ++ '.':b++-- | Maybe generate a 'PackageId' from a 'FilePath'. Note that the 'FilePath' must have its+-- file extension stripped before being passed to 'filePathToPackageId'.+-- +-- >>> filePathToPackageId (Category "dev-haskell") "foo-bar2-3.0.0b_rc2-r1"+-- Just (PackageId {packageId = PackageName {category = Category {unCategory = "dev-haskell"}, cabalPkgName = PackageName "foo-bar2"}, pkgVersion = Version {versionNumber = [3,0,0], versionChar = Just 'b', versionSuffix = [RC 2], versionRevision = 1}})+filePathToPackageId :: Category -> FilePath -> Maybe PackageId+filePathToPackageId cat fp =+  case explicitEitherParsec parser fp of+    Right x -> Just x+    _ -> Nothing+  where+    parser = do+      pn <- parseCabalPackageName+      _ <- P.char '-'+      v <- parsec+      return $ PackageId (PackageName cat pn) v++-- | Create a 'PackageName' from supplied category and package name 'String's.+mkPackageName :: String -> String -> PackageName+mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName package)++-- | Create a 'PackageId' from a 'Category' and 'Cabal.PackageIdentifier'.+fromCabalPackageId :: Category -> Cabal.PackageIdentifier -> PackageId+fromCabalPackageId cat (Cabal.PackageIdentifier name version) =+  PackageId (PackageName cat (normalizeCabalPackageName name))+            (Portage.fromCabalVersion version)++-- | Convert a 'Cabal.PackageName' into lowercase. Internally uses+-- 'cabal_pn_to_PN'.+--+-- >>> normalizeCabalPackageName (Cabal.mkPackageName "FooBar1")+-- PackageName "foobar1"+normalizeCabalPackageName :: Cabal.PackageName -> Cabal.PackageName+normalizeCabalPackageName =+  Cabal.mkPackageName . cabal_pn_to_PN++-- | Apply 'normalizeCabalPackageName' to the 'Cabal.PackageName' of+-- a supplied 'Cabal.PackageIdentifier'.+normalizeCabalPackageId :: Cabal.PackageIdentifier -> Cabal.PackageIdentifier+normalizeCabalPackageId (Cabal.PackageIdentifier name version) =+  Cabal.PackageIdentifier (normalizeCabalPackageName name) version++-- | Convert a 'PackageId' into a 'Maybe' 'Cabal.PackageIdentifier'.+toCabalPackageId :: PackageId -> Maybe Cabal.PackageIdentifier+toCabalPackageId (PackageId (PackageName _cat name) version) =+  fmap (Cabal.PackageIdentifier name)+           (Portage.toCabalVersion version)++-- | Parse a 'String' as a package in the form of @[category\/]name[-version]@:+--+-- Note that we /cannot/ use the 'parsec' function to parse the 'Cabal.PackageName',+-- since it fails the entire parse if it tries to parse a 'Version'.+-- See 'parseCabalPackageName' below.+--+-- If parsing a valid package string:+-- +-- >>> parseFriendlyPackage "category-name/package-name1-0.0.0.1a_beta2-r4"+-- Right (Just (Category {unCategory = "category-name"}),PackageName "package-name1",Just (Version {versionNumber = [0,0,0,1], versionChar = Just 'a', versionSuffix = [Beta 2], versionRevision = 4}))+--+-- If malformed, return an error string:+--+-- >>> parseFriendlyPackage "category-name/package-name-1-0.0.0.1a_beta2-r4"+-- Left ...+parseFriendlyPackage :: String -> Either String (Maybe Category, Cabal.PackageName, Maybe Portage.Version)+parseFriendlyPackage str = explicitEitherParsec parser str+  where+  parser = do+    mc <- P.optional . P.try $ do+      c <- parsec+      _ <- P.char '/'+      return c+    p <- parseCabalPackageName+    mv <- P.optional $ do+      _ <- P.char '-'+      v <- parsec+      return v+    return (mc, p, mv)++-- | Parse a 'Cabal.PackageName'.+--+-- This parser is a replacement for 'parsecUnqualComponentName' which fails when+-- trying to parse a 'Version'.+parseCabalPackageName :: CabalParsing m => m Cabal.PackageName+parseCabalPackageName = do+  pn <- P.some . P.try $+    P.choice+    [ P.alphaNum+    , P.char '+'+    , P.char '-' <* P.notFollowedBy (P.some P.digit <* P.notFollowedBy P.letter)+    ]+  return $ Cabal.mkPackageName pn++-- | Pretty-print a lowercase 'Cabal.PackageName'.+--+-- Note the difference between this function and 'normalizeCabalPackageName':+-- this function returns a 'String', the other a 'Cabal.PackageName'.+--+-- >>> cabal_pn_to_PN (Cabal.mkPackageName "FooBar1")+-- "foobar1"+cabal_pn_to_PN :: Cabal.PackageName -> String+cabal_pn_to_PN = map Char.toLower . prettyShow
+ src/Portage/Resolve.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE PatternGuards #-}++module Portage.Resolve+    ( resolveCategory+    , resolveCategories+    , resolveFullPortageName+    ) where++import qualified Portage.Overlay as Overlay+import qualified Portage.PackageId as Portage++import Distribution.Verbosity+import Distribution.Pretty (prettyShow)+import qualified Distribution.Package as Cabal+import Distribution.Simple.Utils++import qualified Data.Map as Map++import Error++import Debug.Trace (trace)++-- | If a package already exist in the overlay, find which category it has.+-- If it does not exist, we default to \'dev-haskell\'.+resolveCategory :: Verbosity -> Overlay.Overlay -> Cabal.PackageName -> IO Portage.Category+resolveCategory verbosity overlay pn = do+  info verbosity "Searching for which category to use..."+  case resolveCategories overlay pn of+    [] -> do+      info verbosity "No previous version of this package, defaulting category to dev-haskell."+      return devhaskell+    [cat] -> do+      info verbosity $ "Exact match of already existing package, using category: "+                         ++ prettyShow cat+      return cat+    cats -> do+      warn verbosity $ "Multiple matches of categories: " ++ unwords (map prettyShow cats)+      if devhaskell `elem` cats+        then do notice verbosity "Defaulting to dev-haskell"+                return devhaskell+        else do warn verbosity "Multiple matches and no known default. Override by specifying "+                warn verbosity "package category like so  'hackport merge categoryname/package[-version]."+                throwEx (ArgumentError "Specify package category and try again.")+  where+  devhaskell = Portage.Category "dev-haskell"++resolveCategories :: Overlay.Overlay -> Cabal.PackageName -> [Portage.Category]+resolveCategories overlay pn =+  [ cat +  | (Portage.PackageName cat pn') <- Map.keys om+  , Portage.normalizeCabalPackageName pn == pn'+  ]+  where+    om = Overlay.overlayMap overlay++resolveFullPortageName :: Overlay.Overlay -> Cabal.PackageName -> Maybe Portage.PackageName+resolveFullPortageName overlay pn =+  case resolveCategories overlay pn of+    [] -> Nothing+    [cat] -> ret cat+    cats | (cat:_) <- (filter (`elem` cats) priority) -> ret cat+         | otherwise -> trace ("Ambiguous package name: " ++ show pn ++ ", hits: " ++ show cats) Nothing+  where+  ret c = return (Portage.PackageName c (Portage.normalizeCabalPackageName pn))+  mkC = Portage.Category+  -- if any of these categories show up in the result list, the match isn't+  -- ambiguous, pick the first match in the list+  priority = [ mkC "dev-haskell"+             , mkC "sys-libs"+             , mkC "dev-libs"+             , mkC "x11-libs"+             , mkC "media-libs"+             , mkC "net-libs"+             , mkC "sci-libs"+             ]
+ src/Portage/Tables.hs view
@@ -0,0 +1,37 @@+{-|+Module      : Portage.Tables+License     : GPL-3++Maintainer  : haskell@gentoo.org++Tables of Portage-specific conversions.+-}+module Portage.Tables+  ( set_build_slot+  ) where++import Portage.Dependency.Builder+import Portage.Dependency.Types+import Portage.PackageId++import Data.Monoid++-- | Set the @SLOT@ for a given 'Dependency'.+set_build_slot :: Dependency -> Dependency+set_build_slot = +  overAtom $ \a@(Atom pn dr (DAttr _ u)) -> +      case mconcat $ map (First . matches a) slottedPkgs of+          First (Just s) -> Atom pn dr (DAttr s u)+          First Nothing  -> Atom pn dr (DAttr AnyBuildTimeSlot u)+    where+      matches (Atom pn _ _) (nm,s) +        | pn == nm  = Just s+        | otherwise = Nothing++-- | List of 'PackageName's with their corresponding default 'SlotDepend's.+--+-- For example, dependency @QuickCheck@ has its @SLOT@ always set to @2@.+slottedPkgs :: [(PackageName, SlotDepend)]+slottedPkgs =+  [ (mkPackageName "dev-haskell" "quickcheck", GivenSlot "2=")+  , (mkPackageName "dev-haskell" "hdbc", GivenSlot "2=")+  ]
+ src/Portage/Use.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}++module Portage.Use (+  -- * main structures+  UseFlag(..),+  Use(..),+  dispUses,+  -- * helpers+  mkUse,+  mkNotUse,+  mkQUse+  ) where++import qualified Text.PrettyPrint as Disp+import Text.PrettyPrint ((<>))+import Distribution.Pretty (Pretty(..))++import           Control.DeepSeq (NFData(..))++#if MIN_VERSION_base(4,11,0)+import Prelude hiding ((<>))+#endif++-- | Use variable modificator+data UseFlag = UseFlag Use           -- ^ no modificator+             | E UseFlag             -- ^ = modificator (Equiv    mark)+             | Q UseFlag             -- ^ ? modificator (Question mark)+             | X UseFlag             -- ^ ! modificator (eXclamation mark)+             | N UseFlag             -- ^ - modificator +             deriving (Eq,Show,Ord,Read)++instance NFData UseFlag where+  rnf (UseFlag u) = rnf u+  rnf (E f) = rnf f+  rnf (Q f) = rnf f+  rnf (X f) = rnf f+  rnf (N f) = rnf f++instance Pretty UseFlag where+  pretty = showModificator++mkUse :: Use -> UseFlag+mkUse  = UseFlag ++mkNotUse :: Use -> UseFlag+mkNotUse = N . UseFlag++mkQUse :: Use -> UseFlag+mkQUse = Q . UseFlag++showModificator :: UseFlag -> Disp.Doc+showModificator (UseFlag u) = pretty u+showModificator (X u)     = Disp.char '!' <> pretty u+showModificator (Q u)     = pretty u <> Disp.char '?'+showModificator (E u)     = pretty u <> Disp.char '='+showModificator (N u)     = Disp.char '-' <> pretty u++dispUses :: [UseFlag] -> Disp.Doc+dispUses [] = Disp.empty+dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map pretty us++newtype Use = Use String+    deriving (Eq, Read, Show)++instance NFData Use where+  rnf (Use s) = rnf s++instance Pretty Use where+  pretty (Use u) = Disp.text u++instance Ord Use where+    compare (Use a) (Use b) = case (a,b) of+        ("test", "test") -> EQ+        ("test", _)      -> LT+        (_, "test")      -> GT+        (_, _)           -> a `compare` b
+ src/Portage/Version.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE CPP #-}+{-|+    Author      :  Andres Loeh <kosmikus@gentoo.org>+    Stability   :  provisional+    Portability :  haskell98++    Version parser, according to Portage spec.++    Shamelessly borrowed from exi, ported from Parsec to ReadP++-}+module Portage.Version (+    Version(..),+    Suffix(..),+    fromCabalVersion,+    toCabalVersion,+    is_live+  ) where++import qualified Distribution.Version as Cabal++import           Distribution.Pretty (Pretty(..))++import           Distribution.Parsec (Parsec(..))+import qualified Distribution.Compat.CharParsing as P+import qualified Text.PrettyPrint as Disp+import           Text.PrettyPrint ((<>))+import qualified Data.List.NonEmpty as NE++import           Control.DeepSeq (NFData(..))++#if MIN_VERSION_base(4,11,0)+import Prelude hiding ((<>))+#endif++-- | Portage-style version type.+data Version = Version { versionNumber   :: [Int]        -- ^ @[1,42,3]@ ~= 1.42.3+                       , versionChar     :: (Maybe Char) -- ^ optional letter+                       , versionSuffix   :: [Suffix]+                       , versionRevision :: Int          -- ^ revision, 0 means none+                       }+  deriving (Eq, Ord, Show, Read)++instance NFData Version where+  rnf (Version n c s r) = rnf n `seq` rnf c `seq` rnf s `seq` rnf r++-- | Prints a valid Portage 'Version' string.+instance Pretty Version where+  pretty (Version ver c suf rev) =+    dispVer ver <> dispC c <> dispSuf suf <> dispRev rev+    where+      dispVer   = Disp.hcat . Disp.punctuate (Disp.char '.') . map Disp.int+      dispC     = maybe Disp.empty Disp.char+      dispSuf   = Disp.hcat . map pretty+      dispRev 0 = Disp.empty+      dispRev n = Disp.text "-r" <> Disp.int n++-- | 'Version' parser using 'Parsec'.+instance Parsec Version where+  parsec = do+    ver <- P.sepByNonEmpty digits (P.char '.')+    c   <- P.optional P.lower+    suf <- P.many parsec+    rev <- P.option 0 $ P.string "-r" *> digits+    return $ Version (NE.toList ver) c suf rev++-- | Check if the ebuild is a live ebuild, i.e. if its 'Version' is @9999@.+--+-- foo-9999* is treated as live ebuild+-- Cabal-1.17.9999* as well+--+-- >>> let (c,s,r) = (Nothing,[],0)+-- >>> is_live (Version [1,0,0] c s r)+-- False+-- >>> is_live (Version [999] c s r)+-- False+-- >>> is_live (Version [1,0,0,9999] c s r)+-- True+-- >>> is_live (Version [9999] c s r)+-- True+--+-- $+-- prop> \verNum char rev -> is_live (Version verNum char [] rev) == if length verNum >= 1 && last verNum >= 9999 then True else False+is_live :: Version -> Bool+is_live v =+    case vs of+        -- nonempty+        (_:_) | many_nines (last vs) -> True+        _                            -> False+  where vs = versionNumber v+        many_nines n = is_big n && all_nines n+        is_big n     = n >= 9999+        all_nines n  = (all (== '9') . show) n++-- | Various allowed suffixes in Portage versions.+data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int+  deriving (Eq, Ord, Show, Read)++instance NFData Suffix where+  rnf (Alpha n) = rnf n+  rnf (Beta n)  = rnf n+  rnf (Pre n)   = rnf n+  rnf (RC n)    = rnf n+  rnf (P n)     = rnf n++instance Pretty Suffix where+  pretty suf = case suf of+    Alpha n -> Disp.text "_alpha" <> dispPos n+    Beta n  -> Disp.text "_beta"  <> dispPos n+    Pre n   -> Disp.text "_pre"   <> dispPos n+    RC n    -> Disp.text "_rc"    <> dispPos n+    P  n    -> Disp.text "_p"     <> dispPos n++    where+      dispPos :: Int -> Disp.Doc+      dispPos 0 = Disp.empty+      dispPos n = Disp.int n++instance Parsec Suffix where+  parsec = P.char '_'+       *> P.choice+    [ P.string "alpha"       >> fmap Alpha maybeDigits+    , P.string "beta"        >> fmap Beta  maybeDigits+    , P.try (P.string "pre") >> fmap Pre   maybeDigits+    , P.string "rc"          >> fmap RC    maybeDigits+    , P.string "p"           >> fmap P     maybeDigits+    ]+    where+      maybeDigits = P.option 0 digits++-- | Convert from a 'Cabal.Version' to a Portage 'Version'.+-- +-- prop> \verNum -> fromCabalVersion (Cabal.mkVersion verNum) == Version verNum Nothing [] 0+fromCabalVersion :: Cabal.Version -> Version+fromCabalVersion cabal_version = Version (Cabal.versionNumbers cabal_version) Nothing [] 0++-- | Convert from a Portage 'Version' to a 'Cabal.Version'.+-- $+-- prop> \verNum char rev -> toCabalVersion (Version verNum char [] rev) == if char == Nothing then Just (Cabal.mkVersion verNum) else Nothing+toCabalVersion :: Version -> Maybe Cabal.Version+toCabalVersion (Version nums Nothing [] _) = Just (Cabal.mkVersion nums)+toCabalVersion _                           = Nothing++-- | Parser which munches digits.+digits :: P.CharParsing m => m Int+digits = read <$> P.some P.digit
+ src/Status.hs view
@@ -0,0 +1,258 @@+module Status+    ( FileStatus(..)+    , StatusDirection(..)+    , fromStatus+    , status+    , runStatus+    ) where++import AnsiColor++import qualified Portage.Version as V (is_live)++import Portage.Overlay+import Portage.PackageId+import Portage.Resolve++import qualified Data.List as List++import qualified Data.ByteString.Char8 as BS++import Data.Char+import Data.Function (on)+import qualified Data.Map as Map+import Data.Map as Map (Map)++import qualified Data.Traversable as T+import Control.Monad++-- cabal+import qualified Distribution.Verbosity as Cabal+import qualified Distribution.Package as Cabal (pkgName)+import qualified Distribution.Simple.Utils as Cabal (comparing, die', equating)+import Distribution.Pretty (prettyShow)+import Distribution.Parsec (simpleParsec)++import qualified Distribution.Client.GlobalFlags as CabalInstall+import qualified Distribution.Client.IndexUtils as CabalInstall+import qualified Distribution.Client.Types as CabalInstall ( SourcePackageDb(..) )+import qualified Distribution.Solver.Types.PackageIndex as CabalInstall+import qualified Distribution.Solver.Types.SourcePackage as CabalInstall ( SourcePackage(..) )++data StatusDirection+    = PortagePlusOverlay+    | OverlayToPortage+    | HackageToOverlay+    deriving Eq++data FileStatus a+        = Same a+        | Differs a a+        | OverlayOnly a+        | PortageOnly a+        | HackageOnly a+        deriving (Show,Eq)++instance Ord a => Ord (FileStatus a) where+    compare = Cabal.comparing fromStatus++instance Functor FileStatus where+    fmap f st =+        case st of+            Same a -> Same (f a)+            Differs a b -> Differs (f a) (f b)+            OverlayOnly a -> OverlayOnly (f a)+            PortageOnly a -> PortageOnly (f a)+            HackageOnly a -> HackageOnly (f a)++fromStatus :: FileStatus a -> a+fromStatus fs =+    case fs of+        Same a -> a+        Differs a _ -> a -- second status is lost+        OverlayOnly a -> a+        PortageOnly a -> a+        HackageOnly a -> a++++loadHackage :: Cabal.Verbosity -> CabalInstall.RepoContext -> Overlay -> IO [[PackageId]]+loadHackage verbosity repoContext overlay = do+    CabalInstall.SourcePackageDb { CabalInstall.packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity repoContext+    let get_cat cabal_pkg = case resolveCategories overlay (Cabal.pkgName cabal_pkg) of+                                []    -> Category "dev-haskell"+                                [cat] -> cat+                                _     -> {- ambig -} Category "dev-haskell"+        pkg_infos = map ( reverse . take 3 . reverse -- hackage usually has a ton of older versions+                        . map ((\p -> fromCabalPackageId (get_cat p) p)+                              . CabalInstall.srcpkgPackageId))+                        (CabalInstall.allPackagesByName pindex)+    return pkg_infos++status :: Cabal.Verbosity -> FilePath -> FilePath -> CabalInstall.RepoContext -> IO (Map PackageName [FileStatus ExistingEbuild])+status verbosity portdir overlaydir repoContext = do+    overlay <- loadLazy overlaydir+    hackage <- loadHackage verbosity repoContext overlay+    portage <- filterByEmail ("haskell@gentoo.org" `elem`) <$> loadLazy portdir+    let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)++    both' <- T.forM both $ mapM $ \e -> do+            -- can't fail, we know the ebuild exists in both portagedirs+            -- also, one of them is already bound to 'e'+            let (Just e1) = lookupEbuildWith (overlayMap portage) (ebuildId e)+                (Just e2) = lookupEbuildWith (overlayMap overlay) (ebuildId e)+            eq <- equals (ebuildPath e1) (ebuildPath e2)+            return $ if eq+                        then Same e1+                        else Differs e1 e2++    let p_to_ee :: PackageId -> ExistingEbuild+        p_to_ee p = ExistingEbuild p cabal_p ebuild_path+            where Just cabal_p = toCabalPackageId p -- lame doubleconv+                  ebuild_path = packageIdToFilePath p+        mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])+        mk_fake_ee ~pkgs@(p:_) = (packageId p, map p_to_ee pkgs)++        map_diff = Map.differenceWith (\le re -> Just $ foldr (List.deleteBy (Cabal.equating ebuildId)) le re)+        hack = (( -- We merge package names as we do case-insensitive match.+                  -- Hackage contains the following 2 package names:+                  --   ... Cabal-1.24.0.0 Cabal-1.24.1.0+                  --   cabal-0.0.0.0+                  -- We need to pick both lists of versions, not the first.+                  -- TODO: have a way to distict between them in the output.+                  Map.fromListWith (++) $+                      map mk_fake_ee hackage) `map_diff` overlayMap overlay) `map_diff` overlayMap portage++        meld = Map.unionsWith (\a b -> List.sort (a++b))+                [ Map.map (map PortageOnly) port+                , both'+                , Map.map (map OverlayOnly) over+                , Map.map (map HackageOnly) hack+                ]+    return meld++type EMap = Map PackageName [ExistingEbuild]++lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild+lookupEbuildWith overlay pkgid = do+  ebuilds <- Map.lookup (packageId pkgid) overlay+  List.find (\e -> ebuildId e == pkgid) ebuilds++runStatus :: Cabal.Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> CabalInstall.RepoContext -> IO ()+runStatus verbosity portdir overlaydir direction pkgs repoContext = do+  let pkgFilter = case direction of+                      OverlayToPortage   -> toPortageFilter+                      PortagePlusOverlay -> id+                      HackageToOverlay   -> fromHackageFilter+  pkgs' <- forM pkgs $ \p ->+            case simpleParsec p of+              Nothing -> Cabal.die' verbosity ("Could not parse package name: " ++ p ++ ". Format cat/pkg")+              Just pn -> return pn+  tree0 <- status verbosity portdir overlaydir repoContext+  let tree = pkgFilter tree0+  if (null pkgs')+    then statusPrinter tree+    else forM_ pkgs' $ \pkg -> statusPrinter (Map.filterWithKey (\k _ -> k == pkg) tree)++-- |Only return packages that seems interesting to sync to portage;+--+--   * Ebuild differs, or+--   * Newer version in overlay than in portage+toPortageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]+toPortageFilter = Map.mapMaybe $ \ sts ->+    let filter_out_lives = filter (not . V.is_live . pkgVersion . ebuildId . fromStatus)+        inPortage = flip filter sts $ \st ->+                        case st of+                            OverlayOnly _ -> False+                            HackageOnly _ -> False+                            _ -> True+        latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage+        interestingPackages = flip filter sts $ \st ->+            case st of+                HackageOnly _ -> False+                Differs _ _ -> True+                _ | pkgVersion (ebuildId (fromStatus st)) > latestPortageVersion -> True+                  | otherwise -> False+    in if not (null inPortage) && not (null $ filter_out_lives interestingPackages)+        then Just sts+        else Nothing++-- |Only return packages that exist in overlay or portage but look outdated+fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]+fromHackageFilter = Map.mapMaybe $ \ sts ->+    let inEbuilds = flip filter sts $ \st ->+                        case st of+                            HackageOnly _ -> False+                            _ -> True+        -- treat live as oldest version not avoid masking hackage releases+        mangle_live_versions v+            | V.is_live v = v {versionNumber=[-1]}+            | otherwise   = v+        latestVersion = List.maximumBy (compare `on` mangle_live_versions . pkgVersion . ebuildId . fromStatus) sts+    in case latestVersion of+            HackageOnly _ | not (null inEbuilds) -> Just sts+            _                                    -> Nothing++statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()+statusPrinter packages = do+    putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"+    putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"+    putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"+    putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"+    putStrLn $ toColor (HackageOnly "Cyan") ++ ": package only exist on hackage"+    forM_ (zip [(1 :: Int) ..] $ Map.toAscList packages) $ \(ix, (pkg, ebuilds)) -> do+        let (PackageName c p) = pkg+        putStr (bold (show ix))+        putStr " "+        putStr $ prettyShow c ++ '/' : bold (prettyShow p)+        putStr " "+        forM_ ebuilds $ \e -> do+            putStr $ toColor (fmap (prettyShow . pkgVersion . ebuildId) e)+            putChar ' '+        putStrLn ""++toColor :: FileStatus String -> String+toColor st = inColor c False Default (fromStatus st)+    where+    c = case st of+        (Same _) -> Green+        (Differs _ _) -> Yellow+        (OverlayOnly _) -> Red+        (PortageOnly _) -> Magenta+        (HackageOnly _) -> Cyan++portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)+portageDiff p1 p2 = (in1, ins, in2)+    where ins = Map.filter (not . null) $ Map.intersectionWith (List.intersectBy $ Cabal.equating ebuildId) p1 p2+          in1 = difference p1 p2+          in2 = difference p2 p1+          difference x y = Map.filter (not . null) $+                       Map.differenceWith (\xs ys ->+                        let lst = foldr (List.deleteBy (Cabal.equating ebuildId)) xs ys in+                        if null lst+                            then Nothing+                            else Just lst+                            ) x y++-- | Compares two ebuilds, returns True if they are equal.+--   Disregards comments.+equals :: FilePath -> FilePath -> IO Bool+equals fp1 fp2 = do+    -- don't leave halfopenfiles+    f1 <- BS.readFile fp1+    f2 <- BS.readFile fp2+    return (equal' f1 f2)++equal' :: BS.ByteString -> BS.ByteString -> Bool+equal' = Cabal.equating essence+    where+    essence = filter (not . isEmpty)+            . filter (not . isComment)+            . filter (not . isHOMEPAGE)+            . BS.lines+    isComment = BS.isPrefixOf (BS.pack "#") . BS.dropWhile isSpace+    -- HOMEPAGE= frequently gets updated for http:// / https://.+    -- It's to much noise usually and should really be fixed+    -- in upstream Cabal definition.+    isHOMEPAGE = BS.isPrefixOf (BS.pack "HOMEPAGE=") . BS.dropWhile isSpace+    isEmpty = BS.null . BS.dropWhile isSpace
+ src/Util.hs view
@@ -0,0 +1,31 @@+{-|+    Author      :  Sergei Trofimovich <slyfox@inbox.ru>+    Stability   :  experimental+    Portability :  haskell98++    Ungrouped utilitary stuff lays here until someone finds better place for it :]+-}++module Util+    ( run_cmd -- :: String -> IO (Maybe String)+    ) where++import System.IO+import System.Process+import System.Exit (ExitCode(..))++-- 'run_cmd' executes command and returns it's standard output+-- as 'String'.++run_cmd :: String -> IO (Maybe String)+run_cmd cmd = do (hI, hO, hE, hProcess) <- runInteractiveCommand cmd+                 hClose hI+                 output <- hGetContents hO+                 errors <- hGetContents hE -- TODO: propagate error to caller+                 length output `seq` hClose hO+                 length errors `seq` hClose hE++                 exitCode <- waitForProcess hProcess+                 return $ if (output == "" || exitCode /= ExitSuccess)+                          then Nothing+                          else Just output
+ tests/doctests-v2.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Control.Monad.Fail (fail)+import Data.Foldable (for_)+import System.Exit (ExitCode (..), exitWith)+import System.Process (readProcess, createProcess, proc, waitForProcess, getProcessExitCode)++#if !MIN_VERSION_base(4,13,0)+import Prelude hiding (fail)+#endif+++main :: IO ()+main = do+    doctestPath <- head . lines <$> readProcess "cabal" ["list-bin", "doctest"] []++    let components =+            [ "hackport:lib:hackport-internal"+            , "hackport:exe:hackport"+            ]++    for_ components $ \component -> do+        let cabalArgs =+                [ "repl"+                , "--with-compiler=" ++ doctestPath+                , component+                ]+        putStrLn $ "Running: cabal " ++ unwords cabalArgs+        (_, _, _, processHandle) <- createProcess (proc "cabal" cabalArgs)+        waitForProcess processHandle+        exitCode <- getProcessExitCode processHandle+        case exitCode of+            Nothing -> fail "No exit code from cabal process..."+            Just ExitSuccess -> pure ()+            Just c@(ExitFailure i) -> do+                putStrLn $ "\nFailure: cabal process returned exit code " ++ show i+                exitWith c
tests/doctests.hs view
@@ -1,12 +1,36 @@ module Main where -import Test.DocTest--- Some modules fail to find module Paths_hackport, which is generated during building.--- There is a way to make this work properly, but for now just test modules which--- don't import Paths_hackport.-main = doctest [ "Portage/Cabal.hs"-               , "Portage/GHCCore.hs"-               , "Portage/PackageId.hs"-               , "Portage/Version.hs"-               , "Portage/Metadata.hs"-               ]+import Build_doctests (Component (..), Name (..), components)+import Test.DocTest (doctest)+import Data.Foldable (for_)+import qualified Data.List as L+import GHC.IO.Encoding (setLocaleEncoding)+import System.Directory (getCurrentDirectory, makeAbsolute)+import System.Environment.Compat (unsetEnv)+import System.FilePath.Glob (glob)+import System.FilePath.Posix ((</>))+import System.IO (utf8)++main :: IO ()+main = do+    setLocaleEncoding utf8+    unsetEnv "GHC_ENVIRONMENT"+    pwd    <- getCurrentDirectory+    prefix <- makeAbsolute pwd++    for_ components $ \(Component name pkgs flags _) -> do+        putStrLn "----------"+        print name++        maybeSources <- case name of+            NameLib (Just "hackport-internal") -> Just <$> glob (prefix </> "src" </> "**/*.hs")+            NameExe "hackport"                 -> Just <$> glob (prefix </> "exe" </> "**/*.hs")+            _                                  -> fail $+                "Unexpected component: " ++ show name ++ "\n" +++                "Please edit tests/doctests.hs to add sources for this component."++        for_ maybeSources $ \sources -> do+            let args = flags ++ pkgs ++ sources+            putStrLn "Flags passed:"+            for_ args $ \a -> putStr "    " *> print a+            doctest args