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
|
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Step.Imports
( Align (..)
, ImportAlign (..)
, ListAlign (..)
, LongListAlign (..)
, step
) where
--------------------------------------------------------------------------------
import Control.Arrow ((&&&))
import Data.Char (isAlpha, toLower)
import Data.List (intercalate, sortBy)
import Data.Maybe (isJust, maybeToList)
import Data.Ord (comparing)
import qualified Language.Haskell.Exts.Annotated as H
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
--------------------------------------------------------------------------------
data Align = Align
{ importAlign :: ImportAlign
, listAlign :: ListAlign
, longListAlign :: LongListAlign
, listPadding :: Int
}
deriving (Eq, Show)
data ImportAlign
= Global
| File
| Group
| None
deriving (Eq, Show)
data ListAlign
= NewLine
| WithAlias
| AfterAlias
deriving (Eq, Show)
data LongListAlign
= Inline
| InlineWithBreak
| Multiline
deriving (Eq, Show)
--------------------------------------------------------------------------------
imports :: H.Module l -> [H.ImportDecl l]
imports (H.Module _ _ _ is _) = is
imports _ = []
--------------------------------------------------------------------------------
importName :: H.ImportDecl l -> String
importName i = let (H.ModuleName _ n) = H.importModule i in n
--------------------------------------------------------------------------------
longestImport :: [H.ImportDecl l] -> Int
longestImport = maximum . map (length . importName)
--------------------------------------------------------------------------------
-- | Compare imports for ordering
compareImports :: H.ImportDecl l -> H.ImportDecl l -> Ordering
compareImports = comparing (map toLower . importName &&& H.importQualified)
--------------------------------------------------------------------------------
-- | The implementation is a bit hacky to get proper sorting for input specs:
-- constructors first, followed by functions, and then operators.
compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering
compareImportSpecs = comparing key
where
key :: H.ImportSpec l -> (Int, Int, String)
key (H.IVar _ _ x) = let n = nameToString x in (1, operator n, n)
key (H.IAbs _ x) = (0, 0, nameToString x)
key (H.IThingAll _ x) = (0, 0, nameToString x)
key (H.IThingWith _ x _) = (0, 0, nameToString x)
operator [] = 0 -- But this should not happen
operator (x : _) = if isAlpha x then 0 else 1
--------------------------------------------------------------------------------
-- | Sort the input spec list inside an 'H.ImportDecl'
sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l
sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}
where
sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $
sortBy compareImportSpecs specs
--------------------------------------------------------------------------------
-- | By default, haskell-src-exts pretty-prints
--
-- > import Foo (Bar(..))
--
-- but we want
--
-- > import Foo (Bar (..))
--
-- instead.
prettyImportSpec :: H.ImportSpec l -> String
prettyImportSpec (H.IThingAll _ n) = H.prettyPrint n ++ " (..)"
prettyImportSpec (H.IThingWith _ n cns) = H.prettyPrint n ++ " (" ++
intercalate ", " (map H.prettyPrint cns) ++ ")"
prettyImportSpec x = H.prettyPrint x
--------------------------------------------------------------------------------
prettyImport :: Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l
-> [String]
prettyImport columns Align{..} padQualified padName longest imp =
case longListAlign of
Inline -> inlineWrap
InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap
Multiline -> longListWrapper inlineWrap multilineWrap
where
longListWrapper shortWrap longWrap =
if listAlign == NewLine || length shortWrap > 1
then longWrap
else shortWrap
inlineWrap = inlineWrapper
$ mapSpecs
$ withInit (++ ",")
. withHead ("(" ++)
. withLast (++ ")")
inlineWrapper = case listAlign of
NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding
WithAlias -> wrap columns paddedBase (inlineBaseLength + 1)
-- Add 1 extra space to ensure same padding as in original code.
AfterAlias -> withTail (' ' :)
. wrap columns paddedBase (afterAliasBaseLength + 1)
inlineWithBreakWrap = paddedNoSpecBase : (wrapRest columns listPadding
$ mapSpecs
$ withInit (++ ",")
. withHead ("(" ++)
. withLast (++ ")"))
-- 'wrapRest 0' ensures that every item of spec list is on new line.
multilineWrap = paddedNoSpecBase : (wrapRest 0 listPadding
$ (mapSpecs
$ withHead ("( " ++)
. withTail (", " ++))
++ [")"])
paddedBase = base $ padImport $ importName imp
paddedNoSpecBase = base $ padImportNoSpec $ importName imp
padImport = if hasExtras && padName
then padRight longest
else id
padImportNoSpec = if (isJust (H.importAs imp) || hasHiding) && padName
then padRight longest
else id
base' baseName importAs hasHiding' = unwords $ concat $ filter (not . null)
[ ["import"]
, qualified
, (fmap show $ maybeToList $ H.importPkg imp)
, [baseName]
, importAs
, hasHiding'
]
base baseName = base' baseName
["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]
(if hasHiding then (["hiding"]) else [])
inlineBaseLength = length $ base' (padImport $ importName imp) [] []
afterAliasBaseLength = length $ base' (padImport $ importName imp)
["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] []
(hasHiding, importSpecs) = case H.importSpecs imp of
Just (H.ImportSpecList _ h l) -> (h, Just l)
_ -> (False, Nothing)
hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)
qualified
| H.importQualified imp = ["qualified"]
| padQualified = [" "]
| otherwise = []
mapSpecs f = case importSpecs of
Nothing -> [] -- Import everything
Just [] -> ["()"] -- Instance only imports
Just is -> f $ map prettyImportSpec is
--------------------------------------------------------------------------------
prettyImportGroup :: Int -> Align -> Bool -> Int
-> [H.ImportDecl LineBlock]
-> Lines
prettyImportGroup columns align fileAlign longest imps =
concatMap (prettyImport columns align padQual padName longest') $
sortBy compareImports imps
where
align' = importAlign align
longest' = case align' of
Group -> longestImport imps
_ -> longest
padName = align' /= None
padQual = case align' of
Global -> True
File -> fileAlign
Group -> any H.importQualified imps
None -> False
--------------------------------------------------------------------------------
step :: Int -> Align -> Step
step columns = makeStep "Imports" . step' columns
--------------------------------------------------------------------------------
step' :: Int -> Align -> Lines -> Module -> Lines
step' columns align ls (module', _) = flip applyChanges ls
[ change block $ const $
prettyImportGroup columns align fileAlign longest importGroup
| (block, importGroup) <- groups
]
where
imps = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'
longest = longestImport imps
groups = groupAdjacent [(H.ann i, i) | i <- imps]
fileAlign = case importAlign align of
File -> any H.importQualified imps
_ -> False
|