hark-0.2: src/Helpers/Common.hs
{-# 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"