Skip to content

Commit a8b578d

Browse files
authored
Merge pull request #185 from NixOS/treefmt
Ensure formatted Nix and Haskell files
2 parents 87c4879 + 27f8016 commit a8b578d

File tree

15 files changed

+1993
-1641
lines changed

15 files changed

+1993
-1641
lines changed

.github/workflows/main.yml

+3
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,9 @@ jobs:
2323
- name: hlint
2424
run: nix-build -A checks.hlint
2525

26+
- name: treefmt
27+
run: nix-build -A checks.treefmt
28+
2629
- name: build nixfmt
2730
run: nix-build
2831
if: success() || failure()

default.nix

+21-1
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,20 @@ let
3939
haskell.lib.dontHaddock
4040
(drv: lib.lazyDerivation { derivation = drv; })
4141
];
42+
43+
treefmtEval = (import sources.treefmt-nix).evalModule pkgs {
44+
# Used to find the project root
45+
projectRootFile = ".git/config";
46+
47+
# This uses the version from Nixpkgs instead of the local one,
48+
# which would require building the package to get a development shell
49+
programs.nixfmt-rfc-style.enable = true;
50+
# We don't want to format the files we use to test the formatter!
51+
settings.formatter.nixfmt-rfc-style.excludes = [ "test/*" ];
52+
53+
# Haskell formatter
54+
programs.fourmolu.enable = true;
55+
};
4256
in
4357
build
4458
// {
@@ -56,11 +70,17 @@ build
5670
shellcheck
5771
npins
5872
hlint
73+
treefmtEval.config.build.wrapper
5974
];
6075
};
6176

6277
checks = {
6378
hlint = pkgs.build.haskell.hlint src;
64-
stylish-haskell = pkgs.build.haskell.stylish-haskell ./.;
79+
treefmt = treefmtEval.config.build.check (
80+
lib.fileset.toSource {
81+
root = ./.;
82+
fileset = lib.fileset.gitTracked ./.;
83+
}
84+
);
6585
};
6686
}

fourmolu.yaml

+51
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
# Number of spaces per indentation step
2+
indentation: 2
3+
4+
# Max line length for automatic line breaking
5+
column-limit: none
6+
7+
# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
8+
function-arrows: trailing
9+
10+
# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
11+
comma-style: trailing
12+
13+
# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
14+
import-export-style: diff-friendly
15+
16+
# Whether to full-indent or half-indent 'where' bindings past the preceding body
17+
indent-wheres: true
18+
19+
# Whether to leave a space before an opening record brace
20+
record-brace-space: false
21+
22+
# Number of spaces between top-level declarations
23+
newlines-between-decls: 1
24+
25+
# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
26+
haddock-style: single-line
27+
28+
# How to print module docstring
29+
haddock-style-module: null
30+
31+
# Styling of let blocks (choices: auto, inline, newline, or mixed)
32+
let-style: inline
33+
34+
# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
35+
in-style: no-space
36+
37+
# Whether to put parentheses around a single constraint (choices: auto, always, or never)
38+
single-constraint-parens: always
39+
40+
# Output Unicode syntax (choices: detect, always, or never)
41+
unicode: never
42+
43+
# Give the programmer more choice on where to insert blank lines
44+
respectful: true
45+
46+
# Fixity information for operators
47+
fixities: []
48+
49+
# Module reexports Fourmolu should know about
50+
reexports: []
51+

main/Main.hs

+97-83
Original file line numberDiff line numberDiff line change
@@ -1,97 +1,108 @@
1-
{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns, MultiWayIf #-}
1+
{-# LANGUAGE DeriveDataTypeable #-}
2+
{-# LANGUAGE MultiWayIf #-}
3+
{-# LANGUAGE NamedFieldPuns #-}
24

35
module Main where
46

57
import Control.Concurrent (Chan, forkIO, newChan, readChan, writeChan)
68
import Data.Either (lefts)
7-
import Data.Text (Text)
89
import Data.List (isSuffixOf)
10+
import Data.Text (Text)
11+
import qualified Data.Text.IO as TextIO (getContents, hPutStr, putStr)
912
import Data.Version (showVersion)
1013
import GHC.IO.Encoding (utf8)
14+
import qualified Nixfmt
1115
import Paths_nixfmt (version)
12-
import System.Console.CmdArgs
13-
(Data, Typeable, args, cmdArgs, help, summary, typ, (&=))
14-
import System.Exit (ExitCode(..), exitFailure, exitSuccess)
16+
import System.Console.CmdArgs (
17+
Data,
18+
Typeable,
19+
args,
20+
cmdArgs,
21+
help,
22+
summary,
23+
typ,
24+
(&=),
25+
)
26+
import System.Directory (doesDirectoryExist, listDirectory)
27+
import System.Exit (ExitCode (..), exitFailure, exitSuccess)
1528
import System.FilePath ((</>))
1629
import System.IO (hPutStrLn, hSetEncoding, stderr)
17-
import System.Posix.Process (exitImmediately)
18-
import System.Posix.Signals (Handler(..), installHandler, keyboardSignal)
19-
import System.Directory (listDirectory, doesDirectoryExist)
20-
21-
import qualified Data.Text.IO as TextIO (getContents, hPutStr, putStr)
22-
23-
import qualified Nixfmt
2430
import System.IO.Atomic (withOutputFile)
2531
import System.IO.Utf8 (readFileUtf8, withUtf8StdHandles)
32+
import System.Posix.Process (exitImmediately)
33+
import System.Posix.Signals (Handler (..), installHandler, keyboardSignal)
2634

2735
type Result = Either String ()
36+
2837
type Width = Int
2938

3039
data Nixfmt = Nixfmt
31-
{ files :: [FilePath]
32-
, width :: Width
33-
, check :: Bool
34-
, quiet :: Bool
35-
, verify :: Bool
36-
} deriving (Show, Data, Typeable)
40+
{ files :: [FilePath],
41+
width :: Width,
42+
check :: Bool,
43+
quiet :: Bool,
44+
verify :: Bool
45+
}
46+
deriving (Show, Data, Typeable)
3747

3848
options :: Nixfmt
3949
options =
4050
let defaultWidth = 100
4151
addDefaultHint value message =
4252
message ++ "\n[default: " ++ show value ++ "]"
43-
in Nixfmt
44-
{ files = [] &= args &= typ "FILES"
45-
, width =
46-
defaultWidth &=
47-
help (addDefaultHint defaultWidth "Maximum width in characters")
48-
, check = False &= help "Check whether files are formatted without modifying them"
49-
, quiet = False &= help "Do not report errors"
50-
, verify =
51-
False &=
52-
help
53+
in Nixfmt
54+
{ files = [] &= args &= typ "FILES",
55+
width =
56+
defaultWidth
57+
&= help (addDefaultHint defaultWidth "Maximum width in characters"),
58+
check = False &= help "Check whether files are formatted without modifying them",
59+
quiet = False &= help "Do not report errors",
60+
verify =
61+
False
62+
&= help
5363
"Apply sanity checks on the output after formatting"
54-
} &=
55-
summary ("nixfmt v" ++ showVersion version) &=
56-
help "Format Nix source code"
64+
}
65+
&= summary ("nixfmt v" ++ showVersion version)
66+
&= help "Format Nix source code"
5767

5868
data Target = Target
59-
{ tDoRead :: IO Text
60-
, tPath :: FilePath
61-
-- The bool is true when the formatted file differs from the input
62-
, tDoWrite :: Bool -> Text -> IO ()
63-
}
69+
{ tDoRead :: IO Text,
70+
tPath :: FilePath,
71+
-- The bool is true when the formatted file differs from the input
72+
tDoWrite :: Bool -> Text -> IO ()
73+
}
6474

6575
-- | Recursively collect nix files in a directory
6676
collectNixFiles :: FilePath -> IO [FilePath]
6777
collectNixFiles path = do
6878
dir <- doesDirectoryExist path
69-
if | dir -> do
70-
files <- listDirectory path
71-
concat <$> mapM collectNixFiles ((path </>) <$> files)
72-
| ".nix" `isSuffixOf` path -> pure [path]
73-
| otherwise -> pure []
79+
if
80+
| dir -> do
81+
files <- listDirectory path
82+
concat <$> mapM collectNixFiles ((path </>) <$> files)
83+
| ".nix" `isSuffixOf` path -> pure [path]
84+
| otherwise -> pure []
7485

7586
-- | Recursively collect nix files in a list of directories
7687
collectAllNixFiles :: [FilePath] -> IO [FilePath]
7788
collectAllNixFiles paths = concat <$> mapM collectNixFiles paths
7889

7990
formatTarget :: Formatter -> Target -> IO Result
8091
formatTarget format Target{tDoRead, tPath, tDoWrite} = do
81-
contents <- tDoRead
82-
let formatResult = format tPath contents
83-
mapM (\formatted -> tDoWrite (formatted /= contents) formatted) formatResult
92+
contents <- tDoRead
93+
let formatResult = format tPath contents
94+
mapM (\formatted -> tDoWrite (formatted /= contents) formatted) formatResult
8495

8596
-- | Return an error if target could not be parsed or was not formatted
8697
-- correctly.
8798
checkTarget :: Formatter -> Target -> IO Result
8899
checkTarget format Target{tDoRead, tPath} = do
89-
contents <- tDoRead
90-
return $ case format tPath contents of
91-
Left err -> Left err
92-
Right formatted
93-
| formatted == contents -> Right ()
94-
| otherwise -> Left $ tPath ++ ": not formatted"
100+
contents <- tDoRead
101+
return $ case format tPath contents of
102+
Left err -> Left err
103+
Right formatted
104+
| formatted == contents -> Right ()
105+
| otherwise -> Left $ tPath ++ ": not formatted"
95106

96107
stdioTarget :: Target
97108
stdioTarget = Target TextIO.getContents "<stdin>" (const TextIO.putStr)
@@ -109,26 +120,26 @@ checkFileTarget :: FilePath -> Target
109120
checkFileTarget path = Target (readFileUtf8 path) path (const $ const $ pure ())
110121

111122
toTargets :: Nixfmt -> IO [Target]
112-
toTargets Nixfmt{ files = [] } = pure [stdioTarget]
113-
toTargets Nixfmt{ files = ["-"] } = pure [stdioTarget]
114-
toTargets Nixfmt{ check = False, files = paths } = map fileTarget <$> collectAllNixFiles paths
115-
toTargets Nixfmt{ check = True, files = paths } = map checkFileTarget <$> collectAllNixFiles paths
123+
toTargets Nixfmt{files = []} = pure [stdioTarget]
124+
toTargets Nixfmt{files = ["-"]} = pure [stdioTarget]
125+
toTargets Nixfmt{check = False, files = paths} = map fileTarget <$> collectAllNixFiles paths
126+
toTargets Nixfmt{check = True, files = paths} = map checkFileTarget <$> collectAllNixFiles paths
116127

117128
type Formatter = FilePath -> Text -> Either String Text
118129

119130
toFormatter :: Nixfmt -> Formatter
120-
toFormatter Nixfmt{ width, verify = True } = Nixfmt.formatVerify width
121-
toFormatter Nixfmt{ width, verify = False } = Nixfmt.format width
131+
toFormatter Nixfmt{width, verify = True} = Nixfmt.formatVerify width
132+
toFormatter Nixfmt{width, verify = False} = Nixfmt.format width
122133

123134
type Operation = Formatter -> Target -> IO Result
124135

125136
toOperation :: Nixfmt -> Operation
126-
toOperation Nixfmt{ check = True } = checkTarget
127-
toOperation Nixfmt{ } = formatTarget
137+
toOperation Nixfmt{check = True} = checkTarget
138+
toOperation Nixfmt{} = formatTarget
128139

129140
toWriteError :: Nixfmt -> String -> IO ()
130-
toWriteError Nixfmt{ quiet = False } = hPutStrLn stderr
131-
toWriteError Nixfmt{ quiet = True } = const $ return ()
141+
toWriteError Nixfmt{quiet = False} = hPutStrLn stderr
142+
toWriteError Nixfmt{quiet = True} = const $ return ()
132143

133144
toJobs :: Nixfmt -> IO [IO Result]
134145
toJobs opts = map (toOperation opts $ toFormatter opts) <$> toTargets opts
@@ -141,36 +152,39 @@ doParallel = sequence
141152

142153
errorWriter :: (String -> IO ()) -> Chan (Maybe String) -> Chan () -> IO ()
143154
errorWriter doWrite chan done = do
144-
item <- readChan chan
145-
case item of
146-
Nothing -> return ()
147-
Just msg -> doWrite msg >> errorWriter doWrite chan done
148-
writeChan done ()
155+
item <- readChan chan
156+
case item of
157+
Nothing -> return ()
158+
Just msg -> doWrite msg >> errorWriter doWrite chan done
159+
writeChan done ()
149160

150161
writeErrorBundle :: Chan (Maybe String) -> Result -> IO Result
151162
writeErrorBundle chan result = do
152-
case result of
153-
Right () -> return ()
154-
Left err -> writeChan chan $ Just err
155-
return result
163+
case result of
164+
Right () -> return ()
165+
Left err -> writeChan chan $ Just err
166+
return result
156167

157168
-- | Run a list of jobs and write errors to stderr without interleaving them.
158169
runJobs :: (String -> IO ()) -> [IO Result] -> IO [Result]
159170
runJobs writeError jobs = do
160-
errChan <- newChan
161-
doneChan <- newChan
162-
_ <- forkIO $ errorWriter writeError errChan doneChan
163-
results <- doParallel $ map (>>= writeErrorBundle errChan) jobs
164-
writeChan errChan Nothing
165-
_ <- readChan doneChan
166-
return results
171+
errChan <- newChan
172+
doneChan <- newChan
173+
_ <- forkIO $ errorWriter writeError errChan doneChan
174+
results <- doParallel $ map (>>= writeErrorBundle errChan) jobs
175+
writeChan errChan Nothing
176+
_ <- readChan doneChan
177+
return results
167178

168179
main :: IO ()
169180
main = withUtf8StdHandles $ do
170-
_ <- installHandler keyboardSignal
171-
(Catch (exitImmediately $ ExitFailure 2)) Nothing
172-
opts <- cmdArgs options
173-
results <- runJobs (toWriteError opts) =<< toJobs opts
174-
case lefts results of
175-
[] -> exitSuccess
176-
_ -> exitFailure
181+
_ <-
182+
installHandler
183+
keyboardSignal
184+
(Catch (exitImmediately $ ExitFailure 2))
185+
Nothing
186+
opts <- cmdArgs options
187+
results <- runJobs (toWriteError opts) =<< toJobs opts
188+
case lefts results of
189+
[] -> exitSuccess
190+
_ -> exitFailure

0 commit comments

Comments
 (0)