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 $ filter visible pkgInf
      where visible = not . null . filter exposed . snd


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