2fd53f6 · ormolu · git.iko.soy

git.iko.soy/ormolu

Support typed and untyped splices

commit2fd53f6af201a311961d18f901dd468d48c00fb6 authorBasile Henry <bjm.henry@gmail.com> dateSun 16 Jun 2019, 15:58 (7 years ago) parent4a0e5d4

20 files changed+255−73

compare with master

unifiedsplit

data/examples/declaration/splice/bracket-out.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+foo =

3+ [e|

4+ foo bar

5+ |]

7+foo =

8+ [e|

9+ foo bar

10+ |]

11+

12+foo = [t|Char|]

13+

14+foo =

15+ [d|

16+ foo :: Int -> Char

17+

18+ bar = 42

19+

20+ |]

21+

22+foo =

23+ [||

24+ foo bar

25+ ||]

data/examples/declaration/splice/bracket.hsnew file+17

@@ -0,0 +1,17 @@

1+{-# LANGUAGE TemplateHaskell #-}

3+foo = [| foo bar

4+ |]

6+foo = [e| foo bar

7+ |]

9+foo = [t| Char |]

10+

11+foo = [d|

12+ foo:: Int -> Char

13+ bar = 42

14+ |]

15+

16+foo = [|| foo bar

17+ ||]

data/examples/declaration/splice/quasiquote-out.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE QuasiQuotes #-}

2+x = [foo| foo bar |]

4+x =

5+ [e| foo

6+ bar {- -}

7+ |]

9+[d| foo bar

10+

11+|]

data/examples/declaration/splice/quasiquote.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE QuasiQuotes #-}

3+x = [foo| foo bar |]

5+x = [e| foo

6+ bar {- -}

7+ |]

9+[d| foo bar

10+

11+|]

data/examples/declaration/splice/splice-decl-out.hsnew file+16

@@ -0,0 +1,16 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+$(foo bar)

4+$foo

6+$$(foo bar)

8+$$foo

10+foo bar

11+

12+[e|booya|]

13+

14+-- TemplateHaskell allows Q () at the top level

15+do

16+ pure []

data/examples/declaration/splice/splice-decl.hsnew file+17

@@ -0,0 +1,17 @@

1+{-# LANGUAGE TemplateHaskell #-}

3+$( foo bar)

5+$foo

7+$$( foo bar)

9+$$foo

10+

11+foo bar

12+

13+[|booya|]

14+

15+-- TemplateHaskell allows Q () at the top level

16+do

17+ pure []

data/examples/declaration/splice/typed-splice-out.hsnew file+6

@@ -0,0 +1,6 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+x =

3+ $$( foo bar

4+ )

6+x = $$foo

data/examples/declaration/splice/typed-splice.hsnew file+6

@@ -0,0 +1,6 @@

1+{-# LANGUAGE TemplateHaskell #-}

3+x = $$( foo bar

4+ )

6+x = $$foo

data/examples/declaration/splice/untyped-splice-out.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+x = $(foo bar)

4+x =

5+ $( foo

6+ bar

7+ )

9+x = $foo

data/examples/declaration/splice/untyped-splice.hsnew file+8

@@ -0,0 +1,8 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+x = $( foo bar )

4+x = $(

5+ foo

6+ bar )

8+x = $foo

data/examples/declaration/value/function/pattern/quasi-quotes-pattern-out.hs+3−4

@@ -4,7 +4,6 @@ singleline [yamlQQ|something|] = ()

55multiline :: ()

66multiline = case y of

7− [yamlQQ|

8− name: John Doe

9− age: 23

10− |] -> ()

7+ [yamlQQ| name: John Doe

8+age: 23

9+|] -> ()

data/examples/declaration/value/function/pattern/splice-pattern-out.hs+2−2

@@ -5,8 +5,8 @@ singleLine = case () of

66multiline = case () of

77 $( x +

8− y

8+ y

99 ) -> ()

1010 $( y

11− "something"

11+ "something"

1212 ) -> ()

data/examples/declaration/value/function/quasi-quotes-out.hs+4−5

@@ -4,9 +4,8 @@ singleline = [yamlQQ|something|]

55multiline :: Value

66multiline =

7− [yamlQQ|

8− name: John Doe

9− age: 23

7+ [yamlQQ| name: John Doe

8+age: 23

109

11− something: foo

12− |]

10+something: foo

11+|]

ormolu.cabal+1

@@ -68,6 +68,7 @@ library

6868 , Ormolu.Printer.Meat.Declaration.Instance

6969 , Ormolu.Printer.Meat.Declaration.RoleAnnotation

7070 , Ormolu.Printer.Meat.Declaration.Signature

71+ , Ormolu.Printer.Meat.Declaration.Splice

7172 , Ormolu.Printer.Meat.Declaration.Type

7273 , Ormolu.Printer.Meat.Declaration.TypeFamily

7374 , Ormolu.Printer.Meat.Declaration.Value

src/Ormolu/Printer/Combinators.hs+10−3

@@ -22,6 +22,7 @@ module Ormolu.Printer.Combinators

2222 , switchLayout

2323 , vlayout

2424 , breakpoint

25+ , breakpoint'

2526 -- ** Formatting lists

2627 , velt

2728 , velt'

@@ -143,6 +144,14 @@ switchLayout spn = enterLayout

143144breakpoint :: R ()

144145breakpoint = vlayout space newline

145146

147+-- | Similar to 'breakpoint' but outputs nothing in case of single-line

148+-- layout.

149+--

150+-- > breakpoint' = vlayout (return ()) newline

151+

152+breakpoint' :: R ()

153+breakpoint' = vlayout (return ()) newline

154+

146155----------------------------------------------------------------------------

147156-- Formatting lists

148157

@@ -155,9 +164,7 @@ breakpoint = vlayout space newline

155164-- when layout is single line.

156165

157166velt :: [R ()] -> R ()

158−velt xs = sequence_ (intersperse sep (sitcc <$> xs))

159− where

160− sep = vlayout (pure ()) newline

167+velt xs = sequence_ (intersperse breakpoint' (sitcc <$> xs))

161168

162169-- | Like 'velt', but all sub-elements start at the same indentation level

163170-- as first element, additionally spaces are inserted when layout is single

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

@@ -1,13 +1,16 @@

11{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE PatternSynonyms #-}

23{-# LANGUAGE RecordWildCards #-}

45-- | Rendering of declarations.

67module Ormolu.Printer.Meat.Declaration

7− ( p_hsDecl

8+ ( p_hsDecls

9+ , p_hsDecl

810 )

911where

1012

13+import Control.Monad (forM_)

1114import GHC

1215import Ormolu.Printer.Combinators

1316import Ormolu.Printer.Meat.Common

@@ -15,16 +18,28 @@ import Ormolu.Printer.Meat.Declaration.Annotation

1518import Ormolu.Printer.Meat.Declaration.Class

1619import Ormolu.Printer.Meat.Declaration.Data

1720import Ormolu.Printer.Meat.Declaration.Default

18−import Ormolu.Printer.Meat.Declaration.Instance

1921import Ormolu.Printer.Meat.Declaration.Foreign

22+import Ormolu.Printer.Meat.Declaration.Instance

2023import Ormolu.Printer.Meat.Declaration.RoleAnnotation

2124import Ormolu.Printer.Meat.Declaration.Signature

25+import Ormolu.Printer.Meat.Declaration.Splice

2226import Ormolu.Printer.Meat.Declaration.Type

2327import Ormolu.Printer.Meat.Declaration.TypeFamily

2428import Ormolu.Printer.Meat.Declaration.Value

2529import Ormolu.Printer.Meat.Type

2630import Ormolu.Utils

2731

32+p_hsDecls :: [LHsDecl GhcPs] -> R ()

33+p_hsDecls decls =

34+ forM_ (zip decls ((Just <$> drop 1 decls) ++ [Nothing])) $

35+ \(d, md) -> do

36+ case md of

37+ Nothing -> located d p_hsDecl

38+ Just d' ->

39+ if separatedDecls (unLoc d) (unLoc d')

40+ then line (located d p_hsDecl)

41+ else located d p_hsDecl

42+

2843p_hsDecl :: HsDecl GhcPs -> R ()

2944p_hsDecl = \case

3045 TyClD NoExt x -> p_tyClDecl x

@@ -37,7 +52,7 @@ p_hsDecl = \case

3752 WarningD _ _ -> notImplemented "WarningD"

3853 AnnD NoExt x -> p_annDecl x

3954 RuleD _ _ -> notImplemented "RuleD"

40− SpliceD _ _ -> notImplemented "SpliceD"

55+ SpliceD NoExt x -> p_spliceDecl x

4156 DocD _ _ -> notImplemented "DocD"

4257 RoleAnnotD NoExt x -> p_roleAnnot x

4358 XHsDecl _ -> notImplemented "XHsDecl"

@@ -72,3 +87,26 @@ p_derivDecl :: DerivDecl GhcPs -> R ()

7287p_derivDecl = \case

7388 d@DerivDecl {..} -> p_standaloneDerivDecl d

7489 XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"

90+

91+-- | Determine if these declarations should be separated by a blank line.

92+

93+separatedDecls

94+ :: HsDecl GhcPs

95+ -> HsDecl GhcPs

96+ -> Bool

97+separatedDecls (TypeSignature n) (FunctionBody n') = n /= n'

98+separatedDecls (FunctionBody n) (InlinePragma n') = n /= n'

99+separatedDecls (InlinePragma n) (TypeSignature n') = n /= n'

100+separatedDecls (FunctionBody n) (SpecializePragma n') = n /= n'

101+separatedDecls (SpecializePragma n) (TypeSignature n') = n /= n'

102+separatedDecls (SpecializePragma n) (SpecializePragma n') = n /= n'

103+separatedDecls _ _ = True

104+

105+pattern TypeSignature

106+ , FunctionBody

107+ , InlinePragma

108+ , SpecializePragma :: RdrName -> HsDecl GhcPs

109+pattern TypeSignature n <- SigD NoExt (TypeSig NoExt ((L _ n):_) _)

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

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

112+pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)

src/Ormolu/Printer/Meat/Declaration.hs-bootnew file+12

@@ -0,0 +1,12 @@

1+module Ormolu.Printer.Meat.Declaration

2+ ( p_hsDecls

3+ , p_hsDecl

4+ )

5+where

7+import GHC

8+import Ormolu.Printer.Combinators

10+p_hsDecls :: [LHsDecl GhcPs] -> R ()

11+

12+p_hsDecl :: HsDecl GhcPs -> R ()

src/Ormolu/Printer/Meat/Declaration/Splice.hsnew file+16

@@ -0,0 +1,16 @@

1+{-# LANGUAGE LambdaCase #-}

3+module Ormolu.Printer.Meat.Declaration.Splice

4+ ( p_spliceDecl

5+ )

6+where

8+import GHC

9+import Ormolu.Printer.Combinators

10+import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)

11+import Ormolu.Utils

12+

13+p_spliceDecl :: SpliceDecl GhcPs -> R ()

14+p_spliceDecl = \case

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

16+ XSpliceDecl {} -> notImplemented "XSpliceDecl"

src/Ormolu/Printer/Meat/Declaration/Value.hs+39−22

@@ -6,6 +6,7 @@ module Ormolu.Printer.Meat.Declaration.Value

66 ( p_valDecl

77 , p_pat

88 , p_hsExpr

9+ , p_hsSplice

910 )

1011where

1112

@@ -14,8 +15,7 @@ import BasicTypes

1415import Control.Monad

1516import Data.Data

1617import Data.List (sortOn)

17−import Data.String (fromString)

18−import FastString as GHC

18+import Data.Text (Text)

1919import GHC

2020import Ormolu.Printer.Combinators

2121import Ormolu.Printer.Meat.Common

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

2525import Outputable (Outputable (..))

2626import SrcLoc (combineSrcSpans, isOneLineSpan)

2727import qualified Data.List.NonEmpty as NE

28−import qualified Data.Text as T

28+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration

2929

3030data MatchGroupStyle

3131 = Function (Located RdrName)

@@ -381,7 +381,6 @@ p_hsExpr = \case

381381 HsIB {..} = hswc_body

382382 located hsib_body p_hsType

383383 ArithSeq NoExt _ x -> do

384− let breakpoint' = vlayout (return ()) newline

385384 case x of

386385 From from -> brackets $ do

387386 located from p_hsExpr

@@ -413,7 +412,7 @@ p_hsExpr = \case

413412 txt " #-}"

414413 breakpoint

415414 located x p_hsExpr

416− HsBracket {} -> notImplemented "HsBracket"

415+ HsBracket NoExt x -> p_hsBracket x

417416 HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

418417 HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

419418 HsSpliceE NoExt splice -> p_hsSplice splice

@@ -557,10 +556,13 @@ p_hsSplice = \case

557556 HsTypedSplice NoExt deco _ expr -> p_hsSpliceTH True expr deco

558557 HsUntypedSplice NoExt deco _ expr -> p_hsSpliceTH False expr deco

559558 HsQuasiQuote NoExt _ quoterName srcSpan str -> do

560− let locatedQuoterName = L srcSpan quoterName

561− p_quasiQuote locatedQuoterName $ do

562− let p x = unless (T.null x) (txt x)

563− newlineSep (p . T.strip) (T.lines . T.strip . fromString . GHC.unpackFS $ str)

559+ txt "["

560+ p_rdrName (L srcSpan quoterName)

561+ txt "|"

562+ -- NOTE QuasiQuoters often rely on precise custom strings. We cannot do

563+ -- any formatting here without potentially breaking someone's code.

564+ atom str

565+ txt "|]"

564566 HsSpliced {} -> notImplemented "HsSpliced"

565567 XSplice {} -> notImplemented "XSplice"

566568

@@ -572,25 +574,40 @@ p_hsSpliceTH

572574p_hsSpliceTH isTyped expr = \case

573575 HasParens -> do

574576 txt decoSymbol

575− parens (located expr p_hsExpr)

577+ parens (located expr (sitcc . p_hsExpr))

576578 HasDollar -> do

577579 txt decoSymbol

578− located expr p_hsExpr

580+ located expr (sitcc . p_hsExpr)

579581 NoParens -> do

580− located expr p_hsExpr

582+ located expr (sitcc . p_hsExpr)

581583 where

582584 decoSymbol = if isTyped then "$$" else "$"

583585

584−p_quasiQuote :: Located RdrName -> R () -> R ()

585−p_quasiQuote quoter m = do

586− txt "["

587− p_rdrName quoter

588− txt "|"

589− let breakpoint' = vlayout (return ()) newline

590− breakpoint'

591− inci m

592− breakpoint'

593− txt "|]"

586+p_hsBracket :: HsBracket GhcPs -> R ()

587+p_hsBracket = \case

588+ ExpBr NoExt expr -> quote "e" (located expr p_hsExpr)

589+ PatBr NoExt pat -> quote "p" (located pat p_pat)

590+ DecBrL NoExt decls -> quote "d" (p_hsDecls decls)

591+ DecBrG NoExt _ -> notImplemented "DecBrG" -- result of renamer

592+ TypBr NoExt ty -> quote "t" (located ty p_hsType)

593+ VarBr NoExt _ _ -> notImplemented "VarBr"

594+ TExpBr NoExt expr -> do

595+ txt "[||"

596+ breakpoint'

597+ located expr p_hsExpr

598+ breakpoint'

599+ txt "||]"

600+ XBracket {} -> notImplemented "XBracket"

601+ where

602+ quote :: Text -> R () -> R ()

603+ quote name body = do

604+ txt "["

605+ txt name

606+ txt "|"

607+ breakpoint'

608+ body

609+ breakpoint'

610+ txt "|]"

594611

595612----------------------------------------------------------------------------

596613-- Helpers

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

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE PatternSynonyms #-}

43{-# LANGUAGE RecordWildCards #-}

65-- | Rendering of modules.

@@ -50,16 +49,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

5049 when (not (null hsmodImports) || not (null hsmodDecls)) newline

5150 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

5251 when (not (null hsmodImports) && not (null hsmodDecls)) newline

53−

54− forM_ (zip hsmodDecls ((Just <$> drop 1 hsmodDecls) ++ [Nothing])) $

55− \(d, md) -> do

56− case md of

57− Nothing -> located d p_hsDecl

58− Just d' ->

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

60− then line (located d p_hsDecl)

61− else located d p_hsDecl

62−

52+ p_hsDecls hsmodDecls

6353 trailingComments <- hasMoreComments

6454 when (trailingComments && isJust hsmodName) newline

6555 spitRemainingComments

@@ -83,26 +73,3 @@ p_warningTxt = \case

8373 p_lits = \case

8474 [l] -> atom l

8575 ls -> brackets . velt $ withSep comma atom ls

86−

87−-- | Determine if these declarations should be separated by a blank line.

88−

89−separatedDecls

90− :: HsDecl GhcPs

91− -> HsDecl GhcPs

92− -> Bool

93−separatedDecls (TypeSignature n) (FunctionBody n') = n /= n'

94−separatedDecls (FunctionBody n) (InlinePragma n') = n /= n'

95−separatedDecls (InlinePragma n) (TypeSignature n') = n /= n'

96−separatedDecls (FunctionBody n) (SpecializePragma n') = n /= n'

97−separatedDecls (SpecializePragma n) (TypeSignature n') = n /= n'

98−separatedDecls (SpecializePragma n) (SpecializePragma n') = n /= n'

99−separatedDecls _ _ = True

100−

101−pattern TypeSignature

102− , FunctionBody

103− , InlinePragma

104− , SpecializePragma :: RdrName -> HsDecl GhcPs

105−pattern TypeSignature n <- SigD NoExt (TypeSig NoExt ((L _ n):_) _)

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

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

108−pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)