{-# LANGUAGE DeriveDataTypeable #-} {----------------------------------------------------------------- this module contains some common function used by other modules that don't (yet) have their own category (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 some common function used by other modules -- that don't (yet) have their own category module Helpers.Common ( defaultVersionToken , find_package_paths , get_categories , show_version , strip_category , split_version_BS , VersionToken(..) ) where -- imports import Control.Monad(filterM, liftM) import qualified Data.ByteString as B(append, ByteString, empty, null, tail) import qualified Data.ByteString.Char8 as BC(pack) import List(sort) import Prelude import System.Directory(doesDirectoryExist, getDirectoryContents) import System.FilePath.Posix((), dropTrailingPathSeparator, splitPath, takeFileName) import Text.Regex.PCRE((=~)) -- local imports import Helpers.FileIO import Parsers.Slot -- some global and useful definitions -- | current version of hark harkVersion :: String harkVersion = "0.2" -- | data structure holding the pieces of an EAPI -- version string, i.e. name-version:slot[useDep] data VersionToken = VersionToken { dName :: B.ByteString , dVersion :: B.ByteString , dSlot :: B.ByteString , dUseDeps :: B.ByteString } defaultVersionToken :: VersionToken defaultVersionToken = VersionToken { dName = B.empty , dVersion = B.empty , dSlot = B.empty , dUseDeps = B.empty } -- | token which signify the beginning of a version or -- SLOT specifier versionStartToken :: B.ByteString versionStartToken = BC.pack "[-][0-9]" slotStartToken :: B.ByteString slotStartToken = BC.pack "[:]" useDepStartToken :: B.ByteString useDepStartToken = BC.pack "[[]" -- | filter all category directories from main database -- directory get_categories :: FilePath -> IO [FilePath] get_categories path = getDirectoryContents path >>= \rawContent -> let content = filter_dot_dirs rawContent in liftM (sort . map takeFileName) (filterM doesDirectoryExist $ map ( path ) content) -- | given a pattern and a list of search paths, try to strip -- the category of the pattern. If one exists, restrict -- the search to the single path in the list of filepaths -- corresponding to the category. strip_category :: String -> [FilePath] -> (String, [FilePath]) strip_category x [] = (x,[]) strip_category pattern paths | length splitPattern == 2 = (aName, filter (\x -> x =~ path :: Bool) paths ) | otherwise = (pattern,paths) where splitPattern = splitPath pattern path = dropTrailingPathSeparator $ (!!) splitPattern 0 aName = (!!) splitPattern 1 -- | splits off the version string from the package name -- via regular expression -- NOTE: This is a specialized version for ByteString split_version_BS :: B.ByteString -> VersionToken split_version_BS inString = let -- split off use depend tokens if present (r1, _, use) = inString =~ useDepStartToken :: (B.ByteString,B.ByteString,B.ByteString) -- split off the slot if present (r2, _, slot) = r1 =~ slotStartToken :: (B.ByteString,B.ByteString,B.ByteString) -- split the rest into the name plus version if present (name, m, vers) = r2 =~ versionStartToken :: (B.ByteString,B.ByteString,B.ByteString) in if B.null m then defaultVersionToken { dName = name , dSlot = slot , dUseDeps = use } else defaultVersionToken { dName = name , dVersion = B.append (B.tail m) vers , dSlot = slot , dUseDeps = use } -- | look for packages matching the searched for name in database find_package_paths :: String -> [FilePath] -> IO [FilePath] find_package_paths packageName paths = find_path [] paths where -- go through all categories and try to find a match find_path :: [FilePath] -> [FilePath] -> IO [FilePath] find_path acc [] = return acc find_path acc (dir:dirs) = retrieve_directory_contents dir >>= \packages -> -- NOTE: Slotted packages can lead to more than -- a single match in a category if only the -- package name is given match_package packageName packages dir >>= \matches -> case length matches of 0 -> find_path acc dirs _ -> find_path (make_paths matches ++ acc) dirs where make_paths = map (\x -> dir ++ "/" ++ x) -- | check if a package is in a list of FilePaths -- The following additional constraints apply: -- -- * if the user specified only the package name we attempt -- to match entries in the pathList based on the name only. -- * if a version is supplied we do a full match only. -- * if a slot dependency is supplied we only match packages -- the have this exact slot match_package :: String -> [FilePath] -> FilePath -> IO [FilePath] match_package packageQuery pathList topDir = -- if we have a full version we're good apart from stripping -- off the slot information in case it is present if not $ null aVersion then return $ filter (\x -> x == (aName ++ aVersion)) pathList else -- if we have a slot we only pick packages with -- a matching slot if not $ null aSlot then filterM (check_slot_name aName aSlot) pathList else -- only have the name was provided return $ filter (\x -> get_name x == aName) pathList where (aName, aVersion, aSlot) = split_version_slot packageQuery -- | in case the user supplied a slot we try to figure out -- retrieve the SLOT of the target package as well and -- make sure it matches. -- NOTE: We have to be prepared that some packges don't -- have a SLOT check_slot_name n s pkg = try_get_slot (topDir ++ "/" ++ pkg) >>= \pkgSlot -> case pkgSlot of Nothing -> return (get_name pkg == n) Just val -> return $ (get_name pkg == n) && (val == BC.pack s) -- | splits a full package name request into the name, -- and possibly version and slot info split_version_slot theName = let -- split off the slot if present (r1, _, theSlot) = theName =~ slotStartToken :: (String, String, String) -- split off the version if present (name, m, vers) = r1 =~ versionStartToken :: (String, String, String) in (name, m ++ vers, theSlot) -- | conveniece function to get at the name only get_name item = let (theName, _, _) = split_version_slot item in theName -- | function printing out the current version information show_version :: IO () show_version = do putStr $ "hark version " ++ harkVersion ++ " " putStrLn "(C) 2008-2009 Markus Dittrich\n" putStrLn "Please type 'man hark' for a detailed description" putStrLn "of hark's capabilities.\n" putStrLn "hark is distributed under the terms of the GNU General" putStrLn "Public License v3. There is NO warranty; not even for" putStrLn "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"