Merge pull request #10683 from cabalism/add/fourmolu-on-off

Add `make style-todo` and fourmolu on off comments

Cabal-described/src/Distribution/Utils/CharSet.hs

@@ -114,7 +114,9 @@ member c (CS m) = go (IM.toList m)
     i = ord c
 
 -- | Insert 'Char' into 'CharSet'.
+{- FOURMOLU_DISABLE -}
 insert :: Char -> CharSet -> CharSet
+{- FOURMOLU_ENABLE -}
 insert c (CS m) = normalise (IM.insert (ord c) (ord c) m)
 
 -- | Union of two 'CharSet's.

Cabal-tests/tests/HackageTests.hs

@@ -301,6 +301,7 @@ roundtripTest testFieldsTransform fpath bs = do
         putStrLn bs'
         exitFailure
 
+{- FOURMOLU_DISABLE -}
     parse phase c = do
         let (_, x') = Parsec.runParseResult $
                       Parsec.parseGenericPackageDescription c
@@ -311,6 +312,7 @@ roundtripTest testFieldsTransform fpath bs = do
                 traverse_ print errs
                 B.putStr c
                 fail "parse error"
+{- FOURMOLU_ENABLE -}
 
 -------------------------------------------------------------------------------
 -- Main

Cabal-tests/tests/ParserTests.hs

@@ -200,12 +200,14 @@ regressionTests = testGroup "regressions"
 
 regressionTest :: FilePath -> TestTree
 regressionTest fp = testGroup fp
+{- FOURMOLU_DISABLE -}
     [ formatGoldenTest fp
     , formatRoundTripTest fp
 #ifdef MIN_VERSION_tree_diff
     , treeDiffGoldenTest fp
 #endif
     ]
+{- FOURMOLU_ENABLE -}
 
 formatGoldenTest :: FilePath -> TestTree
 formatGoldenTest fp = cabalGoldenTest "format" correct $ do
@@ -248,6 +250,7 @@ formatRoundTripTest fp = testCase "roundtrip" $ do
     y <- parse (toUTF8BS contents')
     -- previously we mangled licenses a bit
     let y' = y
+{- FOURMOLU_DISABLE -}
     unless (x == y') $
 #ifdef MIN_VERSION_tree_diff
         assertFailure $ unlines
@@ -273,6 +276,7 @@ formatRoundTripTest fp = testCase "roundtrip" $ do
                 void $ assertFailure $ unlines (map (showPError fp) $ NE.toList errs)
                 fail "failure"
     input = "tests" </> "ParserTests" </> "regressions" </> fp
+{- FOURMOLU_ENABLE -}
 
 -------------------------------------------------------------------------------
 -- InstalledPackageInfo regressions
@@ -287,13 +291,15 @@ ipiTests = testGroup "ipis"
     ]
 
 ipiTest :: FilePath -> TestTree
+{- FOURMOLU_DISABLE -}
 ipiTest fp = testGroup fp $
 #ifdef MIN_VERSION_tree_diff
     [ ipiTreeDiffGoldenTest fp ] ++
 #endif
     [ ipiFormatGoldenTest fp
     , ipiFormatRoundTripTest fp
     ]
+{- FOURMOLU_ENABLE -}
 
 ipiFormatGoldenTest :: FilePath -> TestTree
 ipiFormatGoldenTest fp = cabalGoldenTest "format" correct $ do

Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs

@@ -283,6 +283,7 @@ addDoctestsUserHook testsuiteName uh = uh
 
 -- | Convert only flags used by 'generateBuildModule'.
 haddockToBuildFlags :: HaddockFlags -> BuildFlags
+{- FOURMOLU_DISABLE -}
 haddockToBuildFlags f =
 #if MIN_VERSION_Cabal(3,11,0)
   emptyBuildFlags
@@ -293,6 +294,7 @@ haddockToBuildFlags f =
     , buildDistPref  = haddockDistPref f
     }
 #endif
+{- FOURMOLU_ENABLE -}
 
 data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show)
 
@@ -331,6 +333,7 @@ data Component = Component Name [String] [String] [String]
 generateBuildModule
     :: String -- ^ doctests test-suite name
     -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
+{- FOURMOLU_DISABLE -}
 generateBuildModule testSuiteName flags pkg lbi = do
   let verbosity = fromFlag (buildVerbosity flags)
   let distPref = fromFlag (buildDistPref flags)
@@ -581,6 +584,7 @@ generateBuildModule testSuiteName flags pkg lbi = do
 #else
     executableName = exeName
 #endif
+{- FOURMOLU_ENABLE -}
 
 -- | In compat settings it's better to omit the type-signature
 testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo

Cabal-tests/tests/custom-setup/IdrisSetup.hs

@@ -92,12 +92,14 @@ idrisCmd local = Px.joinPath $ splitDirectories $ ".." Px.</> ".." Px.</> bd Px.
 #else
 idrisCmd local = ".." </> ".." </> bd </> "idris" </> "idris"
 #endif
+{- FOURMOLU_DISABLE -}
   where
     bd =
 #if MIN_VERSION_Cabal(3,11,0)
         getSymbolicPath $
 #endif
         buildDir local
+{- FOURMOLU_ENABLE -}
 
 -- -----------------------------------------------------------------------------
 -- Make Commands
@@ -223,6 +225,7 @@ generateToolchainModule verbosity srcDir toolDir = do
     createDirectoryIfMissingVerbose verbosity True srcDir
     rewriteFileEx verbosity toolPath (commonContent ++ toolContent)
 
+{- FOURMOLU_DISABLE -}
 idrisConfigure _ flags pkgdesc local = do
     configureRTS
     withLibLBI pkgdesc local $ \_ libcfg -> do
@@ -256,6 +259,7 @@ idrisConfigure _ flags pkgdesc local = do
 #if !(MIN_VERSION_Cabal(2,0,0))
       autogenComponentModulesDir lbi _ = autogenModulesDir lbi
 #endif
+{- FOURMOLU_ENABLE -}
 
 #if !MIN_VERSION_Cabal(3,0,0)
 idrisPreSDist args flags = do
@@ -372,6 +376,7 @@ idrisInstall verbosity copy pkg local
 -- We want it to be the install directory where we put the idris libraries.
 fixPkg pkg target = pkg { dataDir = target }
 
+{- FOURMOLU_DISABLE -}
 idrisTestHook args pkg local hooks flags = do
   let target =
 #if MIN_VERSION_Cabal(3,11,0)
@@ -403,3 +408,4 @@ main = defaultMainWithHooks $ simpleUserHooks
 #endif
    , testHook = idrisTestHook
    }
+{- FOURMOLU_ENABLE -}

Makefile

@@ -27,18 +27,45 @@ init: ## Set up git hooks and ignored revisions.
 	@git config core.hooksPath .githooks
 	## TODO
 
+# NOTE: Keep this in sync with `.github/workflows/format.yml`.
+FORMAT_DIRS := \
+	Cabal \
+	Cabal-syntax \
+	cabal-install \
+	cabal-validate
+
+FORMAT_DIRS_TODO := \
+	Cabal-QuickCheck \
+	Cabal-described \
+	Cabal-hooks \
+	Cabal-tests \
+	Cabal-tree-diff \
+	bootstrap \
+	buildinfo-reference-generator \
+	cabal-benchmarks \
+	cabal-dev-scripts \
+	cabal-install-solver \
+	cabal-testsuite/main \
+	cabal-testsuite/src \
+	cabal-testsuite/static \
+	solver-benchmarks
+
+.PHONY: style-todo
+style-todo: ## Configured for fourmolu, avoiding GHC parser failures
+	@fourmolu -q $(FORMAT_DIRS_TODO) > /dev/null
+
 .PHONY: style
 style: ## Run the code styler.
-	@fourmolu -q -i Cabal Cabal-syntax cabal-install cabal-validate
+	@fourmolu -q -i $(FORMAT_DIRS)
 
 .PHONY: style-modified
 style-modified: ## Run the code styler on modified files.
-	@git ls-files --modified Cabal Cabal-syntax cabal-install cabal-validate \
+	@git ls-files --modified $(FORMAT_DIRS) \
 		| grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {}
 
 .PHONY: style-commit
 style-commit: ## Run the code styler on the previous commit.
-	@git diff --name-only HEAD $(COMMIT) Cabal Cabal-syntax cabal-install cabal-validate \
+	@git diff --name-only HEAD $(COMMIT) -- $(FORMAT_DIRS) \
 		| grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {}
 
 .PHONY: whitespace

cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs

@@ -171,6 +171,7 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
 --
 -- This only does something if the @debug-tracetree@ configure argument was
 -- given; otherwise this is just the identity function.
+{- FOURMOLU_DISABLE -}
 traceTree ::
 #ifdef DEBUG_TRACETREE
   GSimpleTree a =>
@@ -183,6 +184,7 @@ traceTree = gtraceJson
 #else
 traceTree _ _ = id
 #endif
+{- FOURMOLU_ENABLE -}
 
 #ifdef DEBUG_TRACETREE
 instance GSimpleTree (Tree d c) where

cabal-testsuite/src/Test/Cabal/Server.hs

@@ -253,6 +253,7 @@ startServer chan senv = do
 
 -- | Unmasked initialization for the server
 initServer :: Server -> IO Server
+{- FOURMOLU_DISABLE -}
 initServer s0 = do
     -- NB: withProcessHandle reads an MVar and is interruptible
 
@@ -275,6 +276,7 @@ initServer s0 = do
     write s ":set prompt \"\""
     write s "System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering"
     return s
+{- FOURMOLU_ENABLE -}
 
 -- | Stop a GHCi session.
 stopServer :: Server -> IO ()