-
Notifications
You must be signed in to change notification settings - Fork 83
/
Ormolu.hs
262 lines (248 loc) · 8.53 KB
/
Ormolu.hs
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
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
-- | A formatter for Haskell source code. This module exposes the official
-- stable API, other modules may be not as reliable.
module Ormolu
( -- * Top-level formatting functions
ormolu,
ormoluFile,
ormoluStdin,
-- * Configuration
Config (..),
ColorMode (..),
RegionIndices (..),
SourceType (..),
defaultConfig,
detectSourceType,
refineConfig,
DynOption (..),
-- * Cabal info
CabalUtils.CabalSearchResult (..),
CabalUtils.CabalInfo (..),
CabalUtils.getCabalInfoForSourceFile,
-- * Fixity overrides and module re-exports
FixityOverrides,
defaultFixityOverrides,
ModuleReexports,
defaultModuleReexports,
getDotOrmoluForSourceFile,
-- * Working with exceptions
OrmoluException (..),
withPrettyOrmoluExceptions,
)
where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (MonadIO (..))
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Debug.Trace
import GHC.Driver.CmdLine qualified as GHC
import GHC.Types.SrcLoc
import Ormolu.Config
import Ormolu.Diff.ParseResult
import Ormolu.Diff.Text
import Ormolu.Exception
import Ormolu.Fixity
import Ormolu.Parser
import Ormolu.Parser.CommentStream (showCommentStream)
import Ormolu.Parser.Result
import Ormolu.Printer
import Ormolu.Utils (showOutputable)
import Ormolu.Utils.Cabal qualified as CabalUtils
import Ormolu.Utils.Fixity (getDotOrmoluForSourceFile)
import Ormolu.Utils.IO
import System.FilePath
-- | Format a 'Text'.
--
-- The function
--
-- * Needs 'IO' because some functions from GHC that are necessary to
-- setup parsing context require 'IO'. There should be no visible
-- side-effects though.
-- * Takes file name just to use it in parse error messages.
-- * Throws 'OrmoluException'.
--
-- __NOTE__: The caller is responsible for setting the appropriate value in
-- the 'cfgSourceType' field. Autodetection of source type won't happen
-- here, see 'detectSourceType'.
ormolu ::
(MonadIO m) =>
-- | Ormolu configuration
Config RegionIndices ->
-- | Location of source file
FilePath ->
-- | Input to format
Text ->
m Text
ormolu cfgWithIndices path originalInput = do
let totalLines = length (T.lines originalInput)
cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices
fixityMap =
packageFixityMap
(cfgDependencies cfg) -- memoized on the set of dependencies
(warnings, result0) <-
parseModule' cfg fixityMap OrmoluParsingFailed path originalInput
when (cfgDebug cfg) $ do
traceM "warnings:\n"
traceM (concatMap showWarn warnings)
forM_ result0 $ \case
ParsedSnippet r -> traceM . showCommentStream . prCommentStream $ r
_ -> pure ()
-- We're forcing 'formattedText' here because otherwise errors (such as
-- messages about not-yet-supported functionality) will be thrown later
-- when we try to parse the rendered code back, inside of GHC monad
-- wrapper which will lead to error messages presenting the exceptions as
-- GHC bugs.
let !formattedText = printSnippets result0
when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do
-- Parse the result of pretty-printing again and make sure that AST
-- is the same as AST of original snippet module span positions.
(_, result1) <-
parseModule'
cfg
fixityMap
OrmoluOutputParsingFailed
path
formattedText
unless (cfgUnsafe cfg) . liftIO $ do
let diff = case diffText originalInput formattedText path of
Nothing -> error "AST differs, yet no changes have been introduced"
Just x -> x
when (length result0 /= length result1) $
throwIO (OrmoluASTDiffers diff [])
forM_ (result0 `zip` result1) $ \case
(ParsedSnippet s, ParsedSnippet s') -> case diffParseResult s s' of
Same -> return ()
Different ss -> throwIO (OrmoluASTDiffers (selectSpans ss diff) ss)
(RawSnippet {}, RawSnippet {}) -> pure ()
_ -> throwIO (OrmoluASTDiffers diff [])
-- Try re-formatting the formatted result to check if we get exactly
-- the same output.
when (cfgCheckIdempotence cfg) . liftIO $
let reformattedText = printSnippets result1
in case diffText formattedText reformattedText path of
Nothing -> return ()
Just diff -> throwIO (OrmoluNonIdempotentOutput diff)
return formattedText
-- | Load a file and format it. The file stays intact and the rendered
-- version is returned as 'Text'.
--
-- __NOTE__: The caller is responsible for setting the appropriate value in
-- the 'cfgSourceType' field. Autodetection of source type won't happen
-- here, see 'detectSourceType'.
ormoluFile ::
(MonadIO m) =>
-- | Ormolu configuration
Config RegionIndices ->
-- | Location of source file
FilePath ->
-- | Resulting rendition
m Text
ormoluFile cfg path =
readFileUtf8 path >>= ormolu cfg path
-- | Read input from stdin and format it.
--
-- __NOTE__: The caller is responsible for setting the appropriate value in
-- the 'cfgSourceType' field. Autodetection of source type won't happen
-- here, see 'detectSourceType'.
ormoluStdin ::
(MonadIO m) =>
-- | Ormolu configuration
Config RegionIndices ->
-- | Resulting rendition
m Text
ormoluStdin cfg =
getContentsUtf8 >>= ormolu cfg "<stdin>"
-- | Refine a 'Config' by incorporating given 'SourceType', 'CabalInfo', and
-- fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce
-- 'SourceType' based on the file extension,
-- 'CabalUtils.getCabalInfoForSourceFile' to obtain 'CabalInfo' and
-- 'getFixityOverridesForSourceFile' for 'FixityMap'.
--
-- @since 0.5.3.0
refineConfig ::
-- | Source type to use
SourceType ->
-- | Cabal info for the file, if available
Maybe CabalUtils.CabalInfo ->
-- | Fixity overrides, if available
Maybe FixityOverrides ->
-- | Module re-exports, if available
Maybe ModuleReexports ->
-- | 'Config' to refine
Config region ->
-- | Refined 'Config'
Config region
refineConfig sourceType mcabalInfo mfixityOverrides mreexports rawConfig =
rawConfig
{ cfgDynOptions = cfgDynOptions rawConfig ++ dynOptsFromCabal,
cfgFixityOverrides =
FixityOverrides $
Map.unions
[ unFixityOverrides fixityOverrides,
unFixityOverrides (cfgFixityOverrides rawConfig),
unFixityOverrides defaultFixityOverrides
],
cfgModuleReexports =
ModuleReexports $
Map.unionsWith
(<>)
[ unModuleReexports reexports,
unModuleReexports (cfgModuleReexports rawConfig),
unModuleReexports defaultModuleReexports
],
cfgDependencies =
Set.union (cfgDependencies rawConfig) depsFromCabal,
cfgSourceType = sourceType
}
where
fixityOverrides = fromMaybe defaultFixityOverrides mfixityOverrides
reexports = fromMaybe defaultModuleReexports mreexports
(dynOptsFromCabal, depsFromCabal) =
case mcabalInfo of
Nothing ->
-- If no cabal info is provided, assume base as a dependency by
-- default.
([], defaultDependencies)
Just CabalUtils.CabalInfo {..} ->
-- It makes sense to take into account the operator info for the
-- package itself if we know it, as if it were its own dependency.
(ciDynOpts, Set.insert ciPackageName ciDependencies)
----------------------------------------------------------------------------
-- Helpers
-- | A wrapper around 'parseModule'.
parseModule' ::
(MonadIO m) =>
-- | Ormolu configuration
Config RegionDeltas ->
-- | Fixity Map for operators
PackageFixityMap ->
-- | How to obtain 'OrmoluException' to throw when parsing fails
(SrcSpan -> String -> OrmoluException) ->
-- | File name to use in errors
FilePath ->
-- | Actual input for the parser
Text ->
m ([GHC.Warn], [SourceSnippet])
parseModule' cfg fixityMap mkException path str = do
(warnings, r) <- parseModule cfg fixityMap path str
case r of
Left (spn, err) -> liftIO $ throwIO (mkException spn err)
Right x -> return (warnings, x)
-- | Pretty-print a 'GHC.Warn'.
showWarn :: GHC.Warn -> String
showWarn (GHC.Warn reason l) =
unlines
[ showOutputable reason,
unLoc l
]
-- | Detect 'SourceType' based on the file extension.
detectSourceType :: FilePath -> SourceType
detectSourceType mpath =
if takeExtension mpath == ".hsig"
then SignatureSource
else ModuleSource