module Distribution.Gentoo.Package where

import Data.Char
import Data.List
import Data.Word

type Slot = String

class GentooPackage p where
    printPkg :: p -> String
    parsePkg :: ReadS p

instance GentooPackage Word where
    printPkg = show
    parsePkg = reads

-- | Most 'String'-based names and elements are composed of [A-Za-z0-9+_.-]
isValidChar   :: Char -> Bool
isValidChar c = isAlpha c || c `elem` "+_.-"

data Package = Pkg { cat     :: Maybe Category
                   , name    :: String
                   , version :: Maybe PkgVersion
                   , slot    :: Maybe Slot
                   }
               deriving (Show, Read)

data PkgVersion = PV { cond   :: Condition
                     , ver    :: String
                     , suffix :: Maybe Suffix
                     , rev    :: Maybe Revision
                     }
                  deriving (Show, Read)

newtype Category = Cat String
    deriving(Show, Read)

instance GentooPackage Category where
    printPkg (Cat cat) = cat

    -- Can't start with . or -
    parsePkg ('.':_) = []
    parsePkg ('-':_) = []
    parsePkg str     = case span isValidChar str of
                         (cat, '/':str') -> [(Cat cat, str')]
                         _               -> []


data Condition = Less
               | LessEq
               | Eq
               | EqRev
               | GreaterEq
               | Greater
                 deriving (Show, Read)

instance GentooPackage Condition where
    printPkg Less      = "<"
    printPkg LessEq    = "<="
    printPkg Eq        = "="
    printPkg EqRev     = "~"
    printPkg GreaterEq = ">="
    printPkg Greater   = ">"

    parsePkg ('<':'=':str) = [(LessEq, str)]
    parsePkg ('<':str)     = [(Less, str)]
    parsePkg ('=':str)     = [(Eq, str)]
    parsePkg ('~':str)     = [(EqRev, str)]
    parsePkg ('>':'=':str) = [(GreaterEq, str)]
    parsePkg ('>':str)     = [(Greater, str)]
    parsePkg _             = []

data SuffixType = Alpha
                | Beta
                | PreRelease
                | ReleaseCandidate
                | PatchLevel
                  deriving (Show, Read)

instance GentooPackage SuffixType where
    printPkg Alpha            = "alpha"
    printPkg Beta             = "beta"
    printPkg PreRelease       = "pre"
    printPkg ReleaseCandidate = "rc"
    printPkg PatchLevel       = "p"

    parsePkg ('a':'l':'p':'h':'a':str) = [(Alpha, str)]
    parsePkg ('b':'e':'t':'a':str)     = [(Beta, str)]
    parsePkg ('p':'r':'e':str)         = [(PreRelease, str)]
    parsePkg ('r':'c':str)             = [(ReleaseCandidate, str)]
    parsePkg ('p':str)                 = [(PatchLevel, str)]
    parsePkg _                         = []

data Suffix = Suffix SuffixType
            | SfxVer SuffixType Word
              deriving (Show, Read)

instance GentooPackage Suffix where
    printPkg (Suffix st)   = '_' : printPkg st
    printPkg (SfxVer st v) = '_' : printPkg st ++ printPkg v

    parsePkg ('_':str) = case parsePkg str of
                           [(st, str')] -> case parsePkg str' of
                                             [(v,str'')] -> [(SfxVer st v, str'')]
                                             []          -> [(Suffix st, str')]
                           []           -> []
    parsePkg _         = []

newtype Revision = Rev (Maybe Word)
    deriving (Show, Read)

instance GentooPackage Revision where
    printPkg (Rev ver) = '-' : 'r' : maybe "" printPkg ver

    parsePkg ('-':'r':str) = case (parsePkg str) of
                               [(ver,str')] -> [(Rev (Just ver), str')]
                               []           -> [(Rev Nothing, str)]
    parsePkg _             = []