From 8aebc12a446971fcc11445358670b8b36da404c2 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sat, 2 May 2020 18:54:15 +0700 Subject: [PATCH] Add command-line options `--hash` and `--no-hash` --- src/Hpack.hs | 128 ++++++++++++++------- src/Hpack/CabalFile.hs | 9 +- src/Hpack/Options.hs | 22 +++- test/Hpack/CabalFileSpec.hs | 14 ++- test/Hpack/OptionsSpec.hs | 24 +++- test/HpackSpec.hs | 220 +++++++++++++++++++++--------------- 6 files changed, 271 insertions(+), 146 deletions(-) diff --git a/src/Hpack.hs b/src/Hpack.hs index fd20c180..ed719b34 100644 --- a/src/Hpack.hs +++ b/src/Hpack.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} module Hpack ( -- | /__NOTE:__/ This module is exposed to allow integration of Hpack into @@ -32,10 +33,12 @@ module Hpack ( , Verbose(..) , Options(..) , Force(..) +, GenerateHashStrategy(..) #ifdef TEST , hpackResultWithVersion , header +, renderCabalFile #endif ) where @@ -47,6 +50,7 @@ import System.Environment import System.Exit import System.IO (stderr) import Data.Aeson (Value) +import Data.Maybe import Paths_hpack (version) import Hpack.Options @@ -56,31 +60,35 @@ import Hpack.Util import Hpack.Utf8 as Utf8 import Hpack.CabalFile -programVersion :: Version -> String -programVersion v = "hpack version " ++ Version.showVersion v +programVersion :: Maybe Version -> String +programVersion Nothing = "hpack" +programVersion (Just v) = "hpack version " ++ Version.showVersion v -header :: FilePath -> Version -> Hash -> String -header p v hash = unlines [ +header :: FilePath -> Maybe Version -> (Maybe Hash) -> [String] +header p v hash = [ "-- This file has been generated from " ++ takeFileName p ++ " by " ++ programVersion v ++ "." , "--" , "-- see: https://github.com/sol/hpack" - , "--" - , "-- hash: " ++ hash - , "" - ] + ] ++ case hash of + Just h -> ["--" , "-- hash: " ++ h, ""] + Nothing -> [""] data Options = Options { optionsDecodeOptions :: DecodeOptions , optionsForce :: Force +, optionsGenerateHashStrategy :: GenerateHashStrategy , optionsToStdout :: Bool } +data GenerateHashStrategy = ForceHash | ForceNoHash | PreferHash | PreferNoHash + deriving (Eq, Show) + getOptions :: FilePath -> [String] -> IO (Maybe (Verbose, Options)) getOptions defaultPackageConfig args = do result <- parseOptions defaultPackageConfig args case result of PrintVersion -> do - putStrLn (programVersion version) + putStrLn (programVersion $ Just version) return Nothing PrintNumericVersion -> do putStrLn (Version.showVersion version) @@ -88,9 +96,12 @@ getOptions defaultPackageConfig args = do Help -> do printHelp return Nothing - Run options -> case options of - ParseOptions verbose force toStdout file -> do - return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force toStdout) + Run (ParseOptions verbose force hash toStdout file) -> do + let generateHash = case hash of + Just True -> ForceHash + Just False -> ForceNoHash + Nothing -> PreferNoHash + return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force generateHash toStdout) ParseError -> do printHelp exitFailure @@ -99,7 +110,7 @@ printHelp :: IO () printHelp = do name <- getProgName Utf8.hPutStrLn stderr $ unlines [ - "Usage: " ++ name ++ " [ --silent ] [ --force | -f ] [ PATH ] [ - ]" + "Usage: " ++ name ++ " [ --silent ] [ --force | -f ] [ --[no-]hash ] [ PATH ] [ - ]" , " " ++ name ++ " --version" , " " ++ name ++ " --numeric-version" , " " ++ name ++ " --help" @@ -109,7 +120,7 @@ hpack :: Verbose -> Options -> IO () hpack verbose options = hpackResult options >>= printResult verbose defaultOptions :: Options -defaultOptions = Options defaultDecodeOptions NoForce False +defaultOptions = Options defaultDecodeOptions NoForce PreferNoHash False setTarget :: FilePath -> Options -> Options setTarget target options@Options{..} = @@ -154,41 +165,76 @@ printResult verbose r = do printWarnings :: [String] -> IO () printWarnings = mapM_ $ Utf8.hPutStrLn stderr . ("WARNING: " ++) -mkStatus :: [String] -> Version -> CabalFile -> Status -mkStatus new v (CabalFile mOldVersion mHash old) = case (mOldVersion, mHash) of - (_, _) | old == new -> OutputUnchanged - (Nothing, _) -> ExistingCabalFileWasModifiedManually - (Just oldVersion, _) | oldVersion < makeVersion [0, 20, 0] -> Generated - (_, Nothing) -> ExistingCabalFileWasModifiedManually - (Just oldVersion, Just hash) - | v < oldVersion -> AlreadyGeneratedByNewerHpack - | sha256 (unlines old) /= hash -> ExistingCabalFileWasModifiedManually - | otherwise -> Generated +mkStatus :: CabalFile -> CabalFile -> Status +mkStatus new@(CabalFile _ mNewVersion mNewHash _) existing@(CabalFile _ mExistingVersion _ _) + | new `hasSameContent` existing = OutputUnchanged + | otherwise = case mExistingVersion of + Nothing -> ExistingCabalFileWasModifiedManually + Just _ + | mNewVersion < mExistingVersion -> AlreadyGeneratedByNewerHpack + | isJust mNewHash && hashMismatch existing -> ExistingCabalFileWasModifiedManually + | otherwise -> Generated + +hasSameContent :: CabalFile -> CabalFile -> Bool +hasSameContent (CabalFile cabalVersionA _ _ a) (CabalFile cabalVersionB _ _ b) = cabalVersionA == cabalVersionB && a == b + +hashMismatch :: CabalFile -> Bool +hashMismatch cabalFile = case cabalFileHash cabalFile of + Nothing -> False + Just hash -> hash /= calculateHash cabalFile + +calculateHash :: CabalFile -> Hash +calculateHash (CabalFile cabalVersion _ _ body) = sha256 (unlines $ cabalVersion ++ body) hpackResult :: Options -> IO Result hpackResult = hpackResultWithVersion version hpackResultWithVersion :: Version -> Options -> IO Result -hpackResultWithVersion v (Options options force 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 +hpackResultWithVersion v (Options options force generateHashStrategy toStdout) = do + DecodeResult pkg (lines -> cabalVersion) cabalFileName warnings <- readPackageConfig options >>= either die return + mExistingCabalFile <- readCabalFile cabalFileName let + newCabalFile = makeCabalFile generateHashStrategy mExistingCabalFile cabalVersion v pkg + status = case force of Force -> Generated - NoForce -> maybe Generated (mkStatus (lines withoutHeader) v) oldCabalFile + NoForce -> maybe Generated (mkStatus newCabalFile) mExistingCabalFile + 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 + Generated -> writeCabalFile options toStdout cabalFileName newCabalFile _ -> return () + return Result { - resultWarnings = warnings - , resultCabalFile = cabalFile - , resultStatus = status - } + resultWarnings = warnings + , resultCabalFile = cabalFileName + , resultStatus = status + } + +writeCabalFile :: DecodeOptions -> Bool -> FilePath -> CabalFile -> IO () +writeCabalFile options toStdout name cabalFile = do + write . unlines $ renderCabalFile (decodeOptionsTarget options) cabalFile + where + write = if toStdout then Utf8.putStr else Utf8.writeFile name + +makeCabalFile :: GenerateHashStrategy -> Maybe CabalFile -> [String] -> Version -> Package -> CabalFile +makeCabalFile strategy mExistingCabalFile cabalVersion v pkg = cabalFile + where + cabalFile = CabalFile cabalVersion (Just v) hash body + + hash + | shouldGenerateHash mExistingCabalFile strategy = Just $ calculateHash cabalFile + | otherwise = Nothing + + body = lines $ renderPackage (maybe [] cabalFileContents mExistingCabalFile) pkg + +shouldGenerateHash :: Maybe CabalFile -> GenerateHashStrategy -> Bool +shouldGenerateHash mExistingCabalFile strategy = case (strategy, mExistingCabalFile) of + (ForceHash, _) -> True + (ForceNoHash, _) -> False + (PreferHash, Nothing) -> True + (PreferNoHash, Nothing) -> False + (_, Just CabalFile {cabalFileHash = Nothing}) -> False + (_, Just CabalFile {cabalFileHash = Just _}) -> True + +renderCabalFile :: FilePath -> CabalFile -> [String] +renderCabalFile file (CabalFile cabalVersion hpackVersion hash body) = cabalVersion ++ header file hpackVersion hash ++ body diff --git a/src/Hpack/CabalFile.hs b/src/Hpack/CabalFile.hs index 8d3a96db..feddf99f 100644 --- a/src/Hpack/CabalFile.hs +++ b/src/Hpack/CabalFile.hs @@ -16,7 +16,8 @@ makeVersion :: [Int] -> Version makeVersion v = Version v [] data CabalFile = CabalFile { - cabalFileHpackVersion :: Maybe Version + cabalFileCabalVersion :: [String] +, cabalFileHpackVersion :: Maybe Version , cabalFileHash :: Maybe Hash , cabalFileContents :: [String] } deriving (Eq, Show) @@ -25,13 +26,13 @@ readCabalFile :: FilePath -> IO (Maybe CabalFile) readCabalFile cabalFile = fmap parse <$> tryReadFile cabalFile where parse :: String -> CabalFile - parse (splitHeader -> (h, c)) = CabalFile (extractVersion h) (extractHash h) c + parse (splitHeader -> (cabalVersion, h, c)) = CabalFile cabalVersion (extractVersion h) (extractHash h) c - splitHeader :: String -> ([String], [String]) + splitHeader :: String -> ([String], [String], [String]) splitHeader (removeGitConflictMarkers . lines -> c) = case span (not . isComment) c of (cabalVersion, xs) -> case span isComment xs of - (header, body) -> (header, cabalVersion ++ dropWhile null body) + (header, body) -> (cabalVersion, header, dropWhile null body) isComment = ("--" `isPrefixOf`) diff --git a/src/Hpack/Options.hs b/src/Hpack/Options.hs index 9b6e3223..c6d8ebcb 100644 --- a/src/Hpack/Options.hs +++ b/src/Hpack/Options.hs @@ -1,6 +1,9 @@ {-# LANGUAGE LambdaCase #-} module Hpack.Options where +import Control.Applicative +import Control.Monad +import Data.Maybe import System.FilePath import System.Directory @@ -16,6 +19,7 @@ data Force = Force | NoForce data ParseOptions = ParseOptions { parseOptionsVerbose :: Verbose , parseOptionsForce :: Force +, parseOptionsHash :: Maybe Bool , parseOptionsToStdout :: Bool , parseOptionsTarget :: FilePath } deriving (Eq, Show) @@ -30,18 +34,30 @@ parseOptions defaultTarget = \ case file <- expandTarget defaultTarget target let options - | toStdout = ParseOptions NoVerbose Force toStdout file - | otherwise = ParseOptions verbose force toStdout file + | toStdout = ParseOptions NoVerbose Force hash toStdout file + | otherwise = ParseOptions verbose force hash toStdout file return (Run options) Left err -> return err where silentFlag = "--silent" forceFlags = ["--force", "-f"] + hashFlag = "--hash" + noHashFlag = "--no-hash" - flags = silentFlag : forceFlags + flags = hashFlag : noHashFlag : silentFlag : forceFlags + verbose :: Verbose verbose = if silentFlag `elem` args then NoVerbose else Verbose + + force :: Force force = if any (`elem` args) forceFlags then Force else NoForce + + hash :: Maybe Bool + hash = listToMaybe . reverse $ mapMaybe parse args + where + parse :: String -> Maybe Bool + parse t = True <$ guard (t == hashFlag) <|> False <$ guard (t == noHashFlag) + ys = filter (`notElem` flags) args targets :: Either ParseResult (Maybe FilePath, Bool) diff --git a/test/Hpack/CabalFileSpec.hs b/test/Hpack/CabalFileSpec.hs index 8b8bb2fc..ac37070b 100644 --- a/test/Hpack/CabalFileSpec.hs +++ b/test/Hpack/CabalFileSpec.hs @@ -9,9 +9,15 @@ import Data.String.Interpolate.Util import Paths_hpack (version) +import Hpack.Util (Hash) +import Data.Version (Version) import Hpack (header) + import Hpack.CabalFile +mkHeader :: FilePath -> Version -> Hash -> String +mkHeader p v hash = unlines $ header p (Just v) (Just hash) + spec :: Spec spec = do describe "readCabalFile" $ do @@ -21,13 +27,13 @@ spec = do it "includes hash" $ do inTempDirectory $ do - writeFile file $ header "package.yaml" version hash - readCabalFile file `shouldReturn` Just (CabalFile (Just version) (Just hash) []) + writeFile file $ mkHeader "package.yaml" version hash + readCabalFile file `shouldReturn` Just (CabalFile [] (Just version) (Just hash) []) it "accepts cabal-version at the beginning of the file" $ do inTempDirectory $ do - writeFile file $ ("cabal-version: 2.2\n" ++ header "package.yaml" version hash) - readCabalFile file `shouldReturn` Just (CabalFile (Just version) (Just hash) ["cabal-version: 2.2"]) + writeFile file $ ("cabal-version: 2.2\n" ++ mkHeader "package.yaml" version hash) + readCabalFile file `shouldReturn` Just (CabalFile ["cabal-version: 2.2"] (Just version) (Just hash) []) describe "extractVersion" $ do it "extracts Hpack version from a cabal file" $ do diff --git a/test/Hpack/OptionsSpec.hs b/test/Hpack/OptionsSpec.hs index 08e8eb8b..53fa387f 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 NoForce Nothing 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 NoForce Nothing False "foo.yaml") context "with superfluous arguments" $ do it "returns ParseError" $ do @@ -29,19 +29,31 @@ 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 NoForce Nothing False defaultTarget) context "with --force" $ do it "sets optionsForce to Force" $ do - parseOptions defaultTarget ["--force"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget) + parseOptions defaultTarget ["--force"] `shouldReturn` Run (ParseOptions Verbose Force Nothing False defaultTarget) context "with -f" $ do it "sets optionsForce to Force" $ do - parseOptions defaultTarget ["-f"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget) + parseOptions defaultTarget ["-f"] `shouldReturn` Run (ParseOptions Verbose Force Nothing False defaultTarget) + + context "when determining parseOptionsHash" $ do + + it "assumes True on --hash" $ do + parseOptions defaultTarget ["--hash"] `shouldReturn` Run (ParseOptions Verbose NoForce (Just True) False defaultTarget) + + it "assumes False on --no-hash" $ do + parseOptions defaultTarget ["--no-hash"] `shouldReturn` Run (ParseOptions Verbose NoForce (Just False) False defaultTarget) + + it "gives last occurrence precedence" $ do + parseOptions defaultTarget ["--no-hash", "--hash"] `shouldReturn` Run (ParseOptions Verbose NoForce (Just True) False defaultTarget) + parseOptions defaultTarget ["--hash", "--no-hash"] `shouldReturn` Run (ParseOptions Verbose NoForce (Just False) 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 Force Nothing True defaultTarget) it "rejects - for target" $ do parseOptions defaultTarget ["-", "-"] `shouldReturn` ParseError diff --git a/test/HpackSpec.hs b/test/HpackSpec.hs index 2a93bfe1..867fb8b6 100644 --- a/test/HpackSpec.hs +++ b/test/HpackSpec.hs @@ -6,7 +6,6 @@ import Prelude hiding (readFile) import qualified Prelude as Prelude import Control.DeepSeq -import Data.List import Hpack.Config import Hpack.CabalFile @@ -17,94 +16,139 @@ 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" - - 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 - - context "when cabal file was created manually" $ do - it "does not overwrite existing cabal file" $ do - let existing = "some existing cabal file" - writeFile file existing - hpack `shouldReturn` modifiedManually + describe "header" $ do + it "generates header" $ do + header "foo.yaml" Nothing Nothing `shouldBe` [ + "-- This file has been generated from foo.yaml by hpack." + , "--" + , "-- see: https://github.com/sol/hpack" + , "" + ] + + context "with hpack version" $ do + it "includes hpack version" $ do + header "foo.yaml" (Just $ makeVersion [0,34,0]) Nothing `shouldBe` [ + "-- This file has been generated from foo.yaml by hpack version 0.34.0." + , "--" + , "-- see: https://github.com/sol/hpack" + , "" + ] + + context "with hash" $ do + it "includes hash" $ do + header "foo.yaml" Nothing (Just "some-hash") `shouldBe` [ + "-- This file has been generated from foo.yaml by hpack." + , "--" + , "-- see: https://github.com/sol/hpack" + , "--" + , "-- hash: some-hash" + , "" + ] + + describe "renderCabalFile" $ do + it "is inverse to readCabalFile" $ do + expected <- lines <$> readFile "hpack.cabal" + Just c <- readCabalFile "hpack.cabal" + renderCabalFile "package.yaml" c `shouldBe` expected + + describe "hpackResult" $ around_ inTempDirectory $ before_ (writeFile packageConfig "name: foo") $ do + let + file = "foo.cabal" + + hpackWithVersion v = hpackResultWithVersion (makeVersion v) defaultOptions + hpackWithStrategy strategy = hpackResult defaultOptions { optionsGenerateHashStrategy = strategy } + hpackForce = hpackResult defaultOptions {optionsForce = Force} + + generated = Result [] file Generated + modifiedManually = Result [] file ExistingCabalFileWasModifiedManually + outputUnchanged = Result [] file OutputUnchanged + alreadyGeneratedByNewerHpack = Result [] file AlreadyGeneratedByNewerHpack + + modifyPackageConfig = writeFile packageConfig $ unlines [ + "name: foo" + , "version: 0.1.0" + ] + + modifyCabalFile = do + xs <- readFile file + writeFile file $ xs ++ "foo\n" + + manuallyCreateCabalFile = do + writeFile file "some existing cabal file" + + doesNotGenerateHash :: HasCallStack => GenerateHashStrategy -> Spec + doesNotGenerateHash strategy = do + it "does not generate hash" $ do + hpackWithStrategy strategy `shouldReturn` generated + readFile file >>= (`shouldNotContain` "hash") + + generatesHash :: HasCallStack => GenerateHashStrategy -> Spec + generatesHash strategy = do + it "generates hash" $ do + hpackWithStrategy strategy `shouldReturn` generated + readFile file >>= (`shouldContain` "hash") + + doesNotOverwrite :: HasCallStack => GenerateHashStrategy -> Spec + doesNotOverwrite strategy = do + it "does not overwrite cabal file" $ do + existing <- readFile file + hpackWithStrategy strategy `shouldReturn` modifiedManually readFile file `shouldReturn` existing + with strategy item = context ("with " ++ show strategy) $ item strategy + + context "without an existing cabal file" $ do + with ForceHash generatesHash + with PreferHash generatesHash + with ForceNoHash doesNotGenerateHash + with PreferNoHash doesNotGenerateHash + + context "with an existing cabal file" $ do + context "without a hash" $ before_ (hpackWithStrategy ForceNoHash >> modifyPackageConfig) $ do + with ForceHash generatesHash + with PreferHash doesNotGenerateHash + with ForceNoHash doesNotGenerateHash + with PreferNoHash doesNotGenerateHash + + context "with a hash" $ before_ (hpackWithStrategy ForceHash >> modifyPackageConfig) $ do + with ForceHash generatesHash + with PreferHash generatesHash + with ForceNoHash doesNotGenerateHash + with PreferNoHash generatesHash + + context "with manual modifications" $ before_ modifyCabalFile $ do + with ForceHash doesNotOverwrite + with PreferHash doesNotOverwrite + with ForceNoHash doesNotGenerateHash + with PreferNoHash doesNotOverwrite + + context "when created manually" $ before_ manuallyCreateCabalFile $ do + with ForceHash doesNotOverwrite + with PreferHash doesNotOverwrite + with ForceNoHash doesNotOverwrite + with PreferNoHash doesNotOverwrite + context "with --force" $ do - it "overwrites existing cabal file" $ do - _ <- hpack - expected <- readFile file - writeFile file "some existing cabal file" + it "overwrites cabal file" $ do hpackForce `shouldReturn` generated - readFile file `shouldReturn` expected - - context "when cabal file was created with hpack < 0.20.0" $ do - it "overwrites existing cabal file" $ do - _ <- hpack - expected <- readFile file - writeFile file "-- This file has been generated from package.yaml by hpack version 0.19.3." - hpack `shouldReturn` generated - readFile file `shouldReturn` expected - - context "when cabal file was created with hpack >= 0.20.0" $ do - context "when hash is missing" $ do - it "does not overwrite existing cabal file" $ do - let existing = "-- This file has been generated from package.yaml by hpack version 0.20.0." - writeFile file existing - hpack `shouldReturn` modifiedManually - readFile file `shouldReturn` existing - - context "when only the the cabal file header changed" $ do - it "does not complain if it's newer" $ do - hpack `shouldReturn` generated - let removeHash = unlines . filter (not . isInfixOf "hash") . lines - readFile file >>= writeFile file . removeHash - hpack `shouldReturn` outputUnchanged - - context "when hash is present" $ do - context "when exsting cabal file was generated with a newer version of hpack" $ do - it "does not overwrite existing cabal file" $ do - writeFile packageConfig $ unlines [ - "name: foo" - , "version: 0.1.0" - ] - _ <- hpackWithVersion (makeVersion [0,22,0]) - old <- readFile file - - writeFile packageConfig $ unlines [ - "name: foo" - , "version: 0.2.0" - ] - - hpackWithVersion (makeVersion [0,20,0]) `shouldReturn` alreadyGeneratedByNewerHpack - readFile file `shouldReturn` old - - context "when cabal file was modified manually" $ do - it "does not overwrite existing cabal file" $ do - _ <- hpack - old <- readFile file - let modified = old ++ "foo\n" - writeFile file modified - _ <- hpack - readFile file `shouldReturn` modified - - context "when only the hpack version in the cabal file header changed" $ do - it "does not overwrite existing cabal file" $ do - _ <- hpackWithVersion (makeVersion [0,20,0]) - old <- readFile file - hpack `shouldReturn` outputUnchanged - readFile file `shouldReturn` old - - it "does not complain if it's newer" $ do - _ <- hpackWithVersion (makeVersion [999,999,0]) - old <- readFile file - hpack `shouldReturn` outputUnchanged - readFile file `shouldReturn` old + + context "when generated with a newer version of hpack" $ do + it "does not overwrite cabal file" $ do + _ <- hpackWithVersion [0,22,0] + old <- readFile file + modifyPackageConfig + hpackWithVersion [0,20,0] `shouldReturn` alreadyGeneratedByNewerHpack + readFile file `shouldReturn` old + + context "when only the hpack version in the cabal file header changed" $ do + it "does not overwrite cabal file" $ do + _ <- hpackWithVersion [0,22,0] + old <- readFile file + hpackWithVersion [0,30,0] `shouldReturn` outputUnchanged + readFile file `shouldReturn` old + + it "does not complain if it's newer" $ do + _ <- hpackWithVersion [0,22,0] + old <- readFile file + hpackWithVersion [0,20,0] `shouldReturn` outputUnchanged + readFile file `shouldReturn` old