Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

189 lines (168 sloc) 6.561 kb
module Diff
( runDiff
, DiffMode(..)
) where
import Control.Monad ( mplus )
import Control.Exception ( assert )
import Data.Maybe ( fromJust, listToMaybe )
import Data.List ( sortBy, groupBy )
import Data.Ord ( comparing )
import qualified Portage.Overlay as Portage
import qualified Portage.Cabal as Portage
import qualified Portage.PackageId as Portage
import qualified Data.Version as Cabal
-- cabal
import Distribution.Verbosity
import Distribution.Text(display)
import qualified Distribution.Package as Cabal
import qualified Distribution.Client.PackageIndex as Index
import Distribution.Simple.Utils (equating)
-- cabal-install
import qualified Distribution.Client.IndexUtils as Index (getSourcePackages)
import qualified Distribution.Client.Types as Cabal
import Distribution.Client.Utils (mergeBy, MergeResult(..))
data DiffMode
= ShowAll
| ShowMissing
| ShowAdditions
| ShowNewer
| ShowCommon
| ShowPackages [String]
deriving Eq
{-
type DiffState a = MergeResult a a
tabs :: String -> String
tabs str = let len = length str in str++(if len < 3*8
then replicate (3*8-len) ' '
else "")
-- TODO: is the new showPackageCompareInfo showing the packages in the same
-- way as showDiffState did?
showDiffState :: Cabal.PackageName -> DiffState Portage.Version -> String
showDiffState pkg st = (tabs (display pkg)) ++ " [" ++ (case st of
InBoth x y -> display x ++ (case compare x y of
EQ -> "="
GT -> ">"
LT -> "<") ++ display y
OnlyInLeft x -> display x ++ ">none"
OnlyInRight y -> "none<" ++ display y) ++ "]"
-}
runDiff :: Verbosity -> FilePath -> DiffMode -> Cabal.Repo -> IO ()
runDiff verbosity overlayPath dm repo = do
-- get package list from hackage
pkgDB <- Index.getSourcePackages verbosity [ repo ]
let (Cabal.SourcePackageDb hackageIndex _) = pkgDB
-- get package list from the overlay
overlay0 <- (Portage.loadLazy overlayPath)
let overlayIndex = Portage.fromOverlay (Portage.reduceOverlay overlay0)
let (subHackage, subOverlay)
= case dm of
ShowPackages pkgs ->
(concatMap (concatMap snd . Index.searchByNameSubstring hackageIndex) pkgs
,concatMap (concatMap snd . Index.searchByNameSubstring overlayIndex) pkgs)
_ ->
(Index.allPackages hackageIndex
,Index.allPackages overlayIndex)
diff subHackage subOverlay dm
data PackageCompareInfo = PackageCompareInfo {
name :: Cabal.PackageName,
-- hackageVersions :: [ Cabal.Version ],
-- overlayVersions :: [ Cabal.Version ]
hackageVersion :: Maybe Cabal.Version,
overlayVersion :: Maybe Cabal.Version
} deriving Show
showPackageCompareInfo :: PackageCompareInfo -> String
showPackageCompareInfo pkgCmpInfo =
display (name pkgCmpInfo) ++ " ["
++ hackageS ++ sign ++ overlayS ++ "]"
where
overlay = overlayVersion pkgCmpInfo
hackage = hackageVersion pkgCmpInfo
hackageS = maybe "none" display hackage
overlayS = maybe "none" display overlay
sign = case compare hackage overlay of
EQ -> "="
GT -> ">"
LT -> "<"
diff :: [Cabal.SourcePackage]
-> [Portage.ExistingEbuild]
-> DiffMode
-> IO ()
diff hackage overlay dm = do
mapM_ (putStrLn . showPackageCompareInfo) pkgCmpInfos
where
merged = mergePackages (map (Portage.normalizeCabalPackageId . Cabal.packageId) hackage)
(map Portage.ebuildCabalId overlay)
pkgCmpInfos = filter pkgFilter (map (uncurry mergePackageInfo) merged)
pkgFilter :: PackageCompareInfo -> Bool
pkgFilter pkgCmpInfo =
let om = overlayVersion pkgCmpInfo
hm = hackageVersion pkgCmpInfo
st = case (om,hm) of
(Just ov, Just hv) -> InBoth ov hv
(Nothing, Just hv) -> OnlyInRight hv
(Just ov, Nothing) -> OnlyInLeft ov
_ -> error "impossible"
in
case dm of
ShowAll -> True
ShowPackages _ -> True -- already filtered
ShowNewer -> case st of
InBoth o h -> h>o
_ -> False
ShowMissing -> case st of
OnlyInLeft _ -> False
InBoth x y -> x < y
OnlyInRight _ -> True
ShowAdditions -> case st of
OnlyInLeft _ -> True
InBoth x y -> x > y
OnlyInRight _ -> False
ShowCommon -> case st of
OnlyInLeft _ -> False
InBoth x y -> x == y
OnlyInRight _ -> False
-- | We get the 'PackageCompareInfo' by combining the info for the overlay
-- and hackage versions of a package.
--
-- * We're building info about a various versions of a single named package so
-- the input package info records are all supposed to refer to the same
-- package name.
--
mergePackageInfo :: [Cabal.PackageIdentifier]
-> [Cabal.PackageIdentifier]
-> PackageCompareInfo
mergePackageInfo hackage overlay =
assert (length overlay + length hackage > 0) $
PackageCompareInfo {
name = combine Cabal.pkgName latestHackage
Cabal.pkgName latestOverlay,
-- hackageVersions = map Cabal.pkgVersion hackage,
-- overlayVersions = map Cabal.pkgVersion overlay
hackageVersion = fmap Cabal.pkgVersion latestHackage,
overlayVersion = fmap Cabal.pkgVersion latestOverlay
}
where
combine f x g y = fromJust (fmap f x `mplus` fmap g y)
latestHackage = latestOf hackage
latestOverlay = latestOf overlay
latestOf :: [Cabal.PackageIdentifier] -> Maybe Cabal.PackageIdentifier
latestOf = listToMaybe . reverse . sortBy (comparing Cabal.pkgVersion)
-- | Rearrange installed and available packages into groups referring to the
-- same package by name. In the result pairs, the lists are guaranteed to not
-- both be empty.
--
mergePackages :: [Cabal.PackageIdentifier] -> [Cabal.PackageIdentifier]
-> [([Cabal.PackageIdentifier], [Cabal.PackageIdentifier])]
mergePackages hackage overlay =
map collect
$ mergeBy (\i a -> fst i `compare` fst a)
(groupOn Cabal.pkgName hackage)
(groupOn Cabal.pkgName overlay)
where
collect (OnlyInLeft (_,is) ) = (is, [])
collect ( InBoth (_,is) (_,as)) = (is, as)
collect (OnlyInRight (_,as)) = ([], as)
groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
groupOn key = map (\xs -> (key (head xs), xs))
. groupBy (equating key)
. sortBy (comparing key)
Jump to Line
Something went wrong with that request. Please try again.