cabal-fmt 0.1.9 → 0.1.10

raw patch · 15 files changed

+338/−160 lines, 15 filesdep +base-orphansPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base-orphans

API changes (from Hackage documentation)

Files

• Changelog.md +5/−0
• cabal-fmt.cabal +6/−2
• fixtures/issue29.cabal +22/−0
• fixtures/issue29.format +15/−0
• src/CabalFmt.hs +38/−21
• src/CabalFmt/Comments.hs +13/−10
• src/CabalFmt/Fields.hs +12/−17
• src/CabalFmt/FreeText.hs +86/−0
• src/CabalFmt/Prelude.hs +18/−0
• src/CabalFmt/Refactoring/ExpandExposedModules.hs +2/−2
• src/CabalFmt/Refactoring/Fragments.hs +3/−2
• src/CabalFmt/Refactoring/GlobFiles.hs +2/−2
• src/CabalFmt/Refactoring/Type.hs +7/−2
• tests/Golden.hs +0/−102
• tests/golden.hs +109/−0

@@ -1,3 +1,8 @@+# 0.1.10++- Fix removal of empty lines in free text fields (like `description`)+  when using `cabal-version: 3.0` (where you can use empty lines)+ # 0.1.9  - Change how version ranges with carets are formatted once again.

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cabal-fmt-version:            0.1.9+version:            0.1.10 synopsis:           Format .cabal files category:           Development description:@@ -56,6 +56,9 @@     , parsec        ^>=3.1.13.0     , pretty        ^>=1.1.3.6 +  if impl(ghc <8.10)+    build-depends: base-orphans ^>=0.9.1+   -- our version interval normalisation   build-depends:    version-interval @@ -70,6 +73,7 @@     CabalFmt.Fields.Modules     CabalFmt.Fields.SourceFiles     CabalFmt.Fields.TestedWith+    CabalFmt.FreeText     CabalFmt.Glob     CabalFmt.Monad     CabalFmt.Options@@ -114,7 +118,7 @@   type:             exitcode-stdio-1.0   default-language: Haskell2010   hs-source-dirs:   tests-  main-is:          Golden.hs+  main-is:          golden.hs    -- dependencies in library   build-depends:

@@ -0,0 +1,22 @@+cabal-version:      3.0+name:               issue29+version:            0+description:+  First Paragraph+  +++++  Second Paragraph++library+  default-language: Haskell2010+  hs-source-dirs:   src+  build-depends:+      base        >=4.3   && <4.18++  exposed-modules:+    Data.Bifunctor.Assoc+    Data.Bifunctor.Swap+

@@ -0,0 +1,15 @@+cabal-version: 3.0+name:          issue29+version:       0+description:+  First Paragraph++  Second Paragraph++library+  default-language: Haskell2010+  hs-source-dirs:   src+  build-depends:    base >=4.3 && <4.18+  exposed-modules:+    Data.Bifunctor.Assoc+    Data.Bifunctor.Swap

@@ -33,6 +33,7 @@ import CabalFmt.Fields import CabalFmt.Fields.BuildDepends import CabalFmt.Fields.Extensions+import CabalFmt.FreeText import CabalFmt.Fields.Modules import CabalFmt.Fields.SourceFiles import CabalFmt.Fields.TestedWith@@ -49,11 +50,20 @@  cabalFmt :: MonadCabalFmt r m => FilePath -> BS.ByteString -> m String cabalFmt filepath contents = do+    -- determine cabal-version+    cabalFile <- asks (optCabalFile . view options)+    csv <- case cabalFile of+        False -> return C.cabalSpecLatest+        True  -> do+            gpd <- parseGpd filepath contents+            return $ C.specVersion+              $ C.packageDescription gpd+     inputFields' <- parseFields contents     let (inputFieldsC, endComments) = attachComments contents inputFields'      -- parse pragmas-    let parse c = case parsePragmas c of (ws, ps) -> traverse_ displayWarning ws *> return (c, ps)+    let parse (pos, c) = case parsePragmas c of (ws, ps) -> traverse_ displayWarning ws *> return (pos, c, ps)     inputFieldsP' <- traverse (traverse parse) inputFieldsC     endCommentsPragmas <- case parsePragmas endComments of         (ws, ps) -> traverse_ displayWarning ws *> return ps@@ -67,29 +77,21 @@     -- options morphisms     let pragmas :: [GlobalPragma]         pragmas = fst $ partitionPragmas $-            foldMap (foldMap snd) inputFieldsP' <> endCommentsPragmas+            foldMap (foldMap trdOf3) inputFieldsP' <> endCommentsPragmas          optsEndo :: OptionsMorphism         optsEndo = foldMap pragmaToOM pragmas -    cabalFile <- asks (optCabalFile . view options)-    csv <- case cabalFile of-        False -> return C.cabalSpecLatest-        True  -> do-            gpd <- parseGpd filepath contents-            return $ C.specVersion-              $ C.packageDescription gpd-     local (over options $ \o -> runOptionsMorphism optsEndo $ o { optSpecVersion = csv }) $ do         indentWith <- asks (optIndent . view options)-        let inputFields = fmap (fmap fst) inputFieldsR+        let inputFields = inputFieldsR -        outputPrettyFields <- C.genericFromParsecFields-            prettyFieldLines+        outputPrettyFields <- genericFromParsecFields+            (\n ann -> prettyFieldLines n (fstOf3 ann))             prettySectionArgs             inputFields -        return $ C.showFields' fromComments (const id) indentWith outputPrettyFields+        return $ C.showFields' (fromComments . sndOf3) (const id) indentWith outputPrettyFields             & if nullComments endComments then id else                 (++ unlines ("" : [ C.fromUTF8BS c | c <- unComments endComments ])) @@ -97,19 +99,34 @@ fromComments (Comments [])  = C.NoComment fromComments (Comments bss) = C.CommentBefore (map C.fromUTF8BS bss) +genericFromParsecFields+    :: Applicative f+    => (C.FieldName -> ann -> [C.FieldLine ann] -> f PP.Doc)     -- ^ transform field contents+    -> (C.FieldName -> [C.SectionArg ann] -> f [PP.Doc])  -- ^ transform section arguments+    -> [C.Field ann]+    -> f [C.PrettyField ann]+genericFromParsecFields f g = goMany where+    goMany = traverse go++    go (C.Field (C.Name ann name) fls)          = C.PrettyField ann name <$> f name ann fls+    go (C.Section (C.Name ann name) secargs fs) = C.PrettySection ann name <$> g name secargs <*> goMany fs+ ------------------------------------------------------------------------------- -- Field prettyfying ------------------------------------------------------------------------------- -prettyFieldLines :: MonadCabalFmt r m => C.FieldName -> [C.FieldLine ann] -> m PP.Doc-prettyFieldLines fn fls =-    fromMaybe (C.prettyFieldLines fn fls) <$> knownField fn fls+prettyFieldLines :: MonadCabalFmt r m => C.FieldName -> C.Position -> [C.FieldLine CommentsPragmas] -> m PP.Doc+prettyFieldLines fn pos fls =+    fromMaybe (C.prettyFieldLines fn fls) <$> knownField fn pos fls -knownField :: MonadCabalFmt r m => C.FieldName -> [C.FieldLine ann] -> m (Maybe PP.Doc)-knownField fn fls = do+knownField :: MonadCabalFmt r m => C.FieldName -> C.Position -> [C.FieldLine CommentsPragmas] -> m (Maybe PP.Doc)+knownField fn pos fls = do     opts <- asks (view options)-    let v = optSpecVersion opts-    return $ join $ fieldDescrLookup (fieldDescrs opts) fn $ \p pp ->+    let v   = optSpecVersion opts+    let ft  = fieldlinesToFreeText v pos (fmap (fmap fstOf3) fls)+    let ft' = showFreeText v ft++    return $ join $ fieldDescrLookup (fieldDescrs opts) fn (Just ft') $ \p pp ->         case C.runParsecParser' v p "<input>" (C.fieldLinesToStream fls) of             Right x -> Just (pp x)             Left _  -> Nothing

@@ -44,9 +44,9 @@ attachComments     :: BS.ByteString        -- ^ source with comments     -> [C.Field C.Position] -- ^ parsed source fields-    -> ([C.Field Comments], Comments)+    -> ([C.Field (C.Position, Comments)], Comments) attachComments input inputFields =-    (overAnn attach inputFields, endComments)+    (overAnn attach attach' inputFields, endComments)   where     inputFieldsU :: [(FieldPath, C.Field C.Position)]     inputFieldsU = fieldUniverseN inputFields@@ -68,27 +68,30 @@         , isNothing (findPath C.fieldAnn l inputFieldsU)         ] -    attach :: FieldPath -> C.Position -> Comments-    attach fp _pos = fromMaybe mempty (Map.lookup fp comments')+    attach :: FieldPath -> C.Position -> (C.Position, Comments)+    attach fp pos = (pos, fromMaybe mempty (Map.lookup fp comments')) -overAnn :: forall a b. (FieldPath -> a -> b) -> [C.Field a] -> [C.Field b]-overAnn f = go' id where+    attach' :: C.Position -> (C.Position, Comments)+    attach' pos = (pos, mempty)++overAnn :: forall a b. (FieldPath -> a -> b) -> (a -> b) -> [C.Field a] -> [C.Field b]+overAnn f h = go' id where     go :: (FieldPath -> FieldPath) -> Int -> C.Field a -> C.Field b     go g i (C.Field (C.Name a name) fls) =-        C.Field (C.Name b name) (b <$$ fls)+        C.Field (C.Name b name) (h <$$> fls)       where         b = f (g (Nth i End)) a      go g i (C.Section (C.Name a name) args fls) =-        C.Section (C.Name b name) (b <$$ args) (go' (g . Nth i) fls)+        C.Section (C.Name b name) (h <$$> args) (go' (g . Nth i) fls)       where         b = f (g (Nth i End)) a      go' :: (FieldPath -> FieldPath) -> [C.Field a] -> [C.Field b]     go' g xs = zipWith (go g) [0..] xs -    (<$$) :: (Functor f, Functor g) => x -> f (g y) -> f (g x)-    x <$$ y = (x <$) <$> y+    (<$$>) :: (Functor f, Functor g) => (x -> y) -> f (g x) -> f (g y)+    x <$$> y = (x <$>) <$> y  ------------------------------------------------------------------------------- -- Find comments in the input

@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveFunctor             #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE GADTs                     #-} {-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE RankNTypes                #-} {-# LANGUAGE UndecidableInstances      #-}@@ -15,7 +16,6 @@     ) where  import qualified Data.Map.Strict                 as Map-import qualified Distribution.Compat.CharParsing as C import qualified Distribution.FieldGrammar       as C import qualified Distribution.Fields.Field       as C import qualified Distribution.Parsec             as C@@ -29,10 +29,11 @@ -------------------------------------------------------------------------------  -- strict pair-data SP = forall f. SP-    { _pPretty :: !(f -> PP.Doc)-    , _pParse  :: !(forall m. C.CabalParsing m => m f)-    }+data SP where+    FreeText :: SP+    SP :: !(f -> PP.Doc)+       -> !(forall m. C.CabalParsing m => m f)+       -> SP  -- | Lookup both pretty-printer and value parser. --@@ -42,10 +43,12 @@     :: C.CabalParsing m     => FieldDescrs s a     -> C.FieldName+    -> r -- field is freetext     -> (forall f. m f -> (f -> PP.Doc) -> r)     -> Maybe r-fieldDescrLookup (F m) fn kont = kont' <$> Map.lookup fn m where+fieldDescrLookup (F m) fn ft kont = kont' <$> Map.lookup fn m where     kont' (SP a b) = kont b a+    kont' FreeText = ft  -- | A collection field parsers and pretty-printers. newtype FieldDescrs s a = F { runF :: Map.Map C.FieldName SP }@@ -94,17 +97,9 @@     monoidalFieldAla fn _pack _ =         singletonF fn (C.pretty . pack' _pack) (unpack' _pack <$> C.parsec) -    freeTextField fn _ = singletonF fn-        PP.text-        (C.munch $ const True)--    freeTextFieldDef fn _ = singletonF fn-        PP.text-        (C.munch $ const True)--    freeTextFieldDefST fn _ = singletonF fn-        PP.text-        (C.munch $ const True)+    freeTextField      fn _ = F $ Map.singleton fn FreeText+    freeTextFieldDef   fn _ = F $ Map.singleton fn FreeText+    freeTextFieldDefST fn _ = F $ Map.singleton fn FreeText      prefixedFields _fnPfx _l = F mempty     knownField _           = pure ()

@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+module CabalFmt.FreeText (+    fieldlinesToFreeText,+    showFreeText,+) where++import Data.List (foldl')++import qualified Distribution.CabalSpecVersion as C+import qualified Distribution.Fields.Field     as C+import qualified Distribution.Parsec           as C+import qualified Distribution.Parsec.Position  as C+import qualified Distribution.Pretty           as C+import qualified Distribution.Utils.String     as C (trim)+import qualified Text.PrettyPrint              as PP++import CabalFmt.Prelude++showFreeText :: C.CabalSpecVersion -> String -> PP.Doc+showFreeText v+    | v >= C.CabalSpecV3_0+    = C.showFreeTextV3++    | otherwise+    = C.showFreeText++-- This should perfectly be exported from Cabal-syntax+fieldlinesToFreeText :: C.CabalSpecVersion -> C.Position -> [C.FieldLine C.Position] -> String+fieldlinesToFreeText v+    | v >= C.CabalSpecV3_0+    = fieldlinesToFreeText3++    | otherwise+    = \_ -> fieldlinesToFreeText2++fieldlinesToFreeText2 :: [C.FieldLine C.Position] -> String+fieldlinesToFreeText2 [C.FieldLine _ "."] = "."+fieldlinesToFreeText2 fls = intercalate "\n" (map go fls)+  where+    go (C.FieldLine _ bs)+      | s == "." = ""+      | otherwise = s+      where+        s = C.trim (fromUTF8BS bs)++fieldlinesToFreeText3 :: C.Position -> [C.FieldLine C.Position] -> String+fieldlinesToFreeText3 _ [] = ""+fieldlinesToFreeText3 _ [C.FieldLine _ bs] = fromUTF8BS bs+fieldlinesToFreeText3 pos (C.FieldLine pos1 bs1 : fls2@(C.FieldLine pos2 _ : _))+  -- if first line is on the same line with field name:+  -- the indentation level is either+  -- 1. the indentation of left most line in rest fields+  -- 2. the indentation of the first line+  -- whichever is leftmost+  | C.positionRow pos == C.positionRow pos1 =+      concat $+        fromUTF8BS bs1+          : mealy (mk mcol1) pos1 fls2+  -- otherwise, also indent the first line+  | otherwise =+      concat $+        replicate (C.positionCol pos1 - mcol2) ' '+          : fromUTF8BS bs1+          : mealy (mk mcol2) pos1 fls2+  where+    mcol1 = foldl' (\a b -> min a $ C.positionCol $ C.fieldLineAnn b) (min (C.positionCol pos1) (C.positionCol pos2)) fls2+    mcol2 = foldl' (\a b -> min a $ C.positionCol $ C.fieldLineAnn b) (C.positionCol pos1) fls2++    mk :: Int -> C.Position -> C.FieldLine C.Position -> (C.Position, String)+    mk col p (C.FieldLine q bs) =+      ( q+      -- in Cabal-syntax there is no upper limit, i.e. no min+      -- we squash multiple empty lines to one+      , replicate (min 2 newlines) '\n'+          ++ replicate indent ' '+          ++ fromUTF8BS bs+      )+      where+        newlines = C.positionRow q - C.positionRow p+        indent = C.positionCol q - col++mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b]+mealy f = go+  where+    go _ [] = []+    go s (x : xs) = let ~(s', y) = f s x in y : go s' xs

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- License: GPL-3.0-or-later -- Copyright: Oleg Grenrus@@ -42,6 +43,10 @@     traverseOf,     over, view,     _1,+    -- ** Tuples+    fstOf3,+    sndOf3,+    trdOf3,     ) where  import Control.Arrow               ((&&&))@@ -62,6 +67,10 @@  import qualified Distribution.Utils.Generic as C +#ifdef MIN_VERSION_base_orphans+import Data.Orphans ()+#endif+ traverseOf     :: Applicative f     => ((a -> f b) -> s ->  f t)@@ -70,3 +79,12 @@  _1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c) _1 f (a, c) = (\b -> (b, c)) <$> f a++fstOf3 :: (a,b,c) -> a+fstOf3 (a,_,_) = a++sndOf3 :: (a,b,c) -> b+sndOf3 (_,b,_) = b++trdOf3 :: (a,b,c) -> c+trdOf3 (_,_,c) = c

@@ -18,13 +18,13 @@  refactoringExpandExposedModules :: FieldRefactoring refactoringExpandExposedModules C.Section {} = pure Nothing-refactoringExpandExposedModules (C.Field name@(C.Name (_, pragmas) _n) fls) = do+refactoringExpandExposedModules (C.Field name@(C.Name (_, _, pragmas) _n) fls) = do     dirs <- parse pragmas     files <- traverseOf (traverse . _1) getFiles dirs      let newModules :: [C.FieldLine CommentsPragmas]         newModules = catMaybes-            [ return $ C.FieldLine mempty $ toUTF8BS $ intercalate "." parts+            [ return $ C.FieldLine emptyCommentsPragmas $ toUTF8BS $ intercalate "." parts             | (files', mns) <- files             , file <- files'             , let parts = splitDirectories $ dropExtension file

@@ -12,6 +12,7 @@ import qualified Distribution.Fields        as C import qualified Distribution.Fields.Field  as C import qualified Distribution.Fields.Pretty as C+import qualified Distribution.Parsec        as C  import CabalFmt.Comments import CabalFmt.Monad@@ -70,10 +71,10 @@                             pure Nothing   where     noCommentsPragmas :: Functor f => [f ann] -> [f CommentsPragmas]-    noCommentsPragmas = map ((Comments [], []) <$)+    noCommentsPragmas = map ((C.zeroPos, Comments [], []) <$)      getPragmas :: C.Field CommentsPragmas -> [FieldPragma]-    getPragmas = snd . C.fieldAnn+    getPragmas = trdOf3 . C.fieldAnn      showSection :: C.Name ann -> [C.SectionArg ann] -> String     showSection (C.Name _ n) []   = show n

@@ -19,13 +19,13 @@  refactoringGlobFiles :: FieldRefactoring refactoringGlobFiles C.Section {} = pure Nothing-refactoringGlobFiles (C.Field name@(C.Name (_, pragmas) _n) fls) = do+refactoringGlobFiles (C.Field name@(C.Name (_, _, pragmas) _n) fls) = do     globs <- parse pragmas     files <- fmap concat (traverse match' globs)      let newFiles :: [C.FieldLine CommentsPragmas]         newFiles = catMaybes-            [ return $ C.FieldLine mempty $ toUTF8BS file+            [ return $ C.FieldLine emptyCommentsPragmas $ toUTF8BS file             | file <- files             ] 

@@ -6,10 +6,12 @@ module CabalFmt.Refactoring.Type (     FieldRefactoring,     CommentsPragmas,+    emptyCommentsPragmas,     rewriteFields,     ) where -import qualified Distribution.Fields       as C+import qualified Distribution.Fields as C+import qualified Distribution.Parsec as C  import CabalFmt.Comments import CabalFmt.Monad@@ -19,7 +21,10 @@ -- Refactoring type ------------------------------------------------------------------------------- -type CommentsPragmas = (Comments, [FieldPragma])+type CommentsPragmas = (C.Position, Comments, [FieldPragma])++emptyCommentsPragmas :: CommentsPragmas+emptyCommentsPragmas = (C.zeroPos, mempty, mempty)  type FieldRefactoring     = forall r m. MonadCabalFmt r m

@@ -1,102 +0,0 @@-module Main (main) where--import System.FilePath            ((-<.>), (</>))-import System.IO                  (hClose, hFlush)-import System.IO.Temp             (withSystemTempFile)-import System.Process             (readProcessWithExitCode)-import Test.Tasty                 (TestTree, defaultMain, testGroup)-import Test.Tasty.Golden.Advanced (goldenTest)--import qualified Data.ByteString       as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.Map              as Map--import CabalFmt         (cabalFmt)-import CabalFmt.Monad   (runCabalFmt)-import CabalFmt.Options (defaultOptions)-import CabalFmt.Prelude--main :: IO ()-main = defaultMain $ testGroup "tests"-    [ goldenTest' "cabal-fmt"-    , goldenTest' "Cabal"-    , goldenTest' "Cabal-notab"-    , goldenTest' "simple-example"-    , goldenTest' "tree-diff"--    , goldenTest' "fragment-missing"-    , goldenTest' "fragment-empty"-    , goldenTest' "fragment-wrong-field"-    , goldenTest' "fragment-wrong-type"-    , goldenTest' "fragment-multiple"-    , goldenTest' "fragment-section"--    , goldenTest' "issue69"-    ]--goldenTest' :: String -> TestTree-goldenTest' n = goldenTest n readGolden makeTest cmp writeGolden-  where-    goldenPath = "fixtures" </> n -<.> "format"-    inputPath  = "fixtures" </> n -<.> "cabal"--    readGolden  = BS.readFile goldenPath-    writeGolden = BS.writeFile goldenPath--    makeTest = do-        contents <- BS.readFile inputPath-        case runCabalFmt files defaultOptions $ cabalFmt inputPath contents of-            Left err            -> fail ("First pass: " ++ show err)-            Right (output', ws) -> do-                -- idempotent-                case runCabalFmt files defaultOptions $ cabalFmt inputPath (toUTF8BS output') of-                    Left err            -> fail ("Second pass: " ++ show err)-                    Right (output'', _) -> do-                        unless (output' == output'') $ fail "Output not idempotent"-                        return (toUTF8BS $ unlines (map ("-- " ++) ws) ++ output')--    cmp a b | a == b    = return Nothing-            | otherwise =-        withSystemTempFile "cabal-fmt-test.txt" $ \fpA hdlA ->-        withSystemTempFile "cabal-fmt-test.txt" $ \fpB hdlB -> do-            BS.hPutStr hdlA a-            BS.hPutStr hdlB b-            hFlush hdlA-            hFlush hdlB-            hClose hdlA-            hClose hdlB--            Just . postProcess <$> readProcess' "diff" ["-u", fpA, fpB] ""--    postProcess :: String -> String-    postProcess = unlines . (["======"] ++) . map (concatMap char) . (++ ["======"]). lines where-        char '\r' = "{CR}"-        char c    = [c]--    readProcess' proc args input = do-        (_, out, _) <- readProcessWithExitCode proc args input-        return out--files :: Map.Map FilePath BS.ByteString-files = Map.fromList-    [ p "empty.fragment" ""--    , p "build-depends.fragment"-        "build-depends: base, doctest >=0.15 && <0.17, QuickCheck >=2.12 && <2.13, simple-example, template-haskell"--    , p "tested-with.fragment"-        "tested-with: GHC ==8.0.2"--    , p "common.fragment"-        "common deps\n  build-depends: base, bytestring, containers\n  ghc-options: -Wall"--    , p "multiple.fragment"-        "build-depends: base\nghc-options: -Wall"--    , p ("cbits" </> "header.h") "..."-    , p ("cbits" </> "source1.c") "..."-    , p ("cbits" </> "source2.c") "..."-    , p ("cbits" </> "sub" </> "source3.c") "..."-    ]-  where-    p x y = (x, BS8.pack y)

@@ -0,0 +1,109 @@+module Main (main) where++import System.FilePath            ((-<.>), (</>))+import System.IO                  (hClose, hFlush)+import System.IO.Temp             (withSystemTempFile)+import System.Process             (readProcessWithExitCode)+import Test.Tasty                 (TestTree, defaultMain, testGroup)+import Test.Tasty.Golden.Advanced (goldenTest)++import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Map              as Map++import CabalFmt         (cabalFmt)+import CabalFmt.Monad   (runCabalFmt)+import CabalFmt.Options (defaultOptions)+import CabalFmt.Prelude++main :: IO ()+main = defaultMain $ testGroup "tests"+    [ goldenTest' "cabal-fmt"+    , goldenTest' "Cabal"+    , goldenTest' "Cabal-notab"+    , goldenTest' "simple-example"+    , goldenTest' "tree-diff"++    , goldenTest' "fragment-missing"+    , goldenTest' "fragment-empty"+    , goldenTest' "fragment-wrong-field"+    , goldenTest' "fragment-wrong-type"+    , goldenTest' "fragment-multiple"+    , goldenTest' "fragment-section"++    , goldenTest' "issue69"+    , goldenTest' "issue29"+    ]++goldenTest' :: String -> TestTree+goldenTest' n = goldenTest n readGolden makeTest cmp writeGolden+  where+    goldenPath = "fixtures" </> n -<.> "format"+    inputPath  = "fixtures" </> n -<.> "cabal"++    readGolden  = BS.readFile goldenPath+    writeGolden = BS.writeFile goldenPath++    makeTest = do+        contents <- BS.readFile inputPath+        case runCabalFmt files defaultOptions $ cabalFmt inputPath contents of+            Left err            -> fail ("First pass: " ++ show err)+            Right (output', ws) -> do+                -- idempotent+                case runCabalFmt files defaultOptions $ cabalFmt inputPath (toUTF8BS output') of+                    Left err            -> fail ("Second pass: " ++ show err)+                    Right (output'', _) -> do+                        unless (output' == output'') $ do+                            putStrLn "<<<<<<<"+                            putStr output'+                            putStrLn "======="+                            putStr output''+                            putStrLn ">>>>>>>"+                            fail "Output not idempotent"+                        return (toUTF8BS $ unlines (map ("-- " ++) ws) ++ output')++    cmp a b | a == b    = return Nothing+            | otherwise =+        withSystemTempFile "cabal-fmt-test.txt" $ \fpA hdlA ->+        withSystemTempFile "cabal-fmt-test.txt" $ \fpB hdlB -> do+            BS.hPutStr hdlA a+            BS.hPutStr hdlB b+            hFlush hdlA+            hFlush hdlB+            hClose hdlA+            hClose hdlB++            Just . postProcess <$> readProcess' "diff" ["-u", fpA, fpB] ""++    postProcess :: String -> String+    postProcess = unlines . (["======"] ++) . map (concatMap char) . (++ ["======"]). lines where+        char '\r' = "{CR}"+        char c    = [c]++    readProcess' proc args input = do+        (_, out, _) <- readProcessWithExitCode proc args input+        return out++files :: Map.Map FilePath BS.ByteString+files = Map.fromList+    [ p "empty.fragment" ""++    , p "build-depends.fragment"+        "build-depends: base, doctest >=0.15 && <0.17, QuickCheck >=2.12 && <2.13, simple-example, template-haskell"++    , p "tested-with.fragment"+        "tested-with: GHC ==8.0.2"++    , p "common.fragment"+        "common deps\n  build-depends: base, bytestring, containers\n  ghc-options: -Wall"++    , p "multiple.fragment"+        "build-depends: base\nghc-options: -Wall"++    , p ("cbits" </> "header.h") "..."+    , p ("cbits" </> "source1.c") "..."+    , p ("cbits" </> "source2.c") "..."+    , p ("cbits" </> "sub" </> "source3.c") "..."+    ]+  where+    p x y = (x, BS8.pack y)