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
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Util
( nameToString
, isOperator
, indent
, padRight
, everything
, infoPoints
, wrap
, wrapRest
, withHead
, withInit
, withTail
, withLast
) where
--------------------------------------------------------------------------------
import Control.Arrow ((&&&), (>>>))
import Data.Char (isAlpha)
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)
--------------------------------------------------------------------------------
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
|
