@@ -1,4 +1,5 @@
11{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE MultiWayIf #-}
23{-# LANGUAGE OverloadedStrings #-}
34{-# LANGUAGE RecordWildCards #-}
45{-# LANGUAGE TypeApplications #-}
@@ -21,12 +22,12 @@ import Data.Char (isPunctuation, isSymbol)
2122import Data.Data hiding (Infix, Prefix)
2223import Data.Functor ((<&>))
2324import Data.List (intersperse, sortOn)
24−import Data.List.NonEmpty ((<|), NonEmpty (..))
25+import Data.List.NonEmpty (NonEmpty (..), (<|))
2526import qualified Data.List.NonEmpty as NE
2627import Data.Text (Text)
2728import qualified Data.Text as Text
2829import GHC
29−import OccName (mkVarOcc)
30+import OccName (occNameString)
3031import Ormolu.Printer.Combinators
3132import Ormolu.Printer.Internal
3233import Ormolu.Printer.Meat.Common
@@ -60,7 +61,7 @@ data Placement
6061 -- should use it and avoid bumping one level
6162 -- of indentation
6263 Hanging
63− deriving (Eq)
64+ deriving (Eq, Show)
6465
6566p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
6667p_valDecl = \case
@@ -179,25 +180,24 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
179180 NoSrcStrict -> return ()
180181 SrcStrict -> txt "!"
181182 SrcLazy -> txt "~"
182− inci' <- case NE.nonEmpty m_pats of
183− Nothing -> id <$ case style of
184− Function name -> p_rdrName name
185− _ -> return ()
183+ indentBody <- case NE.nonEmpty m_pats of
184+ Nothing ->
185+ False <$ case style of
186+ Function name -> p_rdrName name
187+ _ -> return ()
186188 Just ne_pats -> do
187− let combinedSpans =
188− combineSrcSpans' $
189− getLoc <$> ne_pats
190− inci' =
191− if isOneLineSpan combinedSpans
192− then id
193− else inci
189+ let combinedSpans = case style of
190+ Function name -> combineSrcSpans (getLoc name) patSpans
191+ _ -> patSpans
192+ patSpans = combineSrcSpans' (getLoc <$> ne_pats)
193+ indentBody = not (isOneLineSpan combinedSpans)
194194 switchLayout [combinedSpans] $ do
195195 let stdCase = sep breakpoint (located' p_pat) m_pats
196196 case style of
197197 Function name ->
198198 p_infixDefHelper
199199 isInfix
200− inci'
200+ indentBody
201201 (p_rdrName name)
202202 (located' p_pat <$> m_pats)
203203 PatternBind -> stdCase
@@ -212,40 +212,32 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
212212 when needsSpace space
213213 sitcc stdCase
214214 LambdaCase -> stdCase
215− return inci'
215+ return indentBody
216216 let -- Calculate position of end of patterns. This is useful when we decide
217217 -- about putting certain constructions in hanging positions.
218218 endOfPats = case NE.nonEmpty m_pats of
219219 Nothing -> case style of
220− Function name -> (Just . srcSpanEnd . getLoc) name
220+ Function name -> Just (getLoc name)
221221 _ -> Nothing
222− Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats
222+ Just pats -> (Just . getLoc . NE.last) pats
223223 isCase = \case
224224 Case -> True
225225 LambdaCase -> True
226226 _ -> False
227− let hasGuards = withGuards grhssGRHSs
228− unless (length grhssGRHSs > 1) $
229− case style of
230− Function _ | hasGuards -> return ()
231− Function _ -> space >> txt "="
232− PatternBind -> space >> txt "="
233− s | isCase s && hasGuards -> return ()
234− _ -> space >> txt "->"
235− let grhssSpan =
227+ hasGuards = withGuards grhssGRHSs
228+ grhssSpan =
236229 combineSrcSpans' $
237230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
238231 patGrhssSpan =
239232 maybe
240233 grhssSpan
241− (combineSrcSpans grhssSpan . srcLocSpan)
234+ (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)
242235 endOfPats
243236 placement =
244237 case endOfPats of
245238 Nothing -> blockPlacement placer grhssGRHSs
246239 Just spn ->
247− if isOneLineSpan
248− (mkSrcSpan spn (srcSpanStart grhssSpan))
240+ if onTheSameLine spn grhssSpan
249241 then blockPlacement placer grhssGRHSs
250242 else Normal
251243 p_body = do
@@ -261,7 +253,14 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
261253 txt "where"
262254 unless whereIsEmpty breakpoint
263255 inci $ located grhssLocalBinds p_hsLocalBinds
264− inci' $ do
256+ inciIf indentBody $ do
257+ unless (length grhssGRHSs > 1) $
258+ case style of
259+ Function _ | hasGuards -> return ()
260+ Function _ -> space >> inci equals
261+ PatternBind -> space >> inci equals
262+ s | isCase s && hasGuards -> return ()
263+ _ -> space >> txt "->"
265264 switchLayout [patGrhssSpan] $
266265 placeHanging placement p_body
267266 inci p_where
@@ -285,24 +284,24 @@ p_grhs' placer render style (GRHS NoExtField guards body) =
285284 xs -> do
286285 txt "|"
287286 space
288− sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
287+ sitcc (sep commaDel (sitcc . located' p_stmt) xs)
289288 space
290− txt $ case style of
291− EqualSign -> "="
292− RightArrow -> "->"
289+ inci $ case style of
290+ EqualSign -> equals
291+ RightArrow -> txt "->"
293292 placeHanging placement p_body
294293 where
295294 placement =
296295 case endOfGuards of
297296 Nothing -> placer (unLoc body)
298297 Just spn ->
299− if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))
298+ if onTheSameLine spn (getLoc body)
300299 then placer (unLoc body)
301300 else Normal
302301 endOfGuards =
303302 case NE.nonEmpty guards of
304303 Nothing -> Nothing
305− Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs
304+ Just gs -> (Just . getLoc . NE.last) gs
306305 p_body = located body render
307306p_grhs' _ _ _ (XGRHS x) = noExtCon x
308307
@@ -317,7 +316,7 @@ p_hsCmd = \case
317316 HsHigherOrderApp -> txt "-<<"
318317 placeHanging (exprPlacement (unLoc input)) $
319318 located input p_hsExpr
320− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do
321320 located form p_hsExpr
322321 unless (null cmds) $ do
323322 breakpoint
@@ -354,7 +353,14 @@ p_hsCmdTop = \case
354353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
355354 XCmdTop x -> noExtCon x
356355
357−withSpacing :: Data a => (a -> R ()) -> Located a -> R ()
356+-- | Render an expression preserving blank lines between such consecutive
357+-- expressions found in the original source code.
358+withSpacing ::
359+ -- | Rendering function
360+ (a -> R ()) ->
361+ -- | Entity to render
362+ Located a ->
363+ R ()
358364withSpacing f l = located l $ \x -> do
359365 case getLoc l of
360366 UnhelpfulSpan _ -> f x
@@ -363,7 +369,7 @@ withSpacing f l = located l $ \x -> do
363369 -- Spacing before comments will be handled by the code
364370 -- that prints comments, so we just have to deal with
365371 -- blank lines between statements here.
366− Just (OtherSpan lastSpn) ->
372+ Just (StatementSpan lastSpn) ->
367373 if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1
368374 then newline
369375 else return ()
@@ -374,7 +380,7 @@ withSpacing f l = located l $ \x -> do
374380 getSpanMark >>= \case
375381 Just (HaddockSpan _ _) -> return ()
376382 Just (CommentSpan _) -> return ()
377− _ -> setSpanMark (OtherSpan currentSpn)
383+ _ -> setSpanMark (StatementSpan currentSpn)
378384
379385p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
380386p_stmt = p_stmt' exprPlacement p_hsExpr
@@ -465,37 +471,31 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x
465471p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
466472p_hsLocalBinds = \case
467473 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
468− let ssStart =
469− either
470− (srcSpanStart . getLoc)
471− (srcSpanStart . getLoc)
472− items =
473− (Left <$> bagToList bag) ++ (Right <$> lsigs)
474− p_item (Left x) = located x p_valDecl
475− p_item (Right x) = located x p_sigDecl
476474 -- When in a single-line layout, there is a chance that the inner
477475 -- elements will also contain semicolons and they will confuse the
478476 -- parser. so we request braces around every element except the last.
479477 br <- layoutToBraces <$> getLayout
480− sitcc $
481− sepSemi
482− ( \(p, i) ->
483− ( case p of
484− SinglePos -> id
485− FirstPos -> br
486− MiddlePos -> br
487− LastPos -> id
488− )
489− (p_item i)
490− )
491− (attachRelativePos $ sortOn ssStart items)
478+ let items =
479+ let injectLeft (L l x) = L l (Left x)
480+ injectRight (L l x) = L l (Right x)
481+ in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)
482+ positionToBracing = \case
483+ SinglePos -> id
484+ FirstPos -> br
485+ MiddlePos -> br
486+ LastPos -> id
487+ p_item' (p, item) =
488+ positionToBracing p $
489+ withSpacing (either p_valDecl p_sigDecl) item
490+ binds = sortOn (srcSpanStart . getLoc) items
491+ sitcc $ sepSemi p_item' (attachRelativePos binds)
492492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
493493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
494494 -- Second argument of IPBind is always Left before type-checking.
495495 let p_ipBind (IPBind NoExtField (Left name) expr) = do
496496 atom name
497497 space
498− txt "="
498+ equals
499499 breakpoint
500500 useBraces $ inci $ located expr p_hsExpr
501501 p_ipBind (IPBind NoExtField (Right _) _) =
@@ -514,15 +514,12 @@ p_hsRecField HsRecField {..} = do
514514 p_rdrName hsRecFieldLbl
515515 unless hsRecPun $ do
516516 space
517− txt "="
518− let placement = exprPlacement (unLoc hsRecFieldArg)
519− placeHanging placement $ located hsRecFieldArg p_hsExpr
520−
521−p_hsTupArg :: HsTupArg GhcPs -> R ()
522−p_hsTupArg = \case
523− Present NoExtField x -> located x p_hsExpr
524− Missing NoExtField -> pure ()
525− XTupArg x -> noExtCon x
517+ equals
518+ let placement =
519+ if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)
520+ then exprPlacement (unLoc hsRecFieldArg)
521+ else Normal
522+ placeHanging placement (located hsRecFieldArg p_hsExpr)
526523
527524p_hsExpr :: HsExpr GhcPs -> R ()
528525p_hsExpr = p_hsExpr' N
@@ -587,23 +584,21 @@ p_hsExpr' s = \case
587584 -- do-block or case expression it is not a good idea. It seems
588585 -- to be safe to always bump indentation when the function
589586 -- expression is parenthesised.
590− indent =
587+ doIndent =
591588 case func of
592− L _ (HsPar NoExtField _) -> inci
593− L _ (HsAppType NoExtField _ _) -> inci
594− L _ (HsMultiIf NoExtField _) -> inci
595− L spn _ ->
596− if isOneLineSpan spn
597− then inci
598− else id
599− ub <- getLayout <&> \case
600− SingleLine -> useBraces
601− MultiLine -> id
589+ L _ (HsPar NoExtField _) -> True
590+ L _ (HsAppType NoExtField _ _) -> True
591+ L _ (HsMultiIf NoExtField _) -> True
592+ L spn _ -> isOneLineSpan spn
593+ ub <-
594+ getLayout <&> \case
595+ SingleLine -> useBraces
596+ MultiLine -> id
602597 ub $ do
603598 located func (p_hsExpr' s)
604599 breakpoint
605− indent $ sep breakpoint (located' p_hsExpr) initp
606− indent $ do
600+ inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
601+ inciIf doIndent $ do
607602 unless (null initp) breakpoint
608603 located lastp p_hsExpr
609604 Hanging -> do
@@ -618,10 +613,15 @@ p_hsExpr' s = \case
618613 breakpoint
619614 inci $ do
620615 txt "@"
616+ -- Insert a space when the type is represented as a TH splice to avoid
617+ -- gluing @ and $ together.
618+ case unLoc (hswc_body a) of
619+ HsSpliceTy {} -> space
620+ _ -> return ()
621621 located (hswc_body a) p_hsType
622622 OpApp NoExtField x op y -> do
623623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
624− p_exprOpTree True s (reassociateOpTree getOpName opTree)
624+ p_exprOpTree s (reassociateOpTree getOpName opTree)
625625 NegApp NoExtField e _ -> do
626626 txt "-"
627627 space
@@ -638,22 +638,27 @@ p_hsExpr' s = \case
638638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
639639 unless (useRecordDot' && isRecordDot') breakpoint
640640 inci (located x p_hsExpr)
641− ExplicitTuple NoExtField args boxity -> do
641+ ExplicitTuple NoExtField args boxity ->
642642 let isSection = any (isMissing . unLoc) args
643643 isMissing = \case
644644 Missing NoExtField -> True
645645 _ -> False
646− let parens' =
646+ p_arg = \case
647+ Present NoExtField x -> located x p_hsExpr
648+ Missing NoExtField -> pure ()
649+ XTupArg x -> noExtCon x
650+ p_larg = sitcc . located' p_arg
651+ parens' =
647652 case boxity of
648653 Boxed -> parens
649654 Unboxed -> parensHash
650− if isSection
651− then
652− switchLayout [] . parens' s $
653− sep comma (located' p_hsTupArg) args
654− else
655− switchLayout (getLoc <$> args) . parens' s . sitcc $
656− sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
655+ in if isSection
656+ then
657+ switchLayout [] . parens' s $
658+ sep comma p_larg args
659+ else
660+ switchLayout (getLoc <$> args) . parens' s $
661+ sep commaDel p_larg args
657662 ExplicitSum NoExtField tag arity e ->
658663 p_unboxedSum N tag arity (located e p_hsExpr)
659664 HsCase NoExtField e mgroup ->
@@ -661,8 +666,9 @@ p_hsExpr' s = \case
661666 HsIf NoExtField _ if' then' else' ->
662667 p_if exprPlacement p_hsExpr if' then' else'
663668 HsMultiIf NoExtField guards -> do
664− txt "if "
665− inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
669+ txt "if"
670+ breakpoint
671+ inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
666672 HsLet NoExtField localBinds e ->
667673 p_let p_hsExpr localBinds e
668674 HsDo NoExtField ctx es -> do
@@ -674,15 +680,15 @@ p_hsExpr' s = \case
674680 sepSemi
675681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
676682 (unLoc es)
677− compBody = brackets N $ located es $ \xs -> do
683+ compBody = brackets N . located es $ \xs -> do
678684 let p_parBody =
679685 sep
680− (breakpoint >> txt "| ")
686+ (breakpoint >> txt "|" >> space)
681687 p_seqBody
682688 p_seqBody =
683689 sitcc
684690 . sep
685− (comma >> breakpoint)
691+ commaDel
686692 (located' (sitcc . p_stmt))
687693 stmts = init xs
688694 yield = last xs
@@ -703,8 +709,8 @@ p_hsExpr' s = \case
703709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
704710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
705711 ExplicitList _ _ xs ->
706− brackets s . sitcc $
707− sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
712+ brackets s $
713+ sep commaDel (sitcc . located' p_hsExpr) xs
708714 RecordCon {..} -> do
709715 located rcon_con_name atom
710716 breakpoint
@@ -720,8 +726,8 @@ p_hsExpr' s = \case
720726 case rec_dotdot of
721727 Just {} -> [txt ".."]
722728 Nothing -> []
723− inci . braces N . sitcc $
724− sep (comma >> breakpoint) sitcc (fields <> dotdot)
729+ inci . braces N $
730+ sep commaDel sitcc (fields <> dotdot)
725731 RecordUpd {..} -> do
726732 located rupd_expr p_hsExpr
727733 useRecordDot' <- useRecordDot
@@ -739,9 +745,9 @@ p_hsExpr' s = \case
739745 Unambiguous _ n -> n
740746 XAmbiguousFieldOcc x -> noExtCon x
741747 }
742− inci . braces N . sitcc $
748+ inci . braces N $
743749 sep
744− (comma >> breakpoint)
750+ commaDel
745751 (sitcc . located' (p_hsRecField . updName))
746752 rupd_flds
747753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -754,22 +760,22 @@ p_hsExpr' s = \case
754760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
755761 ArithSeq NoExtField _ x ->
756762 case x of
757− From from -> brackets s . sitcc $ do
763+ From from -> brackets s $ do
758764 located from p_hsExpr
759765 breakpoint
760766 txt ".."
761− FromThen from next -> brackets s . sitcc $ do
762− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
767+ FromThen from next -> brackets s $ do
768+ sep commaDel (located' p_hsExpr) [from, next]
763769 breakpoint
764770 txt ".."
765− FromTo from to -> brackets s . sitcc $ do
771+ FromTo from to -> brackets s $ do
766772 located from p_hsExpr
767773 breakpoint
768774 txt ".."
769775 space
770776 located to p_hsExpr
771− FromThenTo from next to -> brackets s . sitcc $ do
772− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
777+ FromThenTo from next to -> brackets s $ do
778+ sep commaDel (located' p_hsExpr) [from, next]
773779 breakpoint
774780 txt ".."
775781 space
@@ -819,7 +825,7 @@ p_patSynBind PSB {..} = do
819825 breakpoint
820826 located psb_def p_pat
821827 ImplicitBidirectional -> do
822− txt "="
828+ equals
823829 breakpoint
824830 located psb_def p_pat
825831 ExplicitBidirectional mgroup -> do
@@ -846,8 +852,8 @@ p_patSynBind PSB {..} = do
846852 inci $ do
847853 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
848854 unless (null xs) breakpoint
849− braces N . sitcc $
850− sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
855+ braces N $
856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs
851857 rhs
852858 InfixCon l r -> do
853859 switchLayout [getLoc l, getLoc r] $ do
@@ -901,10 +907,12 @@ p_if placer render if' then' else' = do
901907 breakpoint
902908 inci $ do
903909 txt "then"
910+ space
904911 located then' $ \x ->
905912 placeHanging (placer x) (render x)
906913 breakpoint
907914 txt "else"
915+ space
908916 located else' $ \x ->
909917 placeHanging (placer x) (render x)
910918
@@ -941,13 +949,13 @@ p_pat = \case
941949 txt "!"
942950 located pat p_pat
943951 ListPat NoExtField pats ->
944− brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
952+ brackets S $ sep commaDel (located' p_pat) pats
945953 TuplePat NoExtField pats boxing -> do
946− let f =
954+ let parens' =
947955 case boxing of
948956 Boxed -> parens S
949957 Unboxed -> parensHash S
950− f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
958+ parens' $ sep commaDel (sitcc . located' p_pat) pats
951959 SumPat NoExtField pat tag arity ->
952960 p_unboxedSum S tag arity (located pat p_pat)
953961 ConPatIn pat details ->
@@ -963,7 +971,7 @@ p_pat = \case
963971 let f = \case
964972 Nothing -> txt ".."
965973 Just x -> located x p_pat_hsRecField
966− inci . braces N . sitcc . sep (comma >> breakpoint) f $
974+ inci . braces N . sep commaDel f $
967975 case dotdot of
968976 Nothing -> Just <$> fields
969977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1004,7 +1012,7 @@ p_pat_hsRecField HsRecField {..} = do
10041012 p_rdrName (rdrNameFieldOcc x)
10051013 unless hsRecPun $ do
10061014 space
1007− txt "="
1015+ equals
10081016 breakpoint
10091017 inci (located hsRecFieldArg p_pat)
10101018
@@ -1013,17 +1021,15 @@ p_unboxedSum s tag arity m = do
10131021 let before = tag - 1
10141022 after = arity - before - 1
10151023 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1016− f (x, i) = do
1017− let isFirst = i == 0
1018− isLast = i == arity - 1
1024+ f x =
10191025 case x :: Maybe (R ()) of
10201026 Nothing ->
1021− unless (isFirst || isLast) space
1027+ space
10221028 Just m' -> do
1023− unless isFirst space
1029+ space
10241030 m'
1025− unless isLast space
1026− parensHash s $ sep (txt "|") f (zip args [0 ..])
1031+ space
1032+ parensHash s $ sep (txt "|") f args
10271033
10281034p_hsSplice :: HsSplice GhcPs -> R ()
10291035p_hsSplice = \case
@@ -1225,11 +1231,10 @@ exprPlacement = \case
12251231 HsCase NoExtField _ _ -> Hanging
12261232 HsDo NoExtField DoExpr _ -> Hanging
12271233 HsDo NoExtField MDoExpr _ -> Hanging
1228− -- If the rightmost expression in an operator chain is hanging, make the
1229− -- whole block hanging; so that we can use the common @f = foo $ do@
1230− -- style.
1231− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1232− -- Same thing for function applications (usually with -XBlockArguments)
1234+ OpApp NoExtField _ op y ->
1235+ case (fmap getOpNameStr . getOpName . unLoc) op of
1236+ Just "$" -> exprPlacement (unLoc y)
1237+ _ -> Normal
12331238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
12341239 HsProc NoExtField p _ ->
12351240 -- Indentation breaks if pattern is longer than one line and left
@@ -1255,15 +1260,16 @@ getOpName = \case
12551260 HsVar NoExtField (L _ a) -> Just a
12561261 _ -> Nothing
12571262
1263+getOpNameStr :: RdrName -> String
1264+getOpNameStr = occNameString . rdrNameOcc
1265+
12581266p_exprOpTree ::
1259− -- | Can use special handling of dollar?
1260− Bool ->
12611267 -- | Bracket style to use
12621268 BracketStyle ->
12631269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
12641270 R ()
1265−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1266−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1271+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1272+p_exprOpTree s (OpBranch x op y) = do
12671273 -- If the beginning of the first argument and the second argument are on
12681274 -- the same line, and the second argument has a hanging form, use hanging
12691275 -- placement.
@@ -1285,44 +1291,54 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
12851291 MultiLine -> case placement of
12861292 Hanging -> useBraces
12871293 Normal -> dontUseBraces
1288− gotDollar = case getOpName (unLoc op) of
1289− Just rname -> mkVarOcc "$" == rdrNameOcc rname
1290− _ -> False
1294+ opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1295+ gotDollar = opNameStr == Just "$"
1296+ gotColon = opNameStr == Just ":"
1297+ gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
12911298 lhs =
12921299 switchLayout [opTreeLoc x] $
1293− p_exprOpTree (not gotDollar) s x
1294− let p_op = located op (opWrapper . p_hsExpr)
1295− p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
1300+ p_exprOpTree s x
1301+ p_op = located op (opWrapper . p_hsExpr)
1302+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)
12961303 isSection = case (opTreeLoc x, getLoc op) of
12971304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
12981305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
12991306 _ -> False
1307+ isDoBlock = \case
1308+ OpNode (L _ HsDo {}) -> True
1309+ _ -> False
13001310 useRecordDot' <- useRecordDot
1301− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1302− if useRecordDot' && isRecordDot'
1303− then do
1304− lhs
1305− when isSection space
1306− p_op
1307− p_y
1308− else
1309− if isDollarSpecial
1310− && gotDollar
1311− && placement
1312− == Normal
1313− && isOneLineSpan (opTreeLoc x)
1314− then do
1315− useBraces lhs
1316− space
1317− p_op
1318− breakpoint
1319− inci p_y
1320− else do
1321− ub lhs
1322− placeHanging placement $ do
1323− p_op
1311+ if
1312+ | gotColon -> do
1313+ lhs
1314+ space
1315+ p_op
1316+ case placement of
1317+ Hanging -> do
13241318 space
13251319 p_y
1320+ Normal -> do
1321+ breakpoint
1322+ inciIf (isDoBlock y) p_y
1323+ | gotDollar
1324+ && isOneLineSpan (opTreeLoc x)
1325+ && placement == Normal -> do
1326+ useBraces lhs
1327+ space
1328+ p_op
1329+ breakpoint
1330+ inci p_y
1331+ | useRecordDot' && gotRecordDot -> do
1332+ lhs
1333+ when isSection space
1334+ p_op
1335+ p_y
1336+ | otherwise -> do
1337+ ub lhs
1338+ placeHanging placement $ do
1339+ p_op
1340+ space
1341+ p_y
13261342
13271343-- | Return 'True' if given expression is a record-dot operator expression.
13281344isRecordDot ::
@@ -1333,14 +1349,10 @@ isRecordDot ::
13331349 Bool
13341350isRecordDot op (RealSrcSpan ySpan) = case op of
13351351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1336− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1352+ (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
13371353 _ -> False
13381354isRecordDot _ _ = False
13391355
1340−-- | Check whether a given 'RdrName' is the dot operator.
1341−isDot :: RdrName -> Bool
1342−isDot name = rdrNameOcc name == mkVarOcc "."
1343−
13441356-- | Get annotations for the enclosing element.
13451357getEnclosingAnns :: R [AnnKeywordId]
13461358getEnclosingAnns = do