2c54729 · ormolu · git.iko.soy

git.iko.soy/ormolu

Update ghc-lib-parser to 8.10.1

GHC 8.10.1 comes with some changes to the AST, which works great for Ormolu, but causes this commit to be a bit large: * Trees That Grow extension points for new constructors are now statically proven to be uninhabited, via noExtCon :: NoExtCon -> a. Thanks to this change I got rid of many notImplemented calls. * LPat constructor is now a lot more usable, so we don't need to use the locatedPat combinator and can remove some boilerplate code. Also it comes with ImportQualifiedPost and StandaloneKindSignatures we should support. I did not implement them in this commit, they'll be merged in later on. It causes one behaviour change, where the ordering of qualified and non-qualified imports of the same module is changed. This is due to our usage of gcompare resulting a different ordering because of the AST change caused by the ImportQualifiedPost extension. I think this is acceptable and we shouldn't try to keep backwards compatibility there. Another behaviour change is that previously HsExpr had a few extra constructors for arrows and patterns used in expression context. Those programs were syntactically incorrect, but refused on a later stage. But we nonetheless formatted those constructs so Ormolu didn't fail there while keeping the source code intact. However, now those constructors are removed, so Ormolu fails with a parse error in this case (same as GHC). I also removed some tests exhibiting this behaviour.

commit2c5472944b2cb37760c1e5476334554ec977599c authorUtku Demir <me@utdemir.com> dateSun 29 Mar 2020, 10:32 (7 years ago) parent57d0d11

36 files changed+480−537

compare with master

unifiedsplit

data/examples/declaration/type/visible-forall-out.hsnew file+2

@@ -0,0 +1,2 @@

1+-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst

2+data T :: forall k -> k -> Type

data/examples/declaration/type/visible-forall.hsnew file+2

@@ -0,0 +1,2 @@

1+-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst

2+data T :: forall k -> k -> Type

data/examples/declaration/value/function/arrow/expression-applications-out.hsdeleted−9

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

1−{-# LANGUAGE Arrows #-}

2−

3−foo x y = x -< y

4−

5−bar f x =

6− f x -< -- Hello

7− x -- World

8−

9−baz x y = x -<< y

data/examples/declaration/value/function/arrow/expression-applications.hsdeleted−9

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

1−{-# LANGUAGE Arrows #-}

2−

3−foo x y = x -< y

4−

5−bar f x

6− = f x -- Hello

7− -< x -- World

8−

9−baz x y = x -<< y

data/examples/declaration/value/function/arrow/expression-forms-out.hsdeleted−14

@@ -1,14 +0,0 @@

1−{-# LANGUAGE Arrows #-}

2−

3−foo f g x y = (| test (f -< x) (g -< y) |)

4−

5−bar f g x y =

6− (|

7− test

8− ( f -<

9− x

10− )

11− ( g -<

12− y

13− )

14− |)

data/examples/declaration/value/function/arrow/expression-forms.hsdeleted−11

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

1−{-# LANGUAGE Arrows #-}

2−

3−foo f g x y = (| test (f -< x) (g -< y) |)

4−

5−bar f g x y = (|

6− test

7− (f

8− -< x)

9− (g

10− -< y)

11− |)

data/examples/declaration/value/function/arrow/proc-forms2-out.hs+8−6

@@ -4,15 +4,17 @@ bar0 f g h x =

44 proc (y, z) ->

55 (| test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x)) |)

7−bar1 f g x y = proc _ -> f -< x &&& g -< y

7+bar1 f g x y = proc _ -> (f -< x) &&& (g -< y)

99bar2 f g h x =

1010 proc (y, z) ->

11− h f . (h g) -< (y x) . y z ||| (h g) . h f -< y z . (y x)

11+ (h f . (h g) -< (y x) . y z) ||| ((h g) . h f -< y z . (y x))

1212

1313bar3 f g h x =

1414 proc (y, z) ->

15− (h f . h g) -<

16− (y x) . y z

17− ||| (h g . h f) -<

18− y z . (y x)

15+ ( (h f . h g) -<

16+ (y x) . y z

17+ ) |||

18+ ( (h g . h f) -<

19+ y z . (y x)

20+ )

data/examples/declaration/value/function/arrow/proc-forms2.hs+6−6

@@ -4,16 +4,16 @@ bar0 f g h x =

44 proc (y, z) ->

55 (| test (h f.(h g) -< (y x).y z)((h g) . h f-<y z . (y x)) |)

7−bar1 f g x y = proc _ -> f -< x&&&g -< y

7+bar1 f g x y = proc _ -> (f -< x)&&&(g -< y)

99bar2 f g h x =

1010 proc (y, z) ->

11− h f.(h g) -< (y x).y z ||| (h g) . h f-<y z . (y x)

11+ (h f.(h g) -< (y x).y z) ||| ((h g) . h f-<y z . (y x))

1212

1313bar3 f g h x =

1414 proc (y, z) ->

15− (h f.h g)

16− -< (y x).y z

15+ ((h f.h g)

16+ -< (y x).y z)

1717 |||

18− (h g . h f)

19− -<y z . (y x)

18+ ((h g . h f)

19+ -<y z . (y x))

data/examples/declaration/value/function/pattern/view-pattern-out.hs−3

@@ -13,6 +13,3 @@ multiline

1313 bar

1414 baz

1515 ) = True

16−

17−-- https://github.com/tweag/ormolu/issues/343

18−foo = (f -> 4)

data/examples/declaration/value/function/pattern/view-pattern.hs−3

@@ -10,6 +10,3 @@ g ((f, _), f -> 4) = True

1010multiline (t -> Foo

1111 bar

1212 baz) = True

13−

14−-- https://github.com/tweag/ormolu/issues/343

15−foo = (f -> 4)

data/examples/import/qualified-prelude-out.hs+1−1

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

11module P where

3−import Prelude hiding ((.), id)

43import qualified Prelude

4+import Prelude hiding ((.), id)

default.nix+6−2

@@ -17,10 +17,14 @@ let

1717 "ormolu" = pkgs.haskell.lib.enableCabalFlag

1818 (super.callCabal2nix "ormolu" source { }) "dev";

1919 # Nixpkgs provides ghc-lib-parser-8.8.0.20190424, but we want

20− # ghc-lib-parser-8.8.1. We disable Haddock generation because it's way

20+ # ghc-lib-parser-8.10.1. We disable Haddock generation because it's way

2121 # too slow.

2222 "ghc-lib-parser" = pkgs.haskell.lib.dontHaddock

23− (super.callHackage "ghc-lib-parser" "8.8.1" { });

23+ (super.callHackageDirect {

24+ pkg = "ghc-lib-parser";

25+ ver = "8.10.1.20200324";

26+ sha256 = "0f2c68fzdj2lw6da2zpx7a0cx631im3kylwd85dzx1npsm1vzlbg";

27+ } {});

2428 };

2529 ormolize = import ./nix/ormolize {

2630 inherit pkgs;

ormolu.cabal+2−2

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

6868 , containers >= 0.5 && < 0.7

6969 , dlist >= 0.8 && < 0.9

7070 , exceptions >= 0.6 && < 0.11

71− , ghc-lib-parser >= 8.8.1 && < 8.8.3

71+ , ghc-lib-parser >= 8.10 && < 8.11

7272 , mtl >= 2.0 && < 3.0

7373 , syb >= 0.7 && < 0.8

7474 , text >= 0.2 && < 1.3

@@ -149,7 +149,7 @@ executable ormolu

149149 main-is: Main.hs

150150 hs-source-dirs: app

151151 build-depends: base >= 4.12 && < 5.0

152− , ghc-lib-parser >= 8.8.1 && < 8.8.3

152+ , ghc-lib-parser >= 8.10 && < 8.11

153153 , gitrev >= 1.3 && < 1.4

154154 , optparse-applicative >= 0.14 && < 0.16

155155 , ormolu

src/GHC.hs+2−10

@@ -6,16 +6,8 @@ where

77import ApiAnnotation as X

88import BasicTypes as X

9−import HsBinds as X

10−import HsDecls as X

11−import HsDoc as X

12−import HsExpr as X

13−import HsExtension as X

14−import HsImpExp as X

15−import HsInstances as X ()

16−import HsLit as X

17−import HsPat as X

18−import HsSyn as X

9+import GHC.Hs as X

10+import GHC.Hs.Instances as X ()

1911import Module as X

2012import RdrName as X

2113import SrcLoc as X

src/GHC/DynFlags.hs+30−19

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

11{-# OPTIONS_GHC -Wno-missing-fields #-}

3+-- Modified from ghc-lib-api-ext.

35module GHC.DynFlags

46 ( baseDynFlags,

57 )

@@ -8,31 +10,40 @@ where

810import Config

911import DynFlags

1012import Fingerprint

11−import Platform

13+import GHC.Platform

14+import ToolSettings

1215

13−-- | Taken from HLint.

1416fakeSettings :: Settings

1517fakeSettings =

1618 Settings

17− { sTargetPlatform = platform,

18− sPlatformConstants = platformConstants,

19− sProjectVersion = cProjectVersion,

20− sProgramName = "ghc",

21− sOpt_P_fingerprint = fingerprint0,

22− sPgm_F = ""

19+ { sGhcNameVersion =

20+ GhcNameVersion

21+ { ghcNameVersion_programName = "ghc",

22+ ghcNameVersion_projectVersion = cProjectVersion

23+ },

24+ sFileSettings = FileSettings {},

25+ sTargetPlatform =

26+ Platform

27+ { platformWordSize = PW8,

28+ platformMini =

29+ PlatformMini

30+ { platformMini_arch = ArchUnknown,

31+ platformMini_os = OSUnknown

32+ },

33+ platformUnregisterised = True

34+ },

35+ sPlatformMisc = PlatformMisc {},

36+ sPlatformConstants =

37+ PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8},

38+ sToolSettings =

39+ ToolSettings

40+ { toolSettings_opt_P_fingerprint = fingerprint0,

41+ toolSettings_pgm_F = ""

42+ }

2343 }

24− where

25− platform =

26− Platform

27− { platformWordSize = 8,

28− platformOS = OSUnknown,

29− platformUnregisterised = True

30− }

31− platformConstants =

32− PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8}

3344

34−fakeLlvmConfig :: (LlvmTargets, LlvmPasses)

35−fakeLlvmConfig = ([], [])

45+fakeLlvmConfig :: LlvmConfig

46+fakeLlvmConfig = LlvmConfig [] []

3647

3748baseDynFlags :: DynFlags

3849baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig

src/Ormolu/Imports.hs+14−14

@@ -13,8 +13,8 @@ import Data.Function (on)

1313import Data.Generics (gcompare)

1414import Data.List (sortBy)

1515import GHC hiding (GhcPs, IE)

16−import HsExtension

17−import HsImpExp (IE (..))

16+import GHC.Hs.Extension

17+import GHC.Hs.ImpExp (IE (..))

1818import Ormolu.Utils (notImplemented)

1919

2020-- | Sort imports by module name. This also sorts explicit import lists for

@@ -29,7 +29,7 @@ sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)

2929 { ideclHiding = second (fmap sortLies) <$> ideclHiding,

3030 ..

3131 }

32− XImportDecl {} -> notImplemented "XImportDecl"

32+ XImportDecl x -> noExtCon x

3333

3434-- | Compare two @'LImportDecl' 'GhcPs'@ things.

3535compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering

@@ -51,8 +51,8 @@ sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)

5151-- | Sort imports\/exports inside of 'IEThingWith'.

5252sortThings :: IE GhcPs -> IE GhcPs

5353sortThings = \case

54− IEThingWith NoExt x w xs fl ->

55− IEThingWith NoExt x w (sortBy (compareIewn `on` unLoc) xs) fl

54+ IEThingWith NoExtField x w xs fl ->

55+ IEThingWith NoExtField x w (sortBy (compareIewn `on` unLoc) xs) fl

5656 other -> other

5757

5858-- | Compare two located imports or exports.

@@ -62,15 +62,15 @@ compareIE = compareIewn `on` getIewn

6262-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.

6363getIewn :: IE GhcPs -> IEWrappedName RdrName

6464getIewn = \case

65− IEVar NoExt x -> unLoc x

66− IEThingAbs NoExt x -> unLoc x

67− IEThingAll NoExt x -> unLoc x

68− IEThingWith NoExt x _ _ _ -> unLoc x

69− IEModuleContents NoExt _ -> notImplemented "IEModuleContents"

70− IEGroup NoExt _ _ -> notImplemented "IEGroup"

71− IEDoc NoExt _ -> notImplemented "IEDoc"

72− IEDocNamed NoExt _ -> notImplemented "IEDocNamed"

73− XIE NoExt -> notImplemented "XIE"

65+ IEVar NoExtField x -> unLoc x

66+ IEThingAbs NoExtField x -> unLoc x

67+ IEThingAll NoExtField x -> unLoc x

68+ IEThingWith NoExtField x _ _ _ -> unLoc x

69+ IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

70+ IEGroup NoExtField _ _ -> notImplemented "IEGroup"

71+ IEDoc NoExtField _ -> notImplemented "IEDoc"

72+ IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

73+ XIE x -> noExtCon x

7474

7575-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

7676compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

src/Ormolu/Parser.hs+52−14

@@ -9,14 +9,17 @@ module Ormolu.Parser

99 )

1010where

1111

12+import Bag (bagToList)

1213import qualified CmdLineParser as GHC

1314import Control.Exception

1415import Control.Monad

1516import Control.Monad.IO.Class

16−import Data.List ((\\), foldl', isPrefixOf)

17+import Data.List ((\\), foldl', isPrefixOf, sortOn)

1718import qualified Data.List.NonEmpty as NE

1819import Data.Maybe (catMaybes)

20+import Data.Ord (Down (Down))

1921import DynFlags as GHC

22+import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)

2023import qualified FastString as GHC

2124import GHC hiding (IE, UnicodeSyntax)

2225import GHC.DynFlags (baseDynFlags)

@@ -29,7 +32,6 @@ import Ormolu.Exception

2932import Ormolu.Parser.Anns

3033import Ormolu.Parser.CommentStream

3134import Ormolu.Parser.Result

32−import qualified Outputable as GHC

3335import qualified Panic as GHC

3436import qualified Parser as GHC

3537import qualified StringBuffer as GHC

@@ -73,20 +75,34 @@ parseModule Config {..} path input' = liftIO $ do

7375 || any

7476 (("RecordDotPreprocessor" ==) . moduleNameString)

7577 (pluginModNames dynFlags)

78+ pStateErrors = \pstate ->

79+ let errs = bagToList $ GHC.getErrorMessages pstate dynFlags

80+ in case sortOn (Down . SeverityOrd . errMsgSeverity) errs of

81+ [] -> Nothing

82+ err : _ -> Just (errMsgSpan err, show err) -- Show instance returns a short error message

7683 r = case runParser GHC.parseModule dynFlags path input of

77− GHC.PFailed _ ss m ->

78− Left (ss, GHC.showSDoc dynFlags m)

84+ GHC.PFailed pstate ->

85+ case pStateErrors pstate of

86+ Just err -> Left err

87+ Nothing -> error "invariant violation: PFailed does not have an error"

7988 GHC.POk pstate pmod ->

80− let (comments, exts, shebangs) = mkCommentStream extraComments pstate

81− in Right

82− ParseResult

83− { prParsedSource = pmod,

84− prAnns = mkAnns pstate,

85− prCommentStream = comments,

86− prExtensions = exts,

87− prShebangs = shebangs,

88− prUseRecordDot = useRecordDot

89− }

89+ case pStateErrors pstate of

90+ -- Some parse errors (pattern/arrow syntax in expr context)

91+ -- do not cause a parse error, but they are replaced with "_"

92+ -- by the parser and the modified AST is propagated to the

93+ -- later stages; but we fail in those cases.

94+ Just err -> Left err

95+ Nothing ->

96+ let (comments, exts, shebangs) = mkCommentStream extraComments pstate

97+ in Right

98+ ParseResult

99+ { prParsedSource = pmod,

100+ prAnns = mkAnns pstate,

101+ prCommentStream = comments,

102+ prExtensions = exts,

103+ prShebangs = shebangs,

104+ prUseRecordDot = useRecordDot

105+ }

90106 return (warnings, r)

91107

92108-- | Extensions that are not enabled automatically and should be activated

@@ -223,3 +239,25 @@ parsePragmasIntoDynFlags flags extraOpts filepath str =

223239 reportErr

224240 (GHC.handleSourceError reportErr act)

225241 reportErr e = return $ Left (show e)

242+

243+----------------------------------------------------------------------------

244+-- Even more helpers

245+

246+-- Wrap GHC's ErrUtils.Severity to add Ord instance

247+newtype SeverityOrd = SeverityOrd Severity

248+

249+instance Eq SeverityOrd where

250+ s1 == s2 = compare s1 s2 == EQ

251+

252+instance Ord SeverityOrd where

253+ compare (SeverityOrd s1) (SeverityOrd s2) =

254+ compare (f s1) (f s2)

255+ where

256+ f :: Severity -> Int

257+ f SevOutput = 1

258+ f SevFatal = 2

259+ f SevInteractive = 3

260+ f SevDump = 4

261+ f SevInfo = 5

262+ f SevWarning = 6

263+ f SevError = 7

src/Ormolu/Printer/Combinators.hs−24

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

2323 inci,

2424 located,

2525 located',

26− locatedPat,

2726 switchLayout,

2827 Layout (..),

2928 vlayout,

@@ -64,7 +63,6 @@ import Control.Monad

6463import Data.Data (Data)

6564import Data.List (intersperse)

6665import Data.Text (Text)

67−import GHC (Pat (XPat), XXPat)

6866import Ormolu.Printer.Comments

6967import Ormolu.Printer.Internal

7068import Ormolu.Utils (isModule)

@@ -111,28 +109,6 @@ located' ::

111109 R ()

112110located' = flip located

113111

114−-- | A version of 'located' that works on 'Pat'.

115−--

116−-- Starting from GHC 8.8, @'LPat' == 'Pat'@. Located 'Pat's are always

117−-- constructed with the 'XPat' constructor, containing a @'Located' 'Pat'@.

118−--

119−-- Most of the time, we can just use 'p_pat' directly, because it handles

120−-- located 'Pat's. However, sometimes we want to use the location to render

121−-- something other than the given 'Pat'.

122−--

123−-- If given 'Pat' does not contain a location, we error out.

124−--

125−-- This should become unnecessary if

126−-- <https://gitlab.haskell.org/ghc/ghc/issues/17330> is ever fixed.

127−locatedPat ::

128− (Data (Pat pass), XXPat pass ~ Located (Pat pass)) =>

129− Pat pass ->

130− (Pat pass -> R ()) ->

131− R ()

132−locatedPat p f = case p of

133− XPat pat -> located pat f

134− _ -> error "locatedPat: Pat does not contain a location"

135−

136112-- | Set layout according to combination of given 'SrcSpan's for a given.

137113-- Use this only when you need to set layout based on e.g. combined span of

138114-- several elements when there is no corresponding 'Located' wrapper

src/Ormolu/Printer/Meat/Declaration.hs+58−57

@@ -110,29 +110,30 @@ groupDecls (lhdr : xs) =

110110

111111p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

112112p_hsDecl style = \case

113− TyClD NoExt x -> p_tyClDecl style x

114− ValD NoExt x -> p_valDecl x

115− SigD NoExt x -> p_sigDecl x

116− InstD NoExt x -> p_instDecl style x

117− DerivD NoExt x -> p_derivDecl x

118− DefD NoExt x -> p_defaultDecl x

119− ForD NoExt x -> p_foreignDecl x

120− WarningD NoExt x -> p_warnDecls x

121− AnnD NoExt x -> p_annDecl x

122− RuleD NoExt x -> p_ruleDecls x

123− SpliceD NoExt x -> p_spliceDecl x

124− DocD NoExt docDecl ->

113+ TyClD NoExtField x -> p_tyClDecl style x

114+ ValD NoExtField x -> p_valDecl x

115+ SigD NoExtField x -> p_sigDecl x

116+ InstD NoExtField x -> p_instDecl style x

117+ DerivD NoExtField x -> p_derivDecl x

118+ DefD NoExtField x -> p_defaultDecl x

119+ ForD NoExtField x -> p_foreignDecl x

120+ WarningD NoExtField x -> p_warnDecls x

121+ AnnD NoExtField x -> p_annDecl x

122+ RuleD NoExtField x -> p_ruleDecls x

123+ SpliceD NoExtField x -> p_spliceDecl x

124+ DocD NoExtField docDecl ->

125125 case docDecl of

126126 DocCommentNext str -> p_hsDocString Pipe False (noLoc str)

127127 DocCommentPrev str -> p_hsDocString Caret False (noLoc str)

128128 DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str)

129129 DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)

130− RoleAnnotD NoExt x -> p_roleAnnot x

131− XHsDecl _ -> notImplemented "XHsDecl"

130+ RoleAnnotD NoExtField x -> p_roleAnnot x

131+ KindSigD NoExtField _ -> notImplemented "StandaloneKindSignatures"

132+ XHsDecl x -> noExtCon x

132133

133134p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()

134135p_tyClDecl style = \case

135− FamDecl NoExt x -> p_famDecl style x

136+ FamDecl NoExtField x -> p_famDecl style x

136137 SynDecl {..} -> p_synDecl tcdLName tcdFixity tcdTyVars tcdRhs

137138 DataDecl {..} ->

138139 p_dataDecl

@@ -153,19 +154,19 @@ p_tyClDecl style = \case

153154 tcdATs

154155 tcdATDefs

155156 tcdDocs

156− XTyClDecl {} -> notImplemented "XTyClDecl"

157+ XTyClDecl x -> noExtCon x

157158

158159p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()

159160p_instDecl style = \case

160− ClsInstD NoExt x -> p_clsInstDecl x

161− TyFamInstD NoExt x -> p_tyFamInstDecl style x

162− DataFamInstD NoExt x -> p_dataFamInstDecl style x

163− XInstDecl _ -> notImplemented "XInstDecl"

161+ ClsInstD NoExtField x -> p_clsInstDecl x

162+ TyFamInstD NoExtField x -> p_tyFamInstDecl style x

163+ DataFamInstD NoExtField x -> p_dataFamInstDecl style x

164+ XInstDecl x -> noExtCon x

164165

165166p_derivDecl :: DerivDecl GhcPs -> R ()

166167p_derivDecl = \case

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

168− XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"

169+ XDerivDecl x -> noExtCon x

169170

170171-- | Determine if these declarations should be grouped together.

171172groupedDecls ::

@@ -225,13 +226,13 @@ pattern

225226 Pattern,

226227 DataDeclaration ::

227228 RdrName -> HsDecl GhcPs

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

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

230−pattern SCCPragma n <- SigD NoExt (SCCFunSig NoExt _ (L _ n) _)

231−pattern AnnTypePragma n <- AnnD NoExt (HsAnnotation NoExt _ (TypeAnnProvenance (L _ n)) _)

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

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

234−pattern DataDeclaration n <- TyClD NoExt (DataDecl NoExt (L _ n) _ _ _)

229+pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _)

230+pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _)

231+pattern SCCPragma n <- SigD NoExtField (SCCFunSig NoExtField _ (L _ n) _)

232+pattern AnnTypePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (TypeAnnProvenance (L _ n)) _)

233+pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _)

234+pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _))

235+pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _)

235236

236237-- Declarations which can refer to multiple names

237238

@@ -249,51 +250,51 @@ pattern PatternSignature n <- (patSigRdrNames -> Just n)

249250pattern WarningPragma n <- (warnSigRdrNames -> Just n)

250251

251252pattern DocNext, DocPrev :: HsDecl GhcPs

252−pattern DocNext <- (DocD NoExt (DocCommentNext _))

253−pattern DocPrev <- (DocD NoExt (DocCommentPrev _))

253+pattern DocNext <- (DocD NoExtField (DocCommentNext _))

254+pattern DocPrev <- (DocD NoExtField (DocCommentPrev _))

254255

255256sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

256−sigRdrNames (SigD NoExt (TypeSig NoExt ns _)) = Just $ map unLoc ns

257−sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns

258−sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns

257+sigRdrNames (SigD NoExtField (TypeSig NoExtField ns _)) = Just $ map unLoc ns

258+sigRdrNames (SigD NoExtField (ClassOpSig NoExtField _ ns _)) = Just $ map unLoc ns

259+sigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns

259260sigRdrNames _ = Nothing

260261

261262defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

262−defSigRdrNames (SigD NoExt (ClassOpSig NoExt True ns _)) = Just $ map unLoc ns

263+defSigRdrNames (SigD NoExtField (ClassOpSig NoExtField True ns _)) = Just $ map unLoc ns

263264defSigRdrNames _ = Nothing

264265

265266funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

266−funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]

267−funRdrNames (ValD NoExt (PatBind NoExt n _ _)) = Just $ patBindNames n

267+funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _ _)) = Just [n]

268+funRdrNames (ValD NoExtField (PatBind NoExtField (L _ n) _ _)) = Just $ patBindNames n

268269funRdrNames _ = Nothing

269270

270271patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

271−patSigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns

272+patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns

272273patSigRdrNames _ = Nothing

273274

274275warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

275−warnSigRdrNames (WarningD NoExt (Warnings NoExt _ ws)) = Just $ flip concatMap ws $ \case

276− L _ (Warning NoExt ns _) -> map unLoc ns

277− L _ (XWarnDecl NoExt) -> []

276+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case

277+ L _ (Warning NoExtField ns _) -> map unLoc ns

278+ L _ (XWarnDecl x) -> noExtCon x

278279warnSigRdrNames _ = Nothing

279280

280281patBindNames :: Pat GhcPs -> [RdrName]

281−patBindNames (TuplePat NoExt ps _) = concatMap (patBindNames . unLoc) ps

282−patBindNames (VarPat NoExt (L _ n)) = [n]

283−patBindNames (WildPat NoExt) = []

284−patBindNames (LazyPat NoExt p) = patBindNames p

285−patBindNames (BangPat NoExt p) = patBindNames p

286−patBindNames (ParPat NoExt p) = patBindNames p

287−patBindNames (ListPat NoExt ps) = concatMap (patBindNames . unLoc) ps

288−patBindNames (AsPat NoExt (L _ n) p) = n : patBindNames p

289−patBindNames (SumPat NoExt p _ _) = patBindNames p

290−patBindNames (ViewPat NoExt _ p) = patBindNames p

291−patBindNames (SplicePat NoExt _) = []

292−patBindNames (LitPat NoExt _) = []

293−patBindNames (SigPat _ p _) = patBindNames p

294−patBindNames (NPat NoExt _ _ _) = []

295−patBindNames (NPlusKPat NoExt (L _ n) _ _ _ _) = [n]

282+patBindNames (TuplePat NoExtField ps _) = concatMap (patBindNames . unLoc) ps

283+patBindNames (VarPat NoExtField (L _ n)) = [n]

284+patBindNames (WildPat NoExtField) = []

285+patBindNames (LazyPat NoExtField (L _ p)) = patBindNames p

286+patBindNames (BangPat NoExtField (L _ p)) = patBindNames p

287+patBindNames (ParPat NoExtField (L _ p)) = patBindNames p

288+patBindNames (ListPat NoExtField ps) = concatMap (patBindNames . unLoc) ps

289+patBindNames (AsPat NoExtField (L _ n) (L _ p)) = n : patBindNames p

290+patBindNames (SumPat NoExtField (L _ p) _ _) = patBindNames p

291+patBindNames (ViewPat NoExtField _ (L _ p)) = patBindNames p

292+patBindNames (SplicePat NoExtField _) = []

293+patBindNames (LitPat NoExtField _) = []

294+patBindNames (SigPat _ (L _ p) _) = patBindNames p

295+patBindNames (NPat NoExtField _ _ _) = []

296+patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n]

296297patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)

297298patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer

298−patBindNames (CoPat NoExt _ p _) = patBindNames p

299−patBindNames (XPat p) = patBindNames (unLoc p)

299+patBindNames (CoPat NoExtField _ p _) = patBindNames p

300+patBindNames (XPat x) = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Annotation.hs+2−3

@@ -10,15 +10,14 @@ import GHC

1010import Ormolu.Printer.Combinators

1111import Ormolu.Printer.Meat.Common

1212import Ormolu.Printer.Meat.Declaration.Value

13−import Ormolu.Utils

1413

1514p_annDecl :: AnnDecl GhcPs -> R ()

1615p_annDecl = \case

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

16+ HsAnnotation NoExtField _ annProv expr -> pragma "ANN" . inci $ do

1817 p_annProv annProv

1918 breakpoint

2019 located expr p_hsExpr

21− XAnnDecl {} -> notImplemented "XAnnDecl"

20+ XAnnDecl x -> noExtCon x

2221

2322p_annProv :: AnnProvenance (IdP GhcPs) -> R ()

2423p_annProv = \case

src/Ormolu/Printer/Meat/Declaration/Class.hs+7−15

@@ -18,7 +18,6 @@ import Ormolu.Printer.Combinators

1818import Ormolu.Printer.Meat.Common

1919import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration

2020import Ormolu.Printer.Meat.Type

21−import Ormolu.Utils

2221import RdrName (RdrName (..))

2322

2423p_classDecl ::

@@ -30,7 +29,7 @@ p_classDecl ::

3029 [LSig GhcPs] ->

3130 LHsBinds GhcPs ->

3231 [LFamilyDecl GhcPs] ->

33− [LTyFamDefltEqn GhcPs] ->

32+ [LTyFamDefltDecl GhcPs] ->

3433 [LDocDecl] ->

3534 R ()

3635p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = do

@@ -42,12 +41,12 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d

4241 -- location order. This happens because different declarations are stored

4342 -- in different lists. Consequently, to get all the declarations in proper

4443 -- order, they need to be manually sorted.

45− sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs

46− vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs

47− tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats

48− docs = (getLoc &&& fmap (DocD NoExt)) <$> cdocs

44+ sigs = (getLoc &&& fmap (SigD NoExtField)) <$> csigs

45+ vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cdefs

46+ tyFams = (getLoc &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats

47+ docs = (getLoc &&& fmap (DocD NoExtField)) <$> cdocs

4948 tyFamDefs =

50− ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt . defltEqnToInstDecl)

49+ ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)

5150 )

5251 <$> catdefs

5352 allDecls =

@@ -70,7 +69,7 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d

7069 unless (null allDecls) $ do

7170 breakpoint -- Ensure whitespace is added after where clause.

7271 inci (p_hsDeclsRespectGrouping Associated allDecls)

73−p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"

72+p_classDecl _ _ (XLHsQTyVars c) _ _ _ _ _ _ _ = noExtCon c

7473

7574p_classContext :: LHsContext GhcPs -> R ()

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

@@ -97,13 +96,6 @@ p_funDep (before, after) = do

9796----------------------------------------------------------------------------

9897-- Helpers

9998

100−defltEqnToInstDecl :: TyFamDefltEqn GhcPs -> TyFamInstDecl GhcPs

101−defltEqnToInstDecl FamEqn {..} = TyFamInstDecl {..}

102− where

103− eqn = FamEqn {feqn_pats = map HsValArg (tyVarsToTypes feqn_pats), ..}

104− tfid_eqn = HsIB {hsib_ext = NoExt, hsib_body = eqn}

105−defltEqnToInstDecl XFamEqn {} = notImplemented "XFamEqn"

106−

10799isInfix :: LexicalFixity -> Bool

108100isInfix = \case

109101 Infix -> True

src/Ormolu/Printer/Meat/Declaration/Data.hs+8−8

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

7676 unless (null $ unLoc dd_derivs) breakpoint

7777 inci . located dd_derivs $ \xs ->

7878 sep newline (located' p_hsDerivingClause) xs

79−p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

79+p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x

8080

8181p_conDecl :: ConDecl GhcPs -> R ()

8282p_conDecl = \case

@@ -106,7 +106,7 @@ p_conDecl = \case

106106 else breakpoint

107107 interArgBreak

108108 when (unLoc con_forall) $ do

109− p_forallBndrs p_hsTyVarBndr (hsq_explicit con_qvars)

109+ p_forallBndrs ForallInvis p_hsTyVarBndr (hsq_explicit con_qvars)

110110 interArgBreak

111111 forM_ con_mb_cxt p_lhsContext

112112 case con_args of

@@ -134,7 +134,7 @@ p_conDecl = \case

134134 <> conArgsSpans con_args

135135 switchLayout conDeclSpn $ do

136136 when (unLoc con_forall) $ do

137− p_forallBndrs p_hsTyVarBndr con_ex_tvs

137+ p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs

138138 breakpoint

139139 forM_ con_mb_cxt p_lhsContext

140140 case con_args of

@@ -153,7 +153,7 @@ p_conDecl = \case

153153 p_rdrName con_name

154154 space

155155 located y p_hsType

156− XConDecl NoExt -> notImplemented "XConDecl"

156+ XConDecl x -> noExtCon x

157157

158158conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]

159159conArgsSpans = \case

@@ -167,7 +167,7 @@ conArgsSpans = \case

167167conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]

168168conTyVarsSpans = \case

169169 HsQTvs {..} -> getLoc <$> hsq_explicit

170− XLHsQTyVars NoExt -> []

170+ XLHsQTyVars x -> noExtCon x

171171

172172p_lhsContext ::

173173 LHsContext GhcPs ->

@@ -225,9 +225,9 @@ p_hsDerivingClause HsDerivingClause {..} = do

225225 txt "via"

226226 space

227227 located hsib_body p_hsType

228− ViaStrategy (XHsImplicitBndrs NoExt) ->

229− notImplemented "XHsImplicitBndrs"

230−p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"

228+ ViaStrategy (XHsImplicitBndrs x) ->

229+ noExtCon x

230+p_hsDerivingClause (XHsDerivingClause x) = noExtCon x

231231

232232----------------------------------------------------------------------------

233233-- Helpers

src/Ormolu/Printer/Meat/Declaration/Default.hs+2−3

@@ -9,13 +9,12 @@ where

99import GHC

1010import Ormolu.Printer.Combinators

1111import Ormolu.Printer.Meat.Type

12−import Ormolu.Utils

1312

1413p_defaultDecl :: DefaultDecl GhcPs -> R ()

1514p_defaultDecl = \case

16− DefaultDecl NoExt ts -> do

15+ DefaultDecl NoExtField ts -> do

1716 txt "default"

1817 breakpoint

1918 inci . parens N . sitcc $

2019 sep (comma >> breakpoint) (sitcc . located' p_hsType) ts

21− XDefaultDecl {} -> notImplemented "XDefaultDecl"

20+ XDefaultDecl x -> noExtCon x

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

@@ -15,7 +15,6 @@ import GHC

1515import Ormolu.Printer.Combinators

1616import Ormolu.Printer.Meat.Common

1717import Ormolu.Printer.Meat.Declaration.Signature

18−import Ormolu.Utils

1918

2019p_foreignDecl :: ForeignDecl GhcPs -> R ()

2120p_foreignDecl = \case

@@ -25,7 +24,7 @@ p_foreignDecl = \case

2524 fd@ForeignExport {fd_fe} -> do

2625 p_foreignExport fd_fe

2726 p_foreignTypeSig fd

28− XForeignDecl {} -> notImplemented "XForeignDecl"

27+ XForeignDecl x -> noExtCon x

2928

3029-- | Printer for the last part of an import\/export, which is function name

3130-- and type signature.

@@ -39,7 +38,7 @@ p_foreignTypeSig fd = do

3938 ]

4039 $ do

4140 p_rdrName (fd_name fd)

42− p_typeAscription (HsWC NoExt (fd_sig_ty fd))

41+ p_typeAscription (HsWC NoExtField (fd_sig_ty fd))

4342

4443-- | Printer for 'ForeignImport'.

4544--

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

@@ -56,8 +56,8 @@ p_standaloneDerivDecl DerivDecl {..} = do

5656 inci (located hsib_body p_hsType)

5757 breakpoint

5858 instTypes True

59− ViaStrategy (XHsImplicitBndrs NoExt) ->

60− notImplemented "XHsImplicitBndrs"

59+ ViaStrategy (XHsImplicitBndrs x) ->

60+ noExtCon x

6161p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"

6262

6363p_clsInstDecl :: ClsInstDecl GhcPs -> R ()

@@ -70,14 +70,14 @@ p_clsInstDecl = \case

7070 -- location order. This happens because different declarations are stored in

7171 -- different lists. Consequently, to get all the declarations in proper

7272 -- order, they need to be manually sorted.

73− let sigs = (getLoc &&& fmap (SigD NoExt)) <$> cid_sigs

74− vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cid_binds

73+ let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs

74+ vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds

7575 tyFamInsts =

76− ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt)

76+ ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)

7777 )

7878 <$> cid_tyfam_insts

7979 dataFamInsts =

80− ( getLoc &&& fmap (InstD NoExt . DataFamInstD NoExt)

80+ ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)

8181 )

8282 <$> cid_datafam_insts

8383 allDecls =

@@ -96,8 +96,8 @@ p_clsInstDecl = \case

9696 -- Ensure whitespace is added after where clause.

9797 breakpoint

9898 dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

99− XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

100− XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

99+ XHsImplicitBndrs x -> noExtCon x

100+ XClsInstDecl x -> noExtCon x

101101

102102p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()

103103p_tyFamInstDecl style = \case

src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs+2−3

@@ -12,14 +12,13 @@ import CoAxiom

1212import GHC

1313import Ormolu.Printer.Combinators

1414import Ormolu.Printer.Meat.Common

15−import Ormolu.Utils

1615import RdrName (RdrName (..))

1716import SrcLoc (Located)

1817

1918p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()

2019p_roleAnnot = \case

21− RoleAnnotDecl NoExt l_name anns -> p_roleAnnot' l_name anns

22− XRoleAnnotDecl _ -> notImplemented "XRoleAnnotDecl"

20+ RoleAnnotDecl NoExtField l_name anns -> p_roleAnnot' l_name anns

21+ XRoleAnnotDecl x -> noExtCon x

2322

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

2524p_roleAnnot' l_name anns = do

src/Ormolu/Printer/Meat/Declaration/Rule.hs+10−11

@@ -14,18 +14,17 @@ import Ormolu.Printer.Meat.Common

1414import Ormolu.Printer.Meat.Declaration.Signature

1515import Ormolu.Printer.Meat.Declaration.Value

1616import Ormolu.Printer.Meat.Type

17−import Ormolu.Utils

1817

1918p_ruleDecls :: RuleDecls GhcPs -> R ()

2019p_ruleDecls = \case

21− HsRules NoExt _ xs ->

20+ HsRules NoExtField _ xs ->

2221 pragma "RULES" . sitcc $

2322 sep breakpoint (sitcc . located' p_ruleDecl) xs

24− XRuleDecls NoExt -> notImplemented "XRuleDecls"

23+ XRuleDecls x -> noExtCon x

2524

2625p_ruleDecl :: RuleDecl GhcPs -> R ()

2726p_ruleDecl = \case

28− HsRule NoExt ruleName activation tyvars ruleBndrs lhs rhs -> do

27+ HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs -> do

2928 located ruleName p_ruleName

3029 space

3130 p_activation activation

@@ -33,13 +32,13 @@ p_ruleDecl = \case

3332 case tyvars of

3433 Nothing -> return ()

3534 Just xs -> do

36− p_forallBndrs p_hsTyVarBndr xs

35+ p_forallBndrs ForallInvis p_hsTyVarBndr xs

3736 space

3837 -- It appears that there is no way to tell if there was an empty forall

3938 -- in the input or no forall at all. We do not want to add redundant

4039 -- foralls, so let's just skip the empty ones.

4140 unless (null ruleBndrs) $

42− p_forallBndrs p_ruleBndr ruleBndrs

41+ p_forallBndrs ForallInvis p_ruleBndr ruleBndrs

4342 breakpoint

4443 inci $ do

4544 located lhs p_hsExpr

@@ -48,15 +47,15 @@ p_ruleDecl = \case

4847 inci $ do

4948 breakpoint

5049 located rhs p_hsExpr

51− XRuleDecl NoExt -> notImplemented "XRuleDecl"

50+ XRuleDecl x -> noExtCon x

5251

5352p_ruleName :: (SourceText, RuleName) -> R ()

54−p_ruleName (_, name) = atom $ HsString NoSourceText name

53+p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs)

5554

5655p_ruleBndr :: RuleBndr GhcPs -> R ()

5756p_ruleBndr = \case

58− RuleBndr NoExt x -> p_rdrName x

59− RuleBndrSig NoExt x hswc -> parens N $ do

57+ RuleBndr NoExtField x -> p_rdrName x

58+ RuleBndrSig NoExtField x hswc -> parens N $ do

6059 p_rdrName x

6160 p_typeAscription hswc

62− XRuleBndr NoExt -> notImplemented "XRuleBndr"

61+ XRuleBndr x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Signature.hs+15−15

@@ -22,16 +22,16 @@ import Ormolu.Utils

2222

2323p_sigDecl :: Sig GhcPs -> R ()

2424p_sigDecl = \case

25− TypeSig NoExt names hswc -> p_typeSig True names hswc

26− PatSynSig NoExt names hsib -> p_patSynSig names hsib

27− ClassOpSig NoExt def names hsib -> p_classOpSig def names hsib

28− FixSig NoExt sig -> p_fixSig sig

29− InlineSig NoExt name inlinePragma -> p_inlineSig name inlinePragma

30− SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma

31− SpecInstSig NoExt _ hsib -> p_specInstSig hsib

32− MinimalSig NoExt _ booleanFormula -> p_minimalSig booleanFormula

33− CompleteMatchSig NoExt _sourceText cs ty -> p_completeSig cs ty

34− SCCFunSig NoExt _ name literal -> p_sccSig name literal

25+ TypeSig NoExtField names hswc -> p_typeSig True names hswc

26+ PatSynSig NoExtField names hsib -> p_patSynSig names hsib

27+ ClassOpSig NoExtField def names hsib -> p_classOpSig def names hsib

28+ FixSig NoExtField sig -> p_fixSig sig

29+ InlineSig NoExtField name inlinePragma -> p_inlineSig name inlinePragma

30+ SpecSig NoExtField name ts inlinePragma -> p_specSig name ts inlinePragma

31+ SpecInstSig NoExtField _ hsib -> p_specInstSig hsib

32+ MinimalSig NoExtField _ booleanFormula -> p_minimalSig booleanFormula

33+ CompleteMatchSig NoExtField _sourceText cs ty -> p_completeSig cs ty

34+ SCCFunSig NoExtField _ name literal -> p_sccSig name literal

3535 _ -> notImplemented "certain types of signature declarations"

3636

3737p_typeSig ::

@@ -65,7 +65,7 @@ p_typeAscription HsWC {..} = do

6565 then newline

6666 else breakpoint

6767 located t p_hsType

68−p_typeAscription (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

68+p_typeAscription (XHsWildCardBndrs x) = noExtCon x

6969

7070p_patSynSig ::

7171 [Located RdrName] ->

@@ -73,7 +73,7 @@ p_patSynSig ::

7373 R ()

7474p_patSynSig names hsib = do

7575 txt "pattern"

76− let body = p_typeSig False names HsWC {hswc_ext = NoExt, hswc_body = hsib}

76+ let body = p_typeSig False names HsWC {hswc_ext = NoExtField, hswc_body = hsib}

7777 if length names > 1

7878 then breakpoint >> inci body

7979 else space >> body

@@ -88,13 +88,13 @@ p_classOpSig ::

8888 R ()

8989p_classOpSig def names hsib = do

9090 when def (txt "default" >> space)

91− p_typeSig True names HsWC {hswc_ext = NoExt, hswc_body = hsib}

91+ p_typeSig True names HsWC {hswc_ext = NoExtField, hswc_body = hsib}

9292

9393p_fixSig ::

9494 FixitySig GhcPs ->

9595 R ()

9696p_fixSig = \case

97− FixitySig NoExt names (Fixity _ n dir) -> do

97+ FixitySig NoExtField names (Fixity _ n dir) -> do

9898 txt $ case dir of

9999 InfixL -> "infixl"

100100 InfixR -> "infixr"

@@ -103,7 +103,7 @@ p_fixSig = \case

103103 atom n

104104 space

105105 sitcc $ sep (comma >> breakpoint) p_rdrName names

106− XFixitySig NoExt -> notImplemented "XFixitySig"

106+ XFixitySig x -> noExtCon x

107107

108108p_inlineSig ::

109109 -- | Name

src/Ormolu/Printer/Meat/Declaration/Splice.hs+2−3

@@ -8,9 +8,8 @@ where

88import GHC

99import Ormolu.Printer.Combinators

1010import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)

11−import Ormolu.Utils

1211

1312p_spliceDecl :: SpliceDecl GhcPs -> R ()

1413p_spliceDecl = \case

15− SpliceDecl NoExt splice _explicit -> located splice p_hsSplice

16− XSpliceDecl {} -> notImplemented "XSpliceDecl"

14+ SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice

15+ XSpliceDecl x -> noExtCon x

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

@@ -11,7 +11,6 @@ import GHC

1111import Ormolu.Printer.Combinators

1212import Ormolu.Printer.Meat.Common

1313import Ormolu.Printer.Meat.Type

14−import Ormolu.Utils (notImplemented)

1514import RdrName (RdrName (..))

1615import SrcLoc (Located)

1716

@@ -38,4 +37,4 @@ p_synDecl name fixity HsQTvs {..} t = do

3837 txt "="

3938 breakpoint

4039 inci (located t p_hsType)

41−p_synDecl _ _ XLHsQTyVars {} _ = notImplemented "XLHsQTyVars"

40+p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

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

@@ -57,7 +57,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do

5757 sep newline (located' (inci . p_tyFamInstEqn)) eqs

5858p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} =

5959 notImplemented "XLHsQTyVars"

60−p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"

60+p_famDecl _ (XFamilyDecl x) = noExtCon x

6161

6262p_familyResultSigL ::

6363 Located (FamilyResultSig GhcPs) ->

@@ -65,17 +65,17 @@ p_familyResultSigL ::

6565p_familyResultSigL l =

6666 case l of

6767 L _ a -> case a of

68− NoSig NoExt -> Nothing

69− KindSig NoExt k -> Just $ do

68+ NoSig NoExtField -> Nothing

69+ KindSig NoExtField k -> Just $ do

7070 txt "::"

7171 breakpoint

7272 located k p_hsType

73− TyVarSig NoExt bndr -> Just $ do

73+ TyVarSig NoExtField bndr -> Just $ do

7474 txt "="

7575 breakpoint

7676 located bndr p_hsTyVarBndr

77− XFamilyResultSig NoExt ->

78− notImplemented "XFamilyResultSig"

77+ XFamilyResultSig x ->

78+ noExtCon x

7979

8080p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

8181p_injectivityAnn (InjectivityAnn a bs) = do

@@ -92,7 +92,7 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

9292 case feqn_bndrs of

9393 Nothing -> return ()

9494 Just bndrs -> do

95− p_forallBndrs p_hsTyVarBndr bndrs

95+ p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

9696 breakpoint

9797 (if null feqn_bndrs then id else inci) $ do

9898 let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats

@@ -106,8 +106,8 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

106106 txt "="

107107 breakpoint

108108 inci (located feqn_rhs p_hsType)

109−p_tyFamInstEqn HsIB {hsib_body = XFamEqn {}} = notImplemented "HsIB XFamEqn"

110−p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

109+p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

110+p_tyFamInstEqn (XHsImplicitBndrs x) = noExtCon x

111111

112112----------------------------------------------------------------------------

113113-- Helpers

src/Ormolu/Printer/Meat/Declaration/Value.hs+170−194

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE TypeApplications #-}

56module Ormolu.Printer.Meat.Declaration.Value

67 ( p_valDecl,

@@ -65,12 +66,12 @@ data Placement

6566

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

6768p_valDecl = \case

68− FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches

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

69+ FunBind NoExtField funId funMatches _ _ -> p_funBind funId funMatches

70+ PatBind NoExtField pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss

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

7172 AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker

72− PatSynBind NoExt psb -> p_patSynBind psb

73− XHsBindsLR NoExt -> notImplemented "XHsBindsLR"

73+ PatSynBind NoExtField psb -> p_patSynBind psb

74+ XHsBindsLR x -> noExtCon x

7475

7576p_funBind ::

7677 Located RdrName ->

@@ -114,8 +115,8 @@ p_matchGroup' placer render style MG {..} = do

114115 (matchStrictness m)

115116 m_pats

116117 m_grhss

117− p_Match _ = notImplemented "XMatch"

118−p_matchGroup' _ _ _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"

118+ p_Match (XMatch x) = noExtCon x

119+p_matchGroup' _ _ _ (XMatchGroup x) = noExtCon x

119120

120121-- | Function id obtained through pattern matching on 'FunBind' should not

121122-- be used to print the actual equations because the different ‘RdrNames’

@@ -193,14 +194,14 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

193194 then id

194195 else inci

195196 switchLayout [combinedSpans] $ do

196− let stdCase = sep breakpoint p_pat m_pats

197+ let stdCase = sep breakpoint (located' p_pat) m_pats

197198 case style of

198199 Function name ->

199200 p_infixDefHelper

200201 isInfix

201202 inci'

202203 (p_rdrName name)

203− (p_pat <$> m_pats)

204+ (located' p_pat <$> m_pats)

204205 PatternBind -> stdCase

205206 Case -> stdCase

206207 Lambda -> do

@@ -266,7 +267,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

266267 switchLayout [patGrhssSpan] $

267268 placeHanging placement p_body

268269 inci p_where

269−p_match' _ _ _ _ _ _ XGRHSs {} = notImplemented "XGRHSs"

270+p_match' _ _ _ _ _ _ (XGRHSs x) = noExtCon x

270271

271272p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()

272273p_grhs = p_grhs' exprPlacement p_hsExpr

@@ -280,7 +281,7 @@ p_grhs' ::

280281 GroupStyle ->

281282 GRHS GhcPs (Located body) ->

282283 R ()

283−p_grhs' placer render style (GRHS NoExt guards body) =

284+p_grhs' placer render style (GRHS NoExtField guards body) =

284285 case guards of

285286 [] -> p_body

286287 xs -> do

@@ -305,11 +306,11 @@ p_grhs' placer render style (GRHS NoExt guards body) =

305306 Nothing -> Nothing

306307 Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs

307308 p_body = located body render

308−p_grhs' _ _ _ (XGRHS NoExt) = notImplemented "XGRHS"

309+p_grhs' _ _ _ (XGRHS x) = noExtCon x

309310

310311p_hsCmd :: HsCmd GhcPs -> R ()

311312p_hsCmd = \case

312− HsCmdArrApp NoExt body input arrType _ -> do

313+ HsCmdArrApp NoExtField body input arrType _ -> do

313314 located body p_hsExpr

314315 space

315316 case arrType of

@@ -317,42 +318,42 @@ p_hsCmd = \case

317318 HsHigherOrderApp -> txt "-<<"

318319 placeHanging (exprPlacement (unLoc input)) $

319320 located input p_hsExpr

320− HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do

321+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do

321322 located form p_hsExpr

322323 unless (null cmds) $ do

323324 breakpoint

324325 inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))

325− HsCmdArrForm NoExt form Infix _ [left, right] -> do

326+ HsCmdArrForm NoExtField form Infix _ [left, right] -> do

326327 located left p_hsCmdTop

327328 space

328329 located form p_hsExpr

329330 placeHanging (cmdTopPlacement (unLoc right)) $

330331 located right p_hsCmdTop

331− HsCmdArrForm NoExt _ Infix _ _ -> notImplemented "HsCmdArrForm"

332+ HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"

332333 HsCmdApp {} ->

333334 -- XXX Does this ever occur in the syntax tree? It does not seem like it

334335 -- does. Open an issue and ping @yumiova if this ever occurs in output.

335336 notImplemented "HsCmdApp"

336− HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup

337− HsCmdPar NoExt c -> parens N (located c p_hsCmd)

338− HsCmdCase NoExt e mgroup ->

337+ HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup

338+ HsCmdPar NoExtField c -> parens N (located c p_hsCmd)

339+ HsCmdCase NoExtField e mgroup ->

339340 p_case cmdPlacement p_hsCmd e mgroup

340− HsCmdIf NoExt _ if' then' else' ->

341+ HsCmdIf NoExtField _ if' then' else' ->

341342 p_if cmdPlacement p_hsCmd if' then' else'

342− HsCmdLet NoExt localBinds c ->

343+ HsCmdLet NoExtField localBinds c ->

343344 p_let p_hsCmd localBinds c

344− HsCmdDo NoExt es -> do

345+ HsCmdDo NoExtField es -> do

345346 txt "do"

346347 newline

347348 inci . located es $

348349 sitcc . sep newline (located' (sitcc . p_stmt' cmdPlacement p_hsCmd))

349350 HsCmdWrap {} -> notImplemented "HsCmdWrap"

350− XCmd {} -> notImplemented "XCmd"

351+ XCmd x -> noExtCon x

351352

352353p_hsCmdTop :: HsCmdTop GhcPs -> R ()

353354p_hsCmdTop = \case

354− HsCmdTop NoExt cmd -> located cmd p_hsCmd

355− XCmdTop {} -> notImplemented "XHsCmdTop"

355+ HsCmdTop NoExtField cmd -> located cmd p_hsCmd

356+ XCmdTop x -> noExtCon x

356357

357358p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

358359p_stmt = p_stmt' exprPlacement p_hsExpr

@@ -367,16 +368,13 @@ p_stmt' ::

367368 Stmt GhcPs (Located body) ->

368369 R ()

369370p_stmt' placer render = \case

370− LastStmt NoExt body _ _ -> located body render

371− BindStmt NoExt p f _ _ -> do

372− p_pat p

371+ LastStmt NoExtField body _ _ -> located body render

372+ BindStmt NoExtField p f _ _ -> do

373+ located p p_pat

373374 space

374375 txt "<-"

375− -- https://gitlab.haskell.org/ghc/ghc/issues/17330

376− let loc = case p of

377− XPat pat -> getLoc pat

378− _ -> error "p_stmt': BindStmt: Pat does not contain a location"

379− let placement =

376+ let loc = getLoc p

377+ placement =

380378 case f of

381379 L l' x ->

382380 if isOneLineSpan

@@ -386,8 +384,8 @@ p_stmt' placer render = \case

386384 switchLayout [loc, getLoc f] $

387385 placeHanging placement (located f render)

388386 ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer

389− BodyStmt NoExt body _ _ -> located body render

390− LetStmt NoExt binds -> do

387+ BodyStmt NoExtField body _ _ -> located body render

388+ LetStmt NoExtField binds -> do

391389 txt "let"

392390 space

393391 sitcc $ located binds p_hsLocalBinds

@@ -429,10 +427,10 @@ p_stmt' placer render = \case

429427 txt "rec"

430428 space

431429 sitcc $ sepSemi (located' (p_stmt' placer render)) recS_stmts

432− XStmtLR {} -> notImplemented "XStmtLR"

430+ XStmtLR c -> noExtCon c

433431

434432gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]

435−gatherStmt (L _ (ParStmt NoExt block _ _)) =

433+gatherStmt (L _ (ParStmt NoExtField block _ _)) =

436434 foldr ((<>) . gatherStmtBlock) [] block

437435gatherStmt (L s stmt@TransStmt {..}) =

438436 foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]])

@@ -441,11 +439,11 @@ gatherStmt stmt = [[stmt]]

441439gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]

442440gatherStmtBlock (ParStmtBlock _ stmts _ _) =

443441 foldr (liftAppend . gatherStmt) [] stmts

444−gatherStmtBlock XParStmtBlock {} = notImplemented "XParStmtBlock"

442+gatherStmtBlock (XParStmtBlock x) = noExtCon x

445443

446444p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

447445p_hsLocalBinds = \case

448− HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do

446+ HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

449447 let ssStart =

450448 either

451449 (srcSpanStart . getLoc)

@@ -467,20 +465,23 @@ p_hsLocalBinds = \case

467465 sepSemi

468466 (\(m, i) -> (if m then br else id) $ p_item i)

469467 (markInit $ sortOn ssStart items)

470− HsValBinds NoExt _ -> notImplemented "HsValBinds"

471− HsIPBinds NoExt (IPBinds NoExt xs) ->

468+ HsValBinds NoExtField _ -> notImplemented "HsValBinds"

469+ HsIPBinds NoExtField (IPBinds NoExtField xs) ->

472470 -- Second argument of IPBind is always Left before type-checking.

473− let p_ipBind (IPBind NoExt (Left name) expr) = do

471+ let p_ipBind (IPBind NoExtField (Left name) expr) = do

474472 atom name

475473 space

476474 txt "="

477475 breakpoint

478476 useBraces $ inci $ located expr p_hsExpr

479− p_ipBind _ = notImplemented "XHsIPBinds"

477+ p_ipBind (IPBind NoExtField (Right _) _) =

478+ -- Should only occur after the type checker

479+ notImplemented "IPBind _ (Right _) _"

480+ p_ipBind (XIPBind x) = noExtCon x

480481 in sepSemi (located' p_ipBind) xs

481− HsIPBinds NoExt _ -> notImplemented "HsIpBinds"

482− EmptyLocalBinds NoExt -> return ()

483− XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"

482+ HsIPBinds NoExtField _ -> notImplemented "HsIpBinds"

483+ EmptyLocalBinds NoExtField -> return ()

484+ XHsLocalBindsLR x -> noExtCon x

484485

485486p_hsRecField ::

486487 HsRecField' RdrName (LHsExpr GhcPs) ->

@@ -495,42 +496,42 @@ p_hsRecField HsRecField {..} = do

495496

496497p_hsTupArg :: HsTupArg GhcPs -> R ()

497498p_hsTupArg = \case

498− Present NoExt x -> located x p_hsExpr

499− Missing NoExt -> pure ()

500− XTupArg {} -> notImplemented "XTupArg"

499+ Present NoExtField x -> located x p_hsExpr

500+ Missing NoExtField -> pure ()

501+ XTupArg x -> noExtCon x

501502

502503p_hsExpr :: HsExpr GhcPs -> R ()

503504p_hsExpr = p_hsExpr' N

504505

505506p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()

506507p_hsExpr' s = \case

507− HsVar NoExt name -> p_rdrName name

508− HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"

509− HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"

510− HsRecFld NoExt x ->

508+ HsVar NoExtField name -> p_rdrName name

509+ HsUnboundVar NoExtField v -> atom (unboundVarOcc v)

510+ HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut"

511+ HsRecFld NoExtField x ->

511512 case x of

512− Unambiguous NoExt name -> p_rdrName name

513− Ambiguous NoExt name -> p_rdrName name

514− XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"

515− HsOverLabel NoExt _ v -> do

513+ Unambiguous NoExtField name -> p_rdrName name

514+ Ambiguous NoExtField name -> p_rdrName name

515+ XAmbiguousFieldOcc xx -> noExtCon xx

516+ HsOverLabel NoExtField _ v -> do

516517 txt "#"

517518 atom v

518− HsIPVar NoExt (HsIPName name) -> do

519+ HsIPVar NoExtField (HsIPName name) -> do

519520 txt "?"

520521 atom name

521− HsOverLit NoExt v -> atom (ol_val v)

522− HsLit NoExt lit ->

522+ HsOverLit NoExtField v -> atom (ol_val v)

523+ HsLit NoExtField lit ->

523524 case lit of

524525 HsString (SourceText stxt) _ -> p_stringLit stxt

525526 HsStringPrim (SourceText stxt) _ -> p_stringLit stxt

526527 r -> atom r

527− HsLam NoExt mgroup ->

528+ HsLam NoExtField mgroup ->

528529 p_matchGroup Lambda mgroup

529− HsLamCase NoExt mgroup -> do

530+ HsLamCase NoExtField mgroup -> do

530531 txt "\\case"

531532 breakpoint

532533 inci (p_matchGroup LambdaCase mgroup)

533− HsApp NoExt f x -> do

534+ HsApp NoExtField f x -> do

534535 let -- In order to format function applications with multiple parameters

535536 -- nicer, traverse the AST to gather the function and all the

536537 -- parameters together.

@@ -564,9 +565,9 @@ p_hsExpr' s = \case

564565 -- expression is parenthesised.

565566 indent =

566567 case func of

567− L _ (HsPar NoExt _) -> inci

568− L _ (HsAppType NoExt _ _) -> inci

569− L _ (HsMultiIf NoExt _) -> inci

568+ L _ (HsPar NoExtField _) -> inci

569+ L _ (HsAppType NoExtField _ _) -> inci

570+ L _ (HsMultiIf NoExtField _) -> inci

570571 L spn _ ->

571572 if isOneLineSpan spn

572573 then inci

@@ -588,35 +589,35 @@ p_hsExpr' s = \case

588589 sep breakpoint (located' p_hsExpr) initp

589590 placeHanging placement $

590591 located lastp p_hsExpr

591− HsAppType NoExt e a -> do

592+ HsAppType NoExtField e a -> do

592593 located e p_hsExpr

593594 breakpoint

594595 inci $ do

595596 txt "@"

596597 located (hswc_body a) p_hsType

597− OpApp NoExt x op y -> do

598+ OpApp NoExtField x op y -> do

598599 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

599600 p_exprOpTree True s (reassociateOpTree getOpName opTree)

600− NegApp NoExt e _ -> do

601+ NegApp NoExtField e _ -> do

601602 txt "-"

602603 space

603604 located e p_hsExpr

604− HsPar NoExt e ->

605+ HsPar NoExtField e ->

605606 parens s (located e (dontUseBraces . p_hsExpr))

606− SectionL NoExt x op -> do

607+ SectionL NoExtField x op -> do

607608 located x p_hsExpr

608609 breakpoint

609610 inci (located op p_hsExpr)

610− SectionR NoExt op x -> do

611+ SectionR NoExtField op x -> do

611612 located op p_hsExpr

612613 useRecordDot' <- useRecordDot

613614 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

614615 unless (useRecordDot' && isRecordDot') breakpoint

615616 inci (located x p_hsExpr)

616− ExplicitTuple NoExt args boxity -> do

617+ ExplicitTuple NoExtField args boxity -> do

617618 let isSection = any (isMissing . unLoc) args

618619 isMissing = \case

619− Missing NoExt -> True

620+ Missing NoExtField -> True

620621 _ -> False

621622 let parens' =

622623 case boxity of

@@ -629,18 +630,18 @@ p_hsExpr' s = \case

629630 else

630631 switchLayout (getLoc <$> args) . parens' s . sitcc $

631632 sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args

632− ExplicitSum NoExt tag arity e ->

633+ ExplicitSum NoExtField tag arity e ->

633634 p_unboxedSum N tag arity (located e p_hsExpr)

634− HsCase NoExt e mgroup ->

635+ HsCase NoExtField e mgroup ->

635636 p_case exprPlacement p_hsExpr e mgroup

636− HsIf NoExt _ if' then' else' ->

637+ HsIf NoExtField _ if' then' else' ->

637638 p_if exprPlacement p_hsExpr if' then' else'

638− HsMultiIf NoExt guards -> do

639+ HsMultiIf NoExtField guards -> do

639640 txt "if "

640641 inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards

641− HsLet NoExt localBinds e ->

642+ HsLet NoExtField localBinds e ->

642643 p_let p_hsExpr localBinds e

643− HsDo NoExt ctx es -> do

644+ HsDo NoExtField ctx es -> do

644645 let doBody header = do

645646 txt header

646647 breakpoint

@@ -685,10 +686,10 @@ p_hsExpr' s = \case

685686 breakpoint

686687 let HsRecFields {..} = rcon_flds

687688 updName f =

688− f

689+ (f :: HsRecField GhcPs (LHsExpr GhcPs))

689690 { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of

690691 FieldOcc _ n -> n

691− XFieldOcc _ -> notImplemented "XFieldOcc"

692+ XFieldOcc x -> noExtCon x

692693 }

693694 fields = located' (p_hsRecField . updName) <$> rec_flds

694695 dotdot =

@@ -708,27 +709,26 @@ p_hsExpr' s = \case

708709 == (srcSpanStartCol <$> mrs (head rupd_flds))

709710 unless (useRecordDot' && isPluginForm) breakpoint

710711 let updName f =

711− f

712+ (f :: HsRecUpdField GhcPs)

712713 { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of

713714 Ambiguous _ n -> n

714715 Unambiguous _ n -> n

715− XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"

716+ XAmbiguousFieldOcc x -> noExtCon x

716717 }

717718 inci . braces N . sitcc $

718719 sep

719720 (comma >> breakpoint)

720721 (sitcc . located' (p_hsRecField . updName))

721722 rupd_flds

722− ExprWithTySig NoExt x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

723+ ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

723724 located x p_hsExpr

724725 space

725726 txt "::"

726727 breakpoint

727728 inci $ located hsib_body p_hsType

728− ExprWithTySig NoExt _ HsWC {hswc_body = XHsImplicitBndrs {}} ->

729− notImplemented "XHsImplicitBndrs"

730− ExprWithTySig NoExt _ XHsWildCardBndrs {} -> notImplemented "XHsWildCardBndrs"

731− ArithSeq NoExt _ x ->

729+ ExprWithTySig NoExtField _ HsWC {hswc_body = XHsImplicitBndrs x} -> noExtCon x

730+ ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

731+ ArithSeq NoExtField _ x ->

732732 case x of

733733 From from -> brackets s . sitcc $ do

734734 located from p_hsExpr

@@ -750,25 +750,25 @@ p_hsExpr' s = \case

750750 txt ".."

751751 space

752752 located to p_hsExpr

753− HsSCC NoExt _ name x -> do

753+ HsSCC NoExtField _ name x -> do

754754 txt "{-# SCC "

755755 atom name

756756 txt " #-}"

757757 breakpoint

758758 located x p_hsExpr

759− HsCoreAnn NoExt _ value x -> do

759+ HsCoreAnn NoExtField _ value x -> do

760760 txt "{-# CORE "

761761 atom value

762762 txt " #-}"

763763 breakpoint

764764 located x p_hsExpr

765− HsBracket NoExt x -> p_hsBracket x

765+ HsBracket NoExtField x -> p_hsBracket x

766766 HsRnBracketOut {} -> notImplemented "HsRnBracketOut"

767767 HsTcBracketOut {} -> notImplemented "HsTcBracketOut"

768− HsSpliceE NoExt splice -> p_hsSplice splice

769− HsProc NoExt p e -> do

768+ HsSpliceE NoExtField splice -> p_hsSplice splice

769+ HsProc NoExtField p e -> do

770770 txt "proc"

771− locatedPat p $ \x -> do

771+ located p $ \x -> do

772772 breakpoint

773773 inci (p_pat x)

774774 breakpoint

@@ -779,31 +779,11 @@ p_hsExpr' s = \case

779779 txt "static"

780780 breakpoint

781781 inci (located e p_hsExpr)

782− HsArrApp NoExt body input arrType cond ->

783− p_hsCmd (HsCmdArrApp NoExt body input arrType cond)

784− HsArrForm NoExt form mfixity cmds ->

785− p_hsCmd (HsCmdArrForm NoExt form Prefix mfixity cmds)

786782 HsTick {} -> notImplemented "HsTick"

787783 HsBinTick {} -> notImplemented "HsBinTick"

788784 HsTickPragma {} -> notImplemented "HsTickPragma"

789− -- These four constructs should never appear in correct programs.

790− -- See: https://github.com/tweag/ormolu/issues/343

791− EWildPat NoExt -> txt "_"

792− EAsPat NoExt n p -> do

793− p_rdrName n

794− txt "@"

795− located p p_hsExpr

796− EViewPat NoExt p e -> do

797− located p p_hsExpr

798− space

799− txt "->"

800− breakpoint

801− inci (located e p_hsExpr)

802− ELazyPat NoExt p -> do

803− txt "~"

804− located p p_hsExpr

805785 HsWrap {} -> notImplemented "HsWrap"

806− XExpr {} -> notImplemented "XExpr"

786+ XExpr x -> noExtCon x

807787

808788p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()

809789p_patSynBind PSB {..} = do

@@ -813,15 +793,15 @@ p_patSynBind PSB {..} = do

813793 Unidirectional -> do

814794 txt "<-"

815795 breakpoint

816− p_pat psb_def

796+ located psb_def p_pat

817797 ImplicitBidirectional -> do

818798 txt "="

819799 breakpoint

820− p_pat psb_def

800+ located psb_def p_pat

821801 ExplicitBidirectional mgroup -> do

822802 txt "<-"

823803 breakpoint

824− p_pat psb_def

804+ located psb_def p_pat

825805 newline

826806 txt "where"

827807 newline

@@ -855,7 +835,7 @@ p_patSynBind PSB {..} = do

855835 space

856836 p_rdrName r

857837 inci rhs

858−p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"

838+p_patSynBind (XPatSynBind x) = noExtCon x

859839

860840p_case ::

861841 Data body =>

@@ -922,40 +902,37 @@ p_let render localBinds e = sitcc $ do

922902

923903p_pat :: Pat GhcPs -> R ()

924904p_pat = \case

925− -- Note: starting from GHC 8.8, 'LPat' == 'Pat'. Located 'Pat's are always

926− -- constructed with the 'XPat' constructor, containing a @Located Pat@.

927− XPat pat -> located pat p_pat

928− WildPat NoExt -> txt "_"

929− VarPat NoExt name -> p_rdrName name

930− LazyPat NoExt pat -> do

905+ WildPat NoExtField -> txt "_"

906+ VarPat NoExtField name -> p_rdrName name

907+ LazyPat NoExtField pat -> do

931908 txt "~"

932− p_pat pat

933− AsPat NoExt name pat -> do

909+ located pat p_pat

910+ AsPat NoExtField name pat -> do

934911 p_rdrName name

935912 txt "@"

936− p_pat pat

937− ParPat NoExt pat ->

938− locatedPat pat (parens S . p_pat)

939− BangPat NoExt pat -> do

913+ located pat p_pat

914+ ParPat NoExtField pat ->

915+ located pat (parens S . p_pat)

916+ BangPat NoExtField pat -> do

940917 txt "!"

941− p_pat pat

942− ListPat NoExt pats ->

943− brackets S . sitcc $ sep (comma >> breakpoint) p_pat pats

944− TuplePat NoExt pats boxing -> do

918+ located pat p_pat

919+ ListPat NoExtField pats ->

920+ brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats

921+ TuplePat NoExtField pats boxing -> do

945922 let f =

946923 case boxing of

947924 Boxed -> parens S

948925 Unboxed -> parensHash S

949− f . sitcc $ sep (comma >> breakpoint) (sitcc . p_pat) pats

950− SumPat NoExt pat tag arity ->

951− p_unboxedSum S tag arity (p_pat pat)

926+ f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats

927+ SumPat NoExtField pat tag arity ->

928+ p_unboxedSum S tag arity (located pat p_pat)

952929 ConPatIn pat details ->

953930 case details of

954931 PrefixCon xs -> sitcc $ do

955932 p_rdrName pat

956933 unless (null xs) $ do

957934 breakpoint

958− inci . sitcc $ sep breakpoint (sitcc . p_pat) xs

935+ inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs

959936 RecCon (HsRecFields fields dotdot) -> do

960937 p_rdrName pat

961938 breakpoint

@@ -965,36 +942,37 @@ p_pat = \case

965942 inci . braces N . sitcc . sep (comma >> breakpoint) f $

966943 case dotdot of

967944 Nothing -> Just <$> fields

968− Just n -> (Just <$> take n fields) ++ [Nothing]

945+ Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

969946 InfixCon l r -> do

970947 switchLayout [getLoc l, getLoc r] $ do

971− p_pat l

948+ located l p_pat

972949 breakpoint

973950 inci $ do

974951 p_rdrName pat

975952 space

976− p_pat r

953+ located r p_pat

977954 ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?

978− ViewPat NoExt expr pat -> sitcc $ do

955+ ViewPat NoExtField expr pat -> sitcc $ do

979956 located expr p_hsExpr

980957 space

981958 txt "->"

982959 breakpoint

983− inci (p_pat pat)

984− SplicePat NoExt splice -> p_hsSplice splice

985− LitPat NoExt p -> atom p

986− NPat NoExt v _ _ -> located v (atom . ol_val)

987− NPlusKPat NoExt n k _ _ _ -> sitcc $ do

960+ inci (located pat p_pat)

961+ SplicePat NoExtField splice -> p_hsSplice splice

962+ LitPat NoExtField p -> atom p

963+ NPat NoExtField v _ _ -> located v (atom . ol_val)

964+ NPlusKPat NoExtField n k _ _ _ -> sitcc $ do

988965 p_rdrName n

989966 breakpoint

990967 inci $ do

991968 txt "+"

992969 space

993970 located k (atom . ol_val)

994− SigPat NoExt pat hswc -> do

995− p_pat pat

971+ SigPat NoExtField pat hswc -> do

972+ located pat p_pat

996973 p_typeAscription hswc

997974 CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage

975+ XPat x -> noExtCon x

998976

999977p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()

1000978p_pat_hsRecField HsRecField {..} = do

@@ -1004,7 +982,7 @@ p_pat_hsRecField HsRecField {..} = do

1004982 space

1005983 txt "="

1006984 breakpoint

1007− inci (p_pat hsRecFieldArg)

985+ inci (located hsRecFieldArg p_pat)

1008986

1009987p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()

1010988p_unboxedSum s tag arity m = do

@@ -1025,9 +1003,9 @@ p_unboxedSum s tag arity m = do

10251003

10261004p_hsSplice :: HsSplice GhcPs -> R ()

10271005p_hsSplice = \case

1028− HsTypedSplice NoExt deco _ expr -> p_hsSpliceTH True expr deco

1029− HsUntypedSplice NoExt deco _ expr -> p_hsSpliceTH False expr deco

1030− HsQuasiQuote NoExt _ quoterName srcSpan str -> do

1006+ HsTypedSplice NoExtField deco _ expr -> p_hsSpliceTH True expr deco

1007+ HsUntypedSplice NoExtField deco _ expr -> p_hsSpliceTH False expr deco

1008+ HsQuasiQuote NoExtField _ quoterName srcSpan str -> do

10311009 txt "["

10321010 p_rdrName (L srcSpan quoterName)

10331011 txt "|"

@@ -1037,7 +1015,7 @@ p_hsSplice = \case

10371015 txt "|]"

10381016 HsSpliced {} -> notImplemented "HsSpliced"

10391017 HsSplicedT {} -> notImplemented "HsSplicedT"

1040− XSplice {} -> notImplemented "XSplice"

1018+ XSplice x -> noExtCon x

10411019

10421020p_hsSpliceTH ::

10431021 -- | Typed splice?

@@ -1061,17 +1039,17 @@ p_hsSpliceTH isTyped expr = \case

10611039

10621040p_hsBracket :: HsBracket GhcPs -> R ()

10631041p_hsBracket = \case

1064− ExpBr NoExt expr -> do

1042+ ExpBr NoExtField expr -> do

10651043 anns <- getEnclosingAnns

10661044 let name = case anns of

10671045 AnnOpenEQ : _ -> ""

10681046 _ -> "e"

10691047 quote name (located expr p_hsExpr)

1070− PatBr NoExt pat -> quote "p" (p_pat pat)

1071− DecBrL NoExt decls -> quote "d" (p_hsDecls Free decls)

1072− DecBrG NoExt _ -> notImplemented "DecBrG" -- result of renamer

1073− TypBr NoExt ty -> quote "t" (located ty p_hsType)

1074− VarBr NoExt isSingleQuote name -> do

1048+ PatBr NoExtField pat -> located pat (quote "p" . p_pat)

1049+ DecBrL NoExtField decls -> quote "d" (p_hsDecls Free decls)

1050+ DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer

1051+ TypBr NoExtField ty -> quote "t" (located ty p_hsType)

1052+ VarBr NoExtField isSingleQuote name -> do

10751053 txt (bool "''" "'" isSingleQuote)

10761054 -- HACK As you can see we use 'noLoc' here to be able to pass name into

10771055 -- 'p_rdrName' since the latter expects a "located" thing. The problem

@@ -1086,13 +1064,13 @@ p_hsBracket = \case

10861064 && not (doesNotNeedExtraParens name)

10871065 wrapper = if isOperator then parens N else id

10881066 wrapper $ p_rdrName (noLoc name)

1089− TExpBr NoExt expr -> do

1067+ TExpBr NoExtField expr -> do

10901068 txt "[||"

10911069 breakpoint'

10921070 located expr p_hsExpr

10931071 breakpoint'

10941072 txt "||]"

1095− XBracket {} -> notImplemented "XBracket"

1073+ XBracket x -> noExtCon x

10961074 where

10971075 quote :: Text -> R () -> R ()

10981076 quote name body = do

@@ -1171,9 +1149,9 @@ liftAppend (x : xs) [] = x : xs

11711149liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys

11721150

11731151getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan

1174−getGRHSSpan (GRHS NoExt guards body) =

1152+getGRHSSpan (GRHS NoExtField guards body) =

11751153 combineSrcSpans' $ getLoc body :| map getLoc guards

1176−getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"

1154+getGRHSSpan (XGRHS x) = noExtCon x

11771155

11781156-- | Place a thing that may have a hanging form. This function handles how

11791157-- to separate it from preceding expressions and whether to bump indentation

@@ -1194,67 +1172,63 @@ blockPlacement ::

11941172 (body -> Placement) ->

11951173 [LGRHS GhcPs (Located body)] ->

11961174 Placement

1197−blockPlacement placer [L _ (GRHS NoExt _ (L _ x))] = placer x

1175+blockPlacement placer [L _ (GRHS NoExtField _ (L _ x))] = placer x

11981176blockPlacement _ _ = Normal

11991177

12001178-- | Check if given command has a hanging form.

12011179cmdPlacement :: HsCmd GhcPs -> Placement

12021180cmdPlacement = \case

1203− HsCmdLam NoExt _ -> Hanging

1204− HsCmdCase NoExt _ _ -> Hanging

1205− HsCmdDo NoExt _ -> Hanging

1181+ HsCmdLam NoExtField _ -> Hanging

1182+ HsCmdCase NoExtField _ _ -> Hanging

1183+ HsCmdDo NoExtField _ -> Hanging

12061184 _ -> Normal

12071185

12081186cmdTopPlacement :: HsCmdTop GhcPs -> Placement

12091187cmdTopPlacement = \case

1210− HsCmdTop NoExt (L _ x) -> cmdPlacement x

1211− XCmdTop {} -> notImplemented "XCmdTop"

1188+ HsCmdTop NoExtField (L _ x) -> cmdPlacement x

1189+ XCmdTop x -> noExtCon x

12121190

12131191-- | Check if given expression has a hanging form.

12141192exprPlacement :: HsExpr GhcPs -> Placement

12151193exprPlacement = \case

12161194 -- Only hang lambdas with single line parameter lists

1217− HsLam NoExt mg -> case mg of

1218− MG _ (L _ [L _ (Match NoExt _ (x : xs) _)]) _

1195+ HsLam NoExtField mg -> case mg of

1196+ MG _ (L _ [L _ (Match NoExtField _ (x : xs) _)]) _

12191197 | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) ->

12201198 Hanging

12211199 _ -> Normal

1222− HsLamCase NoExt _ -> Hanging

1223− HsCase NoExt _ _ -> Hanging

1224− HsDo NoExt DoExpr _ -> Hanging

1225− HsDo NoExt MDoExpr _ -> Hanging

1200+ HsLamCase NoExtField _ -> Hanging

1201+ HsCase NoExtField _ _ -> Hanging

1202+ HsDo NoExtField DoExpr _ -> Hanging

1203+ HsDo NoExtField MDoExpr _ -> Hanging

12261204 -- If the rightmost expression in an operator chain is hanging, make the

12271205 -- whole block hanging; so that we can use the common @f = foo $ do@

12281206 -- style.

1229− OpApp NoExt _ _ y -> exprPlacement (unLoc y)

1207+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

12301208 -- Same thing for function applications (usually with -XBlockArguments)

1231− HsApp NoExt _ y -> exprPlacement (unLoc y)

1232− HsProc NoExt p _ ->

1233− -- https://gitlab.haskell.org/ghc/ghc/issues/17330

1234− let loc = case p of

1235− XPat pat -> getLoc pat

1236− _ -> error "exprPlacement: HsProc: Pat does not contain a location"

1237− in -- Indentation breaks if pattern is longer than one line and left

1238− -- hanging. Consequently, only apply hanging when it is safe.

1239− if isOneLineSpan loc

1240− then Hanging

1241− else Normal

1209+ HsApp NoExtField _ y -> exprPlacement (unLoc y)

1210+ HsProc NoExtField p _ ->

1211+ -- Indentation breaks if pattern is longer than one line and left

1212+ -- hanging. Consequently, only apply hanging when it is safe.

1213+ if isOneLineSpan (getLoc p)

1214+ then Hanging

1215+ else Normal

12421216 _ -> Normal

12431217

12441218withGuards :: [LGRHS GhcPs (Located body)] -> Bool

12451219withGuards = any (checkOne . unLoc)

12461220 where

12471221 checkOne :: GRHS GhcPs (Located body) -> Bool

1248− checkOne (GRHS NoExt [] _) = False

1222+ checkOne (GRHS NoExtField [] _) = False

12491223 checkOne _ = True

12501224

12511225exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)

1252−exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)

1226+exprOpTree (L _ (OpApp NoExtField x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)

12531227exprOpTree n = OpNode n

12541228

12551229getOpName :: HsExpr GhcPs -> Maybe RdrName

12561230getOpName = \case

1257− HsVar NoExt (L _ a) -> Just a

1231+ HsVar NoExtField (L _ a) -> Just a

12581232 _ -> Nothing

12591233

12601234p_exprOpTree ::

@@ -1276,8 +1250,10 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

12761250 OpNode (L _ n) -> exprPlacement n

12771251 _ -> Normal

12781252 else Normal

1253+ -- Distinguish holes used in infix notation.

1254+ -- eg. '1 _foo 2' and '1 `_foo` 2'

12791255 opWrapper = case unLoc op of

1280− EWildPat NoExt -> backticks

1256+ HsUnboundVar NoExtField _ -> backticks

12811257 _ -> id

12821258 layout <- getLayout

12831259 let ub = case layout of

@@ -1332,7 +1308,7 @@ isRecordDot ::

13321308 SrcSpan ->

13331309 Bool

13341310isRecordDot op (RealSrcSpan ySpan) = case op of

1335− HsVar NoExt (L (RealSrcSpan opSpan) opName) ->

1311+ HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

13361312 isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

13371313 _ -> False

13381314isRecordDot _ _ = False

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

@@ -13,17 +13,16 @@ import Data.Text (Text)

1313import GHC

1414import Ormolu.Printer.Combinators

1515import Ormolu.Printer.Meat.Common

16−import Ormolu.Utils

1716

1817p_warnDecls :: WarnDecls GhcPs -> R ()

19−p_warnDecls (Warnings NoExt _ warnings) =

18+p_warnDecls (Warnings NoExtField _ warnings) =

2019 traverse_ (located' p_warnDecl) warnings

21−p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"

20+p_warnDecls (XWarnDecls x) = noExtCon x

2221

2322p_warnDecl :: WarnDecl GhcPs -> R ()

24−p_warnDecl (Warning NoExt functions warningTxt) =

23+p_warnDecl (Warning NoExtField functions warningTxt) =

2524 p_topLevelWarning functions warningTxt

26−p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"

25+p_warnDecl (XWarnDecl x) = noExtCon x

2726

2827p_moduleWarning :: WarningTxt -> R ()

2928p_moduleWarning wtxt = do

src/Ormolu/Printer/Meat/ImportExport.hs+14−13

@@ -11,10 +11,9 @@ where

1111

1212import Control.Monad

1313import GHC

14−import HsImpExp (IE (..))

14+import GHC.Hs.ImpExp (IE (..))

1515import Ormolu.Printer.Combinators

1616import Ormolu.Printer.Meat.Common

17−import Ormolu.Utils

1817

1918p_hsmodExports :: [LIE GhcPs] -> R ()

2019p_hsmodExports [] = do

@@ -34,7 +33,9 @@ p_hsmodImport ImportDecl {..} = do

3433 space

3534 when ideclSafe (txt "safe")

3635 space

37− when ideclQualified (txt "qualified")

36+ when

37+ (isImportDeclQualified ideclQualified)

38+ (txt "qualified")

3839 space

3940 case ideclPkgQual of

4041 Nothing -> return ()

@@ -62,22 +63,22 @@ p_hsmodImport ImportDecl {..} = do

6263 layout <- getLayout

6364 sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)

6465 newline

65−p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"

66+p_hsmodImport (XImportDecl x) = noExtCon x

6667

6768p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()

6869p_lie encLayout (i, totalItems) = \case

69− IEVar NoExt l1 -> do

70+ IEVar NoExtField l1 -> do

7071 located l1 p_ieWrappedName

7172 p_comma

72− IEThingAbs NoExt l1 -> do

73+ IEThingAbs NoExtField l1 -> do

7374 located l1 p_ieWrappedName

7475 p_comma

75− IEThingAll NoExt l1 -> do

76+ IEThingAll NoExtField l1 -> do

7677 located l1 p_ieWrappedName

7778 space

7879 txt "(..)"

7980 p_comma

80− IEThingWith NoExt l1 w xs _ -> sitcc $ do

81+ IEThingWith NoExtField l1 w xs _ -> sitcc $ do

8182 located l1 p_ieWrappedName

8283 breakpoint

8384 inci $ do

@@ -91,16 +92,16 @@ p_lie encLayout (i, totalItems) = \case

9192 let (before, after) = splitAt n names

9293 in before ++ [txt ".."] ++ after

9394 p_comma

94− IEModuleContents NoExt l1 -> do

95+ IEModuleContents NoExtField l1 -> do

9596 located l1 p_hsmodName

9697 p_comma

97− IEGroup NoExt n str -> do

98+ IEGroup NoExtField n str -> do

9899 unless (i == 0) newline

99100 p_hsDocString (Asterisk n) False (noLoc str)

100− IEDoc NoExt str ->

101+ IEDoc NoExtField str ->

101102 p_hsDocString Pipe False (noLoc str)

102− IEDocNamed NoExt str -> p_hsDocName str

103− XIE NoExt -> notImplemented "XIE"

103+ IEDocNamed NoExtField str -> p_hsDocName str

104+ XIE x -> noExtCon x

104105 where

105106 p_comma =

106107 case encLayout of

src/Ormolu/Printer/Meat/Type.hs+40−37

@@ -27,11 +27,11 @@ p_hsType t = p_hsType' (hasDocStrings t) t

2727

2828p_hsType' :: Bool -> HsType GhcPs -> R ()

2929p_hsType' multilineArgs = \case

30− HsForAllTy NoExt bndrs t -> do

31− p_forallBndrs p_hsTyVarBndr bndrs

30+ HsForAllTy NoExtField visibility bndrs t -> do

31+ p_forallBndrs visibility p_hsTyVarBndr bndrs

3232 interArgBreak

3333 p_hsType' multilineArgs (unLoc t)

34− HsQualTy NoExt qs t -> do

34+ HsQualTy NoExtField qs t -> do

3535 located qs p_hsContext

3636 space

3737 txt "=>"

@@ -40,7 +40,7 @@ p_hsType' multilineArgs = \case

4040 HsQualTy {} -> p_hsTypeR (unLoc t)

4141 HsFunTy {} -> p_hsTypeR (unLoc t)

4242 _ -> located t p_hsTypeR

43− HsTyVar NoExt p n -> do

43+ HsTyVar NoExtField p n -> do

4444 case p of

4545 IsPromoted -> do

4646 txt "'"

@@ -49,7 +49,7 @@ p_hsType' multilineArgs = \case

4949 _ -> return ()

5050 NotPromoted -> return ()

5151 p_rdrName n

52− HsAppTy NoExt f x -> sitcc $ do

52+ HsAppTy NoExtField f x -> sitcc $ do

5353 located f p_hsType

5454 breakpoint

5555 inci (located x p_hsType)

@@ -62,7 +62,7 @@ p_hsType' multilineArgs = \case

6262 inci $ do

6363 txt "@"

6464 located kd p_hsType

65− HsFunTy NoExt x y@(L _ y') -> do

65+ HsFunTy NoExtField x y@(L _ y') -> do

6666 located x p_hsType

6767 space

6868 txt "->"

@@ -70,9 +70,9 @@ p_hsType' multilineArgs = \case

7070 case y' of

7171 HsFunTy {} -> p_hsTypeR y'

7272 _ -> located y p_hsTypeR

73− HsListTy NoExt t ->

73+ HsListTy NoExtField t ->

7474 located t (brackets N . p_hsType)

75− HsTupleTy NoExt tsort xs ->

75+ HsTupleTy NoExtField tsort xs ->

7676 let parens' =

7777 case tsort of

7878 HsUnboxedTuple -> parensHash N

@@ -81,33 +81,33 @@ p_hsType' multilineArgs = \case

8181 HsBoxedOrConstraintTuple -> parens N

8282 in parens' . sitcc $

8383 sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

84− HsSumTy NoExt xs ->

84+ HsSumTy NoExtField xs ->

8585 parensHash N . sitcc $

8686 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

87− HsOpTy NoExt x op y ->

87+ HsOpTy NoExtField x op y ->

8888 sitcc $

8989 let opTree = OpBranch (tyOpTree x) op (tyOpTree y)

9090 in p_tyOpTree (reassociateOpTree Just opTree)

91− HsParTy NoExt t ->

91+ HsParTy NoExtField t ->

9292 parens N (located t p_hsType)

93− HsIParamTy NoExt n t -> sitcc $ do

93+ HsIParamTy NoExtField n t -> sitcc $ do

9494 located n atom

9595 space

9696 txt "::"

9797 breakpoint

9898 inci (located t p_hsType)

99− HsStarTy NoExt _ -> txt "*"

100− HsKindSig NoExt t k -> sitcc $ do

99+ HsStarTy NoExtField _ -> txt "*"

100+ HsKindSig NoExtField t k -> sitcc $ do

101101 located t p_hsType

102102 space -- FIXME

103103 txt "::"

104104 space

105105 inci (located k p_hsType)

106− HsSpliceTy NoExt splice -> p_hsSplice splice

107− HsDocTy NoExt t str -> do

106+ HsSpliceTy NoExtField splice -> p_hsSplice splice

107+ HsDocTy NoExtField t str -> do

108108 p_hsDocString Pipe True str

109109 located t p_hsType

110− HsBangTy NoExt (HsSrcBang _ u s) t -> do

110+ HsBangTy NoExtField (HsSrcBang _ u s) t -> do

111111 case u of

112112 SrcUnpack -> txt "{-# UNPACK #-}" >> space

113113 SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space

@@ -117,9 +117,9 @@ p_hsType' multilineArgs = \case

117117 SrcStrict -> txt "!"

118118 NoSrcStrict -> return ()

119119 located t p_hsType

120− HsRecTy NoExt fields ->

120+ HsRecTy NoExtField fields ->

121121 p_conDeclFields fields

122− HsExplicitListTy NoExt p xs -> do

122+ HsExplicitListTy NoExtField p xs -> do

123123 case p of

124124 IsPromoted -> txt "'"

125125 NotPromoted -> return ()

@@ -130,18 +130,18 @@ p_hsType' multilineArgs = \case

130130 (IsPromoted, L _ t : _) | isPromoted t -> space

131131 _ -> return ()

132132 sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

133− HsExplicitTupleTy NoExt xs -> do

133+ HsExplicitTupleTy NoExtField xs -> do

134134 txt "'"

135135 parens N $ do

136136 case xs of

137137 L _ t : _ | isPromoted t -> space

138138 _ -> return ()

139139 sep (comma >> breakpoint) (located' p_hsType) xs

140− HsTyLit NoExt t ->

140+ HsTyLit NoExtField t ->

141141 case t of

142142 HsStrTy (SourceText s) _ -> p_stringLit s

143143 a -> atom a

144− HsWildCardTy NoExt -> txt "_"

144+ HsWildCardTy NoExtField -> txt "_"

145145 XHsType (NHsCoreTy t) -> atom t

146146 where

147147 isPromoted = \case

@@ -173,26 +173,29 @@ p_hsContext = \case

173173

174174p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

175175p_hsTyVarBndr = \case

176− UserTyVar NoExt x ->

176+ UserTyVar NoExtField x ->

177177 p_rdrName x

178− KindedTyVar NoExt l k -> parens N $ do

178+ KindedTyVar NoExtField l k -> parens N $ do

179179 located l atom

180180 space

181181 txt "::"

182182 breakpoint

183183 inci (located k p_hsType)

184− XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

184+ XTyVarBndr x -> noExtCon x

185185

186186-- | Render several @forall@-ed variables.

187−p_forallBndrs :: Data a => (a -> R ()) -> [Located a] -> R ()

188−p_forallBndrs _ [] = txt "forall."

189−p_forallBndrs p tyvars =

187+p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()

188+p_forallBndrs ForallInvis _ [] = txt "forall."

189+p_forallBndrs ForallVis _ [] = txt "forall ->"

190+p_forallBndrs vis p tyvars =

190191 switchLayout (getLoc <$> tyvars) $ do

191192 txt "forall"

192193 breakpoint

193194 inci $ do

194195 sitcc $ sep breakpoint (sitcc . located' p) tyvars

195− txt "."

196+ case vis of

197+ ForallInvis -> txt "."

198+ ForallVis -> space >> txt "->"

196199

197200p_conDeclFields :: [LConDeclField GhcPs] -> R ()

198201p_conDeclFields xs =

@@ -211,10 +214,10 @@ p_conDeclField ConDeclField {..} = do

211214 txt "::"

212215 breakpoint

213216 sitcc . inci $ p_hsType (unLoc cd_fld_type)

214−p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"

217+p_conDeclField (XConDeclField x) = noExtCon x

215218

216219tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)

217−tyOpTree (L _ (HsOpTy NoExt l op r)) =

220+tyOpTree (L _ (HsOpTy NoExtField l op r)) =

218221 OpBranch (tyOpTree l) op (tyOpTree r)

219222tyOpTree n = OpNode n

220223

@@ -235,17 +238,17 @@ p_tyOpTree (OpBranch l op r) = do

235238tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]

236239tyVarsToTypes = \case

237240 HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit

238− XLHsQTyVars {} -> notImplemented "XLHsQTyVars"

241+ XLHsQTyVars x -> noExtCon x

239242

240243tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs

241244tyVarToType = \case

242− UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar

243− KindedTyVar NoExt tvar kind ->

245+ UserTyVar NoExtField tvar -> HsTyVar NoExtField NotPromoted tvar

246+ KindedTyVar NoExtField tvar kind ->

244247 -- Note: we always add parentheses because for whatever reason GHC does

245248 -- not use HsParTy for left-hand sides of declarations. Please see

246249 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

247250 -- long as 'tyVarToType' does not get applied to right-hand sides of

248251 -- declarations.

249− HsParTy NoExt $ noLoc $

250− HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind

251− XTyVarBndr {} -> notImplemented "XTyVarBndr"

252+ HsParTy NoExtField $ noLoc $

253+ HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

254+ XTyVarBndr x -> noExtCon x

src/Ormolu/Utils.hs+1−1

@@ -22,7 +22,7 @@ import Data.Maybe (fromMaybe)

2222import Data.Text (Text)

2323import qualified Data.Text as T

2424import GHC

25−import HsDoc (HsDocString, unpackHDS)

25+import GHC.Hs.Doc (HsDocString, unpackHDS)

2626import qualified Outputable as GHC

2727

2828-- | Combine all source spans from the given list.