Fix a bug related to git conflict markers in existing .cabal files

 When a `.cabal` file was essentially unchanged, but contained git
 conflict markers then `hpack` did not write a new `.cabal` file at
 all.  To address this `hpack` now unconditionally writes a new `.cabal`
 file when the existing `.cabal` file contains any git conflict markers.

CHANGELOG.md

@@ -1,3 +1,13 @@
+## Changes in 0.36.0
+ - When an existing `.cabal` does not align fields then do not align fields in
+   the generated `.cabal` file.
+
+ - Fix a bug related to git conflict markers in existing `.cabal` files: When a
+   `.cabal` file was essentially unchanged, but contained git conflict markers
+   then `hpack` did not write a new `.cabal` file at all.  To address this
+   `hpack` now unconditionally writes a new `.cabal` file when the existing
+   `.cabal` file contains any git conflict markers.
+
 ## Changes in 0.35.2
   - Add support for `ghc-shared-options`
 

hie.yaml

@@ -0,0 +1,3 @@
+cradle:
+  cabal:
+    component: hpack:test:spec

package.yaml

@@ -2,6 +2,7 @@ name: hpack
 version: 0.35.3
 synopsis: A modern format for Haskell packages
 description: See README at <https://github.com/sol/hpack#readme>
+author: Simon Hengel <[email protected]>
 maintainer: Simon Hengel <[email protected]>
 github: sol/hpack
 category: Development

src/Hpack.hs

@@ -206,8 +206,8 @@ printResult verbose r = do
 printWarnings :: [String] -> IO ()
 printWarnings = mapM_ $ Utf8.hPutStrLn stderr . ("WARNING: " ++)
 
-mkStatus :: CabalFile -> CabalFile -> Status
-mkStatus new@(CabalFile _ mNewVersion mNewHash _) existing@(CabalFile _ mExistingVersion _ _)
+mkStatus :: NewCabalFile -> ExistingCabalFile -> Status
+mkStatus new@(CabalFile _ mNewVersion mNewHash _ _) existing@(CabalFile _ mExistingVersion _ _ _)
   | new `hasSameContent` existing = OutputUnchanged
   | otherwise = case mExistingVersion of
       Nothing -> ExistingCabalFileWasModifiedManually
@@ -216,16 +216,19 @@ mkStatus new@(CabalFile _ mNewVersion mNewHash _) existing@(CabalFile _ mExistin
         | isJust mNewHash && hashMismatch existing -> ExistingCabalFileWasModifiedManually
         | otherwise -> Generated
 
-hasSameContent :: CabalFile -> CabalFile -> Bool
-hasSameContent (CabalFile cabalVersionA _ _ a) (CabalFile cabalVersionB _ _ b) = cabalVersionA == cabalVersionB && a == b
+hasSameContent :: NewCabalFile -> ExistingCabalFile -> Bool
+hasSameContent (CabalFile cabalVersionA _ _ a ()) (CabalFile cabalVersionB _ _ b gitConflictMarkers) =
+     cabalVersionA == cabalVersionB
+  && a == b
+  && gitConflictMarkers == DoesNotHaveGitConflictMarkers
 
-hashMismatch :: CabalFile -> Bool
+hashMismatch :: ExistingCabalFile -> Bool
 hashMismatch cabalFile = case cabalFileHash cabalFile of
   Nothing -> False
-  Just hash -> hash /= calculateHash cabalFile
+  Just hash -> cabalFileGitConflictMarkers cabalFile == HasGitConflictMarkers || hash /= calculateHash cabalFile
 
-calculateHash :: CabalFile -> Hash
-calculateHash (CabalFile cabalVersion _ _ body) = sha256 (unlines $ cabalVersion ++ body)
+calculateHash :: CabalFile a -> Hash
+calculateHash (CabalFile cabalVersion _ _ body _) = sha256 (unlines $ cabalVersion ++ body)
 
 hpackResult :: Options -> IO Result
 hpackResult opts = hpackResultWithError opts >>= either (die . formatHpackError programName) return
@@ -258,24 +261,24 @@ hpackResultWithVersion v (Options options force generateHashStrategy toStdout) =
       }
     Left err -> return $ Left err
 
-writeCabalFile :: DecodeOptions -> Bool -> FilePath -> CabalFile -> IO ()
+writeCabalFile :: DecodeOptions -> Bool -> FilePath -> NewCabalFile -> 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 :: GenerateHashStrategy -> Maybe ExistingCabalFile -> [String] -> Version -> Package -> NewCabalFile
 makeCabalFile strategy mExistingCabalFile cabalVersion v pkg = cabalFile
   where
-    cabalFile = CabalFile cabalVersion (Just v) hash body
+    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 :: Maybe ExistingCabalFile -> GenerateHashStrategy -> Bool
 shouldGenerateHash mExistingCabalFile strategy = case (strategy, mExistingCabalFile) of
   (ForceHash, _) -> True
   (ForceNoHash, _) -> False
@@ -284,5 +287,5 @@ shouldGenerateHash mExistingCabalFile strategy = case (strategy, mExistingCabalF
   (_, 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
+renderCabalFile :: FilePath -> NewCabalFile -> [String]
+renderCabalFile file (CabalFile cabalVersion hpackVersion hash body _) = cabalVersion ++ header file hpackVersion hash ++ body

src/Hpack/CabalFile.hs

@@ -1,7 +1,19 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
-module Hpack.CabalFile where
+module Hpack.CabalFile (
+  CabalFile(..)
+, GitConflictMarkers(..)
+, ExistingCabalFile
+, NewCabalFile
+, readCabalFile
+, parseVersion
+#ifdef TEST
+, extractVersion
+, removeGitConflictMarkers
+#endif
+) where
 
 import           Imports
 
@@ -12,28 +24,42 @@ import           Text.ParserCombinators.ReadP
 
 import           Hpack.Util
 
-makeVersion :: [Int] -> Version
-makeVersion v = Version v []
-
-data CabalFile = CabalFile {
+data CabalFile a = CabalFile {
   cabalFileCabalVersion :: [String]
 , cabalFileHpackVersion :: Maybe Version
 , cabalFileHash :: Maybe Hash
 , cabalFileContents :: [String]
+, cabalFileGitConflictMarkers :: a
 } deriving (Eq, Show)
 
-readCabalFile :: FilePath -> IO (Maybe CabalFile)
-readCabalFile cabalFile = fmap parse <$> tryReadFile cabalFile
+data GitConflictMarkers = HasGitConflictMarkers | DoesNotHaveGitConflictMarkers
+  deriving (Show, Eq)
+
+type ExistingCabalFile = CabalFile GitConflictMarkers
+type NewCabalFile = CabalFile ()
+
+readCabalFile :: FilePath -> IO (Maybe ExistingCabalFile)
+readCabalFile cabalFile = fmap parseCabalFile <$> tryReadFile cabalFile
+
+parseCabalFile :: String -> ExistingCabalFile
+parseCabalFile (lines -> input) = case span isComment <$> span (not . isComment) clean of
+  (cabalVersion, (header, body)) -> CabalFile {
+    cabalFileCabalVersion = cabalVersion
+  , cabalFileHpackVersion = extractVersion header
+  , cabalFileHash = extractHash header
+  , cabalFileContents = dropWhile null body
+  , cabalFileGitConflictMarkers = gitConflictMarkers
+  }
   where
-    parse :: String -> CabalFile
-    parse (splitHeader -> (cabalVersion, h, c)) = CabalFile cabalVersion (extractVersion h) (extractHash h) c
+    clean :: [String]
+    clean = removeGitConflictMarkers input
 
-    splitHeader :: String -> ([String], [String], [String])
-    splitHeader (removeGitConflictMarkers . lines -> c) =
-      case span (not . isComment) c of
-        (cabalVersion, xs) -> case span isComment xs of
-          (header, body) -> (cabalVersion, header, dropWhile null body)
+    gitConflictMarkers :: GitConflictMarkers
+    gitConflictMarkers
+      | input == clean = DoesNotHaveGitConflictMarkers
+      | otherwise = HasGitConflictMarkers
 
+    isComment :: String -> Bool
     isComment = ("--" `isPrefixOf`)
 
 extractHash :: [String] -> Maybe Hash

src/Hpack/Render/Hints.hs

@@ -68,16 +68,31 @@ unindent input = map (drop indentation) input
   where
     indentation = minimum $ map (length . takeWhile isSpace) input
 
+data Indentation = Indentation {
+  indentationFieldNameLength :: Int
+, indentationPadding :: Int
+}
+
+indentationTotal :: Indentation -> Int
+indentationTotal (Indentation fieldName padding) = fieldName + padding
+
 sniffAlignment :: [String] -> Maybe Alignment
-sniffAlignment input = case nub . catMaybes . map indentation . catMaybes . map splitField $ input of
-  [n] -> Just (Alignment n)
-  _ -> Nothing
+sniffAlignment input
+  | all (indentationPadding >>> (== 1)) indentations = Just 0
+  | otherwise = case nub (map indentationTotal indentations) of
+      [n] -> Just (Alignment n)
+      _ -> Nothing
   where
+    indentations :: [Indentation]
+    indentations = catMaybes . map (splitField >=> indentation) $ input
 
-    indentation :: (String, String) -> Maybe Int
+    indentation :: (String, String) -> Maybe Indentation
     indentation (name, value) = case span isSpace value of
       (_, "") -> Nothing
-      (xs, _) -> (Just . succ . length $ name ++ xs)
+      (padding, _) -> Just Indentation {
+        indentationFieldNameLength = succ $ length name
+      , indentationPadding = length padding
+      }
 
 splitField :: String -> Maybe (String, String)
 splitField field = case span isNameChar field of

test/Helper.hs

@@ -11,6 +11,7 @@ module Helper (
 , module System.FilePath
 , withCurrentDirectory
 , yaml
+, makeVersion
 ) where
 
 import           Imports
@@ -19,6 +20,7 @@ import           Test.Hspec
 import           Test.Mockery.Directory
 import           Control.Monad
 import           Control.Applicative
+import           Data.Version (Version(..))
 import           System.Directory (getCurrentDirectory, setCurrentDirectory, canonicalizePath)
 import           Control.Exception
 import qualified System.IO.Temp as Temp
@@ -44,3 +46,6 @@ withTempDirectory action = Temp.withSystemTempDirectory "hspec" $ \dir -> do
 
 yaml :: Language.Haskell.TH.Quote.QuasiQuoter
 yaml = yamlQQ
+
+makeVersion :: [Int] -> Version
+makeVersion v = Version v []

test/Hpack/CabalFileSpec.hs

@@ -28,12 +28,12 @@ spec = do
     it "includes hash" $ do
       inTempDirectory $ do
         writeFile file $ mkHeader "package.yaml" version hash
-        readCabalFile file `shouldReturn` Just (CabalFile [] (Just version) (Just hash) [])
+        readCabalFile file `shouldReturn` Just (CabalFile [] (Just version) (Just hash) [] DoesNotHaveGitConflictMarkers)
 
     it "accepts cabal-version at the beginning of the file" $ do
       inTempDirectory $ do
         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) [])
+        readCabalFile file `shouldReturn` Just (CabalFile ["cabal-version: 2.2"] (Just version) (Just hash) [] DoesNotHaveGitConflictMarkers)
 
   describe "extractVersion" $ do
     it "extracts Hpack version from a cabal file" $ do

test/Hpack/Render/HintsSpec.hs

@@ -21,7 +21,7 @@ spec = do
   describe "extractFieldOrder" $ do
     it "extracts field order hints" $ do
       let input = [
-              "name:           cabalize"
+              "name:           hpack"
             , "version:        0.0.0"
             , "license:"
             , "license-file: "
@@ -38,7 +38,7 @@ spec = do
   describe "extractSectionsFieldOrder" $ do
     it "splits input into sections" $ do
       let input = [
-              "name:           cabalize"
+              "name:           hpack"
             , "version:        0.0.0"
             , ""
             , "library"
@@ -88,7 +88,7 @@ spec = do
   describe "sniffAlignment" $ do
     it "sniffs field alignment from given cabal file" $ do
       let input = [
-              "name:           cabalize"
+              "name:           hpack"
             , "version:        0.0.0"
             , "license:        MIT"
             , "license-file:   LICENSE"
@@ -98,14 +98,25 @@ spec = do
 
     it "ignores fields without a value on the same line" $ do
       let input = [
-              "name:           cabalize"
+              "name:           hpack"
             , "version:        0.0.0"
             , "description: "
             , "  foo"
             , "  bar"
             ]
       sniffAlignment input `shouldBe` Just 16
 
+    context "when all fields are padded with exactly one space" $ do
+      it "returns 0" $ do
+        let input = [
+                "name: hpack"
+              , "version: 0.0.0"
+              , "license: MIT"
+              , "license-file: LICENSE"
+              , "build-type: Simple"
+              ]
+        sniffAlignment input `shouldBe` Just 0
+
   describe "splitField" $ do
     it "splits fields" $ do
       splitField "foo:   bar" `shouldBe` Just ("foo", "   bar")

test/HpackSpec.hs

@@ -12,7 +12,7 @@ import           Control.DeepSeq
 import           Hpack.Config
 import           Hpack.CabalFile
 import           Hpack.Error (formatHpackError)
-import           Hpack hiding (hpack)
+import           Hpack
 
 readFile :: FilePath -> IO String
 readFile name = Prelude.readFile name >>= (return $!!)
@@ -52,7 +52,7 @@ spec = do
     it "is inverse to readCabalFile" $ do
       expected <- lines <$> readFile "resources/test/hpack.cabal"
       Just c <- readCabalFile "resources/test/hpack.cabal"
-      renderCabalFile "package.yaml" c `shouldBe` expected
+      renderCabalFile "package.yaml" c {cabalFileGitConflictMarkers = ()} `shouldBe` expected
 
   describe "hpackResult" $ around_ inTempDirectory $ before_ (writeFile packageConfig "name: foo") $ do
     let
@@ -155,3 +155,22 @@ spec = do
           old <- readFile file
           hpackWithVersion [0,20,0] `shouldReturn` outputUnchanged
           readFile file `shouldReturn` old
+
+      context "with git conflict markers" $ do
+        context "when the new and the existing .cabal file are essentially the same" $ do
+          it "still removes the conflict markers" $ do
+            hpack NoVerbose defaultOptions
+            old <- readFile file
+            let
+              modified :: String
+              modified = unlines $ case break (== "version: 0.0.0") $ lines old of
+                (xs, v : ys)  -> xs ++
+                  "<<<<<<< ours" :
+                  v :
+                  "=======" :
+                  "version: 0.1.0" :
+                  ">>>>>>> theirs" : ys
+                _ -> undefined
+            writeFile file modified
+            hpack NoVerbose defaultOptions
+            readFile file `shouldReturn` old