From 4bf66f9916369d5e62be75696a886bc3c0ac6714 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sat, 2 May 2020 18:54:15 +0700 Subject: [PATCH] Refactoring --- src/Hpack.hs | 92 ++++++++++------- src/Hpack/CabalFile.hs | 9 +- test/Hpack/CabalFileSpec.hs | 14 ++- test/HpackSpec.hs | 193 ++++++++++++++++++++++-------------- 4 files changed, 189 insertions(+), 119 deletions(-) diff --git a/src/Hpack.hs b/src/Hpack.hs index f843e2b1..039a5d17 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 @@ -36,6 +37,7 @@ module Hpack ( #ifdef TEST , hpackResultWithVersion , header +, renderCabalFile #endif ) where @@ -56,18 +58,18 @@ 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 @@ -80,7 +82,7 @@ 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) @@ -154,41 +156,61 @@ 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 - (Nothing, _) -> ExistingCabalFileWasModifiedManually - (Just oldVersion, _) | oldVersion < makeVersion [0, 20, 0] -> Generated - (_, Nothing) -> ExistingCabalFileWasModifiedManually - (Just oldVersion, Just hash) - | old == new -> OutputUnchanged - | v < oldVersion -> AlreadyGeneratedByNewerHpack - | sha256 (unlines old) /= hash -> ExistingCabalFileWasModifiedManually - | otherwise -> Generated +mkStatus :: CabalFile -> CabalFile -> Status +mkStatus new@(CabalFile _ mNewVersion _ _) existing@(CabalFile _ mExistingVersion _ _) + | new `hasSameContent` existing = OutputUnchanged + | otherwise = case mExistingVersion of + Nothing -> ExistingCabalFileWasModifiedManually + Just existingVersion + | existingVersion < makeVersion [0, 20, 0] -> Generated + | mNewVersion < mExistingVersion -> AlreadyGeneratedByNewerHpack + | 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 = cabalFileHash cabalFile /= Just (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 + DecodeResult pkg (lines -> cabalVersion) cabalFileName warnings <- readPackageConfig options >>= either die return + mExistingCabalFile <- readCabalFile cabalFileName let + newCabalFile = makeCabalFile 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 :: Maybe CabalFile -> [String] -> Version -> Package -> CabalFile +makeCabalFile mExistingCabalFile cabalVersion v pkg = CabalFile cabalVersion (Just v) (Just hash) body + where + hash = sha256 (unlines $ cabalVersion ++ body) + body = lines $ renderPackage (maybe [] cabalFileContents mExistingCabalFile) pkg + +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/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/HpackSpec.hs b/test/HpackSpec.hs index a718caa0..e72b948f 100644 --- a/test/HpackSpec.hs +++ b/test/HpackSpec.hs @@ -16,87 +16,128 @@ 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 - readFile file `shouldReturn` existing - - context "with --force" $ do - it "overwrites existing cabal file" $ do - _ <- hpack - expected <- readFile file - writeFile file "some existing cabal file" - 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 + 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 $ 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 + + writePackageConfig = writeFile packageConfig $ unlines [ + "name: foo" + ] + modifyPackageConfig = writeFile packageConfig $ unlines [ + "name: foo" + , "version: 0.1.0" + ] + + before_ writePackageConfig $ 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 = "-- This file has been generated from package.yaml by hpack version 0.20.0." + let existing = "some existing cabal file" writeFile file existing hpack `shouldReturn` modifiedManually readFile file `shouldReturn` existing - 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 + context "with --force" $ do + it "overwrites existing cabal file" $ do _ <- hpack - readFile file `shouldReturn` modified + expected <- readFile file + writeFile file "some existing cabal file" + 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 only the hpack version in the cabal file header changed" $ do + 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 - _ <- 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 + 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 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 + _ <- hpackWithVersion (makeVersion [0,22,0]) + old <- readFile file + modifyPackageConfig + hpackWithVersion (makeVersion [0,20,0]) `shouldReturn` alreadyGeneratedByNewerHpack + readFile file `shouldReturn` old + + context "when cabal file was not modified manually" $ do + it "overwrites existing cabal file" $ do + _ <- hpack + modifyPackageConfig + hpack `shouldReturn` generated + + 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 `shouldReturn` modifiedManually + 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