Skip to content

Commit dffc1db

Browse files
author
Mizunashi Mana
committed
Fix layout process for empty let statements
1 parent fd444cc commit dffc1db

7 files changed

+222
-1
lines changed

‎src/Language/Haskell/Exts/InternalLexer.hs

+4
Original file line numberDiff line numberDiff line change
@@ -400,6 +400,10 @@ topLexer = do
400400
#ifdef DEBUG
401401
trace ("By context flag: " ++ show VRightCurly) $ return ()
402402
#endif
403+
b <- checkParentContextL
404+
when b $
405+
popContextL "lexBOL"
406+
403407
-- the lex context state flags that we must do an empty {} - UGLY
404408
sl <- getSrcLocL
405409
setBOL

‎src/Language/Haskell/Exts/ParseMonad.hs

+8-1
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ module Language.Haskell.Exts.ParseMonad(
3434
-- * Harp/Hsx
3535
ExtContext(..),
3636
pushExtContextL, popExtContextL, getExtContext,
37-
pullCtxtFlag, flagDo,
37+
pullCtxtFlag, flagDo, checkParentContextL,
3838
getModuleName
3939
) where
4040

@@ -519,6 +519,13 @@ flagDo :: Lex a ()
519519
flagDo = Lex $ \cont -> P $ \r x y loc ch (ct, exts, e, (_,c), cs) ->
520520
runP (cont ()) r x y loc ch (ct, exts, e, (True,c), cs)
521521

522+
checkParentContextL :: Lex a Bool
523+
checkParentContextL = do
524+
l <- getSrcLocL
525+
parserL $ P $ \_i _x _y _l _ s@(stk, _, _, _, _) _m -> case stk of
526+
(_:Layout StmtLayout i:_) | srcColumn l == i -> Ok s True
527+
_ -> Ok s False
528+
522529

523530
-- Harp/Hsx
524531

‎tests/examples/EmptyBinds.hs

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
m1 = do let
2+
[]
3+
4+
m2 = do
5+
let
6+
[]
7+
8+
x = True

‎tests/examples/EmptyBinds.hs.exactprinter.golden

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Match

‎tests/examples/EmptyBinds.hs.parser.golden

+193
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,193 @@
1+
ParseOk
2+
( Module
3+
SrcSpanInfo
4+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 1 9 1
5+
, srcInfoPoints =
6+
[ SrcSpan "tests/examples/EmptyBinds.hs" 1 1 1 1
7+
, SrcSpan "tests/examples/EmptyBinds.hs" 1 1 1 1
8+
, SrcSpan "tests/examples/EmptyBinds.hs" 1 1 1 1
9+
, SrcSpan "tests/examples/EmptyBinds.hs" 4 1 4 1
10+
, SrcSpan "tests/examples/EmptyBinds.hs" 8 1 8 1
11+
, SrcSpan "tests/examples/EmptyBinds.hs" 9 1 9 1
12+
, SrcSpan "tests/examples/EmptyBinds.hs" 9 1 9 1
13+
]
14+
}
15+
Nothing
16+
[]
17+
[]
18+
[ PatBind
19+
SrcSpanInfo
20+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 1 2 11
21+
, srcInfoPoints = []
22+
}
23+
(PVar
24+
SrcSpanInfo
25+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 1 1 3
26+
, srcInfoPoints = []
27+
}
28+
(Ident
29+
SrcSpanInfo
30+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 1 1 3
31+
, srcInfoPoints = []
32+
}
33+
"m1"))
34+
(UnGuardedRhs
35+
SrcSpanInfo
36+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 4 2 11
37+
, srcInfoPoints =
38+
[ SrcSpan "tests/examples/EmptyBinds.hs" 1 4 1 5 ]
39+
}
40+
(Do
41+
SrcSpanInfo
42+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 6 2 11
43+
, srcInfoPoints =
44+
[ SrcSpan "tests/examples/EmptyBinds.hs" 1 6 1 8
45+
, SrcSpan "tests/examples/EmptyBinds.hs" 1 9 1 9
46+
, SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 9
47+
, SrcSpan "tests/examples/EmptyBinds.hs" 4 1 4 0
48+
]
49+
}
50+
[ LetStmt
51+
SrcSpanInfo
52+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 1 9 2 9
53+
, srcInfoPoints =
54+
[ SrcSpan "tests/examples/EmptyBinds.hs" 1 9 1 12 ]
55+
}
56+
(BDecls
57+
SrcSpanInfo
58+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 9
59+
, srcInfoPoints =
60+
[ SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 9
61+
, SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 9
62+
, SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 0
63+
]
64+
}
65+
[])
66+
, Qualifier
67+
SrcSpanInfo
68+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 11
69+
, srcInfoPoints =
70+
[ SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 10
71+
, SrcSpan "tests/examples/EmptyBinds.hs" 2 10 2 11
72+
]
73+
}
74+
(List
75+
SrcSpanInfo
76+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 11
77+
, srcInfoPoints =
78+
[ SrcSpan "tests/examples/EmptyBinds.hs" 2 9 2 10
79+
, SrcSpan "tests/examples/EmptyBinds.hs" 2 10 2 11
80+
]
81+
}
82+
[])
83+
]))
84+
Nothing
85+
, PatBind
86+
SrcSpanInfo
87+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 4 1 6 4
88+
, srcInfoPoints = []
89+
}
90+
(PVar
91+
SrcSpanInfo
92+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 4 1 4 3
93+
, srcInfoPoints = []
94+
}
95+
(Ident
96+
SrcSpanInfo
97+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 4 1 4 3
98+
, srcInfoPoints = []
99+
}
100+
"m2"))
101+
(UnGuardedRhs
102+
SrcSpanInfo
103+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 4 4 6 4
104+
, srcInfoPoints =
105+
[ SrcSpan "tests/examples/EmptyBinds.hs" 4 4 4 5 ]
106+
}
107+
(Do
108+
SrcSpanInfo
109+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 4 6 6 4
110+
, srcInfoPoints =
111+
[ SrcSpan "tests/examples/EmptyBinds.hs" 4 6 4 8
112+
, SrcSpan "tests/examples/EmptyBinds.hs" 5 2 5 2
113+
, SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 2
114+
, SrcSpan "tests/examples/EmptyBinds.hs" 8 1 8 0
115+
]
116+
}
117+
[ LetStmt
118+
SrcSpanInfo
119+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 5 2 6 2
120+
, srcInfoPoints =
121+
[ SrcSpan "tests/examples/EmptyBinds.hs" 5 2 5 5 ]
122+
}
123+
(BDecls
124+
SrcSpanInfo
125+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 2
126+
, srcInfoPoints =
127+
[ SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 2
128+
, SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 2
129+
, SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 0
130+
]
131+
}
132+
[])
133+
, Qualifier
134+
SrcSpanInfo
135+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 4
136+
, srcInfoPoints =
137+
[ SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 3
138+
, SrcSpan "tests/examples/EmptyBinds.hs" 6 3 6 4
139+
]
140+
}
141+
(List
142+
SrcSpanInfo
143+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 4
144+
, srcInfoPoints =
145+
[ SrcSpan "tests/examples/EmptyBinds.hs" 6 2 6 3
146+
, SrcSpan "tests/examples/EmptyBinds.hs" 6 3 6 4
147+
]
148+
}
149+
[])
150+
]))
151+
Nothing
152+
, PatBind
153+
SrcSpanInfo
154+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 1 8 9
155+
, srcInfoPoints = []
156+
}
157+
(PVar
158+
SrcSpanInfo
159+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 1 8 2
160+
, srcInfoPoints = []
161+
}
162+
(Ident
163+
SrcSpanInfo
164+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 1 8 2
165+
, srcInfoPoints = []
166+
}
167+
"x"))
168+
(UnGuardedRhs
169+
SrcSpanInfo
170+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 3 8 9
171+
, srcInfoPoints =
172+
[ SrcSpan "tests/examples/EmptyBinds.hs" 8 3 8 4 ]
173+
}
174+
(Con
175+
SrcSpanInfo
176+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 5 8 9
177+
, srcInfoPoints = []
178+
}
179+
(UnQual
180+
SrcSpanInfo
181+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 5 8 9
182+
, srcInfoPoints = []
183+
}
184+
(Ident
185+
SrcSpanInfo
186+
{ srcInfoSpan = SrcSpan "tests/examples/EmptyBinds.hs" 8 5 8 9
187+
, srcInfoPoints = []
188+
}
189+
"True"))))
190+
Nothing
191+
]
192+
, []
193+
)

‎tests/examples/EmptyBinds.hs.prettyparser.golden

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Match

‎tests/examples/EmptyBinds.hs.prettyprinter.golden

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
m1
2+
= do let
3+
[]
4+
m2
5+
= do let
6+
[]
7+
x = True

0 commit comments

Comments
 (0)