Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 794d89bfd6
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 182 lines (156 sloc) 6.578 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
module Portage.Overlay
  ( ExistingEbuild(..)
  , Overlay(..)
  , loadLazy
  , readOverlay, readOverlayByPackage
  , getDirectoryTree, DirectoryTree

  , reduceOverlay
  , filterByHerd
  , inOverlay
  )
  where

import qualified Portage.PackageId as Portage
import qualified Portage.Metadata as Portage

import qualified Distribution.Package as Cabal

import Distribution.Text (simpleParse)
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

data Overlay = Overlay {
    overlayPath :: FilePath,
    overlayMap :: Map Portage.PackageName [ExistingEbuild],
    overlayMetadata :: Map Portage.PackageName Portage.Metadata
  } deriving Show

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
        ]

filterByHerd :: ([String] -> Bool) -> Overlay -> Overlay
filterByHerd p overlay = overlay
                            { overlayMetadata = metadataMap'
                            , overlayMap = pkgMap'
                            }
  where
    metadataMap' = Map.filter (p . Portage.metadataHerds) (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 ebuilds = -- gah!
          map (maximumBy (comparing (Portage.pkgVersion . ebuildId)))
          . groupBy (equating (versionNumbers . Portage.pkgVersion . ebuildId))
          . sortBy (comparing (Portage.pkgVersion . ebuildId))
          $ ebuilds

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 <- [simpleParse dir] ]

    packages :: Portage.Category -> DirectoryTree
             -> [(Portage.PackageName, DirectoryTree)]
    packages category entries =
      [ (Portage.PackageName category name, entries')
      | Directory dir entries' <- entries
      , Just name <- [simpleParse 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) <- [simpleParse 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 ['.'] = True
    ignore ['.', '.'] = True
    ignore _ = False
Something went wrong with that request. Please try again.