@@ -65,14 +65,15 @@ p_hsDecls' grouping style decls = sepSemi id $
6565 renderGroupWithPrev prev curr =
6666 -- We can omit a blank line when the user didn't add one, but we must
6767 -- ensure we always add blank lines around documented declarations
68− if or
69− [ grouping == Disregard,
70− separatedByBlank getLoc prev curr,
71− isDocumented prev,
72− isDocumented curr
73− ]
74− then breakpoint : renderGroup curr
75− else renderGroup curr
68+ case grouping of
69+ Disregard ->
70+ breakpoint : renderGroup curr
71+ Respect ->
72+ if separatedByBlankNE getLoc prev curr
73+ || isDocumented prev
74+ || isDocumented curr
75+ then breakpoint : renderGroup curr
76+ else renderGroup curr
7677
7778-- | Is a declaration group documented?
7879isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool
@@ -85,7 +86,7 @@ isDocumented = any (isHaddock . unLoc)
8586-- | Group relevant declarations together.
8687--
8788-- Add a declaration to a group iff it is relevant to either the first or
88−-- the last declaration of the group.
89+-- the preceding declaration in the group.
8990groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]
9091groupDecls [] = []
9192groupDecls (l@(L _ DocNext) : xs) =
@@ -94,18 +95,12 @@ groupDecls (l@(L _ DocNext) : xs) =
9495 case groupDecls xs of
9596 [] -> [l :| []]
9697 (x : xs') -> (l <| x) : xs'
97−groupDecls (lhdr : xs) =
98− let -- Pick the first decl as the group header
99− hdr = unLoc lhdr
100− -- Zip rest of the decls with their previous decl
101− zipped = zip (lhdr : xs) xs
102− -- Pick decls from the tail if they are relevant to the group header
103− -- or the previous decl.
104− (grp, rest) = flip span zipped $ \(L _ prev, L _ cur) ->
105− let relevantToHdr = groupedDecls hdr cur
106− relevantToPrev = groupedDecls prev cur
98+groupDecls (header : xs) =
99+ let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->
100+ let relevantToHdr = groupedDecls header current
101+ relevantToPrev = groupedDecls previous current
107102 in relevantToHdr || relevantToPrev
108− in (lhdr :| map snd grp) : groupDecls (map snd rest)
103+ in (header :| map snd grp) : groupDecls (map snd rest)
109104
110105p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()
111106p_hsDecl style = \case
@@ -169,30 +164,37 @@ p_derivDecl = \case
169164
170165-- | Determine if these declarations should be grouped together.
171166groupedDecls ::
172− HsDecl GhcPs ->
173− HsDecl GhcPs ->
167+ LHsDecl GhcPs ->
168+ LHsDecl GhcPs ->
174169 Bool
175−groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'
176−groupedDecls (TypeSignature ns) (DefaultSignature ns') = ns `intersects` ns'
177−groupedDecls (DefaultSignature ns) (TypeSignature ns') = ns `intersects` ns'
178−groupedDecls (DefaultSignature ns) (FunctionBody ns') = ns `intersects` ns'
179−groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns'
180−groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns'
181−groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns
182−groupedDecls (DataDeclaration n) x
183− | Just ns <- isPragma x =
184− let f = occNameFS . rdrNameOcc in f n `elem` map f ns
185−groupedDecls x y | Just ns <- isPragma x, Just ns' <- isPragma y = ns `intersects` ns'
186−groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'
187−groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'
188−groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns
189−groupedDecls (KindSignature n) (DataDeclaration n') = n == n'
190−groupedDecls (KindSignature n) (ClassDeclaration n') = n == n'
191−groupedDecls (KindSignature n) (FamilyDeclaration n') = n == n'
192−-- This looks only at Haddocks, normal comments are handled elsewhere
193−groupedDecls DocNext _ = True
194−groupedDecls _ DocPrev = True
195−groupedDecls _ _ = False
170+groupedDecls (L l_x x') (L l_y y') =
171+ case (x', y') of
172+ (TypeSignature ns, FunctionBody ns') -> ns `intersects` ns'
173+ (TypeSignature ns, DefaultSignature ns') -> ns `intersects` ns'
174+ (DefaultSignature ns, TypeSignature ns') -> ns `intersects` ns'
175+ (DefaultSignature ns, FunctionBody ns') -> ns `intersects` ns'
176+ (x, FunctionBody ns) | Just ns' <- isPragma x -> ns `intersects` ns'
177+ (FunctionBody ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'
178+ (x, DataDeclaration n) | Just ns <- isPragma x -> n `elem` ns
179+ (DataDeclaration n, x)
180+ | Just ns <- isPragma x ->
181+ let f = occNameFS . rdrNameOcc in f n `elem` map f ns
182+ (x, y)
183+ | Just ns <- isPragma x,
184+ Just ns' <- isPragma y ->
185+ ns `intersects` ns'
186+ (x, TypeSignature ns) | Just ns' <- isPragma x -> ns `intersects` ns'
187+ (TypeSignature ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'
188+ (PatternSignature ns, Pattern n) -> n `elem` ns
189+ (KindSignature n, DataDeclaration n') -> n == n'
190+ (KindSignature n, ClassDeclaration n') -> n == n'
191+ (KindSignature n, FamilyDeclaration n') -> n == n'
192+ -- Special case for TH splices, we look at locations
193+ (Splice, Splice) -> not (separatedByBlank id l_x l_y)
194+ -- This looks only at Haddocks, normal comments are handled elsewhere
195+ (DocNext, _) -> True
196+ (_, DocPrev) -> True
197+ _ -> False
196198
197199intersects :: Ord a => [a] -> [a] -> Bool
198200intersects a b = go (sort a) (sort b)
@@ -217,6 +219,11 @@ isPragma = \case
217219 WarningPragma n -> Just n
218220 _ -> Nothing
219221
222+-- Declarations that do not refer to names
223+
224+pattern Splice :: HsDecl GhcPs
225+pattern Splice <- SpliceD NoExtField (SpliceDecl NoExtField _ _)
226+
220227-- Declarations referring to a single name
221228
222229pattern