@@ -1,4 +1,5 @@
1{-# LANGUAGE LambdaCase #-}
1{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE MultiWayIf #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE TypeApplications #-}
5{-# LANGUAGE TypeApplications #-}
@@ -21,12 +22,12 @@ import Data.Char (isPunctuation, isSymbol)
21import Data.Data hiding (Infix, Prefix)
22import Data.Data hiding (Infix, Prefix)
22import Data.Functor ((<&>))
23import Data.Functor ((<&>))
23import Data.List (intersperse, sortOn)
24import Data.List (intersperse, sortOn)
24−import Data.List.NonEmpty ((<|), NonEmpty (..))
25+import Data.List.NonEmpty (NonEmpty (..), (<|))
25import qualified Data.List.NonEmpty as NE
26import qualified Data.List.NonEmpty as NE
26import Data.Text (Text)
27import Data.Text (Text)
27import qualified Data.Text as Text
28import qualified Data.Text as Text
29−import OccName (mkVarOcc)
30+import OccName (occNameString)
30import Ormolu.Printer.Combinators
31import Ormolu.Printer.Combinators
31import Ormolu.Printer.Internal
32import Ormolu.Printer.Internal
32import Ormolu.Printer.Meat.Common
33import Ormolu.Printer.Meat.Common
@@ -60,7 +61,7 @@ data Placement
60 -- should use it and avoid bumping one level
61 -- should use it and avoid bumping one level
61 -- of indentation
62 -- of indentation
63− deriving (Eq)
64+ deriving (Eq, Show)
65p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
66p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
66p_valDecl = \case
67p_valDecl = \case
@@ -179,25 +180,24 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
179 NoSrcStrict -> return ()
180 NoSrcStrict -> return ()
180 SrcStrict -> txt "!"
181 SrcStrict -> txt "!"
181 SrcLazy -> txt "~"
182 SrcLazy -> txt "~"
182− inci' <- case NE.nonEmpty m_pats of
183+ indentBody <- case NE.nonEmpty m_pats of
183− Nothing -> id <$ case style of
185+ False <$ case style of
184− Function name -> p_rdrName name
186+ Function name -> p_rdrName name
185− _ -> return ()
187+ _ -> return ()
186 Just ne_pats -> do
188 Just ne_pats -> do
187− let combinedSpans =
189+ let combinedSpans = case style of
190+ Function name -> combineSrcSpans (getLoc name) patSpans
188− combineSrcSpans' $
192+ patSpans = combineSrcSpans' (getLoc <$> ne_pats)
191− if isOneLineSpan combinedSpans
193+ indentBody = not (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− inci'
200+ indentBody
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,40 +212,32 @@ 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 inci'
215+ return indentBody
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
219 Nothing -> case style of
219 Nothing -> case style of
220− Function name -> (Just . srcSpanEnd . getLoc) name
220+ Function name -> Just (getLoc name)
221 _ -> Nothing
221 _ -> Nothing
222− Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats
222+ Just pats -> (Just . getLoc . NE.last) pats
223 isCase = \case
223 isCase = \case
224 Case -> True
224 Case -> True
225 LambdaCase -> True
225 LambdaCase -> True
226 _ -> False
226 _ -> False
227− let hasGuards = withGuards grhssGRHSs
227+ hasGuards = withGuards grhssGRHSs
228− unless (length grhssGRHSs > 1) $
230− Function _ | hasGuards -> return ()
231− Function _ -> space >> txt "="
232− PatternBind -> space >> txt "="
233− s | isCase s && hasGuards -> return ()
234− _ -> space >> txt "->"
235− let grhssSpan =
228+ grhssSpan =
236 combineSrcSpans' $
229 combineSrcSpans' $
237 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
238 patGrhssSpan =
231 patGrhssSpan =
240 grhssSpan
233 grhssSpan
241− (combineSrcSpans grhssSpan . srcLocSpan)
234+ (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)
242 endOfPats
235 endOfPats
243 placement =
236 placement =
244 case endOfPats of
237 case endOfPats of
245 Nothing -> blockPlacement placer grhssGRHSs
238 Nothing -> blockPlacement placer grhssGRHSs
246 Just spn ->
239 Just spn ->
248− (mkSrcSpan spn (srcSpanStart grhssSpan))
240+ if onTheSameLine spn grhssSpan
249 then blockPlacement placer grhssGRHSs
241 then blockPlacement placer grhssGRHSs
250 else Normal
242 else Normal
251 p_body = do
243 p_body = do
@@ -261,7 +253,14 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
261 txt "where"
253 txt "where"
262 unless whereIsEmpty breakpoint
254 unless whereIsEmpty breakpoint
263 inci $ located grhssLocalBinds p_hsLocalBinds
255 inci $ located grhssLocalBinds p_hsLocalBinds
264− inci' $ do
256+ inciIf indentBody $ do
257+ unless (length grhssGRHSs > 1) $
259+ Function _ | hasGuards -> return ()
260+ Function _ -> space >> inci equals
261+ PatternBind -> space >> inci equals
262+ s | isCase s && hasGuards -> return ()
263+ _ -> space >> txt "->"
265 switchLayout [patGrhssSpan] $
264 switchLayout [patGrhssSpan] $
266 placeHanging placement p_body
265 placeHanging placement p_body
267 inci p_where
266 inci p_where
@@ -285,24 +284,24 @@ p_grhs' placer render style (GRHS NoExtField guards body) =
288− sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
287+ sitcc (sep commaDel (sitcc . located' p_stmt) xs)
290− txt $ case style of
289+ inci $ case style of
291− EqualSign -> "="
290+ EqualSign -> equals
292− RightArrow -> "->"
291+ RightArrow -> txt "->"
293 placeHanging placement p_body
292 placeHanging placement p_body
295 placement =
294 placement =
296 case endOfGuards of
295 case endOfGuards of
297 Nothing -> placer (unLoc body)
296 Nothing -> placer (unLoc body)
298 Just spn ->
297 Just spn ->
299− if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))
298+ if onTheSameLine spn (getLoc body)
300 then placer (unLoc body)
299 then placer (unLoc body)
301 else Normal
300 else Normal
302 endOfGuards =
301 endOfGuards =
303 case NE.nonEmpty guards of
302 case NE.nonEmpty guards of
304 Nothing -> Nothing
303 Nothing -> Nothing
305− Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs
304+ Just gs -> (Just . getLoc . NE.last) gs
306 p_body = located body render
305 p_body = located body render
307p_grhs' _ _ _ (XGRHS x) = noExtCon x
306p_grhs' _ _ _ (XGRHS x) = noExtCon x
@@ -317,7 +316,7 @@ p_hsCmd = \case
317 HsHigherOrderApp -> txt "-<<"
316 HsHigherOrderApp -> txt "-<<"
318 placeHanging (exprPlacement (unLoc input)) $
317 placeHanging (exprPlacement (unLoc input)) $
319 located input p_hsExpr
318 located input p_hsExpr
320− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do
321 located form p_hsExpr
320 located form p_hsExpr
322 unless (null cmds) $ do
321 unless (null cmds) $ do
323 breakpoint
322 breakpoint
@@ -354,7 +353,14 @@ p_hsCmdTop = \case
354 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
355 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.
357−withSpacing :: Data a => (a -> R ()) -> Located a -> R ()
358+withSpacing ::
359+ -- | Rendering function
361+ -- | Entity to render
358withSpacing f l = located l $ \x -> do
364withSpacing f l = located l $ \x -> do
359 case getLoc l of
365 case getLoc l of
360 UnhelpfulSpan _ -> f x
366 UnhelpfulSpan _ -> f x
@@ -363,7 +369,7 @@ withSpacing f l = located l $ \x -> do
363 -- Spacing before comments will be handled by the code
369 -- Spacing before comments will be handled by the code
364 -- that prints comments, so we just have to deal with
370 -- that prints comments, so we just have to deal with
365 -- blank lines between statements here.
371 -- blank lines between statements here.
366− Just (OtherSpan lastSpn) ->
372+ Just (StatementSpan lastSpn) ->
367 if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1
373 if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1
368 then newline
374 then newline
369 else return ()
375 else return ()
@@ -374,7 +380,7 @@ withSpacing f l = located l $ \x -> do
374 getSpanMark >>= \case
380 getSpanMark >>= \case
375 Just (HaddockSpan _ _) -> return ()
381 Just (HaddockSpan _ _) -> return ()
376 Just (CommentSpan _) -> return ()
382 Just (CommentSpan _) -> return ()
377− _ -> setSpanMark (OtherSpan currentSpn)
383+ _ -> setSpanMark (StatementSpan currentSpn)
379p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
385p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
380p_stmt = p_stmt' exprPlacement p_hsExpr
386p_stmt = p_stmt' exprPlacement p_hsExpr
@@ -465,34 +471,31 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x
465p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
471p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
466p_hsLocalBinds = \case
472p_hsLocalBinds = \case
467 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
473 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
470− (srcSpanStart . getLoc)
471− (srcSpanStart . getLoc)
473− (Left <$> bagToList bag) ++ (Right <$> lsigs)
474− p_item (Left x) = located x p_valDecl
475− p_item (Right x) = located x p_sigDecl
476− -- Assigns 'False' to the last element, 'True' to the rest.
477− markInit :: [a] -> [(Bool, a)]
479− markInit [x] = [(False, x)]
480− markInit (x : xs) = (True, x) : markInit xs
481 -- When in a single-line layout, there is a chance that the inner
474 -- When in a single-line layout, there is a chance that the inner
482 -- elements will also contain semicolons and they will confuse the
475 -- elements will also contain semicolons and they will confuse the
483 -- parser. so we request braces around every element except the last.
476 -- parser. so we request braces around every element except the last.
484 br <- layoutToBraces <$> getLayout
477 br <- layoutToBraces <$> getLayout
485− sitcc $
478+ let items =
486− sepSemi
479+ let injectLeft (L l x) = L l (Left x)
487− (\(m, i) -> (if m then br else id) $ p_item i)
480+ injectRight (L l x) = L l (Right x)
488− (markInit $ sortOn ssStart items)
481+ in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)
482+ positionToBracing = \case
488+ positionToBracing p $
489+ withSpacing (either p_valDecl p_sigDecl) item
490+ binds = sortOn (srcSpanStart . getLoc) items
491+ sitcc $ sepSemi p_item' (attachRelativePos binds)
489 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
490 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
491 -- Second argument of IPBind is always Left before type-checking.
494 -- Second argument of IPBind is always Left before type-checking.
492 let p_ipBind (IPBind NoExtField (Left name) expr) = do
495 let p_ipBind (IPBind NoExtField (Left name) expr) = do
493 atom name
496 atom name
496 breakpoint
499 breakpoint
497 useBraces $ inci $ located expr p_hsExpr
500 useBraces $ inci $ located expr p_hsExpr
498 p_ipBind (IPBind NoExtField (Right _) _) =
501 p_ipBind (IPBind NoExtField (Right _) _) =
@@ -511,15 +514,12 @@ p_hsRecField HsRecField {..} = do
511 p_rdrName hsRecFieldLbl
514 p_rdrName hsRecFieldLbl
512 unless hsRecPun $ do
515 unless hsRecPun $ do
519+ if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)
515− let placement = exprPlacement (unLoc hsRecFieldArg)
520+ then exprPlacement (unLoc hsRecFieldArg)
516− placeHanging placement $ located hsRecFieldArg p_hsExpr
522+ placeHanging placement (located hsRecFieldArg p_hsExpr)
518−p_hsTupArg :: HsTupArg GhcPs -> R ()
520− Present NoExtField x -> located x p_hsExpr
521− Missing NoExtField -> pure ()
522− XTupArg x -> noExtCon x
524p_hsExpr :: HsExpr GhcPs -> R ()
524p_hsExpr :: HsExpr GhcPs -> R ()
525p_hsExpr = p_hsExpr' N
525p_hsExpr = p_hsExpr' N
@@ -584,23 +584,21 @@ p_hsExpr' s = \case
584 -- do-block or case expression it is not a good idea. It seems
584 -- do-block or case expression it is not a good idea. It seems
585 -- to be safe to always bump indentation when the function
585 -- to be safe to always bump indentation when the function
586 -- expression is parenthesised.
586 -- expression is parenthesised.
587− indent =
587+ doIndent =
588 case func of
588 case func of
589− L _ (HsPar NoExtField _) -> inci
589+ L _ (HsPar NoExtField _) -> True
590− L _ (HsAppType NoExtField _ _) -> inci
590+ L _ (HsAppType NoExtField _ _) -> True
591− L _ (HsMultiIf NoExtField _) -> inci
591+ L _ (HsMultiIf NoExtField _) -> True
593− if isOneLineSpan spn
592+ L spn _ -> isOneLineSpan spn
596− ub <- getLayout <&> \case
594+ getLayout <&> \case
597− SingleLine -> useBraces
595+ SingleLine -> useBraces
598− MultiLine -> id
596+ MultiLine -> id
600 located func (p_hsExpr' s)
598 located func (p_hsExpr' s)
601 breakpoint
599 breakpoint
602− indent $ sep breakpoint (located' p_hsExpr) initp
600+ inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
603− indent $ do
601+ inciIf doIndent $ do
604 unless (null initp) breakpoint
602 unless (null initp) breakpoint
605 located lastp p_hsExpr
603 located lastp p_hsExpr
606 Hanging -> do
604 Hanging -> do
@@ -615,10 +613,15 @@ p_hsExpr' s = \case
615 breakpoint
613 breakpoint
616 inci $ do
614 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
618 located (hswc_body a) p_hsType
621 located (hswc_body a) p_hsType
619 OpApp NoExtField x op y -> do
622 OpApp NoExtField x op y -> do
620 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
621− p_exprOpTree True s (reassociateOpTree getOpName opTree)
624+ p_exprOpTree s (reassociateOpTree getOpName opTree)
622 NegApp NoExtField e _ -> do
625 NegApp NoExtField e _ -> do
@@ -635,22 +638,27 @@ p_hsExpr' s = \case
635 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
636 unless (useRecordDot' && isRecordDot') breakpoint
639 unless (useRecordDot' && isRecordDot') breakpoint
637 inci (located x p_hsExpr)
640 inci (located x p_hsExpr)
638− ExplicitTuple NoExtField args boxity -> do
641+ ExplicitTuple NoExtField args boxity ->
639 let isSection = any (isMissing . unLoc) args
642 let isSection = any (isMissing . unLoc) args
640 isMissing = \case
643 isMissing = \case
641 Missing NoExtField -> True
644 Missing NoExtField -> True
642 _ -> False
645 _ -> 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
643− let parens' =
651+ parens' =
644 case boxity of
652 case boxity of
645 Boxed -> parens
653 Boxed -> parens
646 Unboxed -> parensHash
654 Unboxed -> parensHash
647− if isSection
655+ in if isSection
649− switchLayout [] . parens' s $
657+ switchLayout [] . parens' s $
650− sep comma (located' p_hsTupArg) args
658+ sep comma p_larg args
652− switchLayout (getLoc <$> args) . parens' s . sitcc $
660+ switchLayout (getLoc <$> args) . parens' s $
653− sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
661+ sep commaDel p_larg args
654 ExplicitSum NoExtField tag arity e ->
662 ExplicitSum NoExtField tag arity e ->
655 p_unboxedSum N tag arity (located e p_hsExpr)
663 p_unboxedSum N tag arity (located e p_hsExpr)
656 HsCase NoExtField e mgroup ->
664 HsCase NoExtField e mgroup ->
@@ -658,8 +666,9 @@ p_hsExpr' s = \case
658 HsIf NoExtField _ if' then' else' ->
666 HsIf NoExtField _ if' then' else' ->
659 p_if exprPlacement p_hsExpr if' then' else'
667 p_if exprPlacement p_hsExpr if' then' else'
660 HsMultiIf NoExtField guards -> do
668 HsMultiIf NoExtField guards -> do
661− txt "if "
669+ txt "if"
662− inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
671+ inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
663 HsLet NoExtField localBinds e ->
672 HsLet NoExtField localBinds e ->
664 p_let p_hsExpr localBinds e
673 p_let p_hsExpr localBinds e
665 HsDo NoExtField ctx es -> do
674 HsDo NoExtField ctx es -> do
@@ -671,15 +680,15 @@ p_hsExpr' s = \case
672 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
673 (unLoc es)
682 (unLoc es)
674− compBody = brackets N $ located es $ \xs -> do
683+ compBody = brackets N . located es $ \xs -> do
675 let p_parBody =
684 let p_parBody =
677− (breakpoint >> txt "| ")
686+ (breakpoint >> txt "|" >> space)
678 p_seqBody
687 p_seqBody
679 p_seqBody =
688 p_seqBody =
682− (comma >> breakpoint)
691+ commaDel
683 (located' (sitcc . p_stmt))
692 (located' (sitcc . p_stmt))
684 stmts = init xs
693 stmts = init xs
685 yield = last xs
694 yield = last xs
@@ -700,8 +709,8 @@ p_hsExpr' s = \case
700 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
701 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
702 ExplicitList _ _ xs ->
711 ExplicitList _ _ xs ->
703− brackets s . sitcc $
712+ brackets s $
704− sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
713+ sep commaDel (sitcc . located' p_hsExpr) xs
705 RecordCon {..} -> do
714 RecordCon {..} -> do
706 located rcon_con_name atom
715 located rcon_con_name atom
707 breakpoint
716 breakpoint
@@ -717,8 +726,8 @@ p_hsExpr' s = \case
717 case rec_dotdot of
726 case rec_dotdot of
718 Just {} -> [txt ".."]
727 Just {} -> [txt ".."]
719 Nothing -> []
728 Nothing -> []
720− inci . braces N . sitcc $
729+ inci . braces N $
721− sep (comma >> breakpoint) sitcc (fields <> dotdot)
730+ sep commaDel sitcc (fields <> dotdot)
722 RecordUpd {..} -> do
731 RecordUpd {..} -> do
723 located rupd_expr p_hsExpr
732 located rupd_expr p_hsExpr
724 useRecordDot' <- useRecordDot
733 useRecordDot' <- useRecordDot
@@ -736,9 +745,9 @@ p_hsExpr' s = \case
736 Unambiguous _ n -> n
745 Unambiguous _ n -> n
737 XAmbiguousFieldOcc x -> noExtCon x
746 XAmbiguousFieldOcc x -> noExtCon x
739− inci . braces N . sitcc $
748+ inci . braces N $
741− (comma >> breakpoint)
750+ commaDel
742 (sitcc . located' (p_hsRecField . updName))
751 (sitcc . located' (p_hsRecField . updName))
743 rupd_flds
752 rupd_flds
744 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -751,22 +760,22 @@ p_hsExpr' s = \case
751 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
752 ArithSeq NoExtField _ x ->
761 ArithSeq NoExtField _ x ->
753 case x of
762 case x of
754− From from -> brackets s . sitcc $ do
763+ From from -> brackets s $ do
755 located from p_hsExpr
764 located from p_hsExpr
756 breakpoint
765 breakpoint
758− FromThen from next -> brackets s . sitcc $ do
767+ FromThen from next -> brackets s $ do
759− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
768+ sep commaDel (located' p_hsExpr) [from, next]
760 breakpoint
769 breakpoint
762− FromTo from to -> brackets s . sitcc $ do
771+ FromTo from to -> brackets s $ do
763 located from p_hsExpr
772 located from p_hsExpr
764 breakpoint
773 breakpoint
767 located to p_hsExpr
776 located to p_hsExpr
768− FromThenTo from next to -> brackets s . sitcc $ do
777+ FromThenTo from next to -> brackets s $ do
769− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
778+ sep commaDel (located' p_hsExpr) [from, next]
770 breakpoint
779 breakpoint
@@ -816,7 +825,7 @@ p_patSynBind PSB {..} = do
816 breakpoint
825 breakpoint
817 located psb_def p_pat
826 located psb_def p_pat
818 ImplicitBidirectional -> do
827 ImplicitBidirectional -> do
820 breakpoint
829 breakpoint
821 located psb_def p_pat
830 located psb_def p_pat
822 ExplicitBidirectional mgroup -> do
831 ExplicitBidirectional mgroup -> do
@@ -843,8 +852,8 @@ p_patSynBind PSB {..} = do
843 inci $ do
852 inci $ do
844 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
853 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
845 unless (null xs) breakpoint
854 unless (null xs) breakpoint
846− braces N . sitcc $
855+ braces N $
847− sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs
849 InfixCon l r -> do
858 InfixCon l r -> do
850 switchLayout [getLoc l, getLoc r] $ do
859 switchLayout [getLoc l, getLoc r] $ do
@@ -898,10 +907,12 @@ p_if placer render if' then' else' = do
898 breakpoint
907 breakpoint
899 inci $ do
908 inci $ do
900 txt "then"
909 txt "then"
901 located then' $ \x ->
911 located then' $ \x ->
902 placeHanging (placer x) (render x)
912 placeHanging (placer x) (render x)
903 breakpoint
913 breakpoint
904 txt "else"
914 txt "else"
905 located else' $ \x ->
916 located else' $ \x ->
906 placeHanging (placer x) (render x)
917 placeHanging (placer x) (render x)
@@ -938,13 +949,13 @@ p_pat = \case
939 located pat p_pat
950 located pat p_pat
940 ListPat NoExtField pats ->
951 ListPat NoExtField pats ->
941− brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
952+ brackets S $ sep commaDel (located' p_pat) pats
942 TuplePat NoExtField pats boxing -> do
953 TuplePat NoExtField pats boxing -> do
943− let f =
954+ let parens' =
944 case boxing of
955 case boxing of
945 Boxed -> parens S
956 Boxed -> parens S
946 Unboxed -> parensHash S
957 Unboxed -> parensHash S
947− f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
958+ parens' $ sep commaDel (sitcc . located' p_pat) pats
948 SumPat NoExtField pat tag arity ->
959 SumPat NoExtField pat tag arity ->
949 p_unboxedSum S tag arity (located pat p_pat)
960 p_unboxedSum S tag arity (located pat p_pat)
950 ConPatIn pat details ->
961 ConPatIn pat details ->
@@ -960,7 +971,7 @@ p_pat = \case
960 let f = \case
971 let f = \case
961 Nothing -> txt ".."
972 Nothing -> txt ".."
962 Just x -> located x p_pat_hsRecField
973 Just x -> located x p_pat_hsRecField
963− inci . braces N . sitcc . sep (comma >> breakpoint) f $
974+ inci . braces N . sep commaDel f $
964 case dotdot of
975 case dotdot of
965 Nothing -> Just <$> fields
976 Nothing -> Just <$> fields
966 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1001,7 +1012,7 @@ p_pat_hsRecField HsRecField {..} = do
1001 p_rdrName (rdrNameFieldOcc x)
1012 p_rdrName (rdrNameFieldOcc x)
1002 unless hsRecPun $ do
1013 unless hsRecPun $ do
1004− txt "="
1015+ equals
1005 breakpoint
1016 breakpoint
1006 inci (located hsRecFieldArg p_pat)
1017 inci (located hsRecFieldArg p_pat)
@@ -1010,17 +1021,15 @@ p_unboxedSum s tag arity m = do
1010 let before = tag - 1
1021 let before = tag - 1
1011 after = arity - before - 1
1022 after = arity - before - 1
1012 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1023 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1013− f (x, i) = do
1024+ f x =
1014− let isFirst = i == 0
1015− isLast = i == arity - 1
1016 case x :: Maybe (R ()) of
1025 case x :: Maybe (R ()) of
1017 Nothing ->
1026 Nothing ->
1018− unless (isFirst || isLast) space
1027+ space
1019 Just m' -> do
1028 Just m' -> do
1020− unless isFirst space
1029+ space
1022− unless isLast space
1031+ space
1023− parensHash s $ sep (txt "|") f (zip args [0 ..])
1032+ parensHash s $ sep (txt "|") f args
1025p_hsSplice :: HsSplice GhcPs -> R ()
1034p_hsSplice :: HsSplice GhcPs -> R ()
1026p_hsSplice = \case
1035p_hsSplice = \case
@@ -1222,11 +1231,10 @@ exprPlacement = \case
1222 HsCase NoExtField _ _ -> Hanging
1231 HsCase NoExtField _ _ -> Hanging
1223 HsDo NoExtField DoExpr _ -> Hanging
1232 HsDo NoExtField DoExpr _ -> Hanging
1224 HsDo NoExtField MDoExpr _ -> Hanging
1233 HsDo NoExtField MDoExpr _ -> Hanging
1225− -- If the rightmost expression in an operator chain is hanging, make the
1234+ OpApp NoExtField _ op y ->
1226− -- whole block hanging; so that we can use the common @f = foo $ do@
1235+ case (fmap getOpNameStr . getOpName . unLoc) op of
1228− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1236+ Just "$" -> exprPlacement (unLoc y)
1229− -- Same thing for function applications (usually with -XBlockArguments)
1237+ _ -> Normal
1230 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1231 HsProc NoExtField p _ ->
1239 HsProc NoExtField p _ ->
1232 -- Indentation breaks if pattern is longer than one line and left
1240 -- Indentation breaks if pattern is longer than one line and left
@@ -1252,15 +1260,16 @@ getOpName = \case
1252 HsVar NoExtField (L _ a) -> Just a
1260 HsVar NoExtField (L _ a) -> Just a
1253 _ -> Nothing
1261 _ -> Nothing
1263+getOpNameStr :: RdrName -> String
1264+getOpNameStr = occNameString . rdrNameOcc
1255p_exprOpTree ::
1266p_exprOpTree ::
1256− -- | Can use special handling of dollar?
1258 -- | Bracket style to use
1267 -- | Bracket style to use
1259 BracketStyle ->
1268 BracketStyle ->
1260 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1262−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1271+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1263−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1272+p_exprOpTree s (OpBranch x op y) = do
1264 -- If the beginning of the first argument and the second argument are on
1273 -- If the beginning of the first argument and the second argument are on
1265 -- the same line, and the second argument has a hanging form, use hanging
1274 -- the same line, and the second argument has a hanging form, use hanging
1266 -- placement.
1275 -- placement.
@@ -1282,44 +1291,54 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1282 MultiLine -> case placement of
1291 MultiLine -> case placement of
1283 Hanging -> useBraces
1292 Hanging -> useBraces
1284 Normal -> dontUseBraces
1293 Normal -> dontUseBraces
1285− gotDollar = case getOpName (unLoc op) of
1294+ opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1286− Just rname -> mkVarOcc "$" == rdrNameOcc rname
1295+ gotDollar = opNameStr == Just "$"
1287− _ -> False
1296+ gotColon = opNameStr == Just ":"
1297+ gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
1289 switchLayout [opTreeLoc x] $
1299 switchLayout [opTreeLoc x] $
1290− p_exprOpTree (not gotDollar) s x
1300+ p_exprOpTree s x
1291− let p_op = located op (opWrapper . p_hsExpr)
1301+ p_op = located op (opWrapper . p_hsExpr)
1292− p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
1302+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)
1293 isSection = case (opTreeLoc x, getLoc op) of
1303 isSection = case (opTreeLoc x, getLoc op) of
1294 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1295 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1296 _ -> False
1306 _ -> False
1308+ OpNode (L _ HsDo {}) -> True
1297 useRecordDot' <- useRecordDot
1310 useRecordDot' <- useRecordDot
1298− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1311+ if
1299− if useRecordDot' && isRecordDot'
1312+ | gotColon -> do
1302− when isSection space
1310− && isOneLineSpan (opTreeLoc x)
1312− useBraces lhs
1313+ lhs
1315− breakpoint
1316+ case placement of
1316− inci p_y
1317+ Hanging -> do
1319− 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
1324-- | Return 'True' if given expression is a record-dot operator expression.
1343-- | Return 'True' if given expression is a record-dot operator expression.
1325isRecordDot ::
1344isRecordDot ::
@@ -1330,14 +1349,10 @@ isRecordDot ::
1331isRecordDot op (RealSrcSpan ySpan) = case op of
1350isRecordDot op (RealSrcSpan ySpan) = case op of
1332 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1333− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1352+ (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1334 _ -> False
1353 _ -> False
1335isRecordDot _ _ = False
1354isRecordDot _ _ = False
1337−-- | Check whether a given 'RdrName' is the dot operator.
1338−isDot :: RdrName -> Bool
1339−isDot name = rdrNameOcc name == mkVarOcc "."
1341-- | Get annotations for the enclosing element.
1356-- | Get annotations for the enclosing element.
1342getEnclosingAnns :: R [AnnKeywordId]
1357getEnclosingAnns :: R [AnnKeywordId]
1343getEnclosingAnns = do
1358getEnclosingAnns = do