From 05eb9ca446dc1abf1f85c6b97e29defedbd7a221 Mon Sep 17 00:00:00 2001 From: quasicomputational Date: Wed, 19 Dec 2018 13:39:26 +0000 Subject: [PATCH] Add `--check-only`, for staleness checking. With this option, hpack will not generate the `.cabal` file, but will return with a non-zero status if the `.cabal` file is missing, stale, or manually modified. --- CHANGELOG.md | 3 ++ src/Hpack.hs | 92 ++++++++++++++++++++++++++------------- src/Hpack/Options.hs | 19 +++++--- test/Hpack/OptionsSpec.hs | 26 +++++++---- test/HpackSpec.hs | 45 ++++++++++++++----- 5 files changed, 130 insertions(+), 55 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3dcdd476..a94dbaf4 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/src/Hpack.hs b/src/Hpack.hs index f843e2b1..e4880e08 100644 --- a/src/Hpack.hs +++ b/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,8 +139,35 @@ 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 @@ -145,11 +175,11 @@ printResult verbose r = do 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) diff --git a/src/Hpack/Options.hs b/src/Hpack/Options.hs index 9b6e3223..eaec3f51 100644 --- a/src/Hpack/Options.hs +++ b/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) diff --git a/test/Hpack/OptionsSpec.hs b/test/Hpack/OptionsSpec.hs index 08e8eb8b..c235249e 100644 --- a/test/Hpack/OptionsSpec.hs +++ b/test/Hpack/OptionsSpec.hs @@ -18,10 +18,10 @@ 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 @@ -29,19 +29,29 @@ spec = do 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 diff --git a/test/HpackSpec.hs b/test/HpackSpec.hs index a718caa0..290b706f 100644 --- a/test/HpackSpec.hs +++ b/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