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) import Data.Traversable ( traverse ) 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" ]