@@ -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,37 +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 -- 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
477 -- elements will also contain semicolons and they will confuse the
475 -- elements will also contain semicolons and they will confuse the
478 -- parser. so we request braces around every element except the last.
476 -- parser. so we request braces around every element except the last.
479 br <- layoutToBraces <$> getLayout
477 br <- layoutToBraces <$> getLayout
480− sitcc $
478+ let items =
481− sepSemi
479+ let injectLeft (L l x) = L l (Left x)
482− ( \(p, i) ->
480+ injectRight (L l x) = L l (Right x)
483− ( case p of
481+ in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)
482+ positionToBracing = \case
484− SinglePos -> id
483+ SinglePos -> id
485− FirstPos -> br
484+ FirstPos -> br
486− MiddlePos -> br
485+ MiddlePos -> br
487− LastPos -> id
486+ LastPos -> id
488− )
487+ p_item' (p, item) =
489− (p_item i)
488+ positionToBracing p $
490− )
489+ withSpacing (either p_valDecl p_sigDecl) item
490+ binds = sortOn (srcSpanStart . getLoc) items
491− (attachRelativePos $ sortOn ssStart items)
491+ sitcc $ sepSemi p_item' (attachRelativePos binds)
492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
494 -- Second argument of IPBind is always Left before type-checking.
494 -- Second argument of IPBind is always Left before type-checking.
495 let p_ipBind (IPBind NoExtField (Left name) expr) = do
495 let p_ipBind (IPBind NoExtField (Left name) expr) = do
496 atom name
496 atom name
499 breakpoint
499 breakpoint
500 useBraces $ inci $ located expr p_hsExpr
500 useBraces $ inci $ located expr p_hsExpr
501 p_ipBind (IPBind NoExtField (Right _) _) =
501 p_ipBind (IPBind NoExtField (Right _) _) =
@@ -514,15 +514,12 @@ p_hsRecField HsRecField {..} = do
514 p_rdrName hsRecFieldLbl
514 p_rdrName hsRecFieldLbl
515 unless hsRecPun $ do
515 unless hsRecPun $ do
519+ if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)
518− let placement = exprPlacement (unLoc hsRecFieldArg)
520+ then exprPlacement (unLoc hsRecFieldArg)
519− placeHanging placement $ located hsRecFieldArg p_hsExpr
522+ placeHanging placement (located hsRecFieldArg p_hsExpr)
521−p_hsTupArg :: HsTupArg GhcPs -> R ()
523− Present NoExtField x -> located x p_hsExpr
524− Missing NoExtField -> pure ()
525− XTupArg x -> noExtCon x
527p_hsExpr :: HsExpr GhcPs -> R ()
524p_hsExpr :: HsExpr GhcPs -> R ()
528p_hsExpr = p_hsExpr' N
525p_hsExpr = p_hsExpr' N
@@ -587,23 +584,21 @@ p_hsExpr' s = \case
587 -- 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
588 -- to be safe to always bump indentation when the function
585 -- to be safe to always bump indentation when the function
589 -- expression is parenthesised.
586 -- expression is parenthesised.
590− indent =
587+ doIndent =
591 case func of
588 case func of
592− L _ (HsPar NoExtField _) -> inci
589+ L _ (HsPar NoExtField _) -> True
593− L _ (HsAppType NoExtField _ _) -> inci
590+ L _ (HsAppType NoExtField _ _) -> True
594− L _ (HsMultiIf NoExtField _) -> inci
591+ L _ (HsMultiIf NoExtField _) -> True
596− if isOneLineSpan spn
592+ L spn _ -> isOneLineSpan spn
599− ub <- getLayout <&> \case
594+ getLayout <&> \case
600− SingleLine -> useBraces
595+ SingleLine -> useBraces
601− MultiLine -> id
596+ MultiLine -> id
603 located func (p_hsExpr' s)
598 located func (p_hsExpr' s)
604 breakpoint
599 breakpoint
605− indent $ sep breakpoint (located' p_hsExpr) initp
600+ inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
606− indent $ do
601+ inciIf doIndent $ do
607 unless (null initp) breakpoint
602 unless (null initp) breakpoint
608 located lastp p_hsExpr
603 located lastp p_hsExpr
609 Hanging -> do
604 Hanging -> do
@@ -618,10 +613,15 @@ p_hsExpr' s = \case
618 breakpoint
613 breakpoint
619 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
621 located (hswc_body a) p_hsType
621 located (hswc_body a) p_hsType
622 OpApp NoExtField x op y -> do
622 OpApp NoExtField x op y -> do
623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
624− p_exprOpTree True s (reassociateOpTree getOpName opTree)
624+ p_exprOpTree s (reassociateOpTree getOpName opTree)
625 NegApp NoExtField e _ -> do
625 NegApp NoExtField e _ -> do
@@ -638,22 +638,27 @@ p_hsExpr' s = \case
638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
639 unless (useRecordDot' && isRecordDot') breakpoint
639 unless (useRecordDot' && isRecordDot') breakpoint
640 inci (located x p_hsExpr)
640 inci (located x p_hsExpr)
641− ExplicitTuple NoExtField args boxity -> do
641+ ExplicitTuple NoExtField args boxity ->
642 let isSection = any (isMissing . unLoc) args
642 let isSection = any (isMissing . unLoc) args
643 isMissing = \case
643 isMissing = \case
644 Missing NoExtField -> True
644 Missing NoExtField -> True
645 _ -> 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
646− let parens' =
651+ parens' =
647 case boxity of
652 case boxity of
648 Boxed -> parens
653 Boxed -> parens
649 Unboxed -> parensHash
654 Unboxed -> parensHash
650− if isSection
655+ in if isSection
652− switchLayout [] . parens' s $
657+ switchLayout [] . parens' s $
653− sep comma (located' p_hsTupArg) args
658+ sep comma p_larg args
655− switchLayout (getLoc <$> args) . parens' s . sitcc $
660+ switchLayout (getLoc <$> args) . parens' s $
656− sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
661+ sep commaDel p_larg args
657 ExplicitSum NoExtField tag arity e ->
662 ExplicitSum NoExtField tag arity e ->
658 p_unboxedSum N tag arity (located e p_hsExpr)
663 p_unboxedSum N tag arity (located e p_hsExpr)
659 HsCase NoExtField e mgroup ->
664 HsCase NoExtField e mgroup ->
@@ -661,8 +666,9 @@ p_hsExpr' s = \case
661 HsIf NoExtField _ if' then' else' ->
666 HsIf NoExtField _ if' then' else' ->
662 p_if exprPlacement p_hsExpr if' then' else'
667 p_if exprPlacement p_hsExpr if' then' else'
663 HsMultiIf NoExtField guards -> do
668 HsMultiIf NoExtField guards -> do
664− txt "if "
669+ txt "if"
665− inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
671+ inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
666 HsLet NoExtField localBinds e ->
672 HsLet NoExtField localBinds e ->
667 p_let p_hsExpr localBinds e
673 p_let p_hsExpr localBinds e
668 HsDo NoExtField ctx es -> do
674 HsDo NoExtField ctx es -> do
@@ -674,15 +680,15 @@ p_hsExpr' s = \case
675 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
676 (unLoc es)
682 (unLoc es)
677− compBody = brackets N $ located es $ \xs -> do
683+ compBody = brackets N . located es $ \xs -> do
678 let p_parBody =
684 let p_parBody =
680− (breakpoint >> txt "| ")
686+ (breakpoint >> txt "|" >> space)
681 p_seqBody
687 p_seqBody
682 p_seqBody =
688 p_seqBody =
685− (comma >> breakpoint)
691+ commaDel
686 (located' (sitcc . p_stmt))
692 (located' (sitcc . p_stmt))
687 stmts = init xs
693 stmts = init xs
688 yield = last xs
694 yield = last xs
@@ -703,8 +709,8 @@ p_hsExpr' s = \case
703 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
704 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
705 ExplicitList _ _ xs ->
711 ExplicitList _ _ xs ->
706− brackets s . sitcc $
712+ brackets s $
707− sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
713+ sep commaDel (sitcc . located' p_hsExpr) xs
708 RecordCon {..} -> do
714 RecordCon {..} -> do
709 located rcon_con_name atom
715 located rcon_con_name atom
710 breakpoint
716 breakpoint
@@ -720,8 +726,8 @@ p_hsExpr' s = \case
720 case rec_dotdot of
726 case rec_dotdot of
721 Just {} -> [txt ".."]
727 Just {} -> [txt ".."]
722 Nothing -> []
728 Nothing -> []
723− inci . braces N . sitcc $
729+ inci . braces N $
724− sep (comma >> breakpoint) sitcc (fields <> dotdot)
730+ sep commaDel sitcc (fields <> dotdot)
725 RecordUpd {..} -> do
731 RecordUpd {..} -> do
726 located rupd_expr p_hsExpr
732 located rupd_expr p_hsExpr
727 useRecordDot' <- useRecordDot
733 useRecordDot' <- useRecordDot
@@ -739,9 +745,9 @@ p_hsExpr' s = \case
739 Unambiguous _ n -> n
745 Unambiguous _ n -> n
740 XAmbiguousFieldOcc x -> noExtCon x
746 XAmbiguousFieldOcc x -> noExtCon x
742− inci . braces N . sitcc $
748+ inci . braces N $
744− (comma >> breakpoint)
750+ commaDel
745 (sitcc . located' (p_hsRecField . updName))
751 (sitcc . located' (p_hsRecField . updName))
746 rupd_flds
752 rupd_flds
747 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -754,22 +760,22 @@ p_hsExpr' s = \case
754 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
755 ArithSeq NoExtField _ x ->
761 ArithSeq NoExtField _ x ->
756 case x of
762 case x of
757− From from -> brackets s . sitcc $ do
763+ From from -> brackets s $ do
758 located from p_hsExpr
764 located from p_hsExpr
759 breakpoint
765 breakpoint
761− FromThen from next -> brackets s . sitcc $ do
767+ FromThen from next -> brackets s $ do
762− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
768+ sep commaDel (located' p_hsExpr) [from, next]
763 breakpoint
769 breakpoint
765− FromTo from to -> brackets s . sitcc $ do
771+ FromTo from to -> brackets s $ do
766 located from p_hsExpr
772 located from p_hsExpr
767 breakpoint
773 breakpoint
770 located to p_hsExpr
776 located to p_hsExpr
771− FromThenTo from next to -> brackets s . sitcc $ do
777+ FromThenTo from next to -> brackets s $ do
772− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
778+ sep commaDel (located' p_hsExpr) [from, next]
773 breakpoint
779 breakpoint
@@ -819,7 +825,7 @@ p_patSynBind PSB {..} = do
819 breakpoint
825 breakpoint
820 located psb_def p_pat
826 located psb_def p_pat
821 ImplicitBidirectional -> do
827 ImplicitBidirectional -> do
823 breakpoint
829 breakpoint
824 located psb_def p_pat
830 located psb_def p_pat
825 ExplicitBidirectional mgroup -> do
831 ExplicitBidirectional mgroup -> do
@@ -846,8 +852,8 @@ p_patSynBind PSB {..} = do
846 inci $ do
852 inci $ do
847 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
853 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
848 unless (null xs) breakpoint
854 unless (null xs) breakpoint
849− braces N . sitcc $
855+ braces N $
850− sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs
852 InfixCon l r -> do
858 InfixCon l r -> do
853 switchLayout [getLoc l, getLoc r] $ do
859 switchLayout [getLoc l, getLoc r] $ do
@@ -901,10 +907,12 @@ p_if placer render if' then' else' = do
901 breakpoint
907 breakpoint
902 inci $ do
908 inci $ do
903 txt "then"
909 txt "then"
904 located then' $ \x ->
911 located then' $ \x ->
905 placeHanging (placer x) (render x)
912 placeHanging (placer x) (render x)
906 breakpoint
913 breakpoint
907 txt "else"
914 txt "else"
908 located else' $ \x ->
916 located else' $ \x ->
909 placeHanging (placer x) (render x)
917 placeHanging (placer x) (render x)
@@ -941,13 +949,13 @@ p_pat = \case
942 located pat p_pat
950 located pat p_pat
943 ListPat NoExtField pats ->
951 ListPat NoExtField pats ->
944− brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
952+ brackets S $ sep commaDel (located' p_pat) pats
945 TuplePat NoExtField pats boxing -> do
953 TuplePat NoExtField pats boxing -> do
946− let f =
954+ let parens' =
947 case boxing of
955 case boxing of
948 Boxed -> parens S
956 Boxed -> parens S
949 Unboxed -> parensHash S
957 Unboxed -> parensHash S
950− f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
958+ parens' $ sep commaDel (sitcc . located' p_pat) pats
951 SumPat NoExtField pat tag arity ->
959 SumPat NoExtField pat tag arity ->
952 p_unboxedSum S tag arity (located pat p_pat)
960 p_unboxedSum S tag arity (located pat p_pat)
953 ConPatIn pat details ->
961 ConPatIn pat details ->
@@ -963,7 +971,7 @@ p_pat = \case
963 let f = \case
971 let f = \case
964 Nothing -> txt ".."
972 Nothing -> txt ".."
965 Just x -> located x p_pat_hsRecField
973 Just x -> located x p_pat_hsRecField
966− inci . braces N . sitcc . sep (comma >> breakpoint) f $
974+ inci . braces N . sep commaDel f $
967 case dotdot of
975 case dotdot of
968 Nothing -> Just <$> fields
976 Nothing -> Just <$> fields
969 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1004,7 +1012,7 @@ p_pat_hsRecField HsRecField {..} = do
1004 p_rdrName (rdrNameFieldOcc x)
1012 p_rdrName (rdrNameFieldOcc x)
1005 unless hsRecPun $ do
1013 unless hsRecPun $ do
1007− txt "="
1015+ equals
1008 breakpoint
1016 breakpoint
1009 inci (located hsRecFieldArg p_pat)
1017 inci (located hsRecFieldArg p_pat)
@@ -1013,17 +1021,15 @@ p_unboxedSum s tag arity m = do
1013 let before = tag - 1
1021 let before = tag - 1
1014 after = arity - before - 1
1022 after = arity - before - 1
1015 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1023 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1016− f (x, i) = do
1024+ f x =
1017− let isFirst = i == 0
1018− isLast = i == arity - 1
1019 case x :: Maybe (R ()) of
1025 case x :: Maybe (R ()) of
1020 Nothing ->
1026 Nothing ->
1021− unless (isFirst || isLast) space
1027+ space
1022 Just m' -> do
1028 Just m' -> do
1023− unless isFirst space
1029+ space
1025− unless isLast space
1031+ space
1026− parensHash s $ sep (txt "|") f (zip args [0 ..])
1032+ parensHash s $ sep (txt "|") f args
1028p_hsSplice :: HsSplice GhcPs -> R ()
1034p_hsSplice :: HsSplice GhcPs -> R ()
1029p_hsSplice = \case
1035p_hsSplice = \case
@@ -1225,11 +1231,10 @@ exprPlacement = \case
1225 HsCase NoExtField _ _ -> Hanging
1231 HsCase NoExtField _ _ -> Hanging
1226 HsDo NoExtField DoExpr _ -> Hanging
1232 HsDo NoExtField DoExpr _ -> Hanging
1227 HsDo NoExtField MDoExpr _ -> Hanging
1233 HsDo NoExtField MDoExpr _ -> Hanging
1228− -- If the rightmost expression in an operator chain is hanging, make the
1234+ OpApp NoExtField _ op y ->
1229− -- whole block hanging; so that we can use the common @f = foo $ do@
1235+ case (fmap getOpNameStr . getOpName . unLoc) op of
1231− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1236+ Just "$" -> exprPlacement (unLoc y)
1232− -- Same thing for function applications (usually with -XBlockArguments)
1237+ _ -> Normal
1233 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
1234 HsProc NoExtField p _ ->
1239 HsProc NoExtField p _ ->
1235 -- Indentation breaks if pattern is longer than one line and left
1240 -- Indentation breaks if pattern is longer than one line and left
@@ -1255,15 +1260,16 @@ getOpName = \case
1255 HsVar NoExtField (L _ a) -> Just a
1260 HsVar NoExtField (L _ a) -> Just a
1256 _ -> Nothing
1261 _ -> Nothing
1263+getOpNameStr :: RdrName -> String
1264+getOpNameStr = occNameString . rdrNameOcc
1258p_exprOpTree ::
1266p_exprOpTree ::
1259− -- | Can use special handling of dollar?
1261 -- | Bracket style to use
1267 -- | Bracket style to use
1262 BracketStyle ->
1268 BracketStyle ->
1263 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
1265−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1271+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1266−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1272+p_exprOpTree s (OpBranch x op y) = do
1267 -- 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
1268 -- 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
1269 -- placement.
1275 -- placement.
@@ -1285,44 +1291,54 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1285 MultiLine -> case placement of
1291 MultiLine -> case placement of
1286 Hanging -> useBraces
1292 Hanging -> useBraces
1287 Normal -> dontUseBraces
1293 Normal -> dontUseBraces
1288− gotDollar = case getOpName (unLoc op) of
1294+ opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1289− Just rname -> mkVarOcc "$" == rdrNameOcc rname
1295+ gotDollar = opNameStr == Just "$"
1290− _ -> False
1296+ gotColon = opNameStr == Just ":"
1297+ gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
1292 switchLayout [opTreeLoc x] $
1299 switchLayout [opTreeLoc x] $
1293− p_exprOpTree (not gotDollar) s x
1300+ p_exprOpTree s x
1294− let p_op = located op (opWrapper . p_hsExpr)
1301+ p_op = located op (opWrapper . p_hsExpr)
1295− p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
1302+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)
1296 isSection = case (opTreeLoc x, getLoc op) of
1303 isSection = case (opTreeLoc x, getLoc op) of
1297 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
1298 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
1299 _ -> False
1306 _ -> False
1308+ OpNode (L _ HsDo {}) -> True
1300 useRecordDot' <- useRecordDot
1310 useRecordDot' <- useRecordDot
1301− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1311+ if
1302− if useRecordDot' && isRecordDot'
1312+ | gotColon -> do
1305− when isSection space
1313− && isOneLineSpan (opTreeLoc x)
1315− useBraces lhs
1313+ lhs
1318− breakpoint
1316+ case placement of
1319− inci p_y
1317+ Hanging -> do
1322− 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
1327-- | Return 'True' if given expression is a record-dot operator expression.
1343-- | Return 'True' if given expression is a record-dot operator expression.
1328isRecordDot ::
1344isRecordDot ::
@@ -1333,14 +1349,10 @@ isRecordDot ::
1334isRecordDot op (RealSrcSpan ySpan) = case op of
1350isRecordDot op (RealSrcSpan ySpan) = case op of
1335 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1336− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1352+ (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1337 _ -> False
1353 _ -> False
1338isRecordDot _ _ = False
1354isRecordDot _ _ = False
1340−-- | Check whether a given 'RdrName' is the dot operator.
1341−isDot :: RdrName -> Bool
1342−isDot name = rdrNameOcc name == mkVarOcc "."
1344-- | Get annotations for the enclosing element.
1356-- | Get annotations for the enclosing element.
1345getEnclosingAnns :: R [AnnKeywordId]
1357getEnclosingAnns :: R [AnnKeywordId]
1346getEnclosingAnns = do
1358getEnclosingAnns = do