Add --check-only, for staleness checking.

CHANGELOG.md

@@ -1,5 +1,8 @@
 ## Next
   - Add default value for maintainer (see #339)
+  - New `--check-only` option, which doesn't write any files but makes
+    sure that the `.cabal` file is up to date. If it is not, the
+    command exits with a non-zero status.
 
 ## Changes in 0.31.1
   - Show the header when printing to stdout (see #331)

src/Hpack.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 module Hpack (
 -- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
@@ -22,6 +23,7 @@ module Hpack (
 , printResult
 , Result(..)
 , Status(..)
+, HpackCommandStatus(..)
 
 -- * Options
 , defaultOptions
@@ -32,6 +34,7 @@ module Hpack (
 , Verbose(..)
 , Options(..)
 , Force(..)
+, Mode(..)
 
 #ifdef TEST
 , hpackResultWithVersion
@@ -71,7 +74,7 @@ header p v hash = unlines [
 
 data Options = Options {
   optionsDecodeOptions :: DecodeOptions
-, optionsForce :: Force
+, optionsMode :: Mode
 , optionsToStdout :: Bool
 }
 
@@ -89,8 +92,8 @@ getOptions defaultPackageConfig args = do
       printHelp
       return Nothing
     Run options -> case options of
-      ParseOptions verbose force toStdout file -> do
-        return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force toStdout)
+      ParseOptions verbose mode toStdout file -> do
+        return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} mode toStdout)
     ParseError -> do
       printHelp
       exitFailure
@@ -99,17 +102,17 @@ printHelp :: IO ()
 printHelp = do
   name <- getProgName
   Utf8.hPutStrLn stderr $ unlines [
-      "Usage: " ++ name ++ " [ --silent ] [ --force | -f ] [ PATH ] [ - ]"
+      "Usage: " ++ name ++ " [ --silent ] [ --force | -f | --check-only ] [ PATH ] [ - ]"
     , "       " ++ name ++ " --version"
     , "       " ++ name ++ " --numeric-version"
     , "       " ++ name ++ " --help"
     ]
 
 hpack :: Verbose -> Options -> IO ()
-hpack verbose options = hpackResult options >>= printResult verbose
+hpack verbose options = hpackResult options >>= printResult verbose (optionsMode options) >>= exitWithHpackStatus
 
 defaultOptions :: Options
-defaultOptions = Options defaultDecodeOptions NoForce False
+defaultOptions = Options defaultDecodeOptions (Generate NoForce) False
 
 setTarget :: FilePath -> Options -> Options
 setTarget target options@Options{..} =
@@ -136,20 +139,47 @@ data Status =
   | OutputUnchanged
   deriving (Eq, Show)
 
-printResult :: Verbose -> Result -> IO ()
-printResult verbose r = do
+data HpackCommandStatus = HpackSuccess | HpackFailure
+  deriving (Eq, Show)
+
+exitWithHpackStatus :: HpackCommandStatus -> IO ()
+exitWithHpackStatus HpackSuccess = return ()
+exitWithHpackStatus HpackFailure = exitFailure
+
+printResult :: Verbose -> Mode -> Result -> IO HpackCommandStatus
+printResult verbose = \case
+  CheckOnly -> printCheckResult verbose
+  Generate _force -> printGenerateResult verbose
+
+printCheckResult :: Verbose -> Result -> IO HpackCommandStatus
+printCheckResult verbose r = do
+  printWarnings (resultWarnings r)
+  when (verbose == Verbose) $ putStrLn $
+    case resultStatus r of
+      Generated -> resultCabalFile r ++ " requires regeneration"
+      OutputUnchanged -> resultCabalFile r ++ " is up-to-date"
+      AlreadyGeneratedByNewerHpack -> resultCabalFile r ++ " was generated with a newer version of hpack, please upgrade and try again."
+      ExistingCabalFileWasModifiedManually -> resultCabalFile r ++ " was modified manually, please use --force to overwrite."
+  return $ case resultStatus r of
+      Generated -> HpackFailure
+      OutputUnchanged -> HpackSuccess
+      AlreadyGeneratedByNewerHpack -> HpackFailure
+      ExistingCabalFileWasModifiedManually -> HpackFailure
+
+printGenerateResult :: Verbose -> Result -> IO HpackCommandStatus
+printGenerateResult verbose r = do
   printWarnings (resultWarnings r)
   when (verbose == Verbose) $ putStrLn $
     case resultStatus r of
       Generated -> "generated " ++ resultCabalFile r
       OutputUnchanged -> resultCabalFile r ++ " is up-to-date"
       AlreadyGeneratedByNewerHpack -> resultCabalFile r ++ " was generated with a newer version of hpack, please upgrade and try again."
       ExistingCabalFileWasModifiedManually -> resultCabalFile r ++ " was modified manually, please use --force to overwrite."
-  case resultStatus r of
-      Generated -> return ()
-      OutputUnchanged -> return ()
-      AlreadyGeneratedByNewerHpack -> exitFailure
-      ExistingCabalFileWasModifiedManually -> exitFailure
+  return $ case resultStatus r of
+      Generated -> HpackSuccess
+      OutputUnchanged -> HpackSuccess
+      AlreadyGeneratedByNewerHpack -> HpackFailure
+      ExistingCabalFileWasModifiedManually -> HpackFailure
 
 printWarnings :: [String] -> IO ()
 printWarnings = mapM_ $ Utf8.hPutStrLn stderr . ("WARNING: " ++)
@@ -169,26 +199,26 @@ hpackResult :: Options -> IO Result
 hpackResult = hpackResultWithVersion version
 
 hpackResultWithVersion :: Version -> Options -> IO Result
-hpackResultWithVersion v (Options options force toStdout) = do
+hpackResultWithVersion v (Options options mode toStdout) = do
   DecodeResult pkg cabalVersion cabalFile warnings <- readPackageConfig options >>= either die return
   oldCabalFile <- readCabalFile cabalFile
   let
     body = renderPackage (maybe [] cabalFileContents oldCabalFile) pkg
     withoutHeader = cabalVersion ++ body
-  let
-    status = case force of
-      Force -> Generated
-      NoForce -> maybe Generated (mkStatus (lines withoutHeader) v) oldCabalFile
-  case status of
-    Generated -> do
-      let hash = sha256 withoutHeader
-          out  = cabalVersion ++ header (decodeOptionsTarget options) v hash ++ body
-      if toStdout
-        then Utf8.putStr out
-        else Utf8.writeFile cabalFile out
-    _ -> return ()
-  return Result {
-      resultWarnings = warnings
-    , resultCabalFile = cabalFile
-    , resultStatus = status
-    }
+    status = maybe Generated (mkStatus (lines withoutHeader) v) oldCabalFile
+  case mode of
+    CheckOnly -> return (Result warnings cabalFile status)
+    Generate force -> do
+      let
+        forcedStatus = case force of
+          Force -> Generated
+          NoForce -> status
+      case forcedStatus of
+        Generated -> do
+          let hash = sha256 withoutHeader
+              out  = cabalVersion ++ header (decodeOptionsTarget options) v hash ++ body
+          if toStdout
+            then Utf8.putStr out
+            else Utf8.writeFile cabalFile out
+        _ -> return ()
+      return (Result warnings cabalFile forcedStatus)

src/Hpack/Options.hs

@@ -10,12 +10,15 @@ data ParseResult = Help | PrintVersion | PrintNumericVersion | Run ParseOptions
 data Verbose = Verbose | NoVerbose
   deriving (Eq, Show)
 
+data Mode = CheckOnly | Generate Force
+  deriving (Eq, Show)
+
 data Force = Force | NoForce
   deriving (Eq, Show)
 
 data ParseOptions = ParseOptions {
   parseOptionsVerbose :: Verbose
-, parseOptionsForce :: Force
+, parseOptionsForce :: Mode
 , parseOptionsToStdout :: Bool
 , parseOptionsTarget :: FilePath
 } deriving (Eq, Show)
@@ -30,18 +33,24 @@ parseOptions defaultTarget = \ case
       file <- expandTarget defaultTarget target
       let
         options
-          | toStdout = ParseOptions NoVerbose Force toStdout file
-          | otherwise = ParseOptions verbose force toStdout file
+          | toStdout = ParseOptions NoVerbose (Generate Force) toStdout file
+          | otherwise = ParseOptions verbose mode toStdout file
       return (Run options)
     Left err -> return err
     where
       silentFlag = "--silent"
       forceFlags = ["--force", "-f"]
+      checkFlag =  "--check-only"
 
-      flags = silentFlag : forceFlags
+      flags = checkFlag : silentFlag : forceFlags
 
       verbose = if silentFlag `elem` args then NoVerbose else Verbose
-      force = if any (`elem` args) forceFlags then Force else NoForce
+      force = any (`elem` args) forceFlags
+      check = checkFlag `elem` args
+      mode
+        | check = CheckOnly
+        | force = Generate Force
+        | otherwise = Generate NoForce
       ys = filter (`notElem` flags) args
 
       targets :: Either ParseResult (Maybe FilePath, Bool)

test/Hpack/OptionsSpec.hs

@@ -18,30 +18,40 @@ spec = do
 
     context "by default" $ do
       it "returns Run" $ do
-        parseOptions defaultTarget [] `shouldReturn` Run (ParseOptions Verbose NoForce False defaultTarget)
+        parseOptions defaultTarget [] `shouldReturn` Run (ParseOptions Verbose (Generate NoForce) False defaultTarget)
 
       it "includes target" $ do
-        parseOptions defaultTarget ["foo.yaml"] `shouldReturn` Run (ParseOptions Verbose NoForce False "foo.yaml")
+        parseOptions defaultTarget ["foo.yaml"] `shouldReturn` Run (ParseOptions Verbose (Generate NoForce) False "foo.yaml")
 
       context "with superfluous arguments" $ do
         it "returns ParseError" $ do
           parseOptions defaultTarget ["foo", "bar"] `shouldReturn` ParseError
 
       context "with --silent" $ do
         it "sets optionsVerbose to NoVerbose" $ do
-          parseOptions defaultTarget ["--silent"] `shouldReturn` Run (ParseOptions NoVerbose NoForce False defaultTarget)
+          parseOptions defaultTarget ["--silent"] `shouldReturn` Run (ParseOptions NoVerbose (Generate NoForce) False defaultTarget)
 
       context "with --force" $ do
-        it "sets optionsForce to Force" $ do
-          parseOptions defaultTarget ["--force"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget)
+        it "sets optionsMode to GenerateForce" $ do
+          parseOptions defaultTarget ["--force"] `shouldReturn` Run (ParseOptions Verbose (Generate Force) False defaultTarget)
 
       context "with -f" $ do
-        it "sets optionsForce to Force" $ do
-          parseOptions defaultTarget ["-f"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget)
+        it "sets optionsMode to GenerateForce" $ do
+          parseOptions defaultTarget ["-f"] `shouldReturn` Run (ParseOptions Verbose (Generate Force) False defaultTarget)
+
+      context "with --check-only" $ do
+        it "sets optionsMode to CheckOnly" $ do
+          parseOptions defaultTarget ["--check-only"] `shouldReturn` Run (ParseOptions Verbose CheckOnly False defaultTarget)
+
+        it "overrides --force if it comes after" $ do
+          parseOptions defaultTarget ["--force", "--check-only"] `shouldReturn` Run (ParseOptions Verbose CheckOnly False defaultTarget)
+
+        it "overrides --force if it comes before" $ do
+          parseOptions defaultTarget ["--check-only", "--force"] `shouldReturn` Run (ParseOptions Verbose CheckOnly False defaultTarget)
 
       context "with -" $ do
         it "sets optionsToStdout to True, implies Force and NoVerbose" $ do
-          parseOptions defaultTarget ["-"] `shouldReturn` Run (ParseOptions NoVerbose Force True defaultTarget)
+          parseOptions defaultTarget ["-"] `shouldReturn` Run (ParseOptions NoVerbose (Generate Force) True defaultTarget)
 
         it "rejects - for target" $ do
           parseOptions defaultTarget ["-", "-"] `shouldReturn` ParseError

test/HpackSpec.hs

@@ -7,6 +7,8 @@ import qualified Prelude as Prelude
 
 import           Control.DeepSeq
 
+import           System.Directory
+
 import           Hpack.Config
 import           Hpack.CabalFile
 import           Hpack hiding (hpack)
@@ -16,20 +18,21 @@ readFile name = Prelude.readFile name >>= (return $!!)
 
 spec :: Spec
 spec = do
-  describe "hpackResult" $ do
-    context "with existing cabal file" $ around_ inTempDirectory $ before_ (writeFile packageConfig "name: foo") $ do
-      let
-        file = "foo.cabal"
+  let
+    file = "foo.cabal"
 
-        hpackWithVersion v = hpackResultWithVersion v defaultOptions
-        hpack = hpackResult defaultOptions
-        hpackForce = hpackResult defaultOptions {optionsForce = Force}
+    generated = Result [] file Generated
+    modifiedManually = Result [] file ExistingCabalFileWasModifiedManually
+    outputUnchanged = Result [] file OutputUnchanged
+    alreadyGeneratedByNewerHpack = Result [] file AlreadyGeneratedByNewerHpack
 
-        generated = Result [] file Generated
-        modifiedManually = Result [] file ExistingCabalFileWasModifiedManually
-        outputUnchanged = Result [] file OutputUnchanged
-        alreadyGeneratedByNewerHpack = Result [] file AlreadyGeneratedByNewerHpack
+    hpackWithVersion v = hpackResultWithVersion v defaultOptions
+    hpack = hpackResult defaultOptions
+    hpackForce = hpackResult defaultOptions {optionsMode = Generate Force}
+    hpackCheckOnly = hpackResult defaultOptions {optionsMode = CheckOnly}
 
+  describe "hpackResult" $ around_ inTempDirectory $ before_ (writeFile packageConfig "name: foo") $ do
+    context "with existing cabal file" $ do
       context "when cabal file was created manually" $ do
         it "does not overwrite existing cabal file" $ do
           let existing = "some existing cabal file"
@@ -100,3 +103,23 @@ spec = do
               old <- readFile file
               hpack `shouldReturn` outputUnchanged
               readFile file `shouldReturn` old
+
+    context "with non-existent .cabal file" $ do
+      context "--check-only" $ do
+        it "does not write a .cabal file" $ do
+          hpackCheckOnly `shouldReturn` generated
+          doesFileExist file `shouldReturn` False
+
+  describe "printResult" $ do
+    context "in CheckOnly mode" $ do
+      it "fails if the .cabal file requires generation" $ do
+        printResult NoVerbose CheckOnly generated `shouldReturn` HpackFailure
+
+      it "succeeds if the .cabal file is unchanged" $ do
+        printResult NoVerbose CheckOnly outputUnchanged `shouldReturn` HpackSuccess
+
+      it "fails if the .cabal file was manually modified" $ do
+        printResult NoVerbose CheckOnly modifiedManually `shouldReturn` HpackFailure
+
+      it "fails if the .cabal file was generated by a newer version" $ do
+        printResult NoVerbose CheckOnly alreadyGeneratedByNewerHpack `shouldReturn` HpackFailure