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
|
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Monad (forM_, unless)
import qualified Data.ByteString.Char8 as BC8
import Data.Monoid ((<>))
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
--------------------------------------------------------------------------------
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)
mapM_ (file sa conf) $ files' filesR
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.
--------------------------------------------------------------------------------
-- | Processes a single file, or stdin if no filepath is given
file :: StylishArgs -> Config -> Maybe FilePath -> IO ()
file sa conf mfp = do
contents <- maybe getContents readUTF8File mfp
let result = runSteps (configLanguageExtensions conf)
mfp (configSteps conf) $ lines contents
case result of
Right ok -> write contents $ unlines ok
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
|
