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
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Util
( nameToString
, isOperator
, indent
, padRight
, everything
, infoPoints
, trimLeft
, trimRight
, wrap
, wrapRest
, 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)
--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------
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
|
