{----------------------------------------------------------------- (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 parses the depend string of a package and -- returns a list of Dependency data structures module Parsers.Depend ( depend_parser , defaultDepend , get_depend , get_pdepend , get_rdepend , PackageDep(..) , Dependency(..) ) where -- basic imports import qualified Data.ByteString as B(ByteString, append, drop, empty, head, index, init, intercalate, reverse, split, tail, take) import Prelude import System.FilePath.Posix(()) -- local imports import Helpers.ByteString(closeBracket, equalSign, exclMark, openBracket, orSymbol, questMark, spaceChar, spaceCharW, tilde) import Helpers.Common(split_version_BS, VersionToken(..)) import Helpers.FileIO(try_read_file) -- import Debug.Trace -- | data structure for holding a dependency of a package; -- it includes the name, version, qualifier as well as -- the use flag that requested it if applicable data Dependency = Dependency { useFlags :: [B.ByteString] , qualifier :: B.ByteString , fullName :: B.ByteString , package :: B.ByteString , version :: B.ByteString , slot :: B.ByteString , useDeps :: B.ByteString } -- | implement Eq typeclass for Dependency so we can -- compare; for now we define two Dependencies -- identical if they both have the identical full -- name and are pulled in by the same use flag instance Eq Dependency where a == b = (fullName a == fullName b) && (useFlags a == useFlags b) -- | implement Show typeclass for dependency -- We simply want to display the content in an easy -- to parse form for now instance Show Dependency where show d = show $ B.intercalate spaceChar line where part1 = [fullName d, package d, version d, qualifier d] line = part1 ++ (useFlags d) -- | default Dependency data structure defaultDepend :: Dependency defaultDepend = Dependency { useFlags = [] , qualifier = B.empty , fullName = B.empty , package = B.empty , version = B.empty , slot = B.empty , useDeps = B.empty } -- | type holding all dependencies for a particular package newtype PackageDep = PackageDep (String,[Dependency]) deriving(Show) -- | data type used to implement a stack for storing -- useflags or || atoms data StackItem = Use B.ByteString | Or | Bracket deriving(Eq,Show) -- | raw functions for attempting to open DEPEND, RDEPEND, -- and RDEPEND files -- | DEPEND get_depend :: FilePath -> IO (Maybe B.ByteString) get_depend path = try_read_file ( path "DEPEND") -- | RDPEND get_rdepend :: FilePath -> IO (Maybe B.ByteString) get_rdepend path = try_read_file ( path "RDEPEND") -- | PDEPEND get_pdepend :: FilePath -> IO (Maybe B.ByteString) get_pdepend path = try_read_file ( path "PDEPEND") -- | top level function for parsing a package dependency string depend_parser :: B.ByteString -> [Dependency] depend_parser = parse_recursive . B.split spaceCharW -- | recursive parser for depend elements; can go infinitely -- deep and relies on the fact that each nested level is -- enclosed in parentheses parse_recursive :: [B.ByteString] -> [Dependency] parse_recursive atoms = parse atoms [] [] where parse :: [B.ByteString] -> [StackItem] -> [Dependency] -> [Dependency] parse [] _ deps = deps parse (item:items) uFlags deps -- strip the trailing question mark | is_useflag item = parse items (Use (B.init item):uFlags) deps | is_or item = parse items (Or:uFlags) deps -- ignore | is_opening_bracket item = parse items (Bracket:uFlags) deps | is_closing_bracket item = parse items (pop_bracket uFlags) deps | otherwise = parse items uFlags ( create_depend (extract_uses uFlags) item : deps ) where -- every time we encounter a closing bracket we either pop -- a single opening bracket or a single opening bracket plus a -- preceeding Use/Or token if present pop_bracket [] = error "Parse failure in a (R/P)DEPEND statement" pop_bracket ((Bracket):(Or):xs) = xs pop_bracket ((Bracket):(Use _):xs) = xs pop_bracket (_:xs) = xs -- we use foldl since we need to reverse the -- stack anyways extract_uses :: [StackItem] -> [B.ByteString] extract_uses = foldl (\acc x -> case x of Use a -> a:acc _ -> acc ) [] -- -- helper functions to match depend atoms -- is_opening_bracket :: B.ByteString -> Bool is_opening_bracket = (==) openBracket is_closing_bracket :: B.ByteString -> Bool is_closing_bracket = (==) closeBracket is_or :: B.ByteString -> Bool is_or = (==) orSymbol is_useflag :: B.ByteString -> Bool is_useflag x = ( B.head $ B.reverse x) == B.head questMark -- | creates a new dependency data structure create_depend :: [B.ByteString] -> B.ByteString -> Dependency create_depend flags versionString = defaultDepend { useFlags = flags , qualifier = aQualifier , fullName = versionString , package = dName versionTok , version = dVersion versionTok , slot = dSlot versionTok , useDeps = dUseDeps versionTok } where (aQualifier, versionTok) = separate_depend versionString -- | separates a field in a dependency string into its -- qualifier if present (=, >=, <=), name, and version -- info if present separate_depend :: B.ByteString -> (B.ByteString, VersionToken) separate_depend x -- matches blocks starting with a ! -- we need to be careful to catch things like -- !<= and !< as well | B.head x == B.head exclMark = let (tempQual, tmpToken) = separate_depend (B.tail x) in (B.append exclMark tempQual, tmpToken) -- matches tilded deps | B.head x == B.head tilde = (tilde, split_version_BS (B.tail x)) -- matches => and = | B.head x == B.head equalSign = (equalSign, split_version_BS (B.tail x)) -- matches <= | B.index x 1 == B.head equalSign = (B.take 2 x, split_version_BS nameElem) -- matches plain deps without qualifier | otherwise = (B.empty, split_version_BS x) where nameElem = B.drop 2 x