a0aa410 · ormolu · git.iko.soy

git.iko.soy/ormolu

Fix printing of TH brackets

The issue was simply indenting the closing `|]` one more level. However there were a few more issues around them, which led me to a slightly bigger refactor. main reason is that, all `p_*Decl` functions used to print a trailing newline. This makes sense for top-level constructs, however it was making printing something like `[d|data Foo = Foo|]` impossible. In this commit, I removed trailing newlines from individual printers and gave that responsibility to `p_hsDecls`, and inserted an additional trailing newline when printing modules. While doing that, I noticed a few bugs/inconsistencies, and I had to fix them in the process: * Warning pragmas used to not print a trailing newline, so they were always attached to the next expression. I made it more like the other pragmas, where we attach it to a neighbour function if the name matches, otherwise we separate it with a newline. * We used to print single line GADT's and single line `do` notations using multiple lines, which breaks idempotency. I tweak them to prefer single line layout if possible (sometimes it is not possible because of the semicolon syntax).

commita0aa41074118ed3375475b57fa34a0ad05c57c4a authorUtku Demir <me@utdemir.com> dateThu 8 Aug 2019, 14:03 (7 years ago) parente2a6305

24 files changed+93−64

compare with master

unifiedsplit

data/examples/declaration/data/gadt-syntax-out.hs+1−2

@@ -1,3 +1,2 @@

11{-# LANUGAGE GADTSyntax #-}

2−data Foo where

3− MKFoo :: a -> (a -> Bool) -> Foo

2+data Foo where MKFoo :: a -> (a -> Bool) -> Foo

data/examples/declaration/splice/bracket-out.hs+7−8

@@ -2,23 +2,22 @@

33foo =

44 [e|

5− foo bar

6− |]

5+ foo bar

6+ |]

88foo =

99 [e|

10− foo bar

11− |]

10+ foo bar

11+ |]

1212

1313foo = [t|Char|]

1414

1515foo =

1616 [d|

17− foo :: Int -> Char

18−

19− bar = 42

17+ foo :: Int -> Char

2018

21− |]

19+ bar = 42

20+ |]

2221

2322foo =

2423 [||

data/examples/declaration/splice/splice-decl-out.hs+18

@@ -15,3 +15,21 @@ foo bar

1515-- TemplateHaskell allows Q () at the top level

1616do

1717 pure []

18+

19+$(do [d|baz = baz|])

20+

21+[d|data T a where Foo :: T ()|]

22+

23+[d|

24+ data T = T

25+ deriving (Eq, Ord, Enum, Bounded, Show)

26+ |]

27+

28+$(singletons [d|data T = T deriving (Eq, Ord, Enum, Bounded, Show)|])

29+

30+$( singletons

31+ [d|

32+ data T = T

33+ deriving (Eq, Ord, Enum, Bounded, Show)

34+ |]

35+ )

data/examples/declaration/splice/splice-decl.hs+17

@@ -15,3 +15,20 @@ foo bar

1515-- TemplateHaskell allows Q () at the top level

1616do

1717 pure []

18+

19+$( do [d| baz = baz |] )

20+

21+[d| data T a where Foo :: T () |]

22+

23+[d|

24+ data T = T

25+ deriving (Eq, Ord, Enum, Bounded, Show)

26+ |]

27+

28+$(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |])

29+

30+$(singletons [d|

31+ data T = T

32+ deriving (Eq, Ord, Enum, Bounded, Show)

33+ |])

34+

data/examples/declaration/value/function/do-out.hs+1−2

@@ -65,8 +65,7 @@ g = unFoo

6565 ret

6666

6767main =

68− do

69− stuff

68+ do stuff

7069 `finally` do

7170 recover

7271

data/examples/declaration/value/function/operators-out.hs+1−2

@@ -24,8 +24,7 @@ foo =

2424 + 2

2525

2626main =

27− do

28− stuff

27+ do stuff

2928 `finally` do

3029 recover

3130

data/examples/declaration/warning/warning-multiline-out.hs+1

@@ -5,5 +5,6 @@

55 "Really bad!"

66 ]

77 #-}

89test :: IO ()

910test = pure ()

data/examples/declaration/warning/warning-single-line-out.hs+2−1

@@ -1,4 +1,5 @@

1−{-# WARNING test "This is a warning" #-}

21{-# DEPRECATED test, foo "This is a deprecation" #-}

3+{-# WARNING test "This is a warning" #-}

34test :: IO ()

45test = pure ()

data/examples/declaration/warning/warning-single-line.hs+1−1

@@ -1,5 +1,5 @@

1−{-# WARNING test ["This is a warning" ] #-}

21{-# Deprecated test, foo "This is a deprecation"

32 #-}

3+{-# WARNING test ["This is a warning" ] #-}

44test :: IO ()

55test = pure ()

src/Ormolu/Printer/Meat/Declaration.hs+7−4

@@ -37,9 +37,9 @@ p_hsDecls style decls =

3737 case md of

3838 Nothing -> located d pDecl

3939 Just d' ->

40− if separatedDecls (unLoc d) (unLoc d')

41− then line (located d pDecl)

42− else located d pDecl

40+ line $ if separatedDecls (unLoc d) (unLoc d')

41+ then line (located d pDecl)

42+ else located d pDecl

4343 where

4444 pDecl = p_hsDecl style

4545

@@ -118,6 +118,7 @@ isPragma = \case

118118 SCCPragma n -> Just n

119119 AnnTypePragma n -> Just n

120120 AnnValuePragma n -> Just n

121+ WarningPragma n -> Just n

121122 _ -> Nothing

122123

123124pattern TypeSignature

@@ -128,7 +129,8 @@ pattern TypeSignature

128129 , AnnTypePragma

129130 , AnnValuePragma

130131 , PatternSignature

131− , Pattern :: RdrName -> HsDecl GhcPs

132+ , Pattern

133+ , WarningPragma :: RdrName -> HsDecl GhcPs

132134pattern TypeSignature n <- (sigRdrName -> Just n)

133135pattern FunctionBody n <- ValD NoExt (FunBind NoExt (L _ n) _ _ _)

134136pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)

@@ -138,6 +140,7 @@ pattern AnnTypePragma n <- AnnD NoExt (HsAnnotation NoExt _ (TypeAnnProvenance (

138140pattern AnnValuePragma n <- AnnD NoExt (HsAnnotation NoExt _ (ValueAnnProvenance (L _ n)) _)

139141pattern PatternSignature n <- SigD NoExt (PatSynSig NoExt ((L _ n):_) _)

140142pattern Pattern n <- ValD NoExt (PatSynBind NoExt (PSB _ (L _ n) _ _ _))

143+pattern WarningPragma n <- WarningD NoExt (Warnings NoExt _ [(L _ (Warning NoExt [(L _ n)] _))])

141144

142145sigRdrName :: HsDecl GhcPs -> Maybe RdrName

143146sigRdrName (SigD NoExt (TypeSig NoExt ((L _ n):_) _)) = Just n

src/Ormolu/Printer/Meat/Declaration/Annotation.hs+1−1

@@ -14,7 +14,7 @@ import Ormolu.Utils

1414

1515p_annDecl :: AnnDecl GhcPs -> R ()

1616p_annDecl = \case

17− HsAnnotation NoExt _ annProv expr -> line . pragma "ANN" . inci $ do

17+ HsAnnotation NoExt _ annProv expr -> pragma "ANN" . inci $ do

1818 p_annProv annProv

1919 breakpoint

2020 located expr p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Class.hs+1−3

@@ -64,13 +64,11 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

6464 ) <$> catdefs

6565 allDecls =

6666 snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs)

67− if not (null allDecls)

68− then do

67+ unless (null allDecls) $ do

6968 txt " where"

7069 newline -- Ensure line is added after where clause.

7170 newline -- Add newline before first declaration.

7271 inci (p_hsDecls Associated allDecls)

73− else newline

7472

7573p_classContext :: LHsContext GhcPs -> R ()

7674p_classContext ctx = unless (null (unLoc ctx)) $ do

src/Ormolu/Printer/Meat/Declaration/Data.hs+5−4

@@ -51,7 +51,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

5151 if gadt

5252 then do

5353 txt " where"

54− newline

54+ breakpoint

5555 inci . sitcc $ sep newline (sitcc . located' p_conDecl) dd_cons

5656 else switchLayout (getLoc name : (getLoc <$> dd_cons)) $

5757 inci $ do

@@ -59,9 +59,10 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

5959 txt "= "

6060 let s = vlayout (txt " | ") (newline >> txt "| ")

6161 sep s (sitcc . located' p_conDecl) dd_cons

62− newline

63− inci . located dd_derivs $ \xs ->

64− forM_ xs (line . located' p_hsDerivingClause)

62+

63+ unless (null $ unLoc dd_derivs) breakpoint

64+ inci . located dd_derivs $ \xs -> do

65+ sep newline (located' p_hsDerivingClause) xs

6566p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

6667

6768p_conDecl :: ConDecl GhcPs -> R ()

src/Ormolu/Printer/Meat/Declaration/Default.hs+1−1

@@ -13,7 +13,7 @@ import Ormolu.Utils

1313

1414p_defaultDecl :: DefaultDecl GhcPs -> R ()

1515p_defaultDecl = \case

16− DefaultDecl NoExt ts -> line $ do

16+ DefaultDecl NoExt ts -> do

1717 txt "default"

1818 breakpoint

1919 inci . parens . sitcc $

src/Ormolu/Printer/Meat/Declaration/Foreign.hs+2−2

@@ -19,10 +19,10 @@ import Ormolu.Utils

1919

2020p_foreignDecl :: ForeignDecl GhcPs -> R ()

2121p_foreignDecl = \case

22− fd@ForeignImport {fd_fi} -> line $ do

22+ fd@ForeignImport {fd_fi} -> do

2323 p_foreignImport fd_fi

2424 p_foreignTypeSig fd

25− fd@ForeignExport {fd_fe} -> line $ do

25+ fd@ForeignExport {fd_fe} -> do

2626 p_foreignExport fd_fe

2727 p_foreignTypeSig fd

2828 XForeignDecl {} -> notImplemented "XForeignDecl"

src/Ormolu/Printer/Meat/Declaration/Instance.hs+8−11

@@ -14,6 +14,7 @@ where

1414

1515import BasicTypes

1616import Control.Arrow

17+import Control.Monad

1718import Data.Foldable

1819import Data.List (sortBy)

1920import Data.Ord (comparing)

@@ -59,7 +60,6 @@ p_standaloneDerivDecl DerivDecl {..} = do

5960 instTypes True

6061 ViaStrategy (XHsImplicitBndrs NoExt) ->

6162 notImplemented "XHsImplicitBndrs"

62− newline

6363p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"

6464

6565p_clsInstDecl :: ClsInstDecl GhcPs -> R ()

@@ -87,15 +87,13 @@ p_clsInstDecl = \case

8787 allDecls =

8888 snd <$>

8989 sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)

90− if null allDecls

91− then newline

92− else do

93− switchLayout [getLoc hsib_body] breakpoint

94− inci $ do

95− txt "where"

96− newline -- Ensure line is added after where clause.

97− newline -- Add newline before first declaration.

98− p_hsDecls Associated allDecls

90+ unless (null allDecls) $ do

91+ switchLayout [getLoc hsib_body] breakpoint

92+ inci $ do

93+ txt "where"

94+ newline -- Ensure line is added after where clause.

95+ newline -- Add newline before first declaration.

96+ p_hsDecls Associated allDecls

9997 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

10098 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

10199

@@ -107,7 +105,6 @@ p_tyFamInstDecl style = \case

107105 Free -> "type instance"

108106 breakpoint

109107 inci (p_tyFamInstEqn tfid_eqn)

110− newline

111108

112109p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()

113110p_dataFamInstDecl style = \case

src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs+1−1

@@ -24,7 +24,7 @@ p_roleAnnot = \case

2424 XRoleAnnotDecl _ -> notImplemented "XRoleAnnotDecl"

2525

2626p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()

27−p_roleAnnot' l_name anns = line $ do

27+p_roleAnnot' l_name anns = do

2828 txt "type role"

2929 breakpoint

3030 inci $ do

src/Ormolu/Printer/Meat/Declaration/Rule.hs+1−1

@@ -20,7 +20,7 @@ import qualified Data.Text as T

2020

2121p_ruleDecls :: RuleDecls GhcPs -> R ()

2222p_ruleDecls = \case

23− HsRules NoExt _ xs -> line . pragma "RULES" . sitcc $

23+ HsRules NoExt _ xs -> pragma "RULES" . sitcc $

2424 sep breakpoint (sitcc . located' p_ruleDecl) xs

2525 XRuleDecls NoExt -> notImplemented "XRuleDecls"

2626

src/Ormolu/Printer/Meat/Declaration/Signature.hs+1−5

@@ -6,7 +6,6 @@

77module Ormolu.Printer.Meat.Declaration.Signature

88 ( p_sigDecl

9− , p_sigDecl'

109 , p_typeAscription

1110 , p_activation

1211 , visibleActivation

@@ -23,10 +22,7 @@ import Ormolu.Printer.Meat.Type

2322import Ormolu.Utils

2423

2524p_sigDecl :: Sig GhcPs -> R ()

26−p_sigDecl = line . p_sigDecl'

27−

28−p_sigDecl' :: Sig GhcPs -> R ()

29−p_sigDecl' = \case

25+p_sigDecl = \case

3026 TypeSig NoExt names hswc -> p_typeSig names hswc

3127 PatSynSig NoExt names hsib -> p_patSynSig names hsib

3228 ClassOpSig NoExt def names hsib -> p_classOpSig def names hsib

src/Ormolu/Printer/Meat/Declaration/Splice.hs+1−1

@@ -12,5 +12,5 @@ import Ormolu.Utils

1212

1313p_spliceDecl :: SpliceDecl GhcPs -> R ()

1414p_spliceDecl = \case

15− SpliceDecl NoExt splice _explicit -> line $ located splice p_hsSplice

15+ SpliceDecl NoExt splice _explicit -> located splice p_hsSplice

1616 XSpliceDecl {} -> notImplemented "XSpliceDecl"

src/Ormolu/Printer/Meat/Declaration/Type.hs+1−1

@@ -21,7 +21,7 @@ p_synDecl

2121 -> LHsQTyVars GhcPs -- ^ Type variables

2222 -> LHsType GhcPs -- ^ RHS of type declaration

2323 -> R ()

24−p_synDecl name tvars t = line $ do

24+p_synDecl name tvars t = do

2525 txt "type "

2626 p_rdrName name

2727 let HsQTvs {..} = tvars

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+3−3

@@ -46,14 +46,14 @@ p_famDecl style FamilyDecl {..} = do

4646 when (isJust rsig && isJust fdInjectivityAnn) breakpoint

4747 forM_ fdInjectivityAnn (located' p_injectivityAnn)

4848 case mmeqs of

49− Nothing -> newline

49+ Nothing -> return ()

5050 Just meqs -> do

5151 txt " where"

5252 case meqs of

53− Nothing -> txt " .." >> newline

53+ Nothing -> txt " .."

5454 Just eqs -> do

5555 newline

56− forM_ eqs (located' (line . inci . p_tyFamInstEqn))

56+ sep newline (located' (inci . p_tyFamInstEqn)) eqs

5757p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"

5858

5959p_familyResultSigL

src/Ormolu/Printer/Meat/Declaration/Value.hs+10−10

@@ -54,10 +54,7 @@ data Placement

5454 -- of indentation

5555

5656p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

57−p_valDecl = line . p_valDecl'

58−

59−p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()

60−p_valDecl' = \case

57+p_valDecl = \case

6158 FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches

6259 PatBind NoExt pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss

6360 VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker

@@ -412,8 +409,8 @@ p_hsLocalBinds = \case

412409 (srcSpanStart . getLoc)

413410 items =

414411 (Left <$> bagToList bag) ++ (Right <$> lsigs)

415− p_item (Left x) = located x p_valDecl'

416− p_item (Right x) = located x p_sigDecl'

412+ p_item (Left x) = located x p_valDecl

413+ p_item (Right x) = located x p_sigDecl

417414 sitcc $ sep newline (sitcc . p_item) (sortOn ssStart items)

418415 HsValBinds NoExt _ -> notImplemented "HsValBinds"

419416 HsIPBinds NoExt _ -> notImplemented "HsIPBinds"

@@ -546,7 +543,9 @@ p_hsExpr = \case

546543 HsDo NoExt ctx es -> do

547544 let doBody header = do

548545 txt header

549− newline

546+ if length (unLoc es) <= 1

547+ then breakpoint

548+ else newline

550549 inci $ located es (sep newline (located' (sitcc . p_stmt)))

551550 compBody = brackets $ located es $ \xs -> do

552551 let p_parBody = sitcc . sep

@@ -862,9 +861,10 @@ p_hsBracket = \case

862861 txt name

863862 txt "|"

864863 breakpoint'

865− body

866− breakpoint'

867− txt "|]"

864+ inci $ do

865+ body

866+ breakpoint'

867+ txt "|]"

868868

869869----------------------------------------------------------------------------

870870-- Helpers

src/Ormolu/Printer/Meat/Module.hs+1

@@ -54,6 +54,7 @@ p_hsModule exts (L moduleSpan HsModule {..}) = do

5454 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

5555 when (hasImports && hasDecls) newline

5656 p_hsDecls Free hsmodDecls

57+ when hasDecls newline

5758 trailingComments <- hasMoreComments

5859 when (trailingComments && hasModuleHeader) newline

5960 spitRemainingComments