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
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Ormolu.FixitySpec (spec) where
import Data.Choice (pattern Without)
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as T
import Distribution.ModuleName (ModuleName)
import Distribution.Types.PackageName (PackageName)
import GHC.Types.Name (OccName)
import GHC.Types.Name.Occurrence (mkVarOcc)
import GHC.Types.Name.Reader
import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..))
import Language.Haskell.Syntax.Module.Name (mkModuleName)
import Ormolu.Fixity
import Ormolu.Fixity.Imports
import Ormolu.Fixity.Internal
import Ormolu.Utils (showOutputable)
import Test.Hspec
instance Show RdrName where
show = showOutputable
spec :: Spec
spec = do
it "gives the correct fixity info for (:) (built-in)" $
checkFixities
[]
[]
[(unqual ":", FixityApproximation (Just InfixR) 5 5)]
it "does not know operators from base if base is not a dependency" $
checkFixities
[]
[]
[ (unqual "$", defaultFixityApproximation),
(unqual "+", defaultFixityApproximation),
(unqual "++", defaultFixityApproximation)
]
it "does not know operators from base if Prelude is not imported" $
checkFixities
[]
[]
[ (unqual "$", defaultFixityApproximation),
(unqual "+", defaultFixityApproximation),
(unqual "++", defaultFixityApproximation)
]
it "infers fixities of operators from base correctly" $
checkFixities
["base"]
[import_ "Prelude"]
[ (unqual "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", FixityApproximation (Just InfixL) 6 6),
(unqual "++", FixityApproximation (Just InfixR) 5 5)
]
it "does not know (>>>) when Control.Category is not imported" $
checkFixities
["base"]
[import_ "Prelude"]
[ (unqual ">>>", defaultFixityApproximation)
]
it "infer correct fixity for (>>>) when Control.Category is imported" $
checkFixities
["base"]
[ import_ "Prelude",
import_ "Control.Category"
]
[ (unqual ">>>", FixityApproximation (Just InfixR) 1 1)
]
it "handles 'as' imports correctly" $
checkFixities
["base"]
[ import_ "Control.Category" & as_ "Foo"
]
[ (unqual ">>>", FixityApproximation (Just InfixR) 1 1),
(qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1),
(qual "Bar" ">>>", defaultFixityApproximation)
]
it "handles 'qualified' imports correctly" $
checkFixities
["base"]
[import_ "Control.Category" & qualified_]
[ (unqual ">>>", defaultFixityApproximation),
(qual "Control.Category" ">>>", FixityApproximation (Just InfixR) 1 1)
]
it "handles 'qualified as' imports correctly" $
checkFixities
["base"]
[import_ "Control.Category" & qualified_ & as_ "Foo"]
[ (unqual ">>>", defaultFixityApproximation),
(qual "Control.Category" ">>>", defaultFixityApproximation),
(qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1)
]
it "handles explicit import lists correctly" $
checkFixities
["base"]
[import_ "Prelude" & exactly_ ["$"]]
[ (unqual "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", defaultFixityApproximation)
]
it "handles hiding import lists correctly" $
checkFixities
["base"]
[import_ "Prelude" & hiding_ ["$"]]
[ (unqual "$", defaultFixityApproximation),
(unqual "+", FixityApproximation (Just InfixL) 6 6),
(unqual "++", FixityApproximation (Just InfixR) 5 5)
]
it "handles qualified imports with explicit import lists correctly" $
checkFixities
["base"]
[import_ "Prelude" & qualified_ & exactly_ ["$"]]
[ (unqual "$", defaultFixityApproximation),
(qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", defaultFixityApproximation),
(qual "Prelude" "+", defaultFixityApproximation)
]
it "handles qualified import with hiding correctly" $
checkFixities
["base"]
[import_ "Prelude" & qualified_ & hiding_ ["$"]]
[ (unqual "$", defaultFixityApproximation),
(qual "Prelude" "$", defaultFixityApproximation),
(unqual "+", defaultFixityApproximation),
(qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
]
it "handles qualified import and explicit import lists correctly (1)" $
checkFixities
["base"]
[ import_ "Prelude" & qualified_,
import_ "Prelude" & exactly_ ["$"]
]
[ (unqual "$", FixityApproximation (Just InfixR) 0 0),
(qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", defaultFixityApproximation),
(qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
]
it "handles qualified import and explicit import lists correctly (2)" $
checkFixities
["base"]
[ import_ "Prelude" & exactly_ ["$"],
import_ "Prelude" & qualified_
]
[ (unqual "$", FixityApproximation (Just InfixR) 0 0),
(qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", defaultFixityApproximation),
(qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
]
it "handles qualified import and hiding import correctly (1)" $
checkFixities
["base"]
[ import_ "Prelude" & qualified_,
import_ "Prelude" & hiding_ ["$"]
]
[ (unqual "$", defaultFixityApproximation),
(qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", FixityApproximation (Just InfixL) 6 6),
(qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
]
it "handles qualified import and hiding import correctly (2)" $
checkFixities
["base"]
[ import_ "Prelude" & hiding_ ["$"],
import_ "Prelude" & qualified_
]
[ (unqual "$", defaultFixityApproximation),
(qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
(unqual "+", FixityApproximation (Just InfixL) 6 6),
(qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
]
it "works for several imports from different packages" $
checkFixities
["base", "esqueleto"]
[ import_ "Prelude",
import_ "Database.Esqueleto.Experimental" & qualified_ & as_ "E"
]
[ (unqual "$", FixityApproximation (Just InfixR) 0 0),
(qual "E" "++.", FixityApproximation (Just InfixR) 5 5),
(qual "E" "on", FixityApproximation (Just InfixN) 9 9)
]
it "merges approximations in case of a conflict" $
checkFixities
["fclabels", "persistent"]
[ import_ "Data.Label.Monadic",
import_ "Database.Persist"
]
[ (unqual "=.", FixityApproximation (Just InfixR) 2 3)
]
it "correctly handles package-qualified imports (1)" $
checkFixities
["esqueleto"]
[package_ "esqueleto" $ import_ "Database.Esqueleto.Experimental"]
[(unqual "++.", FixityApproximation (Just InfixR) 5 5)]
it "correctly handles package-qualified imports (2)" $
checkFixities
["esqueleto"]
[package_ "bob" $ import_ "Database.Esqueleto.Experimental"]
[(unqual "++.", defaultFixityApproximation)]
it "default module re-exports: Control.Lens brings into scope Control.Lens.Lens" $
checkFixities
["lens"]
( applyModuleReexports
defaultModuleReexports
[import_ "Control.Lens"]
)
[(unqual "<+~", FixityApproximation (Just InfixR) 4 4)]
it "default module re-exports: Control.Lens qualified brings into scope Control.Lens.Lens" $
checkFixities
["lens"]
( applyModuleReexports
defaultModuleReexports
[import_ "Control.Lens" & qualified_]
)
[ (unqual "<+~", defaultFixityApproximation),
(qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
(qual "Control.Lens" "<+~", FixityApproximation (Just InfixR) 4 4)
]
it "default module re-exports: Control.Lens qualified as brings into scope Control.Lens.Lens" $
checkFixities
["lens"]
( applyModuleReexports
defaultModuleReexports
[import_ "Control.Lens" & qualified_ & as_ "L"]
)
[ (unqual "<+~", defaultFixityApproximation),
(qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
(qual "Control.Lens" "<+~", defaultFixityApproximation),
(qual "L" "<+~", FixityApproximation (Just InfixR) 4 4)
]
it "re-export chains: exported module can itself re-export another module" $ do
let reexports =
ModuleReexports $
Map.insert
"Foo"
((Nothing, "Control.Lens") :| [])
(unModuleReexports defaultModuleReexports)
checkFixities
["lens"]
( applyModuleReexports
reexports
[import_ "Foo"]
)
[ (unqual "<+~", FixityApproximation (Just InfixR) 4 4)
]
-- | Build a fixity map using the Hoogle database and then check the fixity
-- of the specified subset of operators.
checkFixities ::
-- | List of dependencies
[PackageName] ->
-- | Imports
[FixityImport] ->
-- | Associative list representing a subset of the resulting fixity map
-- that should be checked.
[(RdrName, FixityApproximation)] ->
Expectation
checkFixities dependencies fixityImports expectedResult =
actualResult `shouldBe` expectedResult
where
actualResult =
fmap
(\(k, _) -> (k, inferFixity (Without #debug) k resultMap))
expectedResult
resultMap =
moduleFixityMap
(packageFixityMap (Set.fromList dependencies))
fixityImports
qual :: String -> OpName -> RdrName
qual moduleName opName = mkRdrQual (mkModuleName moduleName) (opNameToOccName opName)
unqual :: OpName -> RdrName
unqual = mkRdrUnqual . opNameToOccName
opNameToOccName :: OpName -> OccName
opNameToOccName = mkVarOcc . T.unpack . unOpName
-- | Explicitly specify the package.
package_ :: PackageName -> FixityImport -> FixityImport
package_ packageName fixityImport =
fixityImport
{ fimportPackage = Just packageName
}
-- | Construct a simple 'FixityImport'.
import_ :: ModuleName -> FixityImport
import_ moduleName =
FixityImport
{ fimportPackage = Nothing,
fimportModule = moduleName,
fimportQualified = UnqualifiedAndQualified moduleName,
fimportList = Nothing
}
-- | Adds an alias for an import.
as_ :: ModuleName -> FixityImport -> FixityImport
as_ moduleName fixityImport =
fixityImport
{ fimportQualified = case fimportQualified fixityImport of
UnqualifiedAndQualified _ -> UnqualifiedAndQualified moduleName
OnlyQualified _ -> OnlyQualified moduleName
}
-- | Qualified imports.
qualified_ :: FixityImport -> FixityImport
qualified_ fixityImport =
fixityImport
{ fimportQualified = case fimportQualified fixityImport of
UnqualifiedAndQualified m -> OnlyQualified m
OnlyQualified m -> OnlyQualified m
}
-- | Exact import lists.
exactly_ :: [OpName] -> FixityImport -> FixityImport
exactly_ opNames fixityImports =
fixityImports
{ fimportList = Just (Exactly, opNames)
}
-- | Hiding.
hiding_ :: [OpName] -> FixityImport -> FixityImport
hiding_ opNames fixityImports =
fixityImports
{ fimportList = Just (EverythingBut, opNames)
}
|
