Skip to content

Commit 18a1283

Browse files
hurryabitjaspervdj
hurryabit
authored and
jaspervdj
committed
Add new step to squash multiple spaces between some elements
1 parent 8447f67 commit 18a1283

File tree

8 files changed

+213
-5
lines changed

8 files changed

+213
-5
lines changed

‎data/stylish-haskell.yaml‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,11 @@ steps:
198198
# Remove trailing whitespace
199199
- trailing_whitespace: {}
200200

201+
# Squash multiple spaces between the left and right hand sides of some
202+
# elements into single spaces. Basically, this undoes the effect of
203+
# simple_align but is a bit less conservative.
204+
# - squash: {}
205+
201206
# A common setting is the number of columns (parts of) code will be wrapped
202207
# to. Different steps take this into account. Default: 80.
203208
columns: 80

‎lib/Language/Haskell/Stylish/Align.hs‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ module Language.Haskell.Stylish.Align
77

88

99
--------------------------------------------------------------------------------
10-
import Data.Char (isSpace)
1110
import Data.List (nub)
1211
import qualified Language.Haskell.Exts as H
1312

@@ -81,9 +80,6 @@ align maxColumns alignment
8180
(pre, post) = splitAt column str
8281
in [padRight longestLeft (trimRight pre) ++ trimLeft post]
8382

84-
trimLeft = dropWhile isSpace
85-
trimRight = reverse . trimLeft . reverse
86-
8783

8884
--------------------------------------------------------------------------------
8985
-- | Checks that all the alignables appear on a single line, and that they do

‎lib/Language/Haskell/Stylish/Config.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Language.Haskell.Stylish.Step
3636
import qualified Language.Haskell.Stylish.Step.Imports as Imports
3737
import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas
3838
import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign
39+
import qualified Language.Haskell.Stylish.Step.Squash as Squash
3940
import qualified Language.Haskell.Stylish.Step.Tabs as Tabs
4041
import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace
4142
import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax
@@ -137,6 +138,7 @@ catalog = M.fromList
137138
[ ("imports", parseImports)
138139
, ("language_pragmas", parseLanguagePragmas)
139140
, ("simple_align", parseSimpleAlign)
141+
, ("squash", parseSquash)
140142
, ("tabs", parseTabs)
141143
, ("trailing_whitespace", parseTrailingWhitespace)
142144
, ("unicode_syntax", parseUnicodeSyntax)
@@ -174,6 +176,11 @@ parseSimpleAlign c o = SimpleAlign.step
174176
withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k)
175177

176178

179+
--------------------------------------------------------------------------------
180+
parseSquash :: Config -> A.Object -> A.Parser Step
181+
parseSquash _ _ = return Squash.step
182+
183+
177184
--------------------------------------------------------------------------------
178185
parseImports :: Config -> A.Object -> A.Parser Step
179186
parseImports config o = Imports.step

‎lib/Language/Haskell/Stylish/Step/Squash.hs‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
--------------------------------------------------------------------------------
2+
module Language.Haskell.Stylish.Step.Squash
3+
( step
4+
) where
5+
6+
7+
--------------------------------------------------------------------------------
8+
import Data.Maybe (mapMaybe)
9+
import qualified Language.Haskell.Exts as H
10+
11+
12+
--------------------------------------------------------------------------------
13+
import Language.Haskell.Stylish.Editor
14+
import Language.Haskell.Stylish.Step
15+
import Language.Haskell.Stylish.Util
16+
17+
18+
--------------------------------------------------------------------------------
19+
squash
20+
:: (H.Annotated l, H.Annotated r)
21+
=> l H.SrcSpan -> r H.SrcSpan -> Maybe (Change String)
22+
squash left right
23+
| H.srcSpanEndLine lAnn == H.srcSpanStartLine rAnn = Just $
24+
changeLine (H.srcSpanEndLine lAnn) $ \str ->
25+
let (pre, post) = splitAt (H.srcSpanEndColumn lAnn) str
26+
in [trimRight pre ++ " " ++ trimLeft post]
27+
| otherwise = Nothing
28+
where
29+
lAnn = H.ann left
30+
rAnn = H.ann right
31+
32+
33+
--------------------------------------------------------------------------------
34+
squashFieldDecl :: H.FieldDecl H.SrcSpan -> Maybe (Change String)
35+
squashFieldDecl (H.FieldDecl _ names type')
36+
| null names = Nothing
37+
| otherwise = squash (last names) type'
38+
39+
40+
--------------------------------------------------------------------------------
41+
squashMatch :: H.Match H.SrcSpan -> Maybe (Change String)
42+
squashMatch (H.InfixMatch _ _ _ _ _ _) = Nothing
43+
squashMatch (H.Match _ name pats rhs _)
44+
| null pats = squash name rhs
45+
| otherwise = squash (last pats) rhs
46+
47+
48+
--------------------------------------------------------------------------------
49+
squashAlt :: H.Alt H.SrcSpan -> Maybe (Change String)
50+
squashAlt (H.Alt _ pat rhs _) = squash pat rhs
51+
52+
53+
--------------------------------------------------------------------------------
54+
step :: Step
55+
step = makeStep "Squash" $ \ls (module', _) ->
56+
let module'' = fmap H.srcInfoSpan module'
57+
changes = concat
58+
[ mapMaybe squashAlt (everything module'')
59+
, mapMaybe squashMatch (everything module'')
60+
, mapMaybe squashFieldDecl (everything module'')
61+
]
62+
in applyChanges changes ls

‎lib/Language/Haskell/Stylish/Util.hs‎

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ module Language.Haskell.Stylish.Util
66
, padRight
77
, everything
88
, infoPoints
9+
, trimLeft
10+
, trimRight
911
, wrap
1012
, wrapRest
1113

@@ -18,7 +20,7 @@ module Language.Haskell.Stylish.Util
1820

1921
--------------------------------------------------------------------------------
2022
import Control.Arrow ((&&&), (>>>))
21-
import Data.Char (isAlpha)
23+
import Data.Char (isAlpha, isSpace)
2224
import Data.Data (Data)
2325
import qualified Data.Generics as G
2426
import Data.Maybe (fromMaybe, listToMaybe,
@@ -68,6 +70,16 @@ infoPoints :: H.SrcSpanInfo -> [((Int, Int), (Int, Int))]
6870
infoPoints = H.srcInfoPoints >>> map (H.srcSpanStart &&& H.srcSpanEnd)
6971

7072

73+
--------------------------------------------------------------------------------
74+
trimLeft :: String -> String
75+
trimLeft = dropWhile isSpace
76+
77+
78+
--------------------------------------------------------------------------------
79+
trimRight :: String -> String
80+
trimRight = reverse . trimLeft . reverse
81+
82+
7183
--------------------------------------------------------------------------------
7284
wrap :: Int -- ^ Maximum line width
7385
-> String -- ^ Leading string

‎stylish-haskell.cabal‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ Library
3232
Language.Haskell.Stylish.Step.Imports
3333
Language.Haskell.Stylish.Step.LanguagePragmas
3434
Language.Haskell.Stylish.Step.SimpleAlign
35+
Language.Haskell.Stylish.Step.Squash
3536
Language.Haskell.Stylish.Step.Tabs
3637
Language.Haskell.Stylish.Step.TrailingWhitespace
3738
Language.Haskell.Stylish.Step.UnicodeSyntax
@@ -99,6 +100,8 @@ Test-suite stylish-haskell-tests
99100
Language.Haskell.Stylish.Step
100101
Language.Haskell.Stylish.Step.SimpleAlign
101102
Language.Haskell.Stylish.Step.SimpleAlign.Tests
103+
Language.Haskell.Stylish.Step.Squash
104+
Language.Haskell.Stylish.Step.Squash.Tests
102105
Language.Haskell.Stylish.Step.Imports
103106
Language.Haskell.Stylish.Step.Imports.Tests
104107
Language.Haskell.Stylish.Step.LanguagePragmas

‎tests/Language/Haskell/Stylish/Step/Squash/Tests.hs‎

Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
--------------------------------------------------------------------------------
2+
module Language.Haskell.Stylish.Step.Squash.Tests
3+
( tests
4+
) where
5+
6+
7+
--------------------------------------------------------------------------------
8+
import Test.Framework (Test, testGroup)
9+
import Test.Framework.Providers.HUnit (testCase)
10+
import Test.HUnit (Assertion, (@=?))
11+
12+
13+
--------------------------------------------------------------------------------
14+
import Language.Haskell.Stylish.Step.Squash
15+
import Language.Haskell.Stylish.Tests.Util
16+
17+
18+
--------------------------------------------------------------------------------
19+
tests :: Test
20+
tests = testGroup "Language.Haskell.Stylish.Step.SimpleSquash.Tests"
21+
[ testCase "case 01" case01
22+
, testCase "case 02" case02
23+
, testCase "case 03" case03
24+
, testCase "case 04" case04
25+
, testCase "case 05" case05
26+
]
27+
28+
29+
--------------------------------------------------------------------------------
30+
case01 :: Assertion
31+
case01 = expected @=? testStep step input
32+
where
33+
input = unlines
34+
[ "data Foo = Foo"
35+
, " { foo :: Int"
36+
, " , barqux :: String"
37+
, " } deriving (Show)"
38+
]
39+
40+
expected = unlines
41+
[ "data Foo = Foo"
42+
, " { foo :: Int"
43+
, " , barqux :: String"
44+
, " } deriving (Show)"
45+
]
46+
47+
48+
--------------------------------------------------------------------------------
49+
case02 :: Assertion
50+
case02 = expected @=? testStep step input
51+
where
52+
input = unlines
53+
[ "data Foo = Foo"
54+
, " { fooqux"
55+
, " , bar :: String"
56+
, " } deriving (Show)"
57+
]
58+
59+
expected = unlines
60+
[ "data Foo = Foo"
61+
, " { fooqux"
62+
, " , bar :: String"
63+
, " } deriving (Show)"
64+
]
65+
66+
67+
--------------------------------------------------------------------------------
68+
case03 :: Assertion
69+
case03 = expected @=? testStep step input
70+
where
71+
input = unlines
72+
[ "maybe y0 f mx ="
73+
, " case mx of"
74+
, " Nothing -> y0"
75+
, " Just x -> f x"
76+
]
77+
78+
expected = unlines
79+
[ "maybe y0 f mx ="
80+
, " case mx of"
81+
, " Nothing -> y0"
82+
, " Just x -> f x"
83+
]
84+
85+
86+
--------------------------------------------------------------------------------
87+
case04 :: Assertion
88+
case04 = expected @=? testStep step input
89+
where
90+
input = unlines
91+
[ "maybe y0 f mx ="
92+
, " case mx of"
93+
, " Nothing ->"
94+
, " y0"
95+
, " Just x ->"
96+
, " f x"
97+
]
98+
99+
expected = unlines
100+
[ "maybe y0 f mx ="
101+
, " case mx of"
102+
, " Nothing ->"
103+
, " y0"
104+
, " Just x ->"
105+
, " f x"
106+
]
107+
108+
109+
--------------------------------------------------------------------------------
110+
case05 :: Assertion
111+
case05 = expected @=? testStep step input
112+
where
113+
input = unlines
114+
[ "maybe y0 _ Nothing = y"
115+
, "maybe _ f (Just x) = f x"
116+
]
117+
118+
expected = unlines
119+
[ "maybe y0 _ Nothing = y"
120+
, "maybe _ f (Just x) = f x"
121+
]

‎tests/TestSuite.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ import qualified Language.Haskell.Stylish.Parse.Tests
1313
import qualified Language.Haskell.Stylish.Step.Imports.Tests
1414
import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests
1515
import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests
16+
import qualified Language.Haskell.Stylish.Step.Squash.Tests
1617
import qualified Language.Haskell.Stylish.Step.Tabs.Tests
1718
import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests
1819
import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests
@@ -25,6 +26,7 @@ main = defaultMain
2526
, Language.Haskell.Stylish.Step.Imports.Tests.tests
2627
, Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests
2728
, Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests
29+
, Language.Haskell.Stylish.Step.Squash.Tests.tests
2830
, Language.Haskell.Stylish.Step.Tabs.Tests.tests
2931
, Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests
3032
, Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests

0 commit comments

Comments
 (0)