1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Monad (forM_, unless, when)
import qualified Data.ByteString.Char8 as BC8
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import System.Exit (exitFailure)
import qualified System.IO as IO
import qualified System.IO.Strict as IO.Strict
--------------------------------------------------------------------------------
#if __GLASGOW_HASKELL__ < 808
import Data.Monoid ((<>))
#endif
--------------------------------------------------------------------------------
import Language.Haskell.Stylish
--------------------------------------------------------------------------------
data StylishArgs = StylishArgs
{ saVersion :: Bool
, saConfig :: Maybe FilePath
, saRecursive :: Bool
, saVerbose :: Bool
, saDefaults :: Bool
, saInPlace :: Bool
, saNoUtf8 :: Bool
, saFiles :: [FilePath]
} deriving (Show)
--------------------------------------------------------------------------------
parseStylishArgs :: OA.Parser StylishArgs
parseStylishArgs = StylishArgs
<$> OA.switch (
OA.help "Show version information" <>
OA.long "version" <>
OA.hidden)
<*> OA.optional (OA.strOption $
OA.metavar "CONFIG" <>
OA.help "Configuration file" <>
OA.long "config" <>
OA.short 'c' <>
OA.hidden)
<*> OA.switch (
OA.help "Recursive file search" <>
OA.long "recursive" <>
OA.short 'r' <>
OA.hidden)
<*> OA.switch (
OA.help "Run in verbose mode" <>
OA.long "verbose" <>
OA.short 'v' <>
OA.hidden)
<*> OA.switch (
OA.help "Dump default config and exit" <>
OA.long "defaults" <>
OA.short 'd' <>
OA.hidden)
<*> OA.switch (
OA.help "Overwrite the given files in place" <>
OA.long "inplace" <>
OA.short 'i' <>
OA.hidden)
<*> OA.switch (
OA.help "Don't force UTF-8 stdin/stdout" <>
OA.long "no-utf8" <>
OA.hidden)
<*> OA.many (OA.strArgument $
OA.metavar "FILENAME" <>
OA.help "Input file(s)")
--------------------------------------------------------------------------------
stylishHaskellVersion :: String
stylishHaskellVersion = "stylish-haskell " <> showVersion version
--------------------------------------------------------------------------------
parserInfo :: OA.ParserInfo StylishArgs
parserInfo = OA.info (OA.helper <*> parseStylishArgs) $
OA.fullDesc <>
OA.header stylishHaskellVersion
--------------------------------------------------------------------------------
main :: IO ()
main = OA.execParser parserInfo >>= stylishHaskell
--------------------------------------------------------------------------------
stylishHaskell :: StylishArgs -> IO ()
stylishHaskell sa = do
unless (saNoUtf8 sa) $
mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout]
if saVersion sa then
putStrLn stylishHaskellVersion
else if saDefaults sa then do
verbose' "Dumping embedded config..."
BC8.putStr defaultConfigBytes
else do
conf <- loadConfig verbose' (saConfig sa)
filesR <- case (saRecursive sa) of
True -> findHaskellFiles (saVerbose sa) (saFiles sa)
_ -> return $ saFiles sa
let steps = configSteps conf
forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step"
verbose' $ "Extra language extensions: " ++
show (configLanguageExtensions conf)
res <- foldMap (file sa conf) (files' filesR)
verbose' $ "Exit code behavior: " ++ show (configExitCode conf)
when (configExitCode conf == ErrorOnFormatExitBehavior && res == DidFormat) exitFailure
where
verbose' = makeVerbose (saVerbose sa)
files' x = case (saRecursive sa, null x) of
(True,True) -> [] -- No file to format and recursive enabled.
(_,True) -> [Nothing] -- Involving IO.stdin.
(_,False) -> map Just x -- Process available files.
data FormattingResult
= DidFormat
| NoChange
deriving (Eq)
instance Semigroup FormattingResult where
_ <> DidFormat = DidFormat
DidFormat <> _ = DidFormat
_ <> _ = NoChange
instance Monoid FormattingResult where
mempty = NoChange
--------------------------------------------------------------------------------
-- | Processes a single file, or stdin if no filepath is given
file :: StylishArgs -> Config -> Maybe FilePath -> IO FormattingResult
file sa conf mfp = do
contents <- maybe getContents readUTF8File mfp
let
inputLines =
lines contents
result =
runSteps (configLanguageExtensions conf) mfp (configSteps conf) inputLines
case result of
Right ok -> do
write contents (unlines ok)
pure $ if ok /= inputLines then DidFormat else NoChange
Left err -> do
IO.hPutStrLn IO.stderr err
exitFailure
where
write old new = case mfp of
Nothing -> putStrNewline new
Just _ | not (saInPlace sa) -> putStrNewline new
Just path | not (null new) && old /= new ->
IO.withFile path IO.WriteMode $ \h -> do
setNewlineMode h
IO.hPutStr h new
_ -> return ()
setNewlineMode h = do
let nl = configNewline conf
let mode = IO.NewlineMode IO.nativeNewline nl
IO.hSetNewlineMode h mode
putStrNewline txt = setNewlineMode IO.stdout >> putStr txt
readUTF8File :: FilePath -> IO String
readUTF8File fp =
IO.withFile fp IO.ReadMode $ \h -> do
IO.hSetEncoding h IO.utf8
IO.Strict.hGetContents h
|
