module Distribution.RpmDeps where

-- -> Version
import Distribution.Version
-- -> intersperse
import Data.List
import Distribution.PackageDescription
import Distribution.Simple.Utils
import Distribution.Verbosity
-- -> PackageIdentifier
import Distribution.PackageDescription.Parse
-- -> readPackageDescription
import Distribution.Simple
-- -> maybeGetPersistBuildConfig
import Distribution.Simple.Configure
-- -> packageDeps
import Distribution.Simple.LocalBuildInfo
-- -> GetDirectoryContents
import Directory
import System.FilePath
import Distribution.Text

dep_prefix = "haskell"

rpmrequires :: Maybe FilePath -> IO [String]
rpmrequires cabalfile = do
    buildinfo <- maybeGetPersistBuildConfig =<< findcabal cabalfile
    return $ case buildinfo of
        Nothing -> []
        Just bi -> map package2rpmdep (packageDeps bi)

rpmprovides :: Maybe FilePath -> IO [String]
rpmprovides cabalfile = do
    mycabal <- readPackageDescription normal =<< findcabal cabalfile
    return $ [package2rpmdep (package $ packageDescription mycabal)]

rpmbuildrequires :: Maybe FilePath -> IO [String]
rpmbuildrequires cabalfile = do
    fcabal <- findcabal cabalfile
    mycabal <- readPackageDescription normal fcabal
    return $ map dependency2rpmdep (buildDepends $ packageDescription mycabal)

findcabal file = defaultPackageDesc normal

package2rpmdep :: PackageIdentifier -> String
package2rpmdep pkg = dep_prefix ++ "(" ++ display (pkgName pkg) ++ ") = " ++ (version2string $ pkgVersion pkg)

dependency2rpmdep :: Dependency -> String
dependency2rpmdep (Dependency name vers) = dep_prefix ++ "(" ++ display name ++ ")" ++ vers2st
    where 
        vers2st = case vers of
            AnyVersion                  -> ""
            ThisVersion v               -> " " ++ (versionrange2sign vers) ++ " " ++ (version2string v)
            LaterVersion v              -> " " ++ (versionrange2sign vers) ++ " " ++ (version2string v)
            EarlierVersion v            -> " " ++ (versionrange2sign vers) ++ " " ++ (version2string v)
            UnionVersionRanges v v'     ->
                " " ++ (versionrange2sign vers) ++ " " ++ (version2string $
                    case v of
                        ThisVersion y@_ -> y
                        LaterVersion y@_ -> y
                        EarlierVersion y@_ -> y
                        _ -> Version [] []
                    )
            IntersectVersionRanges v v' -> " IV "

versionrange2sign :: VersionRange -> String
versionrange2sign vr = case vr of
    AnyVersion                  -> ""
    ThisVersion v               -> "="
    LaterVersion v              -> ">"
    EarlierVersion v            -> "<"
    UnionVersionRanges v v'     -> case v of 
        ThisVersion _ -> versionrange2sign v' ++ versionrange2sign v
        _             -> versionrange2sign v ++ versionrange2sign v'
    IntersectVersionRanges v v' -> "IV"

version2string :: Version -> String
version2string version = concat . intersperse "." $ map show $ versionBranch version