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 StatusDirection -> StatusDirection -> Bool
(StatusDirection -> StatusDirection -> Bool)
-> (StatusDirection -> StatusDirection -> Bool)
-> Eq StatusDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusDirection -> StatusDirection -> Bool
$c/= :: StatusDirection -> StatusDirection -> Bool
== :: StatusDirection -> StatusDirection -> Bool
$c== :: StatusDirection -> StatusDirection -> Bool
Eq

data FileStatus a
        = Same a
        | Differs a a
        | OverlayOnly a
        | PortageOnly a
        | HackageOnly a
        deriving (Int -> FileStatus a -> ShowS
[FileStatus a] -> ShowS
FileStatus a -> String
(Int -> FileStatus a -> ShowS)
-> (FileStatus a -> String)
-> ([FileStatus a] -> ShowS)
-> Show (FileStatus a)
forall a. Show a => Int -> FileStatus a -> ShowS
forall a. Show a => [FileStatus a] -> ShowS
forall a. Show a => FileStatus a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileStatus a] -> ShowS
$cshowList :: forall a. Show a => [FileStatus a] -> ShowS
show :: FileStatus a -> String
$cshow :: forall a. Show a => FileStatus a -> String
showsPrec :: Int -> FileStatus a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FileStatus a -> ShowS
Show,FileStatus a -> FileStatus a -> Bool
(FileStatus a -> FileStatus a -> Bool)
-> (FileStatus a -> FileStatus a -> Bool) -> Eq (FileStatus a)
forall a. Eq a => FileStatus a -> FileStatus a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileStatus a -> FileStatus a -> Bool
$c/= :: forall a. Eq a => FileStatus a -> FileStatus a -> Bool
== :: FileStatus a -> FileStatus a -> Bool
$c== :: forall a. Eq a => FileStatus a -> FileStatus a -> Bool
Eq)

instance Ord a => Ord (FileStatus a) where
    compare :: FileStatus a -> FileStatus a -> Ordering
compare = (FileStatus a -> a) -> FileStatus a -> FileStatus a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Cabal.comparing FileStatus a -> a
forall a. FileStatus a -> a
fromStatus

instance Functor FileStatus where
    fmap :: (a -> b) -> FileStatus a -> FileStatus b
fmap a -> b
f FileStatus a
st =
        case FileStatus a
st of
            Same a
a -> b -> FileStatus b
forall a. a -> FileStatus a
Same (a -> b
f a
a)
            Differs a
a a
b -> b -> b -> FileStatus b
forall a. a -> a -> FileStatus a
Differs (a -> b
f a
a) (a -> b
f a
b)
            OverlayOnly a
a -> b -> FileStatus b
forall a. a -> FileStatus a
OverlayOnly (a -> b
f a
a)
            PortageOnly a
a -> b -> FileStatus b
forall a. a -> FileStatus a
PortageOnly (a -> b
f a
a)
            HackageOnly a
a -> b -> FileStatus b
forall a. a -> FileStatus a
HackageOnly (a -> b
f a
a)

fromStatus :: FileStatus a -> a
fromStatus :: FileStatus a -> a
fromStatus FileStatus a
fs =
    case FileStatus a
fs of
        Same a
a -> a
a
        Differs a
a a
_ -> a
a -- second status is lost
        OverlayOnly a
a -> a
a
        PortageOnly a
a -> a
a
        HackageOnly a
a -> a
a



loadHackage :: Cabal.Verbosity -> CabalInstall.RepoContext -> Overlay -> IO [[PackageId]]
loadHackage :: Verbosity -> RepoContext -> Overlay -> IO [[PackageId]]
loadHackage Verbosity
verbosity RepoContext
repoContext Overlay
overlay = do
    CabalInstall.SourcePackageDb { packageIndex :: SourcePackageDb -> PackageIndex UnresolvedSourcePackage
CabalInstall.packageIndex = PackageIndex UnresolvedSourcePackage
pindex } <- Verbosity -> RepoContext -> IO SourcePackageDb
CabalInstall.getSourcePackages Verbosity
verbosity RepoContext
repoContext
    let get_cat :: PackageIdentifier -> Category
get_cat PackageIdentifier
cabal_pkg = case Overlay -> PackageName -> [Category]
resolveCategories Overlay
overlay (PackageIdentifier -> PackageName
Cabal.pkgName PackageIdentifier
cabal_pkg) of
                                []    -> String -> Category
Category String
"dev-haskell"
                                [Category
cat] -> Category
cat
                                [Category]
_     -> {- ambig -} String -> Category
Category String
"dev-haskell"
        pkg_infos :: [[PackageId]]
pkg_infos = ([UnresolvedSourcePackage] -> [PackageId])
-> [[UnresolvedSourcePackage]] -> [[PackageId]]
forall a b. (a -> b) -> [a] -> [b]
map ( [PackageId] -> [PackageId]
forall a. [a] -> [a]
reverse ([PackageId] -> [PackageId])
-> ([UnresolvedSourcePackage] -> [PackageId])
-> [UnresolvedSourcePackage]
-> [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [PackageId] -> [PackageId]
forall a. Int -> [a] -> [a]
take Int
3 ([PackageId] -> [PackageId])
-> ([UnresolvedSourcePackage] -> [PackageId])
-> [UnresolvedSourcePackage]
-> [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageId] -> [PackageId]
forall a. [a] -> [a]
reverse -- hackage usually has a ton of older versions
                        ([PackageId] -> [PackageId])
-> ([UnresolvedSourcePackage] -> [PackageId])
-> [UnresolvedSourcePackage]
-> [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnresolvedSourcePackage -> PackageId)
-> [UnresolvedSourcePackage] -> [PackageId]
forall a b. (a -> b) -> [a] -> [b]
map ((\PackageIdentifier
p -> Category -> PackageIdentifier -> PackageId
fromCabalPackageId (PackageIdentifier -> Category
get_cat PackageIdentifier
p) PackageIdentifier
p)
                              (PackageIdentifier -> PackageId)
-> (UnresolvedSourcePackage -> PackageIdentifier)
-> UnresolvedSourcePackage
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> PackageIdentifier
forall loc. SourcePackage loc -> PackageIdentifier
CabalInstall.srcpkgPackageId))
                        (PackageIndex UnresolvedSourcePackage -> [[UnresolvedSourcePackage]]
forall pkg. PackageIndex pkg -> [[pkg]]
CabalInstall.allPackagesByName PackageIndex UnresolvedSourcePackage
pindex)
    [[PackageId]] -> IO [[PackageId]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[PackageId]]
pkg_infos

status :: Cabal.Verbosity -> FilePath -> FilePath -> CabalInstall.RepoContext -> IO (Map PackageName [FileStatus ExistingEbuild])
status :: Verbosity
-> String
-> String
-> RepoContext
-> IO (Map PackageName [FileStatus ExistingEbuild])
status Verbosity
verbosity String
portdir String
overlaydir RepoContext
repoContext = do
    Overlay
overlay <- String -> IO Overlay
loadLazy String
overlaydir
    [[PackageId]]
hackage <- Verbosity -> RepoContext -> Overlay -> IO [[PackageId]]
loadHackage Verbosity
verbosity RepoContext
repoContext Overlay
overlay
    Overlay
portage <- ([String] -> Bool) -> Overlay -> Overlay
filterByEmail (String
"haskell@gentoo.org" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) (Overlay -> Overlay) -> IO Overlay -> IO Overlay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Overlay
loadLazy String
portdir
    let (EMap
over, EMap
both, EMap
port) = EMap -> EMap -> (EMap, EMap, EMap)
portageDiff (Overlay -> EMap
overlayMap Overlay
overlay) (Overlay -> EMap
overlayMap Overlay
portage)

    Map PackageName [FileStatus ExistingEbuild]
both' <- EMap
-> ([ExistingEbuild] -> IO [FileStatus ExistingEbuild])
-> IO (Map PackageName [FileStatus ExistingEbuild])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM EMap
both (([ExistingEbuild] -> IO [FileStatus ExistingEbuild])
 -> IO (Map PackageName [FileStatus ExistingEbuild]))
-> ([ExistingEbuild] -> IO [FileStatus ExistingEbuild])
-> IO (Map PackageName [FileStatus ExistingEbuild])
forall a b. (a -> b) -> a -> b
$ (ExistingEbuild -> IO (FileStatus ExistingEbuild))
-> [ExistingEbuild] -> IO [FileStatus ExistingEbuild]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ExistingEbuild -> IO (FileStatus ExistingEbuild))
 -> [ExistingEbuild] -> IO [FileStatus ExistingEbuild])
-> (ExistingEbuild -> IO (FileStatus ExistingEbuild))
-> [ExistingEbuild]
-> IO [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \ExistingEbuild
e -> do
            -- can't fail, we know the ebuild exists in both portagedirs
            -- also, one of them is already bound to 'e'
            let (Just ExistingEbuild
e1) = EMap -> PackageId -> Maybe ExistingEbuild
lookupEbuildWith (Overlay -> EMap
overlayMap Overlay
portage) (ExistingEbuild -> PackageId
ebuildId ExistingEbuild
e)
                (Just ExistingEbuild
e2) = EMap -> PackageId -> Maybe ExistingEbuild
lookupEbuildWith (Overlay -> EMap
overlayMap Overlay
overlay) (ExistingEbuild -> PackageId
ebuildId ExistingEbuild
e)
            Bool
eq <- String -> String -> IO Bool
equals (ExistingEbuild -> String
ebuildPath ExistingEbuild
e1) (ExistingEbuild -> String
ebuildPath ExistingEbuild
e2)
            FileStatus ExistingEbuild -> IO (FileStatus ExistingEbuild)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus ExistingEbuild -> IO (FileStatus ExistingEbuild))
-> FileStatus ExistingEbuild -> IO (FileStatus ExistingEbuild)
forall a b. (a -> b) -> a -> b
$ if Bool
eq
                        then ExistingEbuild -> FileStatus ExistingEbuild
forall a. a -> FileStatus a
Same ExistingEbuild
e1
                        else ExistingEbuild -> ExistingEbuild -> FileStatus ExistingEbuild
forall a. a -> a -> FileStatus a
Differs ExistingEbuild
e1 ExistingEbuild
e2

    let p_to_ee :: PackageId -> ExistingEbuild
        p_to_ee :: PackageId -> ExistingEbuild
p_to_ee PackageId
p = PackageId -> PackageIdentifier -> String -> ExistingEbuild
ExistingEbuild PackageId
p PackageIdentifier
cabal_p String
ebuild_path
            where Just PackageIdentifier
cabal_p = PackageId -> Maybe PackageIdentifier
toCabalPackageId PackageId
p -- lame doubleconv
                  ebuild_path :: String
ebuild_path = PackageId -> String
packageIdToFilePath PackageId
p
        mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])
        mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])
mk_fake_ee ~pkgs :: [PackageId]
pkgs@(PackageId
p:[PackageId]
_) = (PackageId -> PackageName
packageId PackageId
p, (PackageId -> ExistingEbuild) -> [PackageId] -> [ExistingEbuild]
forall a b. (a -> b) -> [a] -> [b]
map PackageId -> ExistingEbuild
p_to_ee [PackageId]
pkgs)

        map_diff :: EMap -> EMap -> EMap
map_diff = ([ExistingEbuild] -> [ExistingEbuild] -> Maybe [ExistingEbuild])
-> EMap -> EMap -> EMap
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (\[ExistingEbuild]
le [ExistingEbuild]
re -> [ExistingEbuild] -> Maybe [ExistingEbuild]
forall a. a -> Maybe a
Just ([ExistingEbuild] -> Maybe [ExistingEbuild])
-> [ExistingEbuild] -> Maybe [ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ (ExistingEbuild -> [ExistingEbuild] -> [ExistingEbuild])
-> [ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ExistingEbuild -> ExistingEbuild -> Bool)
-> ExistingEbuild -> [ExistingEbuild] -> [ExistingEbuild]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy ((ExistingEbuild -> PackageId)
-> ExistingEbuild -> ExistingEbuild -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
Cabal.equating ExistingEbuild -> PackageId
ebuildId)) [ExistingEbuild]
le [ExistingEbuild]
re)
        hack :: EMap
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.
                  ([ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild])
-> [(PackageName, [ExistingEbuild])] -> EMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild]
forall a. [a] -> [a] -> [a]
(++) ([(PackageName, [ExistingEbuild])] -> EMap)
-> [(PackageName, [ExistingEbuild])] -> EMap
forall a b. (a -> b) -> a -> b
$
                      ([PackageId] -> (PackageName, [ExistingEbuild]))
-> [[PackageId]] -> [(PackageName, [ExistingEbuild])]
forall a b. (a -> b) -> [a] -> [b]
map [PackageId] -> (PackageName, [ExistingEbuild])
mk_fake_ee [[PackageId]]
hackage) EMap -> EMap -> EMap
`map_diff` Overlay -> EMap
overlayMap Overlay
overlay) EMap -> EMap -> EMap
`map_diff` Overlay -> EMap
overlayMap Overlay
portage

        meld :: Map PackageName [FileStatus ExistingEbuild]
meld = ([FileStatus ExistingEbuild]
 -> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild])
-> [Map PackageName [FileStatus ExistingEbuild]]
-> Map PackageName [FileStatus ExistingEbuild]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith (\[FileStatus ExistingEbuild]
a [FileStatus ExistingEbuild]
b -> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. Ord a => [a] -> [a]
List.sort ([FileStatus ExistingEbuild]
a[FileStatus ExistingEbuild]
-> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. [a] -> [a] -> [a]
++[FileStatus ExistingEbuild]
b))
                [ ([ExistingEbuild] -> [FileStatus ExistingEbuild])
-> EMap -> Map PackageName [FileStatus ExistingEbuild]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((ExistingEbuild -> FileStatus ExistingEbuild)
-> [ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> [a] -> [b]
map ExistingEbuild -> FileStatus ExistingEbuild
forall a. a -> FileStatus a
PortageOnly) EMap
port
                , Map PackageName [FileStatus ExistingEbuild]
both'
                , ([ExistingEbuild] -> [FileStatus ExistingEbuild])
-> EMap -> Map PackageName [FileStatus ExistingEbuild]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((ExistingEbuild -> FileStatus ExistingEbuild)
-> [ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> [a] -> [b]
map ExistingEbuild -> FileStatus ExistingEbuild
forall a. a -> FileStatus a
OverlayOnly) EMap
over
                , ([ExistingEbuild] -> [FileStatus ExistingEbuild])
-> EMap -> Map PackageName [FileStatus ExistingEbuild]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((ExistingEbuild -> FileStatus ExistingEbuild)
-> [ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> [a] -> [b]
map ExistingEbuild -> FileStatus ExistingEbuild
forall a. a -> FileStatus a
HackageOnly) EMap
hack
                ]
    Map PackageName [FileStatus ExistingEbuild]
-> IO (Map PackageName [FileStatus ExistingEbuild])
forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName [FileStatus ExistingEbuild]
meld

type EMap = Map PackageName [ExistingEbuild]

lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild
lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild
lookupEbuildWith EMap
overlay PackageId
pkgid = do
  [ExistingEbuild]
ebuilds <- PackageName -> EMap -> Maybe [ExistingEbuild]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageId -> PackageName
packageId PackageId
pkgid) EMap
overlay
  (ExistingEbuild -> Bool)
-> [ExistingEbuild] -> Maybe ExistingEbuild
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\ExistingEbuild
e -> ExistingEbuild -> PackageId
ebuildId ExistingEbuild
e PackageId -> PackageId -> Bool
forall a. Eq a => a -> a -> Bool
== PackageId
pkgid) [ExistingEbuild]
ebuilds

runStatus :: Cabal.Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> CabalInstall.RepoContext -> IO ()
runStatus :: Verbosity
-> String
-> String
-> StatusDirection
-> [String]
-> RepoContext
-> IO ()
runStatus Verbosity
verbosity String
portdir String
overlaydir StatusDirection
direction [String]
pkgs RepoContext
repoContext = do
  let pkgFilter :: Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
pkgFilter = case StatusDirection
direction of
                      StatusDirection
OverlayToPortage   -> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
toPortageFilter
                      StatusDirection
PortagePlusOverlay -> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall a. a -> a
id
                      StatusDirection
HackageToOverlay   -> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
fromHackageFilter
  [PackageName]
pkgs' <- [String] -> (String -> IO PackageName) -> IO [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
pkgs ((String -> IO PackageName) -> IO [PackageName])
-> (String -> IO PackageName) -> IO [PackageName]
forall a b. (a -> b) -> a -> b
$ \String
p ->
            case String -> Maybe PackageName
forall a. Parsec a => String -> Maybe a
simpleParsec String
p of
              Maybe PackageName
Nothing -> Verbosity -> String -> IO PackageName
forall a. Verbosity -> String -> IO a
Cabal.die' Verbosity
verbosity (String
"Could not parse package name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Format cat/pkg")
              Just PackageName
pn -> PackageName -> IO PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
pn
  Map PackageName [FileStatus ExistingEbuild]
tree0 <- Verbosity
-> String
-> String
-> RepoContext
-> IO (Map PackageName [FileStatus ExistingEbuild])
status Verbosity
verbosity String
portdir String
overlaydir RepoContext
repoContext
  let tree :: Map PackageName [FileStatus ExistingEbuild]
tree = Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
pkgFilter Map PackageName [FileStatus ExistingEbuild]
tree0
  if ([PackageName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
pkgs')
    then Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter Map PackageName [FileStatus ExistingEbuild]
tree
    else [PackageName] -> (PackageName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PackageName]
pkgs' ((PackageName -> IO ()) -> IO ())
-> (PackageName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PackageName
pkg -> Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter ((PackageName -> [FileStatus ExistingEbuild] -> Bool)
-> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PackageName
k [FileStatus ExistingEbuild]
_ -> PackageName
k PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pkg) Map PackageName [FileStatus ExistingEbuild]
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 PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
toPortageFilter = ([FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild])
-> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (([FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild])
 -> Map PackageName [FileStatus ExistingEbuild]
 -> Map PackageName [FileStatus ExistingEbuild])
-> ([FileStatus ExistingEbuild]
    -> Maybe [FileStatus ExistingEbuild])
-> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \ [FileStatus ExistingEbuild]
sts ->
    let filter_out_lives :: [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
filter_out_lives = (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (FileStatus ExistingEbuild -> Bool)
-> FileStatus ExistingEbuild
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Bool
V.is_live (Version -> Bool)
-> (FileStatus ExistingEbuild -> Version)
-> FileStatus ExistingEbuild
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
pkgVersion (PackageId -> Version)
-> (FileStatus ExistingEbuild -> PackageId)
-> FileStatus ExistingEbuild
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId (ExistingEbuild -> PackageId)
-> (FileStatus ExistingEbuild -> ExistingEbuild)
-> FileStatus ExistingEbuild
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus ExistingEbuild -> ExistingEbuild
forall a. FileStatus a -> a
fromStatus)
        inPortage :: [FileStatus ExistingEbuild]
inPortage = ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild])
-> [FileStatus ExistingEbuild]
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. (a -> Bool) -> [a] -> [a]
filter [FileStatus ExistingEbuild]
sts ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild])
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \FileStatus ExistingEbuild
st ->
                        case FileStatus ExistingEbuild
st of
                            OverlayOnly ExistingEbuild
_ -> Bool
False
                            HackageOnly ExistingEbuild
_ -> Bool
False
                            FileStatus ExistingEbuild
_ -> Bool
True
        latestPortageVersion :: Version
latestPortageVersion = [Version] -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ (FileStatus ExistingEbuild -> Version)
-> [FileStatus ExistingEbuild] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map (PackageId -> Version
pkgVersion (PackageId -> Version)
-> (FileStatus ExistingEbuild -> PackageId)
-> FileStatus ExistingEbuild
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId (ExistingEbuild -> PackageId)
-> (FileStatus ExistingEbuild -> ExistingEbuild)
-> FileStatus ExistingEbuild
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus ExistingEbuild -> ExistingEbuild
forall a. FileStatus a -> a
fromStatus) [FileStatus ExistingEbuild]
inPortage
        interestingPackages :: [FileStatus ExistingEbuild]
interestingPackages = ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild])
-> [FileStatus ExistingEbuild]
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. (a -> Bool) -> [a] -> [a]
filter [FileStatus ExistingEbuild]
sts ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild])
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \FileStatus ExistingEbuild
st ->
            case FileStatus ExistingEbuild
st of
                HackageOnly ExistingEbuild
_ -> Bool
False
                Differs ExistingEbuild
_ ExistingEbuild
_ -> Bool
True
                FileStatus ExistingEbuild
_ | PackageId -> Version
pkgVersion (ExistingEbuild -> PackageId
ebuildId (FileStatus ExistingEbuild -> ExistingEbuild
forall a. FileStatus a -> a
fromStatus FileStatus ExistingEbuild
st)) Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
latestPortageVersion -> Bool
True
                  | Bool
otherwise -> Bool
False
    in if Bool -> Bool
not ([FileStatus ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileStatus ExistingEbuild]
inPortage) Bool -> Bool -> Bool
&& Bool -> Bool
not ([FileStatus ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FileStatus ExistingEbuild] -> Bool)
-> [FileStatus ExistingEbuild] -> Bool
forall a b. (a -> b) -> a -> b
$ [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
filter_out_lives [FileStatus ExistingEbuild]
interestingPackages)
        then [FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild]
forall a. a -> Maybe a
Just [FileStatus ExistingEbuild]
sts
        else Maybe [FileStatus ExistingEbuild]
forall a. Maybe a
Nothing

-- |Only return packages that exist in overlay or portage but look outdated
fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]
fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
fromHackageFilter = ([FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild])
-> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (([FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild])
 -> Map PackageName [FileStatus ExistingEbuild]
 -> Map PackageName [FileStatus ExistingEbuild])
-> ([FileStatus ExistingEbuild]
    -> Maybe [FileStatus ExistingEbuild])
-> Map PackageName [FileStatus ExistingEbuild]
-> Map PackageName [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \ [FileStatus ExistingEbuild]
sts ->
    let inEbuilds :: [FileStatus ExistingEbuild]
inEbuilds = ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild])
-> [FileStatus ExistingEbuild]
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild] -> [FileStatus ExistingEbuild]
forall a. (a -> Bool) -> [a] -> [a]
filter [FileStatus ExistingEbuild]
sts ((FileStatus ExistingEbuild -> Bool)
 -> [FileStatus ExistingEbuild])
-> (FileStatus ExistingEbuild -> Bool)
-> [FileStatus ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ \FileStatus ExistingEbuild
st ->
                        case FileStatus ExistingEbuild
st of
                            HackageOnly ExistingEbuild
_ -> Bool
False
                            FileStatus ExistingEbuild
_ -> Bool
True
        -- treat live as oldest version not avoid masking hackage releases
        mangle_live_versions :: Version -> Version
mangle_live_versions Version
v
            | Version -> Bool
V.is_live Version
v = Version
v {versionNumber :: [Int]
versionNumber=[-Int
1]}
            | Bool
otherwise   = Version
v
        latestVersion :: FileStatus ExistingEbuild
latestVersion = (FileStatus ExistingEbuild
 -> FileStatus ExistingEbuild -> Ordering)
-> [FileStatus ExistingEbuild] -> FileStatus ExistingEbuild
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Version -> Version -> Ordering)
-> (FileStatus ExistingEbuild -> Version)
-> FileStatus ExistingEbuild
-> FileStatus ExistingEbuild
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Version -> Version
mangle_live_versions (Version -> Version)
-> (FileStatus ExistingEbuild -> Version)
-> FileStatus ExistingEbuild
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
pkgVersion (PackageId -> Version)
-> (FileStatus ExistingEbuild -> PackageId)
-> FileStatus ExistingEbuild
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId (ExistingEbuild -> PackageId)
-> (FileStatus ExistingEbuild -> ExistingEbuild)
-> FileStatus ExistingEbuild
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus ExistingEbuild -> ExistingEbuild
forall a. FileStatus a -> a
fromStatus) [FileStatus ExistingEbuild]
sts
    in case FileStatus ExistingEbuild
latestVersion of
            HackageOnly ExistingEbuild
_ | Bool -> Bool
not ([FileStatus ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileStatus ExistingEbuild]
inEbuilds) -> [FileStatus ExistingEbuild] -> Maybe [FileStatus ExistingEbuild]
forall a. a -> Maybe a
Just [FileStatus ExistingEbuild]
sts
            FileStatus ExistingEbuild
_                                    -> Maybe [FileStatus ExistingEbuild]
forall a. Maybe a
Nothing

statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter Map PackageName [FileStatus ExistingEbuild]
packages = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor (String -> FileStatus String
forall a. a -> FileStatus a
Same String
"Green") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": package in portage and overlay are the same"
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor (String -> String -> FileStatus String
forall a. a -> a -> FileStatus a
Differs String
"Yellow" String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": package in portage and overlay differs"
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor (String -> FileStatus String
forall a. a -> FileStatus a
OverlayOnly String
"Red") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": package only exist in the overlay"
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor (String -> FileStatus String
forall a. a -> FileStatus a
PortageOnly String
"Magenta") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": package only exist in the portage tree"
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor (String -> FileStatus String
forall a. a -> FileStatus a
HackageOnly String
"Cyan") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": package only exist on hackage"
    [(Int, (PackageName, [FileStatus ExistingEbuild]))]
-> ((Int, (PackageName, [FileStatus ExistingEbuild])) -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(PackageName, [FileStatus ExistingEbuild])]
-> [(Int, (PackageName, [FileStatus ExistingEbuild]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] ([(PackageName, [FileStatus ExistingEbuild])]
 -> [(Int, (PackageName, [FileStatus ExistingEbuild]))])
-> [(PackageName, [FileStatus ExistingEbuild])]
-> [(Int, (PackageName, [FileStatus ExistingEbuild]))]
forall a b. (a -> b) -> a -> b
$ Map PackageName [FileStatus ExistingEbuild]
-> [(PackageName, [FileStatus ExistingEbuild])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map PackageName [FileStatus ExistingEbuild]
packages) (((Int, (PackageName, [FileStatus ExistingEbuild])) -> IO ())
 -> IO ())
-> ((Int, (PackageName, [FileStatus ExistingEbuild])) -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
ix, (PackageName
pkg, [FileStatus ExistingEbuild]
ebuilds)) -> do
        let (PackageName Category
c PackageName
p) = PackageName
pkg
        String -> IO ()
putStr (ShowS
bold (Int -> String
forall a. Show a => a -> String
show Int
ix))
        String -> IO ()
putStr String
" "
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Category -> String
forall a. Pretty a => a -> String
prettyShow Category
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
bold (PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
p)
        String -> IO ()
putStr String
" "
        [FileStatus ExistingEbuild]
-> (FileStatus ExistingEbuild -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileStatus ExistingEbuild]
ebuilds ((FileStatus ExistingEbuild -> IO ()) -> IO ())
-> (FileStatus ExistingEbuild -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileStatus ExistingEbuild
e -> do
            String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStatus String -> String
toColor ((ExistingEbuild -> String)
-> FileStatus ExistingEbuild -> FileStatus String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> String
forall a. Pretty a => a -> String
prettyShow (Version -> String)
-> (ExistingEbuild -> Version) -> ExistingEbuild -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
pkgVersion (PackageId -> Version)
-> (ExistingEbuild -> PackageId) -> ExistingEbuild -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId) FileStatus ExistingEbuild
e)
            Char -> IO ()
putChar Char
' '
        String -> IO ()
putStrLn String
""

toColor :: FileStatus String -> String
toColor :: FileStatus String -> String
toColor FileStatus String
st = Color -> Bool -> Color -> ShowS
inColor Color
c Bool
False Color
Default (FileStatus String -> String
forall a. FileStatus a -> a
fromStatus FileStatus String
st)
    where
    c :: Color
c = case FileStatus String
st of
        (Same String
_) -> Color
Green
        (Differs String
_ String
_) -> Color
Yellow
        (OverlayOnly String
_) -> Color
Red
        (PortageOnly String
_) -> Color
Magenta
        (HackageOnly String
_) -> Color
Cyan

portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff EMap
p1 EMap
p2 = (EMap
in1, EMap
ins, EMap
in2)
    where ins :: EMap
ins = ([ExistingEbuild] -> Bool) -> EMap -> EMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> ([ExistingEbuild] -> Bool) -> [ExistingEbuild] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (EMap -> EMap) -> EMap -> EMap
forall a b. (a -> b) -> a -> b
$ ([ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild])
-> EMap -> EMap -> EMap
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith ((ExistingEbuild -> ExistingEbuild -> Bool)
-> [ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.intersectBy ((ExistingEbuild -> ExistingEbuild -> Bool)
 -> [ExistingEbuild] -> [ExistingEbuild] -> [ExistingEbuild])
-> (ExistingEbuild -> ExistingEbuild -> Bool)
-> [ExistingEbuild]
-> [ExistingEbuild]
-> [ExistingEbuild]
forall a b. (a -> b) -> a -> b
$ (ExistingEbuild -> PackageId)
-> ExistingEbuild -> ExistingEbuild -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
Cabal.equating ExistingEbuild -> PackageId
ebuildId) EMap
p1 EMap
p2
          in1 :: EMap
in1 = EMap -> EMap -> EMap
forall k (t :: * -> *).
(Ord k, Foldable t) =>
Map k [ExistingEbuild]
-> Map k (t ExistingEbuild) -> Map k [ExistingEbuild]
difference EMap
p1 EMap
p2
          in2 :: EMap
in2 = EMap -> EMap -> EMap
forall k (t :: * -> *).
(Ord k, Foldable t) =>
Map k [ExistingEbuild]
-> Map k (t ExistingEbuild) -> Map k [ExistingEbuild]
difference EMap
p2 EMap
p1
          difference :: Map k [ExistingEbuild]
-> Map k (t ExistingEbuild) -> Map k [ExistingEbuild]
difference Map k [ExistingEbuild]
x Map k (t ExistingEbuild)
y = ([ExistingEbuild] -> Bool)
-> Map k [ExistingEbuild] -> Map k [ExistingEbuild]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> ([ExistingEbuild] -> Bool) -> [ExistingEbuild] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Map k [ExistingEbuild] -> Map k [ExistingEbuild])
-> Map k [ExistingEbuild] -> Map k [ExistingEbuild]
forall a b. (a -> b) -> a -> b
$
                       ([ExistingEbuild] -> t ExistingEbuild -> Maybe [ExistingEbuild])
-> Map k [ExistingEbuild]
-> Map k (t ExistingEbuild)
-> Map k [ExistingEbuild]
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (\[ExistingEbuild]
xs t ExistingEbuild
ys ->
                        let lst :: [ExistingEbuild]
lst = (ExistingEbuild -> [ExistingEbuild] -> [ExistingEbuild])
-> [ExistingEbuild] -> t ExistingEbuild -> [ExistingEbuild]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ExistingEbuild -> ExistingEbuild -> Bool)
-> ExistingEbuild -> [ExistingEbuild] -> [ExistingEbuild]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy ((ExistingEbuild -> PackageId)
-> ExistingEbuild -> ExistingEbuild -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
Cabal.equating ExistingEbuild -> PackageId
ebuildId)) [ExistingEbuild]
xs t ExistingEbuild
ys in
                        if [ExistingEbuild] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExistingEbuild]
lst
                            then Maybe [ExistingEbuild]
forall a. Maybe a
Nothing
                            else [ExistingEbuild] -> Maybe [ExistingEbuild]
forall a. a -> Maybe a
Just [ExistingEbuild]
lst
                            ) Map k [ExistingEbuild]
x Map k (t ExistingEbuild)
y

-- | Compares two ebuilds, returns True if they are equal.
--   Disregards comments.
equals :: FilePath -> FilePath -> IO Bool
equals :: String -> String -> IO Bool
equals String
fp1 String
fp2 = do
    -- don't leave halfopenfiles
    ByteString
f1 <- String -> IO ByteString
BS.readFile String
fp1
    ByteString
f2 <- String -> IO ByteString
BS.readFile String
fp2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> Bool
equal' ByteString
f1 ByteString
f2)

equal' :: BS.ByteString -> BS.ByteString -> Bool
equal' :: ByteString -> ByteString -> Bool
equal' = (ByteString -> [ByteString]) -> ByteString -> ByteString -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
Cabal.equating ByteString -> [ByteString]
essence
    where
    essence :: ByteString -> [ByteString]
essence = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
isEmpty)
            ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
isComment)
            ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
isHOMEPAGE)
            ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
    isComment :: ByteString -> Bool
isComment = ByteString -> ByteString -> Bool
BS.isPrefixOf (String -> ByteString
BS.pack String
"#") (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace
    -- HOMEPAGE= frequently gets updated for http:// / https://.
    -- It's to much noise usually and should really be fixed
    -- in upstream Cabal definition.
    isHOMEPAGE :: ByteString -> Bool
isHOMEPAGE = ByteString -> ByteString -> Bool
BS.isPrefixOf (String -> ByteString
BS.pack String
"HOMEPAGE=") (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace
    isEmpty :: ByteString -> Bool
isEmpty = ByteString -> Bool
BS.null (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace