@@ -1,5 +1,4 @@
1{-# LANGUAGE LambdaCase #-}
1{-# LANGUAGE LambdaCase #-}
2−{-# LANGUAGE MultiWayIf #-}
3{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE TypeApplications #-}
4{-# LANGUAGE TypeApplications #-}
@@ -22,12 +21,12 @@ import Data.Char (isPunctuation, isSymbol)
22import Data.Data hiding (Infix, Prefix)
21import Data.Data hiding (Infix, Prefix)
23import Data.Functor ((<&>))
22import Data.Functor ((<&>))
24import Data.List (intersperse, sortOn)
23import Data.List (intersperse, sortOn)
25−import Data.List.NonEmpty (NonEmpty (..), (<|))
24+import Data.List.NonEmpty ((<|), NonEmpty (..))
26import qualified Data.List.NonEmpty as NE
25import qualified Data.List.NonEmpty as NE
27import Data.Text (Text)
26import Data.Text (Text)
28import qualified Data.Text as Text
27import qualified Data.Text as Text
30−import OccName (occNameString)
29+import OccName (mkVarOcc)
31import Ormolu.Printer.Combinators
30import Ormolu.Printer.Combinators
32import Ormolu.Printer.Internal
31import Ormolu.Printer.Internal
33import Ormolu.Printer.Meat.Common
32import Ormolu.Printer.Meat.Common
@@ -61,7 +60,7 @@ data Placement
61 -- should use it and avoid bumping one level
60 -- should use it and avoid bumping one level
62 -- of indentation
61 -- of indentation
64− deriving (Eq, Show)
63+ deriving (Eq)
66p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
65p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
67p_valDecl = \case
66p_valDecl = \case
@@ -180,24 +179,25 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
180 NoSrcStrict -> return ()
179 NoSrcStrict -> return ()
181 SrcStrict -> txt "!"
180 SrcStrict -> txt "!"
182 SrcLazy -> txt "~"
181 SrcLazy -> txt "~"
183− indentBody <- case NE.nonEmpty m_pats of
182+ inci' <- case NE.nonEmpty m_pats of
185− False <$ case style of
183+ Nothing -> id <$ case style of
186− Function name -> p_rdrName name
184+ Function name -> p_rdrName name
187− _ -> return ()
185+ _ -> return ()
188 Just ne_pats -> do
186 Just ne_pats -> do
189− let combinedSpans = case style of
187+ let combinedSpans =
190− Function name -> combineSrcSpans (getLoc name) patSpans
188+ combineSrcSpans' $
192− patSpans = combineSrcSpans' (getLoc <$> ne_pats)
189+ getLoc <$> ne_pats
193− indentBody = not (isOneLineSpan combinedSpans)
191+ if isOneLineSpan combinedSpans
194 switchLayout [combinedSpans] $ do
194 switchLayout [combinedSpans] $ do
195 let stdCase = sep breakpoint (located' p_pat) m_pats
195 let stdCase = sep breakpoint (located' p_pat) m_pats
196 case style of
196 case style of
197 Function name ->
197 Function name ->
198 p_infixDefHelper
198 p_infixDefHelper
200− indentBody
200+ inci'
201 (p_rdrName name)
201 (p_rdrName name)
202 (located' p_pat <$> m_pats)
202 (located' p_pat <$> m_pats)
203 PatternBind -> stdCase
203 PatternBind -> stdCase
@@ -212,7 +212,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
212 when needsSpace space
212 when needsSpace space
213 sitcc stdCase
213 sitcc stdCase
214 LambdaCase -> stdCase
214 LambdaCase -> stdCase
215− return indentBody
215+ return inci'
216 let -- Calculate position of end of patterns. This is useful when we decide
216 let -- Calculate position of end of patterns. This is useful when we decide
217 -- about putting certain constructions in hanging positions.
217 -- about putting certain constructions in hanging positions.
218 endOfPats = case NE.nonEmpty m_pats of
218 endOfPats = case NE.nonEmpty m_pats of
@@ -224,7 +224,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
224 Case -> True
224 Case -> True
225 LambdaCase -> True
225 LambdaCase -> True
226 _ -> False
226 _ -> False
227− hasGuards = withGuards grhssGRHSs
227+ let hasGuards = withGuards grhssGRHSs
228 grhssSpan =
228 grhssSpan =
229 combineSrcSpans' $
229 combineSrcSpans' $
230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
@@ -253,7 +253,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
253 txt "where"
253 txt "where"
254 unless whereIsEmpty breakpoint
254 unless whereIsEmpty breakpoint
255 inci $ located grhssLocalBinds p_hsLocalBinds
255 inci $ located grhssLocalBinds p_hsLocalBinds
256− inciIf indentBody $ do
256+ inci' $ do
257 unless (length grhssGRHSs > 1) $
257 unless (length grhssGRHSs > 1) $
258 case style of
258 case style of
259 Function _ | hasGuards -> return ()
259 Function _ | hasGuards -> return ()
@@ -284,7 +284,7 @@ p_grhs' placer render style (GRHS NoExtField guards body) =
287− sitcc (sep commaDel (sitcc . located' p_stmt) xs)
287+ sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
289 inci $ case style of
289 inci $ case style of
290 EqualSign -> equals
290 EqualSign -> equals
@@ -316,7 +316,7 @@ p_hsCmd = \case
316 HsHigherOrderApp -> txt "-<<"
316 HsHigherOrderApp -> txt "-<<"
317 placeHanging (exprPlacement (unLoc input)) $
317 placeHanging (exprPlacement (unLoc input)) $
318 located input p_hsExpr
318 located input p_hsExpr
319− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do
319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
320 located form p_hsExpr
320 located form p_hsExpr
321 unless (null cmds) $ do
321 unless (null cmds) $ do
322 breakpoint
322 breakpoint
@@ -353,14 +353,7 @@ p_hsCmdTop = \case
353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
354 XCmdTop x -> noExtCon x
354 XCmdTop x -> noExtCon x
356−-- | Render an expression preserving blank lines between such consecutive
357−-- expressions found in the original source code.
358−withSpacing ::
356+withSpacing :: Data a => (a -> R ()) -> Located a -> R ()
359− -- | Rendering function
361− -- | Entity to render
364withSpacing f l = located l $ \x -> do
357withSpacing f l = located l $ \x -> do
365 case getLoc l of
358 case getLoc l of
366 UnhelpfulSpan _ -> f x
359 UnhelpfulSpan _ -> f x
@@ -471,24 +464,30 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x
471p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
464p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
472p_hsLocalBinds = \case
465p_hsLocalBinds = \case
473 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
466 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
469+ (srcSpanStart . getLoc)
470+ (srcSpanStart . getLoc)
472+ (Left <$> bagToList bag) ++ (Right <$> lsigs)
473+ p_item (Left x) = located x p_valDecl
474+ p_item (Right x) = located x p_sigDecl
474 -- When in a single-line layout, there is a chance that the inner
475 -- When in a single-line layout, there is a chance that the inner
475 -- elements will also contain semicolons and they will confuse the
476 -- elements will also contain semicolons and they will confuse the
476 -- parser. so we request braces around every element except the last.
477 -- parser. so we request braces around every element except the last.
477 br <- layoutToBraces <$> getLayout
478 br <- layoutToBraces <$> getLayout
478− let items =
479+ sitcc $
479− let injectLeft (L l x) = L l (Left x)
480+ sepSemi
480− injectRight (L l x) = L l (Right x)
481+ ( \(p, i) ->
481− in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)
482+ ( case p of
482− positionToBracing = \case
483− SinglePos -> id
483+ SinglePos -> id
484− FirstPos -> br
484+ FirstPos -> br
485− MiddlePos -> br
485+ MiddlePos -> br
486− LastPos -> id
486+ LastPos -> id
487− p_item' (p, item) =
487+ )
488− positionToBracing p $
488+ (p_item i)
489− withSpacing (either p_valDecl p_sigDecl) item
489+ )
490− binds = sortOn (srcSpanStart . getLoc) items
490+ (attachRelativePos $ sortOn ssStart items)
491− sitcc $ sepSemi p_item' (attachRelativePos binds)
492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
494 -- Second argument of IPBind is always Left before type-checking.
493 -- Second argument of IPBind is always Left before type-checking.
@@ -521,6 +520,12 @@ p_hsRecField HsRecField {..} = do
521 else Normal
520 else Normal
522 placeHanging placement (located hsRecFieldArg p_hsExpr)
521 placeHanging placement (located hsRecFieldArg p_hsExpr)
523+p_hsTupArg :: HsTupArg GhcPs -> R ()
525+ Present NoExtField x -> located x p_hsExpr
526+ Missing NoExtField -> pure ()
527+ XTupArg x -> noExtCon x
524p_hsExpr :: HsExpr GhcPs -> R ()
529p_hsExpr :: HsExpr GhcPs -> R ()
525p_hsExpr = p_hsExpr' N
530p_hsExpr = p_hsExpr' N
@@ -584,21 +589,23 @@ p_hsExpr' s = \case
584 -- do-block or case expression it is not a good idea. It seems
589 -- do-block or case expression it is not a good idea. It seems
585 -- to be safe to always bump indentation when the function
590 -- to be safe to always bump indentation when the function
586 -- expression is parenthesised.
591 -- expression is parenthesised.
587− doIndent =
592+ indent =
588 case func of
593 case func of
589− L _ (HsPar NoExtField _) -> True
594+ L _ (HsPar NoExtField _) -> inci
590− L _ (HsAppType NoExtField _ _) -> True
595+ L _ (HsAppType NoExtField _ _) -> inci
591− L _ (HsMultiIf NoExtField _) -> True
596+ L _ (HsMultiIf NoExtField _) -> inci
592− L spn _ -> isOneLineSpan spn
598+ if isOneLineSpan spn
594− getLayout <&> \case
601+ ub <- getLayout <&> \case
595− SingleLine -> useBraces
602+ SingleLine -> useBraces
596− MultiLine -> id
603+ MultiLine -> id
598 located func (p_hsExpr' s)
605 located func (p_hsExpr' s)
599 breakpoint
606 breakpoint
600− inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
607+ indent $ sep breakpoint (located' p_hsExpr) initp
601− inciIf doIndent $ do
608+ indent $ do
602 unless (null initp) breakpoint
609 unless (null initp) breakpoint
603 located lastp p_hsExpr
610 located lastp p_hsExpr
604 Hanging -> do
611 Hanging -> do
@@ -613,15 +620,10 @@ p_hsExpr' s = \case
613 breakpoint
620 breakpoint
614 inci $ do
621 inci $ do
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
621 located (hswc_body a) p_hsType
623 located (hswc_body a) p_hsType
622 OpApp NoExtField x op y -> do
624 OpApp NoExtField x op y -> do
623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
625 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
624− p_exprOpTree s (reassociateOpTree getOpName opTree)
626+ p_exprOpTree True s (reassociateOpTree getOpName opTree)
625 NegApp NoExtField e _ -> do
627 NegApp NoExtField e _ -> do
@@ -638,27 +640,22 @@ p_hsExpr' s = \case
638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
640 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
639 unless (useRecordDot' && isRecordDot') breakpoint
641 unless (useRecordDot' && isRecordDot') breakpoint
640 inci (located x p_hsExpr)
642 inci (located x p_hsExpr)
641− ExplicitTuple NoExtField args boxity ->
643+ ExplicitTuple NoExtField args boxity -> do
642 let isSection = any (isMissing . unLoc) args
644 let isSection = any (isMissing . unLoc) args
643 isMissing = \case
645 isMissing = \case
644 Missing NoExtField -> True
646 Missing NoExtField -> True
645 _ -> False
647 _ -> False
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' =
648+ let parens' =
652 case boxity of
649 case boxity of
653 Boxed -> parens
650 Boxed -> parens
654 Unboxed -> parensHash
651 Unboxed -> parensHash
655− in if isSection
652+ if isSection
657− switchLayout [] . parens' s $
654+ switchLayout [] . parens' s $
658− sep comma p_larg args
655+ sep comma (located' p_hsTupArg) args
660− switchLayout (getLoc <$> args) . parens' s $
657+ switchLayout (getLoc <$> args) . parens' s . sitcc $
661− sep commaDel p_larg args
658+ sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
662 ExplicitSum NoExtField tag arity e ->
659 ExplicitSum NoExtField tag arity e ->
663 p_unboxedSum N tag arity (located e p_hsExpr)
660 p_unboxedSum N tag arity (located e p_hsExpr)
664 HsCase NoExtField e mgroup ->
661 HsCase NoExtField e mgroup ->
@@ -668,7 +665,7 @@ p_hsExpr' s = \case
668 HsMultiIf NoExtField guards -> do
665 HsMultiIf NoExtField guards -> do
670 breakpoint
667 breakpoint
671− inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
668+ inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
672 HsLet NoExtField localBinds e ->
669 HsLet NoExtField localBinds e ->
673 p_let p_hsExpr localBinds e
670 p_let p_hsExpr localBinds e
674 HsDo NoExtField ctx es -> do
671 HsDo NoExtField ctx es -> do
@@ -680,15 +677,15 @@ p_hsExpr' s = \case
681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
678 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
682 (unLoc es)
679 (unLoc es)
683− compBody = brackets N . located es $ \xs -> do
680+ compBody = brackets N $ located es $ \xs -> do
684 let p_parBody =
681 let p_parBody =
686− (breakpoint >> txt "|" >> space)
683+ (breakpoint >> txt "| ")
687 p_seqBody
684 p_seqBody
688 p_seqBody =
685 p_seqBody =
691− commaDel
688+ (comma >> breakpoint)
692 (located' (sitcc . p_stmt))
689 (located' (sitcc . p_stmt))
693 stmts = init xs
690 stmts = init xs
694 yield = last xs
691 yield = last xs
@@ -709,8 +706,8 @@ p_hsExpr' s = \case
709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
706 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
707 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
711 ExplicitList _ _ xs ->
708 ExplicitList _ _ xs ->
712− brackets s $
709+ brackets s . sitcc $
713− sep commaDel (sitcc . located' p_hsExpr) xs
710+ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
714 RecordCon {..} -> do
711 RecordCon {..} -> do
715 located rcon_con_name atom
712 located rcon_con_name atom
716 breakpoint
713 breakpoint
@@ -726,8 +723,8 @@ p_hsExpr' s = \case
726 case rec_dotdot of
723 case rec_dotdot of
727 Just {} -> [txt ".."]
724 Just {} -> [txt ".."]
728 Nothing -> []
725 Nothing -> []
729− inci . braces N $
726+ inci . braces N . sitcc $
730− sep commaDel sitcc (fields <> dotdot)
727+ sep (comma >> breakpoint) sitcc (fields <> dotdot)
731 RecordUpd {..} -> do
728 RecordUpd {..} -> do
732 located rupd_expr p_hsExpr
729 located rupd_expr p_hsExpr
733 useRecordDot' <- useRecordDot
730 useRecordDot' <- useRecordDot
@@ -745,9 +742,9 @@ p_hsExpr' s = \case
745 Unambiguous _ n -> n
742 Unambiguous _ n -> n
746 XAmbiguousFieldOcc x -> noExtCon x
743 XAmbiguousFieldOcc x -> noExtCon x
748− inci . braces N $
745+ inci . braces N . sitcc $
750− commaDel
747+ (comma >> breakpoint)
751 (sitcc . located' (p_hsRecField . updName))
748 (sitcc . located' (p_hsRecField . updName))
752 rupd_flds
749 rupd_flds
753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
750 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -760,22 +757,22 @@ p_hsExpr' s = \case
760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
757 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
761 ArithSeq NoExtField _ x ->
758 ArithSeq NoExtField _ x ->
762 case x of
759 case x of
763− From from -> brackets s $ do
760+ From from -> brackets s . sitcc $ do
764 located from p_hsExpr
761 located from p_hsExpr
765 breakpoint
762 breakpoint
767− FromThen from next -> brackets s $ do
764+ FromThen from next -> brackets s . sitcc $ do
768− sep commaDel (located' p_hsExpr) [from, next]
765+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
769 breakpoint
766 breakpoint
771− FromTo from to -> brackets s $ do
768+ FromTo from to -> brackets s . sitcc $ do
772 located from p_hsExpr
769 located from p_hsExpr
773 breakpoint
770 breakpoint
776 located to p_hsExpr
773 located to p_hsExpr
777− FromThenTo from next to -> brackets s $ do
774+ FromThenTo from next to -> brackets s . sitcc $ do
778− sep commaDel (located' p_hsExpr) [from, next]
775+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
779 breakpoint
776 breakpoint
@@ -852,8 +849,8 @@ p_patSynBind PSB {..} = do
852 inci $ do
849 inci $ do
853 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
850 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
854 unless (null xs) breakpoint
851 unless (null xs) breakpoint
855− braces N $
852+ braces N . sitcc $
856− sep commaDel (p_rdrName . recordPatSynPatVar) xs
853+ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
858 InfixCon l r -> do
855 InfixCon l r -> do
859 switchLayout [getLoc l, getLoc r] $ do
856 switchLayout [getLoc l, getLoc r] $ do
@@ -949,13 +946,13 @@ p_pat = \case
950 located pat p_pat
947 located pat p_pat
951 ListPat NoExtField pats ->
948 ListPat NoExtField pats ->
952− brackets S $ sep commaDel (located' p_pat) pats
949+ brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
953 TuplePat NoExtField pats boxing -> do
950 TuplePat NoExtField pats boxing -> do
954− let parens' =
951+ let f =
955 case boxing of
952 case boxing of
956 Boxed -> parens S
953 Boxed -> parens S
957 Unboxed -> parensHash S
954 Unboxed -> parensHash S
958− parens' $ sep commaDel (sitcc . located' p_pat) pats
955+ f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
959 SumPat NoExtField pat tag arity ->
956 SumPat NoExtField pat tag arity ->
960 p_unboxedSum S tag arity (located pat p_pat)
957 p_unboxedSum S tag arity (located pat p_pat)
961 ConPatIn pat details ->
958 ConPatIn pat details ->
@@ -971,7 +968,7 @@ p_pat = \case
971 let f = \case
968 let f = \case
972 Nothing -> txt ".."
969 Nothing -> txt ".."
973 Just x -> located x p_pat_hsRecField
970 Just x -> located x p_pat_hsRecField
974− inci . braces N . sep commaDel f $
971+ inci . braces N . sitcc . sep (comma >> breakpoint) f $
975 case dotdot of
972 case dotdot of
976 Nothing -> Just <$> fields
973 Nothing -> Just <$> fields
977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
974 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1021,15 +1018,17 @@ p_unboxedSum s tag arity m = do
1021 let before = tag - 1
1018 let before = tag - 1
1022 after = arity - before - 1
1019 after = arity - before - 1
1023 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1020 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1024− f x =
1021+ f (x, i) = do
1022+ let isFirst = i == 0
1023+ isLast = i == arity - 1
1025 case x :: Maybe (R ()) of
1024 case x :: Maybe (R ()) of
1026 Nothing ->
1025 Nothing ->
1027− space
1026+ unless (isFirst || isLast) space
1028 Just m' -> do
1027 Just m' -> do
1029− space
1028+ unless isFirst space
1031− space
1030+ unless isLast space
1032− parensHash s $ sep (txt "|") f args
1031+ parensHash s $ sep (txt "|") f (zip args [0 ..])
1034p_hsSplice :: HsSplice GhcPs -> R ()
1033p_hsSplice :: HsSplice GhcPs -> R ()
1035p_hsSplice = \case
1034p_hsSplice = \case
@@ -1231,10 +1230,11 @@ exprPlacement = \case
1231 HsCase NoExtField _ _ -> Hanging
1230 HsCase NoExtField _ _ -> Hanging
1232 HsDo NoExtField DoExpr _ -> Hanging
1231 HsDo NoExtField DoExpr _ -> Hanging
1233 HsDo NoExtField MDoExpr _ -> Hanging
1232 HsDo NoExtField MDoExpr _ -> Hanging
1234− OpApp NoExtField _ op y ->
1233+ -- If the rightmost expression in an operator chain is hanging, make the
1235− case (fmap getOpNameStr . getOpName . unLoc) op of
1234+ -- whole block hanging; so that we can use the common @f = foo $ do@
1236− Just "$" -> exprPlacement (unLoc y)
1236+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1237− _ -> Normal
1237+ -- Same thing for function applications (usually with -XBlockArguments)
1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1239 HsProc NoExtField p _ ->
1239 HsProc NoExtField p _ ->
1240 -- Indentation breaks if pattern is longer than one line and left
1240 -- Indentation breaks if pattern is longer than one line and left
@@ -1260,16 +1260,15 @@ getOpName = \case
1260 HsVar NoExtField (L _ a) -> Just a
1260 HsVar NoExtField (L _ a) -> Just a
1261 _ -> Nothing
1261 _ -> Nothing
1263−getOpNameStr :: RdrName -> String
1264−getOpNameStr = occNameString . rdrNameOcc
1266p_exprOpTree ::
1263p_exprOpTree ::
1264+ -- | Can use special handling of dollar?
1267 -- | Bracket style to use
1266 -- | Bracket style to use
1268 BracketStyle ->
1267 BracketStyle ->
1269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1268 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1270+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1272−p_exprOpTree s (OpBranch x op y) = do
1271+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1273 -- If the beginning of the first argument and the second argument are on
1272 -- If the beginning of the first argument and the second argument are on
1274 -- the same line, and the second argument has a hanging form, use hanging
1273 -- the same line, and the second argument has a hanging form, use hanging
1275 -- placement.
1274 -- placement.
@@ -1291,54 +1290,44 @@ p_exprOpTree s (OpBranch x op y) = do
1291 MultiLine -> case placement of
1290 MultiLine -> case placement of
1292 Hanging -> useBraces
1291 Hanging -> useBraces
1293 Normal -> dontUseBraces
1292 Normal -> dontUseBraces
1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1293+ gotDollar = case getOpName (unLoc op) of
1295− gotDollar = opNameStr == Just "$"
1294+ Just rname -> mkVarOcc "$" == rdrNameOcc rname
1296− gotColon = opNameStr == Just ":"
1295+ _ -> False
1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
1299 switchLayout [opTreeLoc x] $
1297 switchLayout [opTreeLoc x] $
1300− p_exprOpTree s x
1298+ p_exprOpTree (not gotDollar) s x
1301− p_op = located op (opWrapper . p_hsExpr)
1299+ let p_op = located op (opWrapper . p_hsExpr)
1302− p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)
1300+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
1303 isSection = case (opTreeLoc x, getLoc op) of
1301 isSection = case (opTreeLoc x, getLoc op) of
1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1302 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1303 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1306 _ -> False
1304 _ -> False
1308− OpNode (L _ HsDo {}) -> True
1310 useRecordDot' <- useRecordDot
1305 useRecordDot' <- useRecordDot
1311− if
1306+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1312− | gotColon -> do
1307+ if useRecordDot' && isRecordDot'
1310+ when isSection space
1318+ && isOneLineSpan (opTreeLoc x)
1316− case placement of
1323+ breakpoint
1317− Hanging -> do
1324+ inci p_y
1327+ placeHanging placement $ do
1322− inciIf (isDoBlock y) p_y
1324− && isOneLineSpan (opTreeLoc x)
1325− && placement == Normal -> do
1331− | useRecordDot' && gotRecordDot -> do
1333− when isSection space
1338− placeHanging placement $ do
1343-- | Return 'True' if given expression is a record-dot operator expression.
1332-- | Return 'True' if given expression is a record-dot operator expression.
1344isRecordDot ::
1333isRecordDot ::
@@ -1349,10 +1338,14 @@ isRecordDot ::
1350isRecordDot op (RealSrcSpan ySpan) = case op of
1339isRecordDot op (RealSrcSpan ySpan) = case op of
1351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1340 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1341+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1353 _ -> False
1342 _ -> False
1354isRecordDot _ _ = False
1343isRecordDot _ _ = False
1345+-- | Check whether a given 'RdrName' is the dot operator.
1346+isDot :: RdrName -> Bool
1347+isDot name = rdrNameOcc name == mkVarOcc "."
1356-- | Get annotations for the enclosing element.
1349-- | Get annotations for the enclosing element.
1357getEnclosingAnns :: R [AnnKeywordId]
1350getEnclosingAnns :: R [AnnKeywordId]
1358getEnclosingAnns = do
1351getEnclosingAnns = do