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
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Step.Imports
( Align (..)
, 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
= Global
| Group
| None
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)
--------------------------------------------------------------------------------
-- | Groups adjacent imports into larger import blocks
groupAdjacent :: [H.ImportDecl LineBlock]
-> [(LineBlock, [H.ImportDecl LineBlock])]
groupAdjacent = foldr go []
where
-- This code is ugly and not optimal, and no fucks were given.
go imp is = case break (adjacent b1 . fst) is of
(_, []) -> (b1, [imp]) : is
(xs, ((b2, imps) : ys)) -> (merge b1 b2, imp : imps) : (xs ++ ys)
where
b1 = H.ann imp
--------------------------------------------------------------------------------
-- | 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 -> Bool -> Bool -> Int -> H.ImportDecl l -> String
prettyImport columns padQualified padName longest imp =
intercalate "\n" $
wrap columns base (length base + 2) $
(if hiding then ("hiding" :) else id) $
withInit (++ ",") $
withHead ("(" ++) $
withLast (++ ")") $
map prettyImportSpec $
importSpecs
where
base = unwords $ concat
[ ["import"]
, qualified
, [(if hasExtras && padName then padRight longest else id)
(importName imp)]
, ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]
]
(hiding, importSpecs) = case H.importSpecs imp of
Just (H.ImportSpecList _ h l) -> (h, l)
_ -> (False, [])
hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)
qualified
| H.importQualified imp = ["qualified"]
| padQualified = [" "]
| otherwise = []
--------------------------------------------------------------------------------
prettyImportGroup :: Int -> Align -> Int -> [H.ImportDecl LineBlock] -> Lines
prettyImportGroup columns align longest imps =
map (prettyImport columns padQual padName longest') $
sortBy compareImports imps
where
longest' = case align of
Group -> longestImport imps
_ -> longest
padName = align /= None
padQual = case align of
Global -> True
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 longest importGroup)
| (block, importGroup) <- groups
]
where
imps = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'
longest = longestImport imps
groups = groupAdjacent imps
|