packages feed

cabal-fmt 0.1.3 → 0.1.4

raw patch · 27 files changed

+382/−36 lines, 27 filesdep ~containersdep ~optparse-applicativePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: containers, optparse-applicative

API changes (from Hackage documentation)

- CabalFmt.Refactoring.ExpandExposedModules: type Refactoring' r m = [Field CommentsPragmas] -> m [Field CommentsPragmas]
+ CabalFmt.Monad: Contents :: ByteString -> Contents
+ CabalFmt.Monad: IOError :: String -> Contents
+ CabalFmt.Monad: NoIO :: Contents
+ CabalFmt.Monad: data Contents
+ CabalFmt.Monad: readFileBS :: MonadCabalFmt r m => FilePath -> m Contents
+ CabalFmt.Options: [optCabalFile] :: Options -> !Bool
+ CabalFmt.Pragma: PragmaFragment :: FilePath -> Pragma
+ CabalFmt.Prelude: asum :: (Foldable t, Alternative f) => t (f a) -> f a
+ CabalFmt.Prelude: unless :: Applicative f => Bool -> f () -> f ()
+ CabalFmt.Prelude: void :: Functor f => f a -> f ()
+ CabalFmt.Prelude: when :: Applicative f => Bool -> f () -> f ()
+ CabalFmt.Refactoring.Fragments: refactoringFragments :: Refactoring
+ CabalFmt.Refactoring.Type: rewriteFields :: Monad m => (Field CommentsPragmas -> m (Maybe (Field CommentsPragmas))) -> [Field CommentsPragmas] -> m [Field CommentsPragmas]
- CabalFmt.Monad: runCabalFmt :: Options -> CabalFmt a -> Either Error a
+ CabalFmt.Monad: runCabalFmt :: Map FilePath ByteString -> Options -> CabalFmt a -> Either Error (a, [String])
- CabalFmt.Options: Options :: !Bool -> !Int -> !Bool -> !CabalSpecVersion -> !Mode -> Options
+ CabalFmt.Options: Options :: !Bool -> !Int -> !Bool -> !Bool -> !CabalSpecVersion -> !Mode -> Options

Files

Changelog.md view
@@ -1,3 +1,12 @@+# 0.1.4++- Add `-n` / `--no-cabal-file` to format cabal like, but not package files.+  Useful to format `cabal.project` or `cabal.haskell-ci`.+- Add `fragment` pragma to substitute a field or a section with+  contents of external file.+  Useful in multi-package setting to keep for example+  `tested-with` field or `common deps` stanza in sync.+ # 0.1.3  - GHC-8.10 support. Require Cabal-3.2
cabal-fmt.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cabal-fmt-version:            0.1.3+version:            0.1.4 synopsis:           Format .cabal files category:           Development description:@@ -55,6 +55,7 @@     CabalFmt.Prelude     CabalFmt.Refactoring     CabalFmt.Refactoring.ExpandExposedModules+    CabalFmt.Refactoring.Fragments     CabalFmt.Refactoring.Type    other-extensions:@@ -83,7 +84,7 @@     , filepath    -- extra dependencies-  build-depends:    optparse-applicative >=0.14.3.0 && <0.16+  build-depends:    optparse-applicative >=0.14.3.0 && <0.17  test-suite golden   type:             exitcode-stdio-1.0@@ -97,6 +98,7 @@     , bytestring     , Cabal     , cabal-fmt-internal+    , containers    -- test dependencies   build-depends:
cli/Main.hs view
@@ -90,6 +90,8 @@         , indentP         , tabularP         , noTabularP+        , cabalFileP+        , noCabalFileP         , stdoutP         , inplaceP         , checkP@@ -109,6 +111,12 @@      noTabularP = O.flag' (mkOptionsMorphism $ \opts -> opts { optTabular = False })         $ O.long "no-tabular"++    cabalFileP = O.flag' (mkOptionsMorphism $ \opts -> opts { optCabalFile = True })+        $ O.long "cabal-file"++    noCabalFileP = O.flag' (mkOptionsMorphism $ \opts -> opts { optCabalFile = False })+        $ O.short 'n' <> O.long "no-cabal-file" <> O.help "Don't parse as .cabal file"      stdoutP = O.flag' (mkOptionsMorphism $ \opts -> opts { optMode = ModeStdout })         $ O.long "stdout" <> O.help "Write output to stdout (default)"
+ fixtures/fragment-empty.cabal view
@@ -0,0 +1,10 @@+cabal-version:       2.4+name:                fragment+version:             1++library+  exposed-modules:     Example+  -- cabal-fmt: fragment empty.fragment+  build-depends:       base >=4.3 && <4.13+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-empty.format view
@@ -0,0 +1,12 @@+-- Fragment empty.fragment is empty.+cabal-version: 2.4+name:          fragment+version:       1++library+  exposed-modules:  Example++  -- cabal-fmt: fragment empty.fragment+  build-depends:    base >=4.3 && <4.13+  hs-source-dirs:   src+  default-language: Haskell2010
+ fixtures/fragment-missing.cabal view
@@ -0,0 +1,10 @@+cabal-version:       2.4+name:                fragment+version:             1++library+  exposed-modules:     Example+  -- cabal-fmt: fragment missing.fragment+  build-depends:       base >=4.3 && <4.13+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-missing.format view
@@ -0,0 +1,12 @@+-- Fragment missing.fragment failed to read: "doesn't exist"+cabal-version: 2.4+name:          fragment+version:       1++library+  exposed-modules:  Example++  -- cabal-fmt: fragment missing.fragment+  build-depends:    base >=4.3 && <4.13+  hs-source-dirs:   src+  default-language: Haskell2010
+ fixtures/fragment-multiple.cabal view
@@ -0,0 +1,10 @@+cabal-version:       2.4+name:                fragment+version:             1++library+  exposed-modules:     Example+  -- cabal-fmt: fragment multiple.fragment+  build-depends:       base >=4.3 && <4.13+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-multiple.format view
@@ -0,0 +1,12 @@+-- Fragment multiple.fragment contains multiple fields or sections, using only the first.+cabal-version: 2.4+name:          fragment+version:       1++library+  exposed-modules:  Example++  -- cabal-fmt: fragment multiple.fragment+  build-depends:    base+  hs-source-dirs:   src+  default-language: Haskell2010
+ fixtures/fragment-section.cabal view
@@ -0,0 +1,12 @@+cabal-version:       2.4+name:                fragment+version:             1++-- cabal-fmt: fragment common.fragment+common deps++library+  import: deps+  exposed-modules:     Example+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-section.format view
@@ -0,0 +1,18 @@+cabal-version: 2.4+name:          fragment+version:       1++-- cabal-fmt: fragment common.fragment+common deps+  build-depends:+    , base+    , bytestring+    , containers++  ghc-options:   -Wall++library+  import:           deps+  exposed-modules:  Example+  hs-source-dirs:   src+  default-language: Haskell2010
+ fixtures/fragment-wrong-field.cabal view
@@ -0,0 +1,10 @@+cabal-version:       2.4+name:                fragment+version:             1++library+  exposed-modules:     Example+  -- cabal-fmt: fragment tested-with.fragment+  build-depends:       base >=4.3 && <4.13+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-wrong-field.format view
@@ -0,0 +1,12 @@+-- Fragment tested-with.fragment contains field "tested-with", expecting field "build-depends".+cabal-version: 2.4+name:          fragment+version:       1++library+  exposed-modules:  Example++  -- cabal-fmt: fragment tested-with.fragment+  build-depends:    base >=4.3 && <4.13+  hs-source-dirs:   src+  default-language: Haskell2010
+ fixtures/fragment-wrong-type.cabal view
@@ -0,0 +1,10 @@+cabal-version:       2.4+name:                fragment+version:             1++library+  exposed-modules:     Example+  -- cabal-fmt: fragment common.fragment+  build-depends:       base >=4.3 && <4.13+  hs-source-dirs:      src+  default-language:    Haskell2010
+ fixtures/fragment-wrong-type.format view
@@ -0,0 +1,12 @@+-- Fragment common.fragment contains a section "common deps", expecting field "build-depends".+cabal-version: 2.4+name:          fragment+version:       1++library+  exposed-modules:  Example++  -- cabal-fmt: fragment common.fragment+  build-depends:    base >=4.3 && <4.13+  hs-source-dirs:   src+  default-language: Haskell2010
fixtures/simple-example.cabal view
@@ -39,12 +39,9 @@ test-suite doctests   type:                exitcode-stdio-1.0   main-is:             doctests.hs++  -- cabal-fmt: fragment build-depends.fragment   build-depends:-    base,-    doctest >= 0.15 && <0.17,-    QuickCheck ==2.12.*,-    simple-example,-    template-haskell    ghc-options:         -Wall -threaded   hs-source-dirs:      tests
fixtures/simple-example.format view
@@ -45,6 +45,8 @@ test-suite doctests   type:             exitcode-stdio-1.0   main-is:          doctests.hs++  -- cabal-fmt: fragment build-depends.fragment   build-depends:       base     , doctest           >=0.15 && <0.17
src/CabalFmt.hs view
@@ -48,7 +48,6 @@  cabalFmt :: MonadCabalFmt r m => FilePath -> BS.ByteString -> m String cabalFmt filepath contents = do-    gpd          <- parseGpd filepath contents     inputFields' <- parseFields contents     let (inputFieldsC, endComments) = attachComments contents inputFields' @@ -62,16 +61,23 @@     inputFieldsR  <- foldM (&) inputFieldsP refactorings      -- options morphisms-    let pragmas = foldMap (foldMap snd) inputFieldsR <> endCommentsPragmas+    let pragmas :: [Pragma]+        pragmas = foldMap (foldMap snd) inputFieldsR <> endCommentsPragmas+         optsEndo :: OptionsMorphism         optsEndo = foldMap pragmaToOM pragmas -    let v = C.cabalSpecFromVersionDigits-          $ C.versionNumbers-          $ C.specVersion-          $ C.packageDescription gpd+    cabalFile <- asks (optCabalFile . view options)+    csv <- case cabalFile of+        False -> return C.cabalSpecLatest+        True  -> do+            gpd <- parseGpd filepath contents+            return $ C.cabalSpecFromVersionDigits+              $ C.versionNumbers+              $ C.specVersion+              $ C.packageDescription gpd -    local (over options $ \o -> runOptionsMorphism optsEndo $ o { optSpecVersion = v }) $ do+    local (over options $ \o -> runOptionsMorphism optsEndo $ o { optSpecVersion = csv }) $ do         indentWith <- asks (optIndent . view options)         let inputFields = fmap (fmap fst) inputFieldsR @@ -93,7 +99,8 @@  refactorings :: MonadCabalFmt r m => [Refactoring' r m] refactorings =-    [ refactoringExpandExposedModules+    [ refactoringFragments+    , refactoringExpandExposedModules     ]  -------------------------------------------------------------------------------@@ -166,3 +173,4 @@ pragmaToOM (PragmaOptIndent n)    = mkOptionsMorphism $ \opts -> opts { optIndent = n } pragmaToOM (PragmaOptTabular b)   = mkOptionsMorphism $ \opts -> opts { optTabular = b } pragmaToOM PragmaExpandModules {} = mempty+pragmaToOM PragmaFragment {}      = mempty
src/CabalFmt/Monad.hs view
@@ -3,13 +3,14 @@ -- Copyright: Oleg Grenrus {-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FunctionalDependencies     #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables        #-} module CabalFmt.Monad (     -- * Monad class     MonadCabalFmt (..),     getFiles,+    Contents (..),     -- * Pure implementation     CabalFmt,     runCabalFmt,@@ -18,15 +19,19 @@     runCabalFmtIO,     ) where -import Control.Exception      (catch, throwIO, try)+import Control.Exception      (IOException, catch, throwIO, try, displayException) import Control.Monad          (when) import Control.Monad.Except   (MonadError (..)) import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Reader   (MonadReader, ReaderT (..), runReaderT, asks)+import Control.Monad.Reader   (MonadReader (..), ReaderT (..), asks, runReaderT)+import Control.Monad.Writer   (WriterT, runWriterT, tell)+import Data.Bifunctor         (first)+import System.Exit            (exitFailure) import System.FilePath        ((</>)) import System.IO              (hPutStrLn, stderr)-import System.Exit (exitFailure) +import qualified Data.ByteString  as BS+import qualified Data.Map         as Map import qualified System.Directory as D  import CabalFmt.Error@@ -45,8 +50,16 @@ class (HasOptions r, MonadReader r m, MonadError Error m) => MonadCabalFmt r m | m -> r where     listDirectory      :: FilePath -> m [FilePath]     doesDirectoryExist :: FilePath -> m Bool++    readFileBS         :: FilePath -> m Contents+     displayWarning     :: String -> m () +data Contents+    = Contents BS.ByteString+    | NoIO+    | IOError String+ ------------------------------------------------------------------------------- -- Pure -------------------------------------------------------------------------------@@ -55,18 +68,30 @@ -- -- 'listDirectory' always return empty list. ---newtype CabalFmt a = CabalFmt { unCabalFmt :: ReaderT Options (Either Error) a }-  deriving newtype (Functor, Applicative, Monad, MonadError Error, MonadReader Options)+newtype CabalFmt a = CabalFmt { unCabalFmt :: ReaderT (Options, Map.Map FilePath BS.ByteString) (WriterT [String] (Either Error)) a }+  deriving newtype (Functor, Applicative, Monad, MonadError Error) +instance MonadReader Options CabalFmt where+    ask = CabalFmt $ asks fst++    local f (CabalFmt m) = CabalFmt $ local (first f) m+ instance MonadCabalFmt Options CabalFmt where     listDirectory _      = return []     doesDirectoryExist _ = return False+    readFileBS p         = CabalFmt $ do+        files <- asks snd+        return (maybe (IOError "doesn't exist") Contents $ Map.lookup p files)     displayWarning w     = do         werror <- asks optError-        when werror $ throwError $ WarningError w+        if werror+        then throwError $ WarningError w+        else CabalFmt $ tell [w] -runCabalFmt :: Options -> CabalFmt a -> Either Error a-runCabalFmt opts m = runReaderT (unCabalFmt m) opts+runCabalFmt+    :: Map.Map FilePath BS.ByteString -> Options+    -> CabalFmt a -> Either Error (a, [String])+runCabalFmt files opts m = runWriterT (runReaderT (unCabalFmt m) (opts, files))  ------------------------------------------------------------------------------- -- IO@@ -102,11 +127,21 @@         case rd of             Nothing -> return False             Just d  -> liftIO (D.doesDirectoryExist (d </> p))-    displayWarning w   = do+    readFileBS p = do+        rd <- asks optRootDir+        case rd of+            Nothing -> return NoIO+            Just d  -> liftIO $ catchIOError $ BS.readFile (d </> p)+    displayWarning w = do         werror <- asks (optError . optOpt)         liftIO $ do             hPutStrLn stderr $ (if werror then "ERROR: " else "WARNING: ") ++ w             when werror exitFailure++catchIOError :: IO BS.ByteString -> IO Contents+catchIOError m = catch (fmap Contents m) handler where+    handler :: IOException -> IO Contents+    handler exc = return (IOError (displayException exc))  runCabalFmtIO :: Maybe FilePath -> Options -> CabalFmtIO a -> IO (Either Error a) runCabalFmtIO mfp opts m = try $ runReaderT (unCabalFmtIO m) (Options' mfp opts)
src/CabalFmt/Options.hs view
@@ -23,6 +23,7 @@     { optError       :: !Bool     , optIndent      :: !Int     , optTabular     :: !Bool+    , optCabalFile   :: !Bool     , optSpecVersion :: !C.CabalSpecVersion     , optMode        :: !Mode     }@@ -33,6 +34,7 @@     { optError       = False     , optIndent      = 2     , optTabular     = True+    , optCabalFile   = True     , optSpecVersion = C.cabalSpecLatest     , optMode        = ModeStdout     }
src/CabalFmt/Pragma.hs view
@@ -14,6 +14,7 @@     = PragmaOptIndent Int     | PragmaOptTabular Bool     | PragmaExpandModules FilePath [C.ModuleName]+    | PragmaFragment FilePath   deriving (Show)  -- | Parse pragma from 'ByteString'.@@ -38,6 +39,7 @@             "indent"     -> indent             "tabular"    -> return $ PragmaOptTabular True             "no-tabular" -> return $ PragmaOptTabular False+            "fragment"   -> fragment             _            -> fail $ "Unknown pragma " ++ t      expandModules :: C.ParsecParser Pragma@@ -52,6 +54,12 @@         C.spaces         n <- C.integral         return $ PragmaOptIndent n++    fragment :: C.ParsecParser Pragma+    fragment = do+        C.spaces+        fn <- C.parsecToken+        return (PragmaFragment fn)  stripWhitespace :: ByteString -> ByteString stripWhitespace bs = case BS.uncons bs of
src/CabalFmt/Prelude.hs view
@@ -6,6 +6,8 @@ module CabalFmt.Prelude (     -- * Control.Arrow     (&&&),+    -- * Control.Monad+    when, unless, void,     -- * Data.Bifunctor     bimap,     -- * Data.Char@@ -13,7 +15,7 @@     -- * Data.Either     partitionEithers,     -- * Data.Foldable-    toList, traverse_,+    toList, traverse_, asum,     -- * Data.Function     on, (&),     -- * Data.List@@ -43,12 +45,13 @@     ) where  import Control.Arrow               ((&&&))+import Control.Monad               (unless, void, when) import Control.Monad.Except        (catchError, throwError) import Data.Bifunctor              (bimap) import Data.ByteString             (ByteString) import Data.Char                   (toLower) import Data.Either                 (partitionEithers)-import Data.Foldable               (toList, traverse_)+import Data.Foldable               (asum, toList, traverse_) import Data.Function               (on, (&)) import Data.List                   (intercalate, nub, sortBy, sortOn) import Data.Maybe                  (catMaybes, fromMaybe, isJust, isNothing)
src/CabalFmt/Refactoring.hs view
@@ -6,4 +6,5 @@     ) where  import CabalFmt.Refactoring.ExpandExposedModules as X+import CabalFmt.Refactoring.Fragments            as X import CabalFmt.Refactoring.Type                 as X
src/CabalFmt/Refactoring/ExpandExposedModules.hs view
@@ -4,8 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-} module CabalFmt.Refactoring.ExpandExposedModules (-    Refactoring,-    Refactoring',     refactoringExpandExposedModules,     ) where 
+ src/CabalFmt/Refactoring/Fragments.hs view
@@ -0,0 +1,83 @@+-- |+-- License: GPL-3.0-or-later+-- Copyright: Oleg Grenrus+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+module CabalFmt.Refactoring.Fragments (+    refactoringFragments,+    ) where++import Text.PrettyPrint (hsep, render)++import qualified Distribution.Fields        as C+import qualified Distribution.Fields.Field  as C+import qualified Distribution.Fields.Pretty as C++import CabalFmt.Comments+import CabalFmt.Monad+import CabalFmt.Parser+import CabalFmt.Pragma+import CabalFmt.Prelude+import CabalFmt.Refactoring.Type++refactoringFragments :: Refactoring+refactoringFragments = rewriteFields refact where+    refact :: MonadCabalFmt r m => C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas))+    refact field = do+        parse (getPragmas field) >>= \mp -> case mp of+            Nothing -> pure Nothing+            Just p  -> readFileBS p >>= \mcontents -> case mcontents of+                NoIO -> pure Nothing+                IOError err -> do+                    displayWarning $ "Fragment " ++ p ++ " failed to read: " ++ show err+                    pure Nothing+                Contents c  -> do+                    fields <- parseFields c+                    case (field, fields) of+                        (_, []) -> do+                            displayWarning $ "Fragment " ++ p ++ " is empty."+                            pure Nothing++                        (C.Field (C.Name _ n) _, C.Section name@(C.Name _ _) arg _ : _) -> do+                            displayWarning $ "Fragment " ++ p ++ " contains a section " ++ showSection name arg ++ ", expecting field " ++ show n ++ "."+                            pure Nothing+                        (C.Section name@(C.Name _ _) arg _, C.Field (C.Name _ n') _ : _) -> do+                            displayWarning $ "Fragment " ++ p ++ " contains a field " ++ show n' ++ ", expection section " ++ showSection name arg ++ "."+                            pure Nothing++                        (C.Field name@(C.Name _ n) _, C.Field (C.Name _ n') fls' : rest) -> do+                            unless (null rest) $+                                displayWarning $ "Fragment " ++ p ++ " contains multiple fields or sections, using only the first."+                            if n == n'+                            then do+                                -- everything is fine, replace+                                pure (Just (C.Field name (noCommentsPragmas fls')))+                            else do+                                displayWarning $ "Fragment " ++ p ++ " contains field " ++ show n' ++ ", expecting field " ++ show n ++ "."+                                pure Nothing++                        (C.Section name@(C.Name _ _) arg _, C.Section name'@(C.Name _ _) arg' fs' : rest) -> do+                            unless (null rest) $+                                displayWarning $ "Fragment " ++ p ++ " contains multiple fields or sections, using only the first."++                            if (void name == void name' && map void arg == map void arg')+                            then do+                                pure (Just (C.Section name arg (noCommentsPragmas fs')))+                            else do+                                displayWarning $ "Fragment " ++ p ++ " contains a section " ++ showSection name arg ++ ", expection section " ++ showSection name' arg' ++ "."+                                pure Nothing++    noCommentsPragmas :: Functor f => [f ann] -> [f CommentsPragmas]+    noCommentsPragmas = map ((Comments [], []) <$)++    getPragmas :: C.Field CommentsPragmas -> [Pragma]+    getPragmas = snd . C.fieldAnn++    showSection :: C.Name ann -> [C.SectionArg ann] -> String+    showSection (C.Name _ n) []   = show n+    showSection (C.Name _ n) args = show (fromUTF8BS n ++ " " ++ render (hsep (C.prettySectionArgs n args)))++    parse :: MonadCabalFmt r m => [Pragma] -> m (Maybe FilePath)+    parse = fmap asum . traverse go where+        go (PragmaFragment f) = return (Just f)+        go _                  = return Nothing
src/CabalFmt/Refactoring/Type.hs view
@@ -9,7 +9,8 @@     RefactoringOfField,     RefactoringOfField',     CommentsPragmas,-    traverseFields+    traverseFields,+    rewriteFields,     ) where  import qualified Distribution.Fields       as C@@ -45,3 +46,19 @@      go (C.Field name fls)       = uncurry C.Field <$> f name fls     go (C.Section name args fs) = C.Section name args <$> goMany fs++-- | A top-to-bottom rewrite of sections and fields+rewriteFields+    :: Monad m+    => (C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas)))+    -> [C.Field CommentsPragmas] -> m [C.Field CommentsPragmas]+rewriteFields f = goMany where+    goMany = traverse go++    go x = do+        m <- f x+        case m of+            Just y -> return y+            Nothing -> case x of+                C.Field {}             -> return x+                C.Section name args fs -> C.Section name args <$> goMany fs
tests/Golden.hs view
@@ -1,14 +1,16 @@ module Main (main) where -import Distribution.Simple.Utils  (fromUTF8BS, toUTF8BS) import System.FilePath            ((-<.>), (</>)) 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       as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Map              as Map  import CabalFmt         (cabalFmt)+import CabalFmt.Prelude import CabalFmt.Monad   (runCabalFmt) import CabalFmt.Options (defaultOptions) @@ -17,6 +19,13 @@     [ goldenTest' "cabal-fmt"     , goldenTest' "Cabal"     , goldenTest' "simple-example"++    , goldenTest' "fragment-missing"+    , goldenTest' "fragment-empty"+    , goldenTest' "fragment-wrong-field"+    , goldenTest' "fragment-wrong-type"+    , goldenTest' "fragment-multiple"+    , goldenTest' "fragment-section"     ]  goldenTest' :: String -> TestTree@@ -30,14 +39,38 @@      makeTest = do         contents <- BS.readFile inputPath-        case runCabalFmt defaultOptions $ cabalFmt inputPath contents of-            Right output' -> return (toUTF8BS output')-            Left err      -> fail (show err)+        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 = Just <$> readProcess' "diff" ["-u", goldenPath, "-"] (fromUTF8BS b) -     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"+    ]+  where+    p x y = (x, BS8.pack y)