Depend.hs

{-----------------------------------------------------------------

  (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]