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 +9/−0
- cabal-fmt.cabal +4/−2
- cli/Main.hs +8/−0
- fixtures/fragment-empty.cabal +10/−0
- fixtures/fragment-empty.format +12/−0
- fixtures/fragment-missing.cabal +10/−0
- fixtures/fragment-missing.format +12/−0
- fixtures/fragment-multiple.cabal +10/−0
- fixtures/fragment-multiple.format +12/−0
- fixtures/fragment-section.cabal +12/−0
- fixtures/fragment-section.format +18/−0
- fixtures/fragment-wrong-field.cabal +10/−0
- fixtures/fragment-wrong-field.format +12/−0
- fixtures/fragment-wrong-type.cabal +10/−0
- fixtures/fragment-wrong-type.format +12/−0
- fixtures/simple-example.cabal +2/−5
- fixtures/simple-example.format +2/−0
- src/CabalFmt.hs +16/−8
- src/CabalFmt/Monad.hs +45/−10
- src/CabalFmt/Options.hs +2/−0
- src/CabalFmt/Pragma.hs +8/−0
- src/CabalFmt/Prelude.hs +5/−2
- src/CabalFmt/Refactoring.hs +1/−0
- src/CabalFmt/Refactoring/ExpandExposedModules.hs +0/−2
- src/CabalFmt/Refactoring/Fragments.hs +83/−0
- src/CabalFmt/Refactoring/Type.hs +18/−1
- tests/Golden.hs +39/−6
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)