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
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Util
( nameToString
, isOperator
, indent
, padRight
, everything
, infoPoints
, trimLeft
, trimRight
, wrap
, wrapRest
, wrapMaybe
, wrapRestMaybe
, withHead
, withInit
, withTail
, withLast
) where
--------------------------------------------------------------------------------
import Control.Arrow ((&&&), (>>>))
import Data.Char (isAlpha, isSpace)
import Data.Data (Data)
import qualified Data.Generics as G
import Data.Maybe (fromMaybe, listToMaybe,
maybeToList)
import Data.Typeable (cast)
import qualified Language.Haskell.Exts as H
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Step
--------------------------------------------------------------------------------
nameToString :: H.Name l -> String
nameToString (H.Ident _ str) = str
nameToString (H.Symbol _ str) = str
--------------------------------------------------------------------------------
isOperator :: H.Name l -> Bool
isOperator = fromMaybe False
. (fmap (not . isAlpha) . listToMaybe)
. nameToString
--------------------------------------------------------------------------------
indent :: Int -> String -> String
indent len = (indentPrefix len ++)
--------------------------------------------------------------------------------
indentPrefix :: Int -> String
indentPrefix = (`replicate` ' ')
--------------------------------------------------------------------------------
padRight :: Int -> String -> String
padRight len str = str ++ replicate (len - length str) ' '
--------------------------------------------------------------------------------
everything :: (Data a, Data b) => a -> [b]
everything = G.everything (++) (maybeToList . cast)
--------------------------------------------------------------------------------
infoPoints :: H.SrcSpanInfo -> [((Int, Int), (Int, Int))]
infoPoints = H.srcInfoPoints >>> map (H.srcSpanStart &&& H.srcSpanEnd)
--------------------------------------------------------------------------------
trimLeft :: String -> String
trimLeft = dropWhile isSpace
--------------------------------------------------------------------------------
trimRight :: String -> String
trimRight = reverse . trimLeft . reverse
--------------------------------------------------------------------------------
wrap :: Int -- ^ Maximum line width
-> String -- ^ Leading string
-> Int -- ^ Indentation
-> [String] -- ^ Strings to add/wrap
-> Lines -- ^ Resulting lines
wrap maxWidth leading ind = wrap' leading
where
wrap' ss [] = [ss]
wrap' ss (str:strs)
| overflows ss str =
ss : wrapRest maxWidth ind (str:strs)
| otherwise = wrap' (ss ++ " " ++ str) strs
overflows ss str = length ss > maxWidth ||
((length ss + length str) >= maxWidth && ind + length str <= maxWidth)
--------------------------------------------------------------------------------
wrapMaybe :: Maybe Int -- ^ Maximum line width (maybe)
-> String -- ^ Leading string
-> Int -- ^ Indentation
-> [String] -- ^ Strings to add/wrap
-> Lines -- ^ Resulting lines
wrapMaybe (Just maxWidth) = wrap maxWidth
wrapMaybe Nothing = noWrap
--------------------------------------------------------------------------------
noWrap :: String -- ^ Leading string
-> Int -- ^ Indentation
-> [String] -- ^ Strings to add
-> Lines -- ^ Resulting lines
noWrap leading _ind = noWrap' leading
where
noWrap' ss [] = [ss]
noWrap' ss (str:strs) = noWrap' (ss ++ " " ++ str) strs
--------------------------------------------------------------------------------
wrapRest :: Int
-> Int
-> [String]
-> Lines
wrapRest maxWidth ind = reverse . wrapRest' [] ""
where
wrapRest' ls ss []
| null ss = ls
| otherwise = ss:ls
wrapRest' ls ss (str:strs)
| null ss = wrapRest' ls (indent ind str) strs
| overflows ss str = wrapRest' (ss:ls) "" (str:strs)
| otherwise = wrapRest' ls (ss ++ " " ++ str) strs
overflows ss str = (length ss + length str + 1) >= maxWidth
--------------------------------------------------------------------------------
wrapRestMaybe :: Maybe Int
-> Int
-> [String]
-> Lines
wrapRestMaybe (Just maxWidth) = wrapRest maxWidth
wrapRestMaybe Nothing = noWrapRest
--------------------------------------------------------------------------------
noWrapRest :: Int
-> [String]
-> Lines
noWrapRest ind = reverse . noWrapRest' [] ""
where
noWrapRest' ls ss []
| null ss = ls
| otherwise = ss:ls
noWrapRest' ls ss (str:strs)
| null ss = noWrapRest' ls (indent ind str) strs
| otherwise = noWrapRest' ls (ss ++ " " ++ str) strs
--------------------------------------------------------------------------------
withHead :: (a -> a) -> [a] -> [a]
withHead _ [] = []
withHead f (x : xs) = f x : xs
--------------------------------------------------------------------------------
withLast :: (a -> a) -> [a] -> [a]
withLast _ [] = []
withLast f [x] = [f x]
withLast f (x : xs) = x : withLast f xs
--------------------------------------------------------------------------------
withInit :: (a -> a) -> [a] -> [a]
withInit _ [] = []
withInit _ [x] = [x]
withInit f (x : xs) = f x : withInit f xs
--------------------------------------------------------------------------------
withTail :: (a -> a) -> [a] -> [a]
withTail _ [] = []
withTail f (x : xs) = x : map f xs
|
