module Main where
import System.Environment (getArgs, getProgName)
import Data.List (intercalate)
import Control.Monad (when)
import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..))
import Distribution.Verbosity (normal)
import Distribution.Simple.GHC (getInstalledPackages)
import Distribution.Simple.Compiler (PackageDB (..))
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Simple.Program.Db (configureAllKnownPrograms)
import Distribution.Simple.PackageIndex (lookupPackageName)
import Distribution.Package (PackageName(..))
import Distribution.InstalledPackageInfo
import Distribution.Version (Version(..), VersionRange(..), withinRange, anyVersion)
import Distribution.ParseUtils (runP, parseVersionRangeQ)
import Distribution.Text (display)
getargs :: IO (String, VersionRange, Bool)
getargs = do args <- getArgs
case length args of
2 -> pvspec args
3 -> pvspec args
_ -> failwith "Invalid arguments."
where pvspec (pkg:vstr:rm) = case runP 1 "inpspec" parseVersionRangeQ vstr of
ParseFailed _err -> badparse vstr
ParseOk _warns vr -> return (pkg, vr, not $ null rm)
pvspec _ = undefined -- never happen, suppresses warning
badparse x = failwith $ "Invalid version constraint specification: \"" ++ x ++ "\""
failwith err = do putStrLn $ "ERROR: " ++ err
pn <- getProgName
putStrLn $ "Usage: " ++ pn ++ " pkgname versionspec [verbose]"
putStrLn " where versionspec is the same as specified in a cabal file."
putStrLn " Examples: >= 5.3"
putStrLn " >= 5.3 && < 6"
putStrLn " >= 5.3 && < 6 || == 4.3"
putStrLn " == 5.*"
putStrLn " < 5.3 || > 5.3 (means not 5.3)"
exitWith $ ExitFailure 2
getInstalledPkgVersion :: String -> IO [Version]
getInstalledPkgVersion p = do
pconfig <- configureAllKnownPrograms normal defaultProgramConfiguration
pkgIdx <- getInstalledPackages normal [GlobalPackageDB, UserPackageDB] pconfig
pkgInf <- return . lookupPackageName pkgIdx $ PackageName p
return . map fst $ pkgInf
main :: IO ()
main = getargs >>= \(pkg, vrange, is_verbose) ->
let say = when (is_verbose) . putStr
conclude = when (is_verbose) . putStrLn
notinst = conclude $ "Package " ++ pkg ++ " is not installed."
vchk vers vrng = any (flip withinRange vrng) vers
in do ipvs <- getInstalledPkgVersion pkg
when (null ipvs) (notinst >> exitFailure)
-- not strictly necessary to check vrange for
-- anyVersion, but this forces evaluation before any
-- verbose output can be generated.
when (vrange == anyVersion) (conclude "Always match if no constraint given."
>> exitSuccess)
say $ "Does installed " ++ pkg ++ " version ("
say $ (intercalate " or " $ map display ipvs) ++ ")"
say $ " satisfy restriction(s): " ++ (display vrange) ++ " ?? "
res <- return $ vchk ipvs vrange
conclude $ show res
if res then exitSuccess else exitFailure