diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2011, Kevin Quick +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Kevin Quick nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main :: IO () +main = defaultMain diff --git a/cabalvchk.cabal b/cabalvchk.cabal new file mode 100644 --- /dev/null +++ b/cabalvchk.cabal @@ -0,0 +1,43 @@ +name: cabalvchk +version: 0.2 +synopsis: Verify installed package version against user-specified constraints. + +description: + + This utility can be used to verify the version of an installed + package against version constraints. The version constraints can + be specified in typical cabal fashion (e.g. >= 8.3, == 0.9.*, >= 8.3 && < 9.0). + . + Usage: cabalvchk package-name version-constraints [verbose] + . + Note that the version-constraints will probably need to be enclosed in + single-quotes to prevent the shell from interpreting characters in the + specification. + . + One use of this utility is by external configuration/validation utilities + (e.g. autoconf) to verify installed package versions without running a + cabal build. This utility produces no output (unless a third argument is + specified) and the return value is 0 if the constraints are met or non-zero + if the constraints are not met (including if the package is not installed). + . + Changes in 0.2: + . + * Handles multiple package installations by returning 0 if any of the + installed versions satisfies the constraints. + . + +category: Text +license: BSD3 +license-file: LICENSE +author: Kevin Quick +maintainer: quick@sparq.org +build-type: Simple +cabal-version: >= 1.2 + + +Executable cabalvchk + Main-is: ghcpkgchk.hs + Build-Depends: + base >= 4 && < 5, + Cabal > 1.10 && < 2 + ghc-options: -Wall diff --git a/ghcpkgchk.hs b/ghcpkgchk.hs new file mode 100644 --- /dev/null +++ b/ghcpkgchk.hs @@ -0,0 +1,69 @@ +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