Refactoring

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

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`)
 

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