blob: fdaf0dee5d4e4e743b228b9049f50b0a2fa4e617 (
plain)
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
|
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Monad (forM_, unless)
import Data.Monoid ((<>))
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import qualified Paths_stylish_haskell
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
, 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 "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 Paths_stylish_haskell.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
fileName <- defaultConfigFilePath
verbose' $ "Dumping config from " ++ fileName
readUTF8File fileName >>= putStr
else do
conf <- loadConfig verbose' (saConfig 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'
where
verbose' = makeVerbose (saVerbose sa)
files' = if null (saFiles sa) then [Nothing] else map Just (saFiles sa)
--------------------------------------------------------------------------------
-- | 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
Left err -> IO.hPutStrLn IO.stderr err >> write contents contents
Right ok -> write contents $ unlines ok
where
write old new = case mfp of
Nothing -> putStr new
Just _ | not (saInPlace sa) -> putStr new
Just path | not (null new) && old /= new ->
IO.withFile path IO.WriteMode $ \h -> do
let nl = configNewline conf
let mode = IO.NewlineMode nl nl
IO.hSetNewlineMode h mode
IO.hPutStr h new
_ -> return ()
readUTF8File :: FilePath -> IO String
readUTF8File fp =
IO.withFile fp IO.ReadMode $ \h -> do
IO.hSetEncoding h IO.utf8
IO.Strict.hGetContents h
|
