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