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 {
ExistingEbuild -> PackageId
ebuildId :: Portage.PackageId,
ExistingEbuild -> PackageIdentifier
ebuildCabalId :: Cabal.PackageIdentifier,
ExistingEbuild -> FilePath
ebuildPath :: FilePath
} deriving (Int -> ExistingEbuild -> ShowS
[ExistingEbuild] -> ShowS
ExistingEbuild -> FilePath
(Int -> ExistingEbuild -> ShowS)
-> (ExistingEbuild -> FilePath)
-> ([ExistingEbuild] -> ShowS)
-> Show ExistingEbuild
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExistingEbuild] -> ShowS
$cshowList :: [ExistingEbuild] -> ShowS
show :: ExistingEbuild -> FilePath
$cshow :: ExistingEbuild -> FilePath
showsPrec :: Int -> ExistingEbuild -> ShowS
$cshowsPrec :: Int -> ExistingEbuild -> ShowS
Show,Eq ExistingEbuild
Eq ExistingEbuild
-> (ExistingEbuild -> ExistingEbuild -> Ordering)
-> (ExistingEbuild -> ExistingEbuild -> Bool)
-> (ExistingEbuild -> ExistingEbuild -> Bool)
-> (ExistingEbuild -> ExistingEbuild -> Bool)
-> (ExistingEbuild -> ExistingEbuild -> Bool)
-> (ExistingEbuild -> ExistingEbuild -> ExistingEbuild)
-> (ExistingEbuild -> ExistingEbuild -> ExistingEbuild)
-> Ord ExistingEbuild
ExistingEbuild -> ExistingEbuild -> Bool
ExistingEbuild -> ExistingEbuild -> Ordering
ExistingEbuild -> ExistingEbuild -> ExistingEbuild
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExistingEbuild -> ExistingEbuild -> ExistingEbuild
$cmin :: ExistingEbuild -> ExistingEbuild -> ExistingEbuild
max :: ExistingEbuild -> ExistingEbuild -> ExistingEbuild
$cmax :: ExistingEbuild -> ExistingEbuild -> ExistingEbuild
>= :: ExistingEbuild -> ExistingEbuild -> Bool
$c>= :: ExistingEbuild -> ExistingEbuild -> Bool
> :: ExistingEbuild -> ExistingEbuild -> Bool
$c> :: ExistingEbuild -> ExistingEbuild -> Bool
<= :: ExistingEbuild -> ExistingEbuild -> Bool
$c<= :: ExistingEbuild -> ExistingEbuild -> Bool
< :: ExistingEbuild -> ExistingEbuild -> Bool
$c< :: ExistingEbuild -> ExistingEbuild -> Bool
compare :: ExistingEbuild -> ExistingEbuild -> Ordering
$ccompare :: ExistingEbuild -> ExistingEbuild -> Ordering
$cp1Ord :: Eq ExistingEbuild
Ord,ExistingEbuild -> ExistingEbuild -> Bool
(ExistingEbuild -> ExistingEbuild -> Bool)
-> (ExistingEbuild -> ExistingEbuild -> Bool) -> Eq ExistingEbuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExistingEbuild -> ExistingEbuild -> Bool
$c/= :: ExistingEbuild -> ExistingEbuild -> Bool
== :: ExistingEbuild -> ExistingEbuild -> Bool
$c== :: ExistingEbuild -> ExistingEbuild -> Bool
Eq)
instance Cabal.Package ExistingEbuild where
packageId :: ExistingEbuild -> PackageIdentifier
packageId = ExistingEbuild -> PackageIdentifier
ebuildCabalId
instance Cabal.HasUnitId ExistingEbuild where
installedUnitId :: ExistingEbuild -> UnitId
installedUnitId ExistingEbuild
_ = FilePath -> UnitId
forall a. HasCallStack => FilePath -> a
error FilePath
"Portage.Cabal.installedUnitId: FIXME: should not be used"
data Overlay = Overlay {
Overlay -> FilePath
overlayPath :: FilePath,
Overlay -> Map PackageName [ExistingEbuild]
overlayMap :: Map Portage.PackageName [ExistingEbuild],
Overlay -> Map PackageName Metadata
overlayMetadata :: Map Portage.PackageName Portage.Metadata
} deriving Int -> Overlay -> ShowS
[Overlay] -> ShowS
Overlay -> FilePath
(Int -> Overlay -> ShowS)
-> (Overlay -> FilePath) -> ([Overlay] -> ShowS) -> Show Overlay
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Overlay] -> ShowS
$cshowList :: [Overlay] -> ShowS
show :: Overlay -> FilePath
$cshow :: Overlay -> FilePath
showsPrec :: Int -> Overlay -> ShowS
$cshowsPrec :: Int -> Overlay -> ShowS
Show
inOverlay :: Overlay -> Cabal.PackageId -> Bool
inOverlay :: Overlay -> PackageIdentifier -> Bool
inOverlay Overlay
overlay PackageIdentifier
pkgId = Bool -> Bool
not (Map PackageName [ExistingEbuild] -> Bool
forall k a. Map k a -> Bool
Map.null Map PackageName [ExistingEbuild]
packages)
where
packages :: Map PackageName [ExistingEbuild]
packages = (PackageName -> [ExistingEbuild] -> Bool)
-> Map PackageName [ExistingEbuild]
-> Map PackageName [ExistingEbuild]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
(\(Portage.PackageName Category
_cat PackageName
overlay_pn) [ExistingEbuild]
ebuilds ->
let cabal_pn :: PackageName
cabal_pn = PackageIdentifier -> PackageName
Cabal.pkgName PackageIdentifier
pkgId
ebs :: [()]
ebs = [ ()
| ExistingEbuild
e <- [ExistingEbuild]
ebuilds
, let ebuild_cabal_id :: PackageIdentifier
ebuild_cabal_id = ExistingEbuild -> PackageIdentifier
ebuildCabalId ExistingEbuild
e
, PackageIdentifier
ebuild_cabal_id PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
pkgId
]
in PackageName
cabal_pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
overlay_pn Bool -> Bool -> Bool
&& (Bool -> Bool
not ([()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [()]
ebs))) Map PackageName [ExistingEbuild]
om
om :: Map PackageName [ExistingEbuild]
om = Overlay -> Map PackageName [ExistingEbuild]
overlayMap Overlay
overlay
loadLazy :: FilePath -> IO Overlay
loadLazy :: FilePath -> IO Overlay
loadLazy FilePath
path = do
DirectoryTree
dir <- FilePath -> IO DirectoryTree
getDirectoryTree FilePath
path
Map PackageName Metadata
metadata <- IO (Map PackageName Metadata) -> IO (Map PackageName Metadata)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Map PackageName Metadata) -> IO (Map PackageName Metadata))
-> IO (Map PackageName Metadata) -> IO (Map PackageName Metadata)
forall a b. (a -> b) -> a -> b
$ FilePath -> DirectoryTree -> IO (Map PackageName Metadata)
mkMetadataMap FilePath
path DirectoryTree
dir
Overlay -> IO Overlay
forall (m :: * -> *) a. Monad m => a -> m a
return (Overlay -> IO Overlay) -> Overlay -> IO Overlay
forall a b. (a -> b) -> a -> b
$ Map PackageName Metadata -> [(PackageName, [Version])] -> Overlay
mkOverlay Map PackageName Metadata
metadata ([(PackageName, [Version])] -> Overlay)
-> [(PackageName, [Version])] -> Overlay
forall a b. (a -> b) -> a -> b
$ DirectoryTree -> [(PackageName, [Version])]
readOverlayByPackage DirectoryTree
dir
where
allowed :: Version -> Bool
allowed Version
v = case Version
v of
(Portage.Version [Int]
_ Maybe Char
Nothing [] Int
_) -> Bool
True
Version
_ -> Bool
False
mkOverlay :: Map Portage.PackageName Portage.Metadata
-> [(Portage.PackageName, [Portage.Version])]
-> Overlay
mkOverlay :: Map PackageName Metadata -> [(PackageName, [Version])] -> Overlay
mkOverlay Map PackageName Metadata
meta [(PackageName, [Version])]
packages = Overlay :: FilePath
-> Map PackageName [ExistingEbuild]
-> Map PackageName Metadata
-> Overlay
Overlay {
overlayPath :: FilePath
overlayPath = FilePath
path,
overlayMetadata :: Map PackageName Metadata
overlayMetadata = Map PackageName Metadata
meta,
overlayMap :: Map PackageName [ExistingEbuild]
overlayMap =
[(PackageName, [ExistingEbuild])]
-> Map PackageName [ExistingEbuild]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (PackageName
pkgName, [ PackageId -> PackageIdentifier -> FilePath -> ExistingEbuild
ExistingEbuild PackageId
portageId PackageIdentifier
cabalId FilePath
filepath
| Version
version <- [Version]
allowedVersions
, let portageId :: PackageId
portageId = PackageName -> Version -> PackageId
Portage.PackageId PackageName
pkgName Version
version
, Just PackageIdentifier
cabalId <- [ PackageId -> Maybe PackageIdentifier
Portage.toCabalPackageId PackageId
portageId ]
, let filepath :: FilePath
filepath = FilePath
path FilePath -> ShowS
</> PackageId -> FilePath
Portage.packageIdToFilePath PackageId
portageId
])
| (PackageName
pkgName, [Version]
allVersions) <- [(PackageName, [Version])]
packages
, let allowedVersions :: [Version]
allowedVersions = (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
filter Version -> Bool
allowed [Version]
allVersions
]
}
mkMetadataMap :: FilePath -> DirectoryTree -> IO (Map Portage.PackageName Portage.Metadata)
mkMetadataMap :: FilePath -> DirectoryTree -> IO (Map PackageName Metadata)
mkMetadataMap FilePath
root DirectoryTree
dir =
(Map PackageName (Maybe Metadata) -> Map PackageName Metadata)
-> IO (Map PackageName (Maybe Metadata))
-> IO (Map PackageName Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Metadata -> Maybe Metadata)
-> Map PackageName (Maybe Metadata) -> Map PackageName Metadata
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe Metadata -> Maybe Metadata
forall a. a -> a
id) (IO (Map PackageName (Maybe Metadata))
-> IO (Map PackageName Metadata))
-> IO (Map PackageName (Maybe Metadata))
-> IO (Map PackageName Metadata)
forall a b. (a -> b) -> a -> b
$
(FilePath -> IO (Maybe Metadata))
-> Map PackageName FilePath
-> IO (Map PackageName (Maybe Metadata))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Maybe Metadata)
Portage.metadataFromFile (Map PackageName FilePath -> IO (Map PackageName (Maybe Metadata)))
-> Map PackageName FilePath
-> IO (Map PackageName (Maybe Metadata))
forall a b. (a -> b) -> a -> b
$
[(PackageName, FilePath)] -> Map PackageName FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (FilePath -> FilePath -> PackageName
Portage.mkPackageName FilePath
category FilePath
package, FilePath
root FilePath -> ShowS
</> FilePath
category FilePath -> ShowS
</> FilePath
package FilePath -> ShowS
</> FilePath
"metadata.xml")
| Directory FilePath
category DirectoryTree
packages <- DirectoryTree
dir
, Directory FilePath
package DirectoryTree
files <- DirectoryTree
packages
, File FilePath
"metadata.xml" <- DirectoryTree
files
]
filterByEmail :: ([String] -> Bool) -> Overlay -> Overlay
filterByEmail :: ([FilePath] -> Bool) -> Overlay -> Overlay
filterByEmail [FilePath] -> Bool
p Overlay
overlay = Overlay
overlay
{ overlayMetadata :: Map PackageName Metadata
overlayMetadata = Map PackageName Metadata
metadataMap'
, overlayMap :: Map PackageName [ExistingEbuild]
overlayMap = Map PackageName [ExistingEbuild]
pkgMap'
}
where
metadataMap' :: Map PackageName Metadata
metadataMap' = (Metadata -> Bool)
-> Map PackageName Metadata -> Map PackageName Metadata
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ([FilePath] -> Bool
p ([FilePath] -> Bool)
-> (Metadata -> [FilePath]) -> Metadata -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> [FilePath]
Portage.metadataEmails) (Overlay -> Map PackageName Metadata
overlayMetadata Overlay
overlay)
pkgMap' :: Map PackageName [ExistingEbuild]
pkgMap' = Map PackageName [ExistingEbuild]
-> Map PackageName Metadata -> Map PackageName [ExistingEbuild]
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection (Overlay -> Map PackageName [ExistingEbuild]
overlayMap Overlay
overlay) Map PackageName Metadata
metadataMap'
reduceOverlay :: Overlay -> Overlay
reduceOverlay :: Overlay -> Overlay
reduceOverlay Overlay
overlay = Overlay
overlay { overlayMap :: Map PackageName [ExistingEbuild]
overlayMap = ([ExistingEbuild] -> [ExistingEbuild])
-> Map PackageName [ExistingEbuild]
-> Map PackageName [ExistingEbuild]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [ExistingEbuild] -> [ExistingEbuild]
reduceVersions (Overlay -> Map PackageName [ExistingEbuild]
overlayMap Overlay
overlay) }
where
versionNumbers :: Version -> [Int]
versionNumbers (Portage.Version [Int]
nums Maybe Char
_ [Suffix]
_ Int
_) = [Int]
nums
reduceVersions :: [ExistingEbuild] -> [ExistingEbuild]
reduceVersions :: [ExistingEbuild] -> [ExistingEbuild]
reduceVersions =
([ExistingEbuild] -> ExistingEbuild)
-> [[ExistingEbuild]] -> [ExistingEbuild]
forall a b. (a -> b) -> [a] -> [b]
map ((ExistingEbuild -> ExistingEbuild -> Ordering)
-> [ExistingEbuild] -> ExistingEbuild
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((ExistingEbuild -> Version)
-> ExistingEbuild -> ExistingEbuild -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (PackageId -> Version
Portage.pkgVersion (PackageId -> Version)
-> (ExistingEbuild -> PackageId) -> ExistingEbuild -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId)))
([[ExistingEbuild]] -> [ExistingEbuild])
-> ([ExistingEbuild] -> [[ExistingEbuild]])
-> [ExistingEbuild]
-> [ExistingEbuild]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExistingEbuild -> ExistingEbuild -> Bool)
-> [ExistingEbuild] -> [[ExistingEbuild]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((ExistingEbuild -> [Int])
-> ExistingEbuild -> ExistingEbuild -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating (Version -> [Int]
versionNumbers (Version -> [Int])
-> (ExistingEbuild -> Version) -> ExistingEbuild -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
Portage.pkgVersion (PackageId -> Version)
-> (ExistingEbuild -> PackageId) -> ExistingEbuild -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId))
([ExistingEbuild] -> [[ExistingEbuild]])
-> ([ExistingEbuild] -> [ExistingEbuild])
-> [ExistingEbuild]
-> [[ExistingEbuild]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExistingEbuild -> Version) -> [ExistingEbuild] -> [ExistingEbuild]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (PackageId -> Version
Portage.pkgVersion (PackageId -> Version)
-> (ExistingEbuild -> PackageId) -> ExistingEbuild -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistingEbuild -> PackageId
ebuildId)
readOverlayByPackage :: DirectoryTree -> [(Portage.PackageName, [Portage.Version])]
readOverlayByPackage :: DirectoryTree -> [(PackageName, [Version])]
readOverlayByPackage DirectoryTree
tree =
[ (PackageName
name, PackageName -> DirectoryTree -> [Version]
versions PackageName
name DirectoryTree
pkgTree)
| (Category
category, DirectoryTree
catTree) <- DirectoryTree -> [(Category, DirectoryTree)]
categories DirectoryTree
tree
, (PackageName
name, DirectoryTree
pkgTree) <- Category -> DirectoryTree -> [(PackageName, DirectoryTree)]
packages Category
category DirectoryTree
catTree
]
where
categories :: DirectoryTree -> [(Portage.Category, DirectoryTree)]
categories :: DirectoryTree -> [(Category, DirectoryTree)]
categories DirectoryTree
entries =
[ (Category
category, DirectoryTree
entries')
| Directory FilePath
dir DirectoryTree
entries' <- DirectoryTree
entries
, Just Category
category <- [FilePath -> Maybe Category
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
dir] ]
packages :: Portage.Category -> DirectoryTree
-> [(Portage.PackageName, DirectoryTree)]
packages :: Category -> DirectoryTree -> [(PackageName, DirectoryTree)]
packages Category
category DirectoryTree
entries =
[ (Category -> PackageName -> PackageName
Portage.PackageName Category
category PackageName
name, DirectoryTree
entries')
| Directory FilePath
dir DirectoryTree
entries' <- DirectoryTree
entries
, Just PackageName
name <- [FilePath -> Maybe PackageName
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
dir] ]
versions :: Portage.PackageName -> DirectoryTree -> [Portage.Version]
versions :: PackageName -> DirectoryTree -> [Version]
versions name :: PackageName
name@(Portage.PackageName (Portage.Category FilePath
category) PackageName
_) DirectoryTree
entries =
[ Version
version
| File FilePath
fileName <- DirectoryTree
entries
, let (FilePath
baseName, FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
fileName
, FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".ebuild"
, let fullName :: FilePath
fullName = FilePath
category FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
baseName
, Just (Portage.PackageId PackageName
name' Version
version) <- [FilePath -> Maybe PackageId
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
fullName]
, PackageName
name PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name' ]
readOverlay :: DirectoryTree -> [Portage.PackageId]
readOverlay :: DirectoryTree -> [PackageId]
readOverlay DirectoryTree
tree = [ PackageName -> Version -> PackageId
Portage.PackageId PackageName
pkgId Version
version
| (PackageName
pkgId, [Version]
versions) <- DirectoryTree -> [(PackageName, [Version])]
readOverlayByPackage DirectoryTree
tree
, Version
version <- [Version]
versions
]
type DirectoryTree = [DirectoryEntry]
data DirectoryEntry = File FilePath | Directory FilePath [DirectoryEntry]
getDirectoryTree :: FilePath -> IO DirectoryTree
getDirectoryTree :: FilePath -> IO DirectoryTree
getDirectoryTree = FilePath -> IO DirectoryTree
dirEntries
where
dirEntries :: FilePath -> IO [DirectoryEntry]
dirEntries :: FilePath -> IO DirectoryTree
dirEntries FilePath
dir = do
[FilePath]
names <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[IO DirectoryEntry] -> IO DirectoryTree
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ do Bool
isDirectory <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
if Bool
isDirectory
then do DirectoryTree
entries <- IO DirectoryTree -> IO DirectoryTree
forall a. IO a -> IO a
unsafeInterleaveIO (FilePath -> IO DirectoryTree
dirEntries FilePath
path)
DirectoryEntry -> IO DirectoryEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DirectoryTree -> DirectoryEntry
Directory FilePath
name DirectoryTree
entries)
else DirectoryEntry -> IO DirectoryEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DirectoryEntry
File FilePath
name)
| FilePath
name <- [FilePath]
names
, Bool -> Bool
not (FilePath -> Bool
ignore FilePath
name)
, let path :: FilePath
path = FilePath
dir FilePath -> ShowS
</> FilePath
name ]
ignore :: FilePath -> Bool
ignore FilePath
path = FilePath
path FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ FilePath
"."
, FilePath
".."
, FilePath
".git"
, FilePath
"CVS"
]