-- ---------------------------------------------------------------
--  AtomParser tries to parse atoms in a portage-like enviroment.
--  Each atom is composed by (maybe) a modifier, a category and
--  (maybe) a version specifier.
--
--  by Fernando J. Pereda <ferdy@gentoo.org>
-- ---------------------------------------------------------------

module AtomParser
  (
    PortageAtom,            -- PortageAtom constructor
    VerSpec,                -- VerSpec constructor
    atomFromString,         -- String -> PortageAtom
    atomListFromStringList, -- [String] -> [PortageAtom]
    atomVerSpecFromString   -- String -> VerSpec
  ) where

import Data.Char (isDigit)

-- {{{ Main types
newtype PortageAtom = PtgAtm (Maybe Modifier,Category,PName,VerSpec)
                      deriving (Show,Eq)
newtype VerSpec     = VrSpc (Maybe Version,Suffix,Maybe Revision)
                      deriving (Show,Eq)
-- }}}

-- {{{ Secondary types, used by PortageAtoms
data Modifier = Less
              | LessEqual
              | Equal
              | GreaterEqual
              | Greater
              | Around
              deriving (Show, Eq)

newtype Suffix   = Sfx (Maybe String) deriving (Show, Eq)
type Category    = String
type PName       = String
type Version     = String
type Revision    = String
--- }}}

-- {{{ Instances of the Ord class
instance Ord VerSpec where
    VrSpc (Nothing,_,_) <= VrSpc (Just _,_,_)    = False
    VrSpc (Just v,s,r)  <= VrSpc (Just v',s',r') = if v == v'
                                                   then if s == s'
                                                        then r <= r'
                                                        else s <= s'
                                                   else v <= v'

instance Ord Suffix where
    Sfx (Just ('a':'l':'p':'h':'a':xs)) <= ys =
                case ys of
                  Sfx (Just ('a':'l':'p':'h':'a':zs)) -> xs <= zs
                  otherwise                           -> True
    Sfx (Just ('b':'e':'t':'a':xs)) <= ys =
                case ys of
                  Sfx (Just ('a':'l':'p':'h':'a':_)) -> False
                  Sfx (Just ('b':'e':'t':'a':zs))    -> xs <= zs
                  otherwise                          -> True
    Sfx (Just ('p':'r':'e':xs)) <= ys =
                case ys of
                  Sfx (Just ('a':'l':'p':'h':'a':_)) -> False
                  Sfx (Just ('b':'e':'t':'a':_))     -> False
                  Sfx (Just ('p':'r':'e':zs))        -> xs <= zs
                  otherwise                          -> True
    Sfx (Just ('r':'c':xs)) <= ys =
                case ys of
                  Sfx (Just ('r':'c':zs)) -> xs <= zs
                  Sfx Nothing             -> True
                  Sfx (Just ('P':_))      -> True
                  otherwise               -> False
    Sfx Nothing <= ys =
                case ys of
                  Sfx Nothing             -> True
                  Sfx (Just ('P':_))      -> True
                  otherwise               -> False
    Sfx (Just ('P':xs)) <= ys =
                case ys of
                  Sfx (Just ('P':zs))     -> xs <= zs
                  otherwise               -> False
-- }}}

-- {{{ Auxiliary modifier functions
-- |atomModifiers returns every possible modifier in a PortageAtom
atomModifiers :: [String]
atomModifiers = ["<","<=","=",">=",">","~"]

-- |Possible characters to be part of an atomModifier
atomModifierChars :: [Char]
atomModifierChars = ['<','=','>','~']
--- }}}

-- {{{ Main Constructors
-- |Constructs a new PortageAtom from a String by calling
--  smaller functions
atomFromString :: String -> PortageAtom
atomFromString xs = PtgAtm (modi,cat,pnam,verspec)
                    where
                        modi    = atomModifierFromString xs
                        cat     = atomCategoryFromString xs
                        pnam    = atomPNameFromString xs
                        verspec = case modi of
                                    Nothing   -> VrSpc (Nothing,Sfx Nothing,Nothing)
                                    otherwise -> atomVerSpecFromString . atomVersionSuffixFromString $ xs

-- |Constructs a new VerSpec from a String
atomVerSpecFromString :: String -> VerSpec
atomVerSpecFromString xs = VrSpc (ver,suf,rev)
                           where
                               ver    = atomVersionFromVersionSuffix xs
                               suf    = case ver of
                                          Nothing   -> Sfx Nothing
                                          otherwise -> atomSuffixFromVersionSuffix xs
                               rev    = case ver of
                                          Nothing   -> Nothing
                                          otherwise -> atomRevisionFromString xs

-- |Convenietly maps atomFromString
atomListFromStringList :: [String] -> [PortageAtom]
atomListFromStringList = map atomFromString
-- }}}

-- {{{ Secondary Constructors
-- |Extracts the modifier from the top of a String
atomModifierFromString :: String -> Maybe Modifier
atomModifierFromString ('<':'=':_) = Just LessEqual
atomModifierFromString ('>':'=':_) = Just GreaterEqual
atomModifierFromString ('<':_)     = Just Less
atomModifierFromString ('=':_)     = Just Equal
atomModifierFromString ('>':_)     = Just Greater
atomModifierFromString ('~':_)     = Just Around
atomModifierFromString _           = Nothing

-- |Extracts the category from a String
atomCategoryFromString :: String -> Category
atomCategoryFromString = dropWhile (`elem` atomModifierChars) . takeWhile (/='/')

-- |Extracts the package name from a String
atomPNameFromString :: String -> PName
atomPNameFromString = atomPNameFromPNameVersion . atomPFFromString

-- |Extracts PR from a String
atomRevisionFromString :: String -> Maybe Revision
atomRevisionFromString xs = if (not $ null a) && (and . map isDigit $ a)
                            then Just a
                            else Just "0"
                            where a = reverse . takeWhile isDigit . reverse $ xs
-- }}}

-- {{{ Auxiliary functions and constructors
-- |Generate a PF construct from a String
atomPFFromString :: String -> String
atomPFFromString = tail . dropWhile (/='/')

-- |Extracts the package name from a PN-PV construct
atomPNameFromPNameVersion :: String -> PName
atomPNameFromPNameVersion []       = []
atomPNameFromPNameVersion (x:[])   = [x]
atomPNameFromPNameVersion (x:y:xs) = if x == '-' && isDigit y
                                     then []
                                     else [x] ++ atomPNameFromPNameVersion (y:xs)

-- |Extracts a PV-Suffix construct from a PF one
atomVersionSuffixFromPF :: String -> String
atomVersionSuffixFromPF (x:y:xs) = if x == '-' && isDigit y
                                   then (y:xs)
                                   else atomVersionSuffixFromPF (y:xs)

-- |Extracts a PV-Suffix from a String
atomVersionSuffixFromString :: String -> String
atomVersionSuffixFromString = atomVersionSuffixFromPF . atomPFFromString

-- |Extracts the version from a String
atomVersionFromString :: String -> Maybe Version
atomVersionFromString = atomVersionFromVersionSuffix . atomVersionSuffixFromString

-- |Extracts the version from a PF construct
atomVersionFromVersionSuffix :: String -> Maybe Version
atomVersionFromVersionSuffix [] = Nothing
atomVersionFromVersionSuffix xs = Just $ takeWhile (\c -> c/='_' && c/='-') $ xs

-- !Extracts the suffix from a PF construct
atomSuffixFromVersionSuffix :: String -> Suffix
atomSuffixFromVersionSuffix xs = Sfx a
                                 where a = if elem '_' xs
                                           then Just $ tail . takeWhile (/='-') . dropWhile (/='_') $ xs
                                           else Nothing
-- }}}