{----------------------------------------------------------------- (c) 2008-2009 Markus Dittrich This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License Version 3 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 3 for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --------------------------------------------------------------------} -- | this module contains the top level routines for searching for -- packages with certain dependencies module Drivers.Depend ( DependTarget(..) , parse_category , search_for_depends ) where -- imports import qualified Data.ByteString as B(append, ByteString, concat, empty, head, null, split, tail) import qualified Data.ByteString.Char8 as BC(pack) import List(intersect, nub, partition, union) import Prelude import System.FilePath.Posix((), takeBaseName) import Text.Regex.PCRE((=~)) -- local imports import Drivers.Version(match_version) import Helpers.ByteString(andStr, exclMark, exclMarkW, remove_last_newline, slashW, spaceChar) import Helpers.Common(split_version_BS, VersionToken(..)) import Helpers.FileIO(retrieve_directory_contents) import Helpers.PrettyPrint(Color(..), putColorStr, putColorBStr) import Parsers.Depend(Dependency(..), depend_parser, get_depend, get_pdepend, get_rdepend, PackageDep(..)) import Parsers.Slot(get_slot) import Parsers.Use(get_USE_flags) -- import Debug.Trace -- | Search for packages depending on a particular package. -- The results from this function are similar to the ones -- from equery via -d search_for_depends :: String -> [FilePath] -> Bool -> IO () search_for_depends _ [] _ = return () search_for_depends filePath fullPaths withUse = -- before we look for packages depending on packageName -- we make sure it exists and we retrieve all neccessary -- information via a DependTarget data structure -- query_requested_package strippedName pkgPaths -- >>= \dependTargetInfo -> get_slot filePath >>= \aSlot -> let info = DependTarget (BC.pack filePath) aSlot in mapM_ (\path -> do matches <- retrieve_matches info path withUse print_matches matches ) fullPaths -- | Data type for tracking the depend info for the requested -- depend package data DependTarget = DependTarget { pkgName :: B.ByteString , pkgSlot :: B.ByteString } -- | retrieve all matches for a particular package category retrieve_matches :: DependTarget -> FilePath -> Bool -> IO [PackageDep] retrieve_matches packageInfo path withUse = retrieve_directory_contents path >>= parse_category packageInfo path withUse . reverse -- | check the DEPEND info for all items in [FilePath] parse_category :: DependTarget -> FilePath -> Bool -> [FilePath] -> IO [PackageDep] parse_category depInfo path withUse packages = check [] packages where category = takeBaseName path -- -- this function checks for matching dependencies and -- discards matches from non-existing USE flags -- or packages that have a slot mismatch. -- check :: [PackageDep] -> [FilePath] -> IO [PackageDep] check acc [] = return acc check acc (x:xs) = let pkgPath = path x in parse_depend (pkgName depInfo) pkgPath >>= \deps -> if null deps then check acc xs else let validDeps = filter_valid_slots (pkgSlot depInfo) deps in if not withUse then check (PackageDep(category x, validDeps):acc) xs else get_USE_flags pkgPath >>= \uFlags -> let finalDeps = filter_valid_use validDeps uFlags in if null finalDeps then check acc xs else check (PackageDep(category x, finalDeps):acc) xs -- | function filtering dependencies not matching in the -- slot info with the requester's filter_valid_slots :: B.ByteString -> [Dependency] -> [Dependency] filter_valid_slots aSlot = filter matchSlot where matchSlot (Dependency {slot = x}) -- without any slot info for the target we accept it | x == B.empty = True -- otherwise we compare | otherwise = aSlot == x -- | filter all dependencies tied to a USE flag not in the -- list of USE flags for this package filter_valid_use :: [Dependency] -> [B.ByteString] -> [Dependency] filter_valid_use [] _ = [] filter_valid_use depList [] = depList filter_valid_use depList uFlags = filter_helper [] depList where filter_helper :: [Dependency] -> [Dependency] -> [Dependency] filter_helper acc [] = acc filter_helper acc (dep:deps) | null $ useFlags dep = filter_helper (dep:acc) deps | otherwise = -- filter USE flags into regular ones and ones prefixed -- by '!' and test them separately let (notDeps,regDeps) = partition check_for_not (useFlags dep) depIntersect = intersect regDeps uFlags notIntersect = intersect (map B.tail notDeps) uFlags in case depIntersect == regDeps && null notIntersect of True -> filter_helper (dep:acc) deps _ -> filter_helper acc deps -- -- function returning if a particular Dependency use -- entry has the '!' (not) qualifier -- check_for_not :: B.ByteString -> Bool check_for_not aUseFlag | B.null aUseFlag == True = False | B.head aUseFlag == exclMarkW = True | otherwise = False -- | parse the actual DEPEND/RDEPEND/PDEPEND files and -- construct a list of Dependencies parse_depend :: B.ByteString -> FilePath -> IO [Dependency] parse_depend targetQuery pathName = -- read DEPEND and parse content get_depend pathName >>= \dependContent -> let dependList = extract_content dependContent in -- read RDEPEND and parse content get_rdepend pathName >>= \rdependContent -> let rdependList = extract_content rdependContent in -- read PDEPEND and parse content get_pdepend pathName >>= \pdependContent -> let pdependList = extract_content pdependContent in -- merge depend lists return (nub $ union dependList $ union rdependList pdependList) where extract_content c = case c of Nothing -> [] Just content -> if B.null content then [] else filter_package_depend targetQuery content -- | parse a the content of a DEPEND, RDEPEND, and PDEPEND file -- for the presence of a package filter_package_depend :: B.ByteString -> B.ByteString -> [Dependency] filter_package_depend targetQuery = match_target_name targetQuery . depend_parser . remove_last_newline -- | parse a list of Dependencies for a particular package. -- Try to match either the package name only of the full name -- including the category. If a version number is supplied -- we check if the dependency matches it also. -- NOTE: to exclude all elements prefixed with ! we match -- these cases with a regular expression instead of an -- exact match. match_target_name :: B.ByteString -> [Dependency] -> [Dependency] match_target_name targetQuery = find_matching_deps [] where find_matching_deps :: [Dependency] -> [Dependency] -> [Dependency] find_matching_deps acc [] = acc find_matching_deps acc (x:xs) | qualifier x =~ exclMark = find_matching_deps acc xs | (package x == targetName) && (version_matches x targetVers) = find_matching_deps (x:acc) xs | (baseName x == targetName) && (version_matches x targetVers) = find_matching_deps (x:acc) xs | otherwise = find_matching_deps acc xs where baseName = \z -> (B.split slashW (package z) ) !! 1 targetName = dName . split_version_BS $ targetQuery targetVers = dVersion . split_version_BS $ targetQuery -- | in case a version was supplied to the search, check -- if it matches the one present in the depend info version_matches :: Dependency -> B.ByteString -> Bool -- no version info supplied or present always leads to -- a successful match version_matches dep t_version | version dep == B.empty = True | t_version == B.empty = True -- use version_matcher to do a full blown version comparison | otherwise = match_version (qualifier dep) (version dep) t_version -- | pretty printer for found DEPEND et al. matches print_matches :: [PackageDep] -> IO () print_matches [] = return () print_matches (PackageDep(aName,depend):xs) = (putStr $ aName ++ " ") >> mapM_ print_depends depend >> putStrLn "" >> print_matches xs where print_depends :: Dependency -> IO () print_depends dep = do case length theUse of 0 -> putStr " [" >> putColorBStr Red thePackage >> putStr "]" _ -> putStr " [" >> putColorStr Blue "( " >> putColorBStr Blue (head theUse) >> (mapM_ (\x -> putColorBStr Blue $ B.append spacer x) $ tail theUse) >> putColorStr Blue " )?" >> putColorStr Red " " >> putColorBStr Red thePackage >> putStr "]" where Dependency { fullName = thePackage, useFlags = theUse } = dep spacer = B.concat [spaceChar, andStr, spaceChar]