Merge pull request NixOS#185 from NixOS/treefmt

Ensure formatted Nix and Haskell files

.github/workflows/main.yml

@@ -23,6 +23,9 @@ jobs:
       - name: hlint
         run: nix-build -A checks.hlint
 
+      - name: treefmt
+        run: nix-build -A checks.treefmt
+
       - name: build nixfmt
         run: nix-build
         if: success() || failure()

default.nix

@@ -39,6 +39,20 @@ let
     haskell.lib.dontHaddock
     (drv: lib.lazyDerivation { derivation = drv; })
   ];
+
+  treefmtEval = (import sources.treefmt-nix).evalModule pkgs {
+    # Used to find the project root
+    projectRootFile = ".git/config";
+
+    # This uses the version from Nixpkgs instead of the local one,
+    # which would require building the package to get a development shell
+    programs.nixfmt-rfc-style.enable = true;
+    # We don't want to format the files we use to test the formatter!
+    settings.formatter.nixfmt-rfc-style.excludes = [ "test/*" ];
+
+    # Haskell formatter
+    programs.fourmolu.enable = true;
+  };
 in
 build
 // {
@@ -56,11 +70,17 @@ build
       shellcheck
       npins
       hlint
+      treefmtEval.config.build.wrapper
     ];
   };
 
   checks = {
     hlint = pkgs.build.haskell.hlint src;
-    stylish-haskell = pkgs.build.haskell.stylish-haskell ./.;
+    treefmt = treefmtEval.config.build.check (
+      lib.fileset.toSource {
+        root = ./.;
+        fileset = lib.fileset.gitTracked ./.;
+      }
+    );
   };
 }

fourmolu.yaml

@@ -0,0 +1,51 @@
+# Number of spaces per indentation step
+indentation: 2
+
+# Max line length for automatic line breaking
+column-limit: none
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: trailing
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: trailing
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
+import-export-style: diff-friendly
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: true
+
+# Whether to leave a space before an opening record brace
+record-brace-space: false
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: single-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
+let-style: inline
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: no-space
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: always
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: true
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports: []
+

main/Main.hs

@@ -1,97 +1,108 @@
-{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns, MultiWayIf #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Main where
 
 import Control.Concurrent (Chan, forkIO, newChan, readChan, writeChan)
 import Data.Either (lefts)
-import Data.Text (Text)
 import Data.List (isSuffixOf)
+import Data.Text (Text)
+import qualified Data.Text.IO as TextIO (getContents, hPutStr, putStr)
 import Data.Version (showVersion)
 import GHC.IO.Encoding (utf8)
+import qualified Nixfmt
 import Paths_nixfmt (version)
-import System.Console.CmdArgs
-  (Data, Typeable, args, cmdArgs, help, summary, typ, (&=))
-import System.Exit (ExitCode(..), exitFailure, exitSuccess)
+import System.Console.CmdArgs (
+  Data,
+  Typeable,
+  args,
+  cmdArgs,
+  help,
+  summary,
+  typ,
+  (&=),
+ )
+import System.Directory (doesDirectoryExist, listDirectory)
+import System.Exit (ExitCode (..), exitFailure, exitSuccess)
 import System.FilePath ((</>))
 import System.IO (hPutStrLn, hSetEncoding, stderr)
-import System.Posix.Process (exitImmediately)
-import System.Posix.Signals (Handler(..), installHandler, keyboardSignal)
-import System.Directory (listDirectory, doesDirectoryExist)
-
-import qualified Data.Text.IO as TextIO (getContents, hPutStr, putStr)
-
-import qualified Nixfmt
 import System.IO.Atomic (withOutputFile)
 import System.IO.Utf8 (readFileUtf8, withUtf8StdHandles)
+import System.Posix.Process (exitImmediately)
+import System.Posix.Signals (Handler (..), installHandler, keyboardSignal)
 
 type Result = Either String ()
+
 type Width = Int
 
 data Nixfmt = Nixfmt
-    { files :: [FilePath]
-    , width :: Width
-    , check :: Bool
-    , quiet :: Bool
-    , verify :: Bool
-    } deriving (Show, Data, Typeable)
+  { files :: [FilePath],
+    width :: Width,
+    check :: Bool,
+    quiet :: Bool,
+    verify :: Bool
+  }
+  deriving (Show, Data, Typeable)
 
 options :: Nixfmt
 options =
   let defaultWidth = 100
       addDefaultHint value message =
         message ++ "\n[default: " ++ show value ++ "]"
-   in Nixfmt
-        { files = [] &= args &= typ "FILES"
-        , width =
-            defaultWidth &=
-            help (addDefaultHint defaultWidth "Maximum width in characters")
-        , check = False &= help "Check whether files are formatted without modifying them"
-        , quiet = False &= help "Do not report errors"
-        , verify =
-            False &=
-            help
+  in Nixfmt
+      { files = [] &= args &= typ "FILES",
+        width =
+          defaultWidth
+            &= help (addDefaultHint defaultWidth "Maximum width in characters"),
+        check = False &= help "Check whether files are formatted without modifying them",
+        quiet = False &= help "Do not report errors",
+        verify =
+          False
+            &= help
               "Apply sanity checks on the output after formatting"
-        } &=
-      summary ("nixfmt v" ++ showVersion version) &=
-      help "Format Nix source code"
+      }
+      &= summary ("nixfmt v" ++ showVersion version)
+      &= help "Format Nix source code"
 
 data Target = Target
-    { tDoRead :: IO Text
-    , tPath :: FilePath
-      -- The bool is true when the formatted file differs from the input
-    , tDoWrite :: Bool -> Text -> IO ()
-    }
+  { tDoRead :: IO Text,
+    tPath :: FilePath,
+    -- The bool is true when the formatted file differs from the input
+    tDoWrite :: Bool -> Text -> IO ()
+  }
 
 -- | Recursively collect nix files in a directory
 collectNixFiles :: FilePath -> IO [FilePath]
 collectNixFiles path = do
   dir <- doesDirectoryExist path
-  if | dir -> do
-         files <- listDirectory path
-         concat <$> mapM collectNixFiles ((path </>) <$> files)
-     | ".nix" `isSuffixOf` path -> pure [path]
-     | otherwise -> pure []
+  if
+    | dir -> do
+        files <- listDirectory path
+        concat <$> mapM collectNixFiles ((path </>) <$> files)
+    | ".nix" `isSuffixOf` path -> pure [path]
+    | otherwise -> pure []
 
 -- | Recursively collect nix files in a list of directories
 collectAllNixFiles :: [FilePath] -> IO [FilePath]
 collectAllNixFiles paths = concat <$> mapM collectNixFiles paths
 
 formatTarget :: Formatter -> Target -> IO Result
 formatTarget format Target{tDoRead, tPath, tDoWrite} = do
-    contents <- tDoRead
-    let formatResult = format tPath contents
-    mapM (\formatted -> tDoWrite (formatted /= contents) formatted) formatResult
+  contents <- tDoRead
+  let formatResult = format tPath contents
+  mapM (\formatted -> tDoWrite (formatted /= contents) formatted) formatResult
 
 -- | Return an error if target could not be parsed or was not formatted
 -- correctly.
 checkTarget :: Formatter -> Target -> IO Result
 checkTarget format Target{tDoRead, tPath} = do
-    contents <- tDoRead
-    return $ case format tPath contents of
-        Left err -> Left err
-        Right formatted
-            | formatted == contents -> Right ()
-            | otherwise             -> Left $ tPath ++ ": not formatted"
+  contents <- tDoRead
+  return $ case format tPath contents of
+    Left err -> Left err
+    Right formatted
+      | formatted == contents -> Right ()
+      | otherwise -> Left $ tPath ++ ": not formatted"
 
 stdioTarget :: Target
 stdioTarget = Target TextIO.getContents "<stdin>" (const TextIO.putStr)
@@ -109,26 +120,26 @@ checkFileTarget :: FilePath -> Target
 checkFileTarget path = Target (readFileUtf8 path) path (const $ const $ pure ())
 
 toTargets :: Nixfmt -> IO [Target]
-toTargets Nixfmt{ files = [] }    = pure [stdioTarget]
-toTargets Nixfmt{ files = ["-"] } = pure [stdioTarget]
-toTargets Nixfmt{ check = False, files = paths } = map fileTarget <$> collectAllNixFiles paths
-toTargets Nixfmt{ check = True, files = paths } = map checkFileTarget <$> collectAllNixFiles paths
+toTargets Nixfmt{files = []} = pure [stdioTarget]
+toTargets Nixfmt{files = ["-"]} = pure [stdioTarget]
+toTargets Nixfmt{check = False, files = paths} = map fileTarget <$> collectAllNixFiles paths
+toTargets Nixfmt{check = True, files = paths} = map checkFileTarget <$> collectAllNixFiles paths
 
 type Formatter = FilePath -> Text -> Either String Text
 
 toFormatter :: Nixfmt -> Formatter
-toFormatter Nixfmt{ width, verify = True  } = Nixfmt.formatVerify width
-toFormatter Nixfmt{ width, verify = False } = Nixfmt.format width
+toFormatter Nixfmt{width, verify = True} = Nixfmt.formatVerify width
+toFormatter Nixfmt{width, verify = False} = Nixfmt.format width
 
 type Operation = Formatter -> Target -> IO Result
 
 toOperation :: Nixfmt -> Operation
-toOperation Nixfmt{ check = True } = checkTarget
-toOperation Nixfmt{ } = formatTarget
+toOperation Nixfmt{check = True} = checkTarget
+toOperation Nixfmt{} = formatTarget
 
 toWriteError :: Nixfmt -> String -> IO ()
-toWriteError Nixfmt{ quiet = False } = hPutStrLn stderr
-toWriteError Nixfmt{ quiet = True } = const $ return ()
+toWriteError Nixfmt{quiet = False} = hPutStrLn stderr
+toWriteError Nixfmt{quiet = True} = const $ return ()
 
 toJobs :: Nixfmt -> IO [IO Result]
 toJobs opts = map (toOperation opts $ toFormatter opts) <$> toTargets opts
@@ -141,36 +152,39 @@ doParallel = sequence
 
 errorWriter :: (String -> IO ()) -> Chan (Maybe String) -> Chan () -> IO ()
 errorWriter doWrite chan done = do
-    item <- readChan chan
-    case item of
-         Nothing  -> return ()
-         Just msg -> doWrite msg >> errorWriter doWrite chan done
-    writeChan done ()
+  item <- readChan chan
+  case item of
+    Nothing -> return ()
+    Just msg -> doWrite msg >> errorWriter doWrite chan done
+  writeChan done ()
 
 writeErrorBundle :: Chan (Maybe String) -> Result -> IO Result
 writeErrorBundle chan result = do
-    case result of
-         Right () -> return ()
-         Left err -> writeChan chan $ Just err
-    return result
+  case result of
+    Right () -> return ()
+    Left err -> writeChan chan $ Just err
+  return result
 
 -- | Run a list of jobs and write errors to stderr without interleaving them.
 runJobs :: (String -> IO ()) -> [IO Result] -> IO [Result]
 runJobs writeError jobs = do
-    errChan <- newChan
-    doneChan <- newChan
-    _ <- forkIO $ errorWriter writeError errChan doneChan
-    results <- doParallel $ map (>>= writeErrorBundle errChan) jobs
-    writeChan errChan Nothing
-    _ <- readChan doneChan
-    return results
+  errChan <- newChan
+  doneChan <- newChan
+  _ <- forkIO $ errorWriter writeError errChan doneChan
+  results <- doParallel $ map (>>= writeErrorBundle errChan) jobs
+  writeChan errChan Nothing
+  _ <- readChan doneChan
+  return results
 
 main :: IO ()
 main = withUtf8StdHandles $ do
-    _ <- installHandler keyboardSignal
-            (Catch (exitImmediately $ ExitFailure 2)) Nothing
-    opts <- cmdArgs options
-    results <- runJobs (toWriteError opts) =<< toJobs opts
-    case lefts results of
-         [] -> exitSuccess
-         _  -> exitFailure
+  _ <-
+    installHandler
+      keyboardSignal
+      (Catch (exitImmediately $ ExitFailure 2))
+      Nothing
+  opts <- cmdArgs options
+  results <- runJobs (toWriteError opts) =<< toJobs opts
+  case lefts results of
+    [] -> exitSuccess
+    _ -> exitFailure