1
- {-# LANGUAGE DeriveDataTypeable, NamedFieldPuns, MultiWayIf #-}
1
+ {-# LANGUAGE DeriveDataTypeable #-}
2
+ {-# LANGUAGE MultiWayIf #-}
3
+ {-# LANGUAGE NamedFieldPuns #-}
2
4
3
5
module Main where
4
6
5
7
import Control.Concurrent (Chan , forkIO , newChan , readChan , writeChan )
6
8
import Data.Either (lefts )
7
- import Data.Text (Text )
8
9
import Data.List (isSuffixOf )
10
+ import Data.Text (Text )
11
+ import qualified Data.Text.IO as TextIO (getContents , hPutStr , putStr )
9
12
import Data.Version (showVersion )
10
13
import GHC.IO.Encoding (utf8 )
14
+ import qualified Nixfmt
11
15
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 )
15
28
import System.FilePath ((</>) )
16
29
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
24
30
import System.IO.Atomic (withOutputFile )
25
31
import System.IO.Utf8 (readFileUtf8 , withUtf8StdHandles )
32
+ import System.Posix.Process (exitImmediately )
33
+ import System.Posix.Signals (Handler (.. ), installHandler , keyboardSignal )
26
34
27
35
type Result = Either String ()
36
+
28
37
type Width = Int
29
38
30
39
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 )
37
47
38
48
options :: Nixfmt
39
49
options =
40
50
let defaultWidth = 100
41
51
addDefaultHint value message =
42
52
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
53
63
" 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"
57
67
58
68
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
+ }
64
74
65
75
-- | Recursively collect nix files in a directory
66
76
collectNixFiles :: FilePath -> IO [FilePath ]
67
77
collectNixFiles path = do
68
78
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 []
74
85
75
86
-- | Recursively collect nix files in a list of directories
76
87
collectAllNixFiles :: [FilePath ] -> IO [FilePath ]
77
88
collectAllNixFiles paths = concat <$> mapM collectNixFiles paths
78
89
79
90
formatTarget :: Formatter -> Target -> IO Result
80
91
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
84
95
85
96
-- | Return an error if target could not be parsed or was not formatted
86
97
-- correctly.
87
98
checkTarget :: Formatter -> Target -> IO Result
88
99
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"
95
106
96
107
stdioTarget :: Target
97
108
stdioTarget = Target TextIO. getContents " <stdin>" (const TextIO. putStr )
@@ -109,26 +120,26 @@ checkFileTarget :: FilePath -> Target
109
120
checkFileTarget path = Target (readFileUtf8 path) path (const $ const $ pure () )
110
121
111
122
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
116
127
117
128
type Formatter = FilePath -> Text -> Either String Text
118
129
119
130
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
122
133
123
134
type Operation = Formatter -> Target -> IO Result
124
135
125
136
toOperation :: Nixfmt -> Operation
126
- toOperation Nixfmt { check = True } = checkTarget
127
- toOperation Nixfmt { } = formatTarget
137
+ toOperation Nixfmt {check = True } = checkTarget
138
+ toOperation Nixfmt {} = formatTarget
128
139
129
140
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 ()
132
143
133
144
toJobs :: Nixfmt -> IO [IO Result ]
134
145
toJobs opts = map (toOperation opts $ toFormatter opts) <$> toTargets opts
@@ -141,36 +152,39 @@ doParallel = sequence
141
152
142
153
errorWriter :: (String -> IO () ) -> Chan (Maybe String ) -> Chan () -> IO ()
143
154
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 ()
149
160
150
161
writeErrorBundle :: Chan (Maybe String ) -> Result -> IO Result
151
162
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
156
167
157
168
-- | Run a list of jobs and write errors to stderr without interleaving them.
158
169
runJobs :: (String -> IO () ) -> [IO Result ] -> IO [Result ]
159
170
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
167
178
168
179
main :: IO ()
169
180
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