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.

data/examples/declaration/type/visible-forall-out.hs

@@ -0,0 +1,2 @@
+-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst
+data T :: forall k -> k -> Type

data/examples/declaration/type/visible-forall.hs

@@ -0,0 +1,2 @@
+-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst
+data T :: forall k -> k -> Type

data/examples/declaration/value/function/arrow/expression-applications-out.hs

@@ -1,9 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-foo x y = x -< y
-
-bar f x =
-  f x -< -- Hello
-    x -- World
-
-baz x y = x -<< y

data/examples/declaration/value/function/arrow/expression-applications.hs

@@ -1,9 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-foo x y = x -< y
-
-bar f x
-    =  f x  -- Hello
-    -< x    -- World
-
-baz x y = x -<< y

data/examples/declaration/value/function/arrow/expression-forms-out.hs

@@ -1,14 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-foo f g x y = (| test (f -< x) (g -< y) |)
-
-bar f g x y =
-  (|
-    test
-      ( f -<
-          x
-      )
-      ( g -<
-          y
-      )
-  |)

data/examples/declaration/value/function/arrow/expression-forms.hs

@@ -1,11 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-foo f g x y = (| test (f -< x) (g -< y) |)
-
-bar f g x y = (|
-    test
-      (f
-       -< x)
-      (g
-       -< y)
-  |)

data/examples/declaration/value/function/arrow/proc-forms2-out.hs

@@ -4,15 +4,17 @@ bar0 f g h x =
   proc (y, z) ->
     (| test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x)) |)
 
-bar1 f g x y = proc _ -> f -< x &&& g -< y
+bar1 f g x y = proc _ -> (f -< x) &&& (g -< y)
 
 bar2 f g h x =
   proc (y, z) ->
-    h f . (h g) -< (y x) . y z ||| (h g) . h f -< y z . (y x)
+    (h f . (h g) -< (y x) . y z) ||| ((h g) . h f -< y z . (y x))
 
 bar3 f g h x =
   proc (y, z) ->
-    (h f . h g) -<
+    ( (h f . h g) -<
-      (y x) . y z
+        (y x) . y z
-        ||| (h g . h f) -<
+    ) |||
-        y z . (y x)
+      ( (h g . h f) -<
+          y z . (y x)
+      )

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

@@ -4,16 +4,16 @@ bar0 f g h x =
   proc (y, z) ->
     (|   test (h f.(h g)  -<  (y x).y z)((h g)  .  h f-<y z  .  (y x))   |)
 
-bar1 f g x y = proc _ -> f -< x&&&g -< y
+bar1 f g x y = proc _ -> (f -< x)&&&(g -< y)
 
 bar2 f g h x =
   proc (y, z) ->
-    h f.(h g)  -<  (y x).y z ||| (h g)  .  h f-<y z  .  (y x)
+    (h f.(h g)  -<  (y x).y z) ||| ((h g)  .  h f-<y z  .  (y x))
 
 bar3 f g h x =
   proc (y, z) ->
-    (h f.h g)
+    ((h f.h g)
-      -<  (y x).y z
+      -<  (y x).y z)
   |||
-    (h g  .  h f)
+    ((h g  .  h f)
-      -<y z  .  (y x)
+      -<y z  .  (y x))

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

@@ -13,6 +13,3 @@ multiline
         bar
         baz
     ) = True
-
--- https://github.com/tweag/ormolu/issues/343
-foo = (f -> 4)

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

@@ -10,6 +10,3 @@ g ((f, _), f -> 4) = True
 multiline (t -> Foo
                   bar
                   baz) = True
-
--- https://github.com/tweag/ormolu/issues/343
-foo = (f -> 4)

data/examples/import/qualified-prelude-out.hs

@@ -1,4 +1,4 @@
 module P where
 
-import Prelude hiding ((.), id)
 import qualified Prelude
+import Prelude hiding ((.), id)

default.nix

@@ -17,10 +17,14 @@ let
     "ormolu" = pkgs.haskell.lib.enableCabalFlag
       (super.callCabal2nix "ormolu" source { }) "dev";
     # Nixpkgs provides ghc-lib-parser-8.8.0.20190424, but we want
-    # ghc-lib-parser-8.8.1. We disable Haddock generation because it's way
+    # ghc-lib-parser-8.10.1. We disable Haddock generation because it's way
     # too slow.
     "ghc-lib-parser" = pkgs.haskell.lib.dontHaddock
-      (super.callHackage "ghc-lib-parser" "8.8.1" { });
+      (super.callHackageDirect {
+        pkg = "ghc-lib-parser";
+        ver = "8.10.1.20200324";
+        sha256 = "0f2c68fzdj2lw6da2zpx7a0cx631im3kylwd85dzx1npsm1vzlbg";
+      } {});
   };
   ormolize = import ./nix/ormolize {
     inherit pkgs;

ormolu.cabal

@@ -68,7 +68,7 @@ library
                     , containers     >= 0.5 && < 0.7
                     , dlist          >= 0.8 && < 0.9
                     , exceptions     >= 0.6 && < 0.11
-                    , ghc-lib-parser >= 8.8.1 && < 8.8.3
+                    , ghc-lib-parser >= 8.10 && < 8.11
                     , mtl            >= 2.0 && < 3.0
                     , syb            >= 0.7 && < 0.8
                     , text           >= 0.2 && < 1.3
@@ -149,7 +149,7 @@ executable ormolu
   main-is:            Main.hs
   hs-source-dirs:     app
   build-depends:      base           >= 4.12 && < 5.0
-                    , ghc-lib-parser >= 8.8.1 && < 8.8.3
+                    , ghc-lib-parser >= 8.10 && < 8.11
                     , gitrev         >= 1.3 && < 1.4
                     , optparse-applicative >= 0.14 && < 0.16
                     , ormolu

src/GHC.hs

@@ -6,16 +6,8 @@ where
 
 import ApiAnnotation as X
 import BasicTypes as X
-import HsBinds as X
+import GHC.Hs as X
-import HsDecls as X
+import GHC.Hs.Instances as X ()
-import HsDoc as X
-import HsExpr as X
-import HsExtension as X
-import HsImpExp as X
-import HsInstances as X ()
-import HsLit as X
-import HsPat as X
-import HsSyn as X
 import Module as X
 import RdrName as X
 import SrcLoc as X

src/GHC/DynFlags.hs

@@ -1,5 +1,7 @@
 {-# OPTIONS_GHC -Wno-missing-fields #-}
 
+-- Modified from ghc-lib-api-ext.
+
 module GHC.DynFlags
   ( baseDynFlags,
   )
@@ -8,31 +10,40 @@ where
 import Config
 import DynFlags
 import Fingerprint
-import Platform
+import GHC.Platform
+import ToolSettings
 
--- | Taken from HLint.
 fakeSettings :: Settings
 fakeSettings =
   Settings
-    { sTargetPlatform = platform,
+    { sGhcNameVersion =
-      sPlatformConstants = platformConstants,
+        GhcNameVersion
-      sProjectVersion = cProjectVersion,
+          { ghcNameVersion_programName = "ghc",
-      sProgramName = "ghc",
+            ghcNameVersion_projectVersion = cProjectVersion
-      sOpt_P_fingerprint = fingerprint0,
+          },
-      sPgm_F = ""
+      sFileSettings = FileSettings {},
+      sTargetPlatform =
+        Platform
+          { platformWordSize = PW8,
+            platformMini =
+              PlatformMini
+                { platformMini_arch = ArchUnknown,
+                  platformMini_os = OSUnknown
+                },
+            platformUnregisterised = True
+          },
+      sPlatformMisc = PlatformMisc {},
+      sPlatformConstants =
+        PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8},
+      sToolSettings =
+        ToolSettings
+          { toolSettings_opt_P_fingerprint = fingerprint0,
+            toolSettings_pgm_F = ""
+          }
     }
-  where
-    platform =
-      Platform
-        { platformWordSize = 8,
-          platformOS = OSUnknown,
-          platformUnregisterised = True
-        }
-    platformConstants =
-      PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8}
 
-fakeLlvmConfig :: (LlvmTargets, LlvmPasses)
+fakeLlvmConfig :: LlvmConfig
-fakeLlvmConfig = ([], [])
+fakeLlvmConfig = LlvmConfig [] []
 
 baseDynFlags :: DynFlags
 baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig

src/Ormolu/Imports.hs

@@ -13,8 +13,8 @@ import Data.Function (on)
 import Data.Generics (gcompare)
 import Data.List (sortBy)
 import GHC hiding (GhcPs, IE)
-import HsExtension
+import GHC.Hs.Extension
-import HsImpExp (IE (..))
+import GHC.Hs.ImpExp (IE (..))
 import Ormolu.Utils (notImplemented)
 
 -- | Sort imports by module name. This also sorts explicit import lists for
@@ -29,7 +29,7 @@ sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)
           { ideclHiding = second (fmap sortLies) <$> ideclHiding,
             ..
           }
-      XImportDecl {} -> notImplemented "XImportDecl"
+      XImportDecl x -> noExtCon x
 
 -- | Compare two @'LImportDecl' 'GhcPs'@ things.
 compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
@@ -51,8 +51,8 @@ sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)
 -- | Sort imports\/exports inside of 'IEThingWith'.
 sortThings :: IE GhcPs -> IE GhcPs
 sortThings = \case
-  IEThingWith NoExt x w xs fl ->
+  IEThingWith NoExtField x w xs fl ->
-    IEThingWith NoExt x w (sortBy (compareIewn `on` unLoc) xs) fl
+    IEThingWith NoExtField x w (sortBy (compareIewn `on` unLoc) xs) fl
   other -> other
 
 -- | Compare two located imports or exports.
@@ -62,15 +62,15 @@ compareIE = compareIewn `on` getIewn
 -- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.
 getIewn :: IE GhcPs -> IEWrappedName RdrName
 getIewn = \case
-  IEVar NoExt x -> unLoc x
+  IEVar NoExtField x -> unLoc x
-  IEThingAbs NoExt x -> unLoc x
+  IEThingAbs NoExtField x -> unLoc x
-  IEThingAll NoExt x -> unLoc x
+  IEThingAll NoExtField x -> unLoc x
-  IEThingWith NoExt x _ _ _ -> unLoc x
+  IEThingWith NoExtField x _ _ _ -> unLoc x
-  IEModuleContents NoExt _ -> notImplemented "IEModuleContents"
+  IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"
-  IEGroup NoExt _ _ -> notImplemented "IEGroup"
+  IEGroup NoExtField _ _ -> notImplemented "IEGroup"
-  IEDoc NoExt _ -> notImplemented "IEDoc"
+  IEDoc NoExtField _ -> notImplemented "IEDoc"
-  IEDocNamed NoExt _ -> notImplemented "IEDocNamed"
+  IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"
-  XIE NoExt -> notImplemented "XIE"
+  XIE x -> noExtCon x
 
 -- | Compare two @'IEWrapppedName' 'RdrName'@ things.
 compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

src/Ormolu/Parser.hs

@@ -9,14 +9,17 @@ module Ormolu.Parser
   )
 where
 
+import Bag (bagToList)
 import qualified CmdLineParser as GHC
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
-import Data.List ((\\), foldl', isPrefixOf)
+import Data.List ((\\), foldl', isPrefixOf, sortOn)
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe (catMaybes)
+import Data.Ord (Down (Down))
 import DynFlags as GHC
+import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)
 import qualified FastString as GHC
 import GHC hiding (IE, UnicodeSyntax)
 import GHC.DynFlags (baseDynFlags)
@@ -29,7 +32,6 @@ import Ormolu.Exception
 import Ormolu.Parser.Anns
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
-import qualified Outputable as GHC
 import qualified Panic as GHC
 import qualified Parser as GHC
 import qualified StringBuffer as GHC
@@ -73,20 +75,34 @@ parseModule Config {..} path input' = liftIO $ do
           || any
             (("RecordDotPreprocessor" ==) . moduleNameString)
             (pluginModNames dynFlags)
+      pStateErrors = \pstate ->
+        let errs = bagToList $ GHC.getErrorMessages pstate dynFlags
+         in case sortOn (Down . SeverityOrd . errMsgSeverity) errs of
+              [] -> Nothing
+              err : _ -> Just (errMsgSpan err, show err) -- Show instance returns a short error message
       r = case runParser GHC.parseModule dynFlags path input of
-        GHC.PFailed _ ss m ->
+        GHC.PFailed pstate ->
-          Left (ss, GHC.showSDoc dynFlags m)
+          case pStateErrors pstate of
+            Just err -> Left err
+            Nothing -> error "invariant violation: PFailed does not have an error"
         GHC.POk pstate pmod ->
-          let (comments, exts, shebangs) = mkCommentStream extraComments pstate
+          case pStateErrors pstate of
-           in Right
+            -- Some parse errors (pattern/arrow syntax in expr context)
-                ParseResult
+            -- do not cause a parse error, but they are replaced with "_"
-                  { prParsedSource = pmod,
+            -- by the parser and the modified AST is propagated to the
-                    prAnns = mkAnns pstate,
+            -- later stages; but we fail in those cases.
-                    prCommentStream = comments,
+            Just err -> Left err
-                    prExtensions = exts,
+            Nothing ->
-                    prShebangs = shebangs,
+              let (comments, exts, shebangs) = mkCommentStream extraComments pstate
-                    prUseRecordDot = useRecordDot
+               in Right
-                  }
+                    ParseResult
+                      { prParsedSource = pmod,
+                        prAnns = mkAnns pstate,
+                        prCommentStream = comments,
+                        prExtensions = exts,
+                        prShebangs = shebangs,
+                        prUseRecordDot = useRecordDot
+                      }
   return (warnings, r)
 
 -- | Extensions that are not enabled automatically and should be activated
@@ -223,3 +239,25 @@ parsePragmasIntoDynFlags flags extraOpts filepath str =
         reportErr
         (GHC.handleSourceError reportErr act)
     reportErr e = return $ Left (show e)
+
+----------------------------------------------------------------------------
+-- Even more helpers
+
+-- Wrap GHC's ErrUtils.Severity to add Ord instance
+newtype SeverityOrd = SeverityOrd Severity
+
+instance Eq SeverityOrd where
+  s1 == s2 = compare s1 s2 == EQ
+
+instance Ord SeverityOrd where
+  compare (SeverityOrd s1) (SeverityOrd s2) =
+    compare (f s1) (f s2)
+    where
+      f :: Severity -> Int
+      f SevOutput = 1
+      f SevFatal = 2
+      f SevInteractive = 3
+      f SevDump = 4
+      f SevInfo = 5
+      f SevWarning = 6
+      f SevError = 7

src/Ormolu/Printer/Combinators.hs

@@ -23,7 +23,6 @@ module Ormolu.Printer.Combinators
     inci,
     located,
     located',
-    locatedPat,
     switchLayout,
     Layout (..),
     vlayout,
@@ -64,7 +63,6 @@ import Control.Monad
 import Data.Data (Data)
 import Data.List (intersperse)
 import Data.Text (Text)
-import GHC (Pat (XPat), XXPat)
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Internal
 import Ormolu.Utils (isModule)
@@ -111,28 +109,6 @@ located' ::
   R ()
 located' = flip located
 
--- | A version of 'located' that works on 'Pat'.
---
--- Starting from GHC 8.8, @'LPat' == 'Pat'@. Located 'Pat's are always
--- constructed with the 'XPat' constructor, containing a @'Located' 'Pat'@.
---
--- Most of the time, we can just use 'p_pat' directly, because it handles
--- located 'Pat's. However, sometimes we want to use the location to render
--- something other than the given 'Pat'.
---
--- If given 'Pat' does not contain a location, we error out.
---
--- This should become unnecessary if
--- <https://gitlab.haskell.org/ghc/ghc/issues/17330> is ever fixed.
-locatedPat ::
-  (Data (Pat pass), XXPat pass ~ Located (Pat pass)) =>
-  Pat pass ->
-  (Pat pass -> R ()) ->
-  R ()
-locatedPat p f = case p of
-  XPat pat -> located pat f
-  _ -> error "locatedPat: Pat does not contain a location"
-
 -- | Set layout according to combination of given 'SrcSpan's for a given.
 -- Use this only when you need to set layout based on e.g. combined span of
 -- several elements when there is no corresponding 'Located' wrapper

src/Ormolu/Printer/Meat/Declaration.hs

@@ -110,29 +110,30 @@ groupDecls (lhdr : xs) =
 
 p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()
 p_hsDecl style = \case
-  TyClD NoExt x -> p_tyClDecl style x
+  TyClD NoExtField x -> p_tyClDecl style x
-  ValD NoExt x -> p_valDecl x
+  ValD NoExtField x -> p_valDecl x
-  SigD NoExt x -> p_sigDecl x
+  SigD NoExtField x -> p_sigDecl x
-  InstD NoExt x -> p_instDecl style x
+  InstD NoExtField x -> p_instDecl style x
-  DerivD NoExt x -> p_derivDecl x
+  DerivD NoExtField x -> p_derivDecl x
-  DefD NoExt x -> p_defaultDecl x
+  DefD NoExtField x -> p_defaultDecl x
-  ForD NoExt x -> p_foreignDecl x
+  ForD NoExtField x -> p_foreignDecl x
-  WarningD NoExt x -> p_warnDecls x
+  WarningD NoExtField x -> p_warnDecls x
-  AnnD NoExt x -> p_annDecl x
+  AnnD NoExtField x -> p_annDecl x
-  RuleD NoExt x -> p_ruleDecls x
+  RuleD NoExtField x -> p_ruleDecls x
-  SpliceD NoExt x -> p_spliceDecl x
+  SpliceD NoExtField x -> p_spliceDecl x
-  DocD NoExt docDecl ->
+  DocD NoExtField docDecl ->
     case docDecl of
       DocCommentNext str -> p_hsDocString Pipe False (noLoc str)
       DocCommentPrev str -> p_hsDocString Caret False (noLoc str)
       DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str)
       DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)
-  RoleAnnotD NoExt x -> p_roleAnnot x
+  RoleAnnotD NoExtField x -> p_roleAnnot x
-  XHsDecl _ -> notImplemented "XHsDecl"
+  KindSigD NoExtField _ -> notImplemented "StandaloneKindSignatures"
+  XHsDecl x -> noExtCon x
 
 p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()
 p_tyClDecl style = \case
-  FamDecl NoExt x -> p_famDecl style x
+  FamDecl NoExtField x -> p_famDecl style x
   SynDecl {..} -> p_synDecl tcdLName tcdFixity tcdTyVars tcdRhs
   DataDecl {..} ->
     p_dataDecl
@@ -153,19 +154,19 @@ p_tyClDecl style = \case
       tcdATs
       tcdATDefs
       tcdDocs
-  XTyClDecl {} -> notImplemented "XTyClDecl"
+  XTyClDecl x -> noExtCon x
 
 p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()
 p_instDecl style = \case
-  ClsInstD NoExt x -> p_clsInstDecl x
+  ClsInstD NoExtField x -> p_clsInstDecl x
-  TyFamInstD NoExt x -> p_tyFamInstDecl style x
+  TyFamInstD NoExtField x -> p_tyFamInstDecl style x
-  DataFamInstD NoExt x -> p_dataFamInstDecl style x
+  DataFamInstD NoExtField x -> p_dataFamInstDecl style x
-  XInstDecl _ -> notImplemented "XInstDecl"
+  XInstDecl x -> noExtCon x
 
 p_derivDecl :: DerivDecl GhcPs -> R ()
 p_derivDecl = \case
   d@DerivDecl {..} -> p_standaloneDerivDecl d
-  XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"
+  XDerivDecl x -> noExtCon x
 
 -- | Determine if these declarations should be grouped together.
 groupedDecls ::
@@ -225,13 +226,13 @@ pattern
   Pattern,
   DataDeclaration ::
     RdrName -> HsDecl GhcPs
-pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)
+pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _)
-pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)
+pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _)
-pattern SCCPragma n <- SigD NoExt (SCCFunSig NoExt _ (L _ n) _)
+pattern SCCPragma n <- SigD NoExtField (SCCFunSig NoExtField _ (L _ n) _)
-pattern AnnTypePragma n <- AnnD NoExt (HsAnnotation NoExt _ (TypeAnnProvenance (L _ n)) _)
+pattern AnnTypePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (TypeAnnProvenance (L _ n)) _)
-pattern AnnValuePragma n <- AnnD NoExt (HsAnnotation NoExt _ (ValueAnnProvenance (L _ n)) _)
+pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _)
-pattern Pattern n <- ValD NoExt (PatSynBind NoExt (PSB _ (L _ n) _ _ _))
+pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _))
-pattern DataDeclaration n <- TyClD NoExt (DataDecl NoExt (L _ n) _ _ _)
+pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _)
 
 -- Declarations which can refer to multiple names
 
@@ -249,51 +250,51 @@ pattern PatternSignature n <- (patSigRdrNames -> Just n)
 pattern WarningPragma n <- (warnSigRdrNames -> Just n)
 
 pattern DocNext, DocPrev :: HsDecl GhcPs
-pattern DocNext <- (DocD NoExt (DocCommentNext _))
+pattern DocNext <- (DocD NoExtField (DocCommentNext _))
-pattern DocPrev <- (DocD NoExt (DocCommentPrev _))
+pattern DocPrev <- (DocD NoExtField (DocCommentPrev _))
 
 sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
-sigRdrNames (SigD NoExt (TypeSig NoExt ns _)) = Just $ map unLoc ns
+sigRdrNames (SigD NoExtField (TypeSig NoExtField ns _)) = Just $ map unLoc ns
-sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns
+sigRdrNames (SigD NoExtField (ClassOpSig NoExtField _ ns _)) = Just $ map unLoc ns
-sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns
+sigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns
 sigRdrNames _ = Nothing
 
 defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
-defSigRdrNames (SigD NoExt (ClassOpSig NoExt True ns _)) = Just $ map unLoc ns
+defSigRdrNames (SigD NoExtField (ClassOpSig NoExtField True ns _)) = Just $ map unLoc ns
 defSigRdrNames _ = Nothing
 
 funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
-funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]
+funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _ _)) = Just [n]
-funRdrNames (ValD NoExt (PatBind NoExt n _ _)) = Just $ patBindNames n
+funRdrNames (ValD NoExtField (PatBind NoExtField (L _ n) _ _)) = Just $ patBindNames n
 funRdrNames _ = Nothing
 
 patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
-patSigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns
+patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns
 patSigRdrNames _ = Nothing
 
 warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
-warnSigRdrNames (WarningD NoExt (Warnings NoExt _ ws)) = Just $ flip concatMap ws $ \case
+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case
-  L _ (Warning NoExt ns _) -> map unLoc ns
+  L _ (Warning NoExtField ns _) -> map unLoc ns
-  L _ (XWarnDecl NoExt) -> []
+  L _ (XWarnDecl x) -> noExtCon x
 warnSigRdrNames _ = Nothing
 
 patBindNames :: Pat GhcPs -> [RdrName]
-patBindNames (TuplePat NoExt ps _) = concatMap (patBindNames . unLoc) ps
+patBindNames (TuplePat NoExtField ps _) = concatMap (patBindNames . unLoc) ps
-patBindNames (VarPat NoExt (L _ n)) = [n]
+patBindNames (VarPat NoExtField (L _ n)) = [n]
-patBindNames (WildPat NoExt) = []
+patBindNames (WildPat NoExtField) = []
-patBindNames (LazyPat NoExt p) = patBindNames p
+patBindNames (LazyPat NoExtField (L _ p)) = patBindNames p
-patBindNames (BangPat NoExt p) = patBindNames p
+patBindNames (BangPat NoExtField (L _ p)) = patBindNames p
-patBindNames (ParPat NoExt p) = patBindNames p
+patBindNames (ParPat NoExtField (L _ p)) = patBindNames p
-patBindNames (ListPat NoExt ps) = concatMap (patBindNames . unLoc) ps
+patBindNames (ListPat NoExtField ps) = concatMap (patBindNames . unLoc) ps
-patBindNames (AsPat NoExt (L _ n) p) = n : patBindNames p
+patBindNames (AsPat NoExtField (L _ n) (L _ p)) = n : patBindNames p
-patBindNames (SumPat NoExt p _ _) = patBindNames p
+patBindNames (SumPat NoExtField (L _ p) _ _) = patBindNames p
-patBindNames (ViewPat NoExt _ p) = patBindNames p
+patBindNames (ViewPat NoExtField _ (L _ p)) = patBindNames p
-patBindNames (SplicePat NoExt _) = []
+patBindNames (SplicePat NoExtField _) = []
-patBindNames (LitPat NoExt _) = []
+patBindNames (LitPat NoExtField _) = []
-patBindNames (SigPat _ p _) = patBindNames p
+patBindNames (SigPat _ (L _ p) _) = patBindNames p
-patBindNames (NPat NoExt _ _ _) = []
+patBindNames (NPat NoExtField _ _ _) = []
-patBindNames (NPlusKPat NoExt (L _ n) _ _ _ _) = [n]
+patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n]
 patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)
 patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer
-patBindNames (CoPat NoExt _ p _) = patBindNames p
+patBindNames (CoPat NoExtField _ p _) = patBindNames p
-patBindNames (XPat p) = patBindNames (unLoc p)
+patBindNames (XPat x) = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Annotation.hs

@@ -10,15 +10,14 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration.Value
-import Ormolu.Utils
 
 p_annDecl :: AnnDecl GhcPs -> R ()
 p_annDecl = \case
-  HsAnnotation NoExt _ annProv expr -> pragma "ANN" . inci $ do
+  HsAnnotation NoExtField _ annProv expr -> pragma "ANN" . inci $ do
     p_annProv annProv
     breakpoint
     located expr p_hsExpr
-  XAnnDecl {} -> notImplemented "XAnnDecl"
+  XAnnDecl x -> noExtCon x
 
 p_annProv :: AnnProvenance (IdP GhcPs) -> R ()
 p_annProv = \case

src/Ormolu/Printer/Meat/Declaration/Class.hs

@@ -18,7 +18,6 @@ import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
 import Ormolu.Printer.Meat.Type
-import Ormolu.Utils
 import RdrName (RdrName (..))
 
 p_classDecl ::
@@ -30,7 +29,7 @@ p_classDecl ::
   [LSig GhcPs] ->
   LHsBinds GhcPs ->
   [LFamilyDecl GhcPs] ->
-  [LTyFamDefltEqn GhcPs] ->
+  [LTyFamDefltDecl GhcPs] ->
   [LDocDecl] ->
   R ()
 p_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
       -- location order. This happens because different declarations are stored
       -- in different lists. Consequently, to get all the declarations in proper
       -- order, they need to be manually sorted.
-      sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs
+      sigs = (getLoc &&& fmap (SigD NoExtField)) <$> csigs
-      vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs
+      vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cdefs
-      tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats
+      tyFams = (getLoc &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats
-      docs = (getLoc &&& fmap (DocD NoExt)) <$> cdocs
+      docs = (getLoc &&& fmap (DocD NoExtField)) <$> cdocs
       tyFamDefs =
-        ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt . defltEqnToInstDecl)
+        ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)
         )
           <$> catdefs
       allDecls =
@@ -70,7 +69,7 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d
   unless (null allDecls) $ do
     breakpoint -- Ensure whitespace is added after where clause.
     inci (p_hsDeclsRespectGrouping Associated allDecls)
-p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"
+p_classDecl _ _ (XLHsQTyVars c) _ _ _ _ _ _ _ = noExtCon c
 
 p_classContext :: LHsContext GhcPs -> R ()
 p_classContext ctx = unless (null (unLoc ctx)) $ do
@@ -97,13 +96,6 @@ p_funDep (before, after) = do
 ----------------------------------------------------------------------------
 -- Helpers
 
-defltEqnToInstDecl :: TyFamDefltEqn GhcPs -> TyFamInstDecl GhcPs
-defltEqnToInstDecl FamEqn {..} = TyFamInstDecl {..}
-  where
-    eqn = FamEqn {feqn_pats = map HsValArg (tyVarsToTypes feqn_pats), ..}
-    tfid_eqn = HsIB {hsib_ext = NoExt, hsib_body = eqn}
-defltEqnToInstDecl XFamEqn {} = notImplemented "XFamEqn"
-
 isInfix :: LexicalFixity -> Bool
 isInfix = \case
   Infix -> True

src/Ormolu/Printer/Meat/Declaration/Data.hs

@@ -76,7 +76,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
   unless (null $ unLoc dd_derivs) breakpoint
   inci . located dd_derivs $ \xs ->
     sep newline (located' p_hsDerivingClause) xs
-p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
+p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x
 
 p_conDecl :: ConDecl GhcPs -> R ()
 p_conDecl = \case
@@ -106,7 +106,7 @@ p_conDecl = \case
                 else breakpoint
         interArgBreak
         when (unLoc con_forall) $ do
-          p_forallBndrs p_hsTyVarBndr (hsq_explicit con_qvars)
+          p_forallBndrs ForallInvis p_hsTyVarBndr (hsq_explicit con_qvars)
           interArgBreak
         forM_ con_mb_cxt p_lhsContext
         case con_args of
@@ -134,7 +134,7 @@ p_conDecl = \case
             <> conArgsSpans con_args
     switchLayout conDeclSpn $ do
       when (unLoc con_forall) $ do
-        p_forallBndrs p_hsTyVarBndr con_ex_tvs
+        p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs
         breakpoint
       forM_ con_mb_cxt p_lhsContext
       case con_args of
@@ -153,7 +153,7 @@ p_conDecl = \case
             p_rdrName con_name
             space
             located y p_hsType
-  XConDecl NoExt -> notImplemented "XConDecl"
+  XConDecl x -> noExtCon x
 
 conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]
 conArgsSpans = \case
@@ -167,7 +167,7 @@ conArgsSpans = \case
 conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]
 conTyVarsSpans = \case
   HsQTvs {..} -> getLoc <$> hsq_explicit
-  XLHsQTyVars NoExt -> []
+  XLHsQTyVars x -> noExtCon x
 
 p_lhsContext ::
   LHsContext GhcPs ->
@@ -225,9 +225,9 @@ p_hsDerivingClause HsDerivingClause {..} = do
           txt "via"
           space
           located hsib_body p_hsType
-      ViaStrategy (XHsImplicitBndrs NoExt) ->
+      ViaStrategy (XHsImplicitBndrs x) ->
-        notImplemented "XHsImplicitBndrs"
+        noExtCon x
-p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"
+p_hsDerivingClause (XHsDerivingClause x) = noExtCon x
 
 ----------------------------------------------------------------------------
 -- Helpers

src/Ormolu/Printer/Meat/Declaration/Default.hs

@@ -9,13 +9,12 @@ where
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Type
-import Ormolu.Utils
 
 p_defaultDecl :: DefaultDecl GhcPs -> R ()
 p_defaultDecl = \case
-  DefaultDecl NoExt ts -> do
+  DefaultDecl NoExtField ts -> do
     txt "default"
     breakpoint
     inci . parens N . sitcc $
       sep (comma >> breakpoint) (sitcc . located' p_hsType) ts
-  XDefaultDecl {} -> notImplemented "XDefaultDecl"
+  XDefaultDecl x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Foreign.hs

@@ -15,7 +15,6 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration.Signature
-import Ormolu.Utils
 
 p_foreignDecl :: ForeignDecl GhcPs -> R ()
 p_foreignDecl = \case
@@ -25,7 +24,7 @@ p_foreignDecl = \case
   fd@ForeignExport {fd_fe} -> do
     p_foreignExport fd_fe
     p_foreignTypeSig fd
-  XForeignDecl {} -> notImplemented "XForeignDecl"
+  XForeignDecl x -> noExtCon x
 
 -- | Printer for the last part of an import\/export, which is function name
 -- and type signature.
@@ -39,7 +38,7 @@ p_foreignTypeSig fd = do
       ]
     $ do
       p_rdrName (fd_name fd)
-      p_typeAscription (HsWC NoExt (fd_sig_ty fd))
+      p_typeAscription (HsWC NoExtField (fd_sig_ty fd))
 
 -- | Printer for 'ForeignImport'.
 --

src/Ormolu/Printer/Meat/Declaration/Instance.hs

@@ -56,8 +56,8 @@ p_standaloneDerivDecl DerivDecl {..} = do
         inci (located hsib_body p_hsType)
         breakpoint
         instTypes True
-      ViaStrategy (XHsImplicitBndrs NoExt) ->
+      ViaStrategy (XHsImplicitBndrs x) ->
-        notImplemented "XHsImplicitBndrs"
+        noExtCon x
 p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"
 
 p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
@@ -70,14 +70,14 @@ p_clsInstDecl = \case
         -- location order. This happens because different declarations are stored in
         -- different lists. Consequently, to get all the declarations in proper
         -- order, they need to be manually sorted.
-        let sigs = (getLoc &&& fmap (SigD NoExt)) <$> cid_sigs
+        let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs
-            vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cid_binds
+            vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds
             tyFamInsts =
-              ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt)
+              ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)
               )
                 <$> cid_tyfam_insts
             dataFamInsts =
-              ( getLoc &&& fmap (InstD NoExt . DataFamInstD NoExt)
+              ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)
               )
                 <$> cid_datafam_insts
             allDecls =
@@ -96,8 +96,8 @@ p_clsInstDecl = \case
             -- Ensure whitespace is added after where clause.
             breakpoint
             dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls
-      XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
+      XHsImplicitBndrs x -> noExtCon x
-  XClsInstDecl NoExt -> notImplemented "XClsInstDecl"
+  XClsInstDecl x -> noExtCon x
 
 p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
 p_tyFamInstDecl style = \case

src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs

@@ -12,14 +12,13 @@ import CoAxiom
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
-import Ormolu.Utils
 import RdrName (RdrName (..))
 import SrcLoc (Located)
 
 p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()
 p_roleAnnot = \case
-  RoleAnnotDecl NoExt l_name anns -> p_roleAnnot' l_name anns
+  RoleAnnotDecl NoExtField l_name anns -> p_roleAnnot' l_name anns
-  XRoleAnnotDecl _ -> notImplemented "XRoleAnnotDecl"
+  XRoleAnnotDecl x -> noExtCon x
 
 p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()
 p_roleAnnot' l_name anns = do

src/Ormolu/Printer/Meat/Declaration/Rule.hs

@@ -14,18 +14,17 @@ import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration.Signature
 import Ormolu.Printer.Meat.Declaration.Value
 import Ormolu.Printer.Meat.Type
-import Ormolu.Utils
 
 p_ruleDecls :: RuleDecls GhcPs -> R ()
 p_ruleDecls = \case
-  HsRules NoExt _ xs ->
+  HsRules NoExtField _ xs ->
     pragma "RULES" . sitcc $
       sep breakpoint (sitcc . located' p_ruleDecl) xs
-  XRuleDecls NoExt -> notImplemented "XRuleDecls"
+  XRuleDecls x -> noExtCon x
 
 p_ruleDecl :: RuleDecl GhcPs -> R ()
 p_ruleDecl = \case
-  HsRule NoExt ruleName activation tyvars ruleBndrs lhs rhs -> do
+  HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs -> do
     located ruleName p_ruleName
     space
     p_activation activation
@@ -33,13 +32,13 @@ p_ruleDecl = \case
     case tyvars of
       Nothing -> return ()
       Just xs -> do
-        p_forallBndrs p_hsTyVarBndr xs
+        p_forallBndrs ForallInvis p_hsTyVarBndr xs
         space
     -- It appears that there is no way to tell if there was an empty forall
     -- in the input or no forall at all. We do not want to add redundant
     -- foralls, so let's just skip the empty ones.
     unless (null ruleBndrs) $
-      p_forallBndrs p_ruleBndr ruleBndrs
+      p_forallBndrs ForallInvis p_ruleBndr ruleBndrs
     breakpoint
     inci $ do
       located lhs p_hsExpr
@@ -48,15 +47,15 @@ p_ruleDecl = \case
       inci $ do
         breakpoint
         located rhs p_hsExpr
-  XRuleDecl NoExt -> notImplemented "XRuleDecl"
+  XRuleDecl x -> noExtCon x
 
 p_ruleName :: (SourceText, RuleName) -> R ()
-p_ruleName (_, name) = atom $ HsString NoSourceText name
+p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs)
 
 p_ruleBndr :: RuleBndr GhcPs -> R ()
 p_ruleBndr = \case
-  RuleBndr NoExt x -> p_rdrName x
+  RuleBndr NoExtField x -> p_rdrName x
-  RuleBndrSig NoExt x hswc -> parens N $ do
+  RuleBndrSig NoExtField x hswc -> parens N $ do
     p_rdrName x
     p_typeAscription hswc
-  XRuleBndr NoExt -> notImplemented "XRuleBndr"
+  XRuleBndr x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Signature.hs

@@ -22,16 +22,16 @@ import Ormolu.Utils
 
 p_sigDecl :: Sig GhcPs -> R ()
 p_sigDecl = \case
-  TypeSig NoExt names hswc -> p_typeSig True names hswc
+  TypeSig NoExtField names hswc -> p_typeSig True names hswc
-  PatSynSig NoExt names hsib -> p_patSynSig names hsib
+  PatSynSig NoExtField names hsib -> p_patSynSig names hsib
-  ClassOpSig NoExt def names hsib -> p_classOpSig def names hsib
+  ClassOpSig NoExtField def names hsib -> p_classOpSig def names hsib
-  FixSig NoExt sig -> p_fixSig sig
+  FixSig NoExtField sig -> p_fixSig sig
-  InlineSig NoExt name inlinePragma -> p_inlineSig name inlinePragma
+  InlineSig NoExtField name inlinePragma -> p_inlineSig name inlinePragma
-  SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma
+  SpecSig NoExtField name ts inlinePragma -> p_specSig name ts inlinePragma
-  SpecInstSig NoExt _ hsib -> p_specInstSig hsib
+  SpecInstSig NoExtField _ hsib -> p_specInstSig hsib
-  MinimalSig NoExt _ booleanFormula -> p_minimalSig booleanFormula
+  MinimalSig NoExtField _ booleanFormula -> p_minimalSig booleanFormula
-  CompleteMatchSig NoExt _sourceText cs ty -> p_completeSig cs ty
+  CompleteMatchSig NoExtField _sourceText cs ty -> p_completeSig cs ty
-  SCCFunSig NoExt _ name literal -> p_sccSig name literal
+  SCCFunSig NoExtField _ name literal -> p_sccSig name literal
   _ -> notImplemented "certain types of signature declarations"
 
 p_typeSig ::
@@ -65,7 +65,7 @@ p_typeAscription HsWC {..} = do
       then newline
       else breakpoint
     located t p_hsType
-p_typeAscription (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"
+p_typeAscription (XHsWildCardBndrs x) = noExtCon x
 
 p_patSynSig ::
   [Located RdrName] ->
@@ -73,7 +73,7 @@ p_patSynSig ::
   R ()
 p_patSynSig names hsib = do
   txt "pattern"
-  let body = p_typeSig False names HsWC {hswc_ext = NoExt, hswc_body = hsib}
+  let body = p_typeSig False names HsWC {hswc_ext = NoExtField, hswc_body = hsib}
   if length names > 1
     then breakpoint >> inci body
     else space >> body
@@ -88,13 +88,13 @@ p_classOpSig ::
   R ()
 p_classOpSig def names hsib = do
   when def (txt "default" >> space)
-  p_typeSig True names HsWC {hswc_ext = NoExt, hswc_body = hsib}
+  p_typeSig True names HsWC {hswc_ext = NoExtField, hswc_body = hsib}
 
 p_fixSig ::
   FixitySig GhcPs ->
   R ()
 p_fixSig = \case
-  FixitySig NoExt names (Fixity _ n dir) -> do
+  FixitySig NoExtField names (Fixity _ n dir) -> do
     txt $ case dir of
       InfixL -> "infixl"
       InfixR -> "infixr"
@@ -103,7 +103,7 @@ p_fixSig = \case
     atom n
     space
     sitcc $ sep (comma >> breakpoint) p_rdrName names
-  XFixitySig NoExt -> notImplemented "XFixitySig"
+  XFixitySig x -> noExtCon x
 
 p_inlineSig ::
   -- | Name

src/Ormolu/Printer/Meat/Declaration/Splice.hs

@@ -8,9 +8,8 @@ where
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)
-import Ormolu.Utils
 
 p_spliceDecl :: SpliceDecl GhcPs -> R ()
 p_spliceDecl = \case
-  SpliceDecl NoExt splice _explicit -> located splice p_hsSplice
+  SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice
-  XSpliceDecl {} -> notImplemented "XSpliceDecl"
+  XSpliceDecl x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Type.hs

@@ -11,7 +11,6 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
-import Ormolu.Utils (notImplemented)
 import RdrName (RdrName (..))
 import SrcLoc (Located)
 
@@ -38,4 +37,4 @@ p_synDecl name fixity HsQTvs {..} t = do
   txt "="
   breakpoint
   inci (located t p_hsType)
-p_synDecl _ _ XLHsQTyVars {} _ = notImplemented "XLHsQTyVars"
+p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs

@@ -57,7 +57,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do
           sep newline (located' (inci . p_tyFamInstEqn)) eqs
 p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} =
   notImplemented "XLHsQTyVars"
-p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"
+p_famDecl _ (XFamilyDecl x) = noExtCon x
 
 p_familyResultSigL ::
   Located (FamilyResultSig GhcPs) ->
@@ -65,17 +65,17 @@ p_familyResultSigL ::
 p_familyResultSigL l =
   case l of
     L _ a -> case a of
-      NoSig NoExt -> Nothing
+      NoSig NoExtField -> Nothing
-      KindSig NoExt k -> Just $ do
+      KindSig NoExtField k -> Just $ do
         txt "::"
         breakpoint
         located k p_hsType
-      TyVarSig NoExt bndr -> Just $ do
+      TyVarSig NoExtField bndr -> Just $ do
         txt "="
         breakpoint
         located bndr p_hsTyVarBndr
-      XFamilyResultSig NoExt ->
+      XFamilyResultSig x ->
-        notImplemented "XFamilyResultSig"
+        noExtCon x
 
 p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
 p_injectivityAnn (InjectivityAnn a bs) = do
@@ -92,7 +92,7 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do
   case feqn_bndrs of
     Nothing -> return ()
     Just bndrs -> do
-      p_forallBndrs p_hsTyVarBndr bndrs
+      p_forallBndrs ForallInvis p_hsTyVarBndr bndrs
       breakpoint
   (if null feqn_bndrs then id else inci) $ do
     let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats
@@ -106,8 +106,8 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do
     txt "="
     breakpoint
     inci (located feqn_rhs p_hsType)
-p_tyFamInstEqn HsIB {hsib_body = XFamEqn {}} = notImplemented "HsIB XFamEqn"
+p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x
-p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"
+p_tyFamInstEqn (XHsImplicitBndrs x) = noExtCon x
 
 ----------------------------------------------------------------------------
 -- Helpers

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Ormolu.Printer.Meat.Declaration.Value
   ( p_valDecl,
@@ -65,12 +66,12 @@ data Placement
 
 p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
 p_valDecl = \case
-  FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches
+  FunBind NoExtField funId funMatches _ _ -> p_funBind funId funMatches
-  PatBind NoExt pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss
+  PatBind NoExtField pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss
   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker
   AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker
-  PatSynBind NoExt psb -> p_patSynBind psb
+  PatSynBind NoExtField psb -> p_patSynBind psb
-  XHsBindsLR NoExt -> notImplemented "XHsBindsLR"
+  XHsBindsLR x -> noExtCon x
 
 p_funBind ::
   Located RdrName ->
@@ -114,8 +115,8 @@ p_matchGroup' placer render style MG {..} = do
         (matchStrictness m)
         m_pats
         m_grhss
-    p_Match _ = notImplemented "XMatch"
+    p_Match (XMatch x) = noExtCon x
-p_matchGroup' _ _ _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"
+p_matchGroup' _ _ _ (XMatchGroup x) = noExtCon x
 
 -- | Function id obtained through pattern matching on 'FunBind' should not
 -- 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
               then id
               else inci
       switchLayout [combinedSpans] $ do
-        let stdCase = sep breakpoint p_pat m_pats
+        let stdCase = sep breakpoint (located' p_pat) m_pats
         case style of
           Function name ->
             p_infixDefHelper
               isInfix
               inci'
               (p_rdrName name)
-              (p_pat <$> m_pats)
+              (located' p_pat <$> m_pats)
           PatternBind -> stdCase
           Case -> stdCase
           Lambda -> do
@@ -266,7 +267,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
     switchLayout [patGrhssSpan] $
       placeHanging placement p_body
     inci p_where
-p_match' _ _ _ _ _ _ XGRHSs {} = notImplemented "XGRHSs"
+p_match' _ _ _ _ _ _ (XGRHSs x) = noExtCon x
 
 p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
 p_grhs = p_grhs' exprPlacement p_hsExpr
@@ -280,7 +281,7 @@ p_grhs' ::
   GroupStyle ->
   GRHS GhcPs (Located body) ->
   R ()
-p_grhs' placer render style (GRHS NoExt guards body) =
+p_grhs' placer render style (GRHS NoExtField guards body) =
   case guards of
     [] -> p_body
     xs -> do
@@ -305,11 +306,11 @@ p_grhs' placer render style (GRHS NoExt guards body) =
         Nothing -> Nothing
         Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs
     p_body = located body render
-p_grhs' _ _ _ (XGRHS NoExt) = notImplemented "XGRHS"
+p_grhs' _ _ _ (XGRHS x) = noExtCon x
 
 p_hsCmd :: HsCmd GhcPs -> R ()
 p_hsCmd = \case
-  HsCmdArrApp NoExt body input arrType _ -> do
+  HsCmdArrApp NoExtField body input arrType _ -> do
     located body p_hsExpr
     space
     case arrType of
@@ -317,42 +318,42 @@ p_hsCmd = \case
       HsHigherOrderApp -> txt "-<<"
     placeHanging (exprPlacement (unLoc input)) $
       located input p_hsExpr
-  HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do
+  HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
     located form p_hsExpr
     unless (null cmds) $ do
       breakpoint
       inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))
-  HsCmdArrForm NoExt form Infix _ [left, right] -> do
+  HsCmdArrForm NoExtField form Infix _ [left, right] -> do
     located left p_hsCmdTop
     space
     located form p_hsExpr
     placeHanging (cmdTopPlacement (unLoc right)) $
       located right p_hsCmdTop
-  HsCmdArrForm NoExt _ Infix _ _ -> notImplemented "HsCmdArrForm"
+  HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"
   HsCmdApp {} ->
     -- XXX Does this ever occur in the syntax tree? It does not seem like it
     -- does. Open an issue and ping @yumiova if this ever occurs in output.
     notImplemented "HsCmdApp"
-  HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup
+  HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup
-  HsCmdPar NoExt c -> parens N (located c p_hsCmd)
+  HsCmdPar NoExtField c -> parens N (located c p_hsCmd)
-  HsCmdCase NoExt e mgroup ->
+  HsCmdCase NoExtField e mgroup ->
     p_case cmdPlacement p_hsCmd e mgroup
-  HsCmdIf NoExt _ if' then' else' ->
+  HsCmdIf NoExtField _ if' then' else' ->
     p_if cmdPlacement p_hsCmd if' then' else'
-  HsCmdLet NoExt localBinds c ->
+  HsCmdLet NoExtField localBinds c ->
     p_let p_hsCmd localBinds c
-  HsCmdDo NoExt es -> do
+  HsCmdDo NoExtField es -> do
     txt "do"
     newline
     inci . located es $
       sitcc . sep newline (located' (sitcc . p_stmt' cmdPlacement p_hsCmd))
   HsCmdWrap {} -> notImplemented "HsCmdWrap"
-  XCmd {} -> notImplemented "XCmd"
+  XCmd x -> noExtCon x
 
 p_hsCmdTop :: HsCmdTop GhcPs -> R ()
 p_hsCmdTop = \case
-  HsCmdTop NoExt cmd -> located cmd p_hsCmd
+  HsCmdTop NoExtField cmd -> located cmd p_hsCmd
-  XCmdTop {} -> notImplemented "XHsCmdTop"
+  XCmdTop x -> noExtCon x
 
 p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
 p_stmt = p_stmt' exprPlacement p_hsExpr
@@ -367,16 +368,13 @@ p_stmt' ::
   Stmt GhcPs (Located body) ->
   R ()
 p_stmt' placer render = \case
-  LastStmt NoExt body _ _ -> located body render
+  LastStmt NoExtField body _ _ -> located body render
-  BindStmt NoExt p f _ _ -> do
+  BindStmt NoExtField p f _ _ -> do
-    p_pat p
+    located p p_pat
     space
     txt "<-"
-    -- https://gitlab.haskell.org/ghc/ghc/issues/17330
+    let loc = getLoc p
-    let loc = case p of
+        placement =
-          XPat pat -> getLoc pat
-          _ -> error "p_stmt': BindStmt: Pat does not contain a location"
-    let placement =
           case f of
             L l' x ->
               if isOneLineSpan
@@ -386,8 +384,8 @@ p_stmt' placer render = \case
     switchLayout [loc, getLoc f] $
       placeHanging placement (located f render)
   ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer
-  BodyStmt NoExt body _ _ -> located body render
+  BodyStmt NoExtField body _ _ -> located body render
-  LetStmt NoExt binds -> do
+  LetStmt NoExtField binds -> do
     txt "let"
     space
     sitcc $ located binds p_hsLocalBinds
@@ -429,10 +427,10 @@ p_stmt' placer render = \case
     txt "rec"
     space
     sitcc $ sepSemi (located' (p_stmt' placer render)) recS_stmts
-  XStmtLR {} -> notImplemented "XStmtLR"
+  XStmtLR c -> noExtCon c
 
 gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
-gatherStmt (L _ (ParStmt NoExt block _ _)) =
+gatherStmt (L _ (ParStmt NoExtField block _ _)) =
   foldr ((<>) . gatherStmtBlock) [] block
 gatherStmt (L s stmt@TransStmt {..}) =
   foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]])
@@ -441,11 +439,11 @@ gatherStmt stmt = [[stmt]]
 gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
 gatherStmtBlock (ParStmtBlock _ stmts _ _) =
   foldr (liftAppend . gatherStmt) [] stmts
-gatherStmtBlock XParStmtBlock {} = notImplemented "XParStmtBlock"
+gatherStmtBlock (XParStmtBlock x) = noExtCon x
 
 p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
 p_hsLocalBinds = \case
-  HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do
+  HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
     let ssStart =
           either
             (srcSpanStart . getLoc)
@@ -467,20 +465,23 @@ p_hsLocalBinds = \case
       sepSemi
         (\(m, i) -> (if m then br else id) $ p_item i)
         (markInit $ sortOn ssStart items)
-  HsValBinds NoExt _ -> notImplemented "HsValBinds"
+  HsValBinds NoExtField _ -> notImplemented "HsValBinds"
-  HsIPBinds NoExt (IPBinds NoExt xs) ->
+  HsIPBinds NoExtField (IPBinds NoExtField xs) ->
     -- Second argument of IPBind is always Left before type-checking.
-    let p_ipBind (IPBind NoExt (Left name) expr) = do
+    let p_ipBind (IPBind NoExtField (Left name) expr) = do
           atom name
           space
           txt "="
           breakpoint
           useBraces $ inci $ located expr p_hsExpr
-        p_ipBind _ = notImplemented "XHsIPBinds"
+        p_ipBind (IPBind NoExtField (Right _) _) =
+          -- Should only occur after the type checker
+          notImplemented "IPBind _ (Right _) _"
+        p_ipBind (XIPBind x) = noExtCon x
      in sepSemi (located' p_ipBind) xs
-  HsIPBinds NoExt _ -> notImplemented "HsIpBinds"
+  HsIPBinds NoExtField _ -> notImplemented "HsIpBinds"
-  EmptyLocalBinds NoExt -> return ()
+  EmptyLocalBinds NoExtField -> return ()
-  XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"
+  XHsLocalBindsLR x -> noExtCon x
 
 p_hsRecField ::
   HsRecField' RdrName (LHsExpr GhcPs) ->
@@ -495,42 +496,42 @@ p_hsRecField HsRecField {..} = do
 
 p_hsTupArg :: HsTupArg GhcPs -> R ()
 p_hsTupArg = \case
-  Present NoExt x -> located x p_hsExpr
+  Present NoExtField x -> located x p_hsExpr
-  Missing NoExt -> pure ()
+  Missing NoExtField -> pure ()
-  XTupArg {} -> notImplemented "XTupArg"
+  XTupArg x -> noExtCon x
 
 p_hsExpr :: HsExpr GhcPs -> R ()
 p_hsExpr = p_hsExpr' N
 
 p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
 p_hsExpr' s = \case
-  HsVar NoExt name -> p_rdrName name
+  HsVar NoExtField name -> p_rdrName name
-  HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"
+  HsUnboundVar NoExtField v -> atom (unboundVarOcc v)
-  HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"
+  HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut"
-  HsRecFld NoExt x ->
+  HsRecFld NoExtField x ->
     case x of
-      Unambiguous NoExt name -> p_rdrName name
+      Unambiguous NoExtField name -> p_rdrName name
-      Ambiguous NoExt name -> p_rdrName name
+      Ambiguous NoExtField name -> p_rdrName name
-      XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"
+      XAmbiguousFieldOcc xx -> noExtCon xx
-  HsOverLabel NoExt _ v -> do
+  HsOverLabel NoExtField _ v -> do
     txt "#"
     atom v
-  HsIPVar NoExt (HsIPName name) -> do
+  HsIPVar NoExtField (HsIPName name) -> do
     txt "?"
     atom name
-  HsOverLit NoExt v -> atom (ol_val v)
+  HsOverLit NoExtField v -> atom (ol_val v)
-  HsLit NoExt lit ->
+  HsLit NoExtField lit ->
     case lit of
       HsString (SourceText stxt) _ -> p_stringLit stxt
       HsStringPrim (SourceText stxt) _ -> p_stringLit stxt
       r -> atom r
-  HsLam NoExt mgroup ->
+  HsLam NoExtField mgroup ->
     p_matchGroup Lambda mgroup
-  HsLamCase NoExt mgroup -> do
+  HsLamCase NoExtField mgroup -> do
     txt "\\case"
     breakpoint
     inci (p_matchGroup LambdaCase mgroup)
-  HsApp NoExt f x -> do
+  HsApp NoExtField f x -> do
     let -- In order to format function applications with multiple parameters
         -- nicer, traverse the AST to gather the function and all the
         -- parameters together.
@@ -564,9 +565,9 @@ p_hsExpr' s = \case
             -- expression is parenthesised.
             indent =
               case func of
-                L _ (HsPar NoExt _) -> inci
+                L _ (HsPar NoExtField _) -> inci
-                L _ (HsAppType NoExt _ _) -> inci
+                L _ (HsAppType NoExtField _ _) -> inci
-                L _ (HsMultiIf NoExt _) -> inci
+                L _ (HsMultiIf NoExtField _) -> inci
                 L spn _ ->
                   if isOneLineSpan spn
                     then inci
@@ -588,35 +589,35 @@ p_hsExpr' s = \case
           sep breakpoint (located' p_hsExpr) initp
         placeHanging placement $
           located lastp p_hsExpr
-  HsAppType NoExt e a -> do
+  HsAppType NoExtField e a -> do
     located e p_hsExpr
     breakpoint
     inci $ do
       txt "@"
       located (hswc_body a) p_hsType
-  OpApp NoExt x op y -> do
+  OpApp NoExtField x op y -> do
     let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
     p_exprOpTree True s (reassociateOpTree getOpName opTree)
-  NegApp NoExt e _ -> do
+  NegApp NoExtField e _ -> do
     txt "-"
     space
     located e p_hsExpr
-  HsPar NoExt e ->
+  HsPar NoExtField e ->
     parens s (located e (dontUseBraces . p_hsExpr))
-  SectionL NoExt x op -> do
+  SectionL NoExtField x op -> do
     located x p_hsExpr
     breakpoint
     inci (located op p_hsExpr)
-  SectionR NoExt op x -> do
+  SectionR NoExtField op x -> do
     located op p_hsExpr
     useRecordDot' <- useRecordDot
     let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
     unless (useRecordDot' && isRecordDot') breakpoint
     inci (located x p_hsExpr)
-  ExplicitTuple NoExt args boxity -> do
+  ExplicitTuple NoExtField args boxity -> do
     let isSection = any (isMissing . unLoc) args
         isMissing = \case
-          Missing NoExt -> True
+          Missing NoExtField -> True
           _ -> False
     let parens' =
           case boxity of
@@ -629,18 +630,18 @@ p_hsExpr' s = \case
       else
         switchLayout (getLoc <$> args) . parens' s . sitcc $
           sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
-  ExplicitSum NoExt tag arity e ->
+  ExplicitSum NoExtField tag arity e ->
     p_unboxedSum N tag arity (located e p_hsExpr)
-  HsCase NoExt e mgroup ->
+  HsCase NoExtField e mgroup ->
     p_case exprPlacement p_hsExpr e mgroup
-  HsIf NoExt _ if' then' else' ->
+  HsIf NoExtField _ if' then' else' ->
     p_if exprPlacement p_hsExpr if' then' else'
-  HsMultiIf NoExt guards -> do
+  HsMultiIf NoExtField guards -> do
     txt "if "
     inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
-  HsLet NoExt localBinds e ->
+  HsLet NoExtField localBinds e ->
     p_let p_hsExpr localBinds e
-  HsDo NoExt ctx es -> do
+  HsDo NoExtField ctx es -> do
     let doBody header = do
           txt header
           breakpoint
@@ -685,10 +686,10 @@ p_hsExpr' s = \case
     breakpoint
     let HsRecFields {..} = rcon_flds
         updName f =
-          f
+          (f :: HsRecField GhcPs (LHsExpr GhcPs))
             { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of
                 FieldOcc _ n -> n
-                XFieldOcc _ -> notImplemented "XFieldOcc"
+                XFieldOcc x -> noExtCon x
             }
         fields = located' (p_hsRecField . updName) <$> rec_flds
         dotdot =
@@ -708,27 +709,26 @@ p_hsExpr' s = \case
             == (srcSpanStartCol <$> mrs (head rupd_flds))
     unless (useRecordDot' && isPluginForm) breakpoint
     let updName f =
-          f
+          (f :: HsRecUpdField GhcPs)
             { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of
                 Ambiguous _ n -> n
                 Unambiguous _ n -> n
-                XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"
+                XAmbiguousFieldOcc x -> noExtCon x
             }
     inci . braces N . sitcc $
       sep
         (comma >> breakpoint)
         (sitcc . located' (p_hsRecField . updName))
         rupd_flds
-  ExprWithTySig NoExt x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
+  ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
     located x p_hsExpr
     space
     txt "::"
     breakpoint
     inci $ located hsib_body p_hsType
-  ExprWithTySig NoExt _ HsWC {hswc_body = XHsImplicitBndrs {}} ->
+  ExprWithTySig NoExtField _ HsWC {hswc_body = XHsImplicitBndrs x} -> noExtCon x
-    notImplemented "XHsImplicitBndrs"
+  ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
-  ExprWithTySig NoExt _ XHsWildCardBndrs {} -> notImplemented "XHsWildCardBndrs"
+  ArithSeq NoExtField _ x ->
-  ArithSeq NoExt _ x ->
     case x of
       From from -> brackets s . sitcc $ do
         located from p_hsExpr
@@ -750,25 +750,25 @@ p_hsExpr' s = \case
         txt ".."
         space
         located to p_hsExpr
-  HsSCC NoExt _ name x -> do
+  HsSCC NoExtField _ name x -> do
     txt "{-# SCC "
     atom name
     txt " #-}"
     breakpoint
     located x p_hsExpr
-  HsCoreAnn NoExt _ value x -> do
+  HsCoreAnn NoExtField _ value x -> do
     txt "{-# CORE "
     atom value
     txt " #-}"
     breakpoint
     located x p_hsExpr
-  HsBracket NoExt x -> p_hsBracket x
+  HsBracket NoExtField x -> p_hsBracket x
   HsRnBracketOut {} -> notImplemented "HsRnBracketOut"
   HsTcBracketOut {} -> notImplemented "HsTcBracketOut"
-  HsSpliceE NoExt splice -> p_hsSplice splice
+  HsSpliceE NoExtField splice -> p_hsSplice splice
-  HsProc NoExt p e -> do
+  HsProc NoExtField p e -> do
     txt "proc"
-    locatedPat p $ \x -> do
+    located p $ \x -> do
       breakpoint
       inci (p_pat x)
       breakpoint
@@ -779,31 +779,11 @@ p_hsExpr' s = \case
     txt "static"
     breakpoint
     inci (located e p_hsExpr)
-  HsArrApp NoExt body input arrType cond ->
-    p_hsCmd (HsCmdArrApp NoExt body input arrType cond)
-  HsArrForm NoExt form mfixity cmds ->
-    p_hsCmd (HsCmdArrForm NoExt form Prefix mfixity cmds)
   HsTick {} -> notImplemented "HsTick"
   HsBinTick {} -> notImplemented "HsBinTick"
   HsTickPragma {} -> notImplemented "HsTickPragma"
-  -- These four constructs should never appear in correct programs.
-  -- See: https://github.com/tweag/ormolu/issues/343
-  EWildPat NoExt -> txt "_"
-  EAsPat NoExt n p -> do
-    p_rdrName n
-    txt "@"
-    located p p_hsExpr
-  EViewPat NoExt p e -> do
-    located p p_hsExpr
-    space
-    txt "->"
-    breakpoint
-    inci (located e p_hsExpr)
-  ELazyPat NoExt p -> do
-    txt "~"
-    located p p_hsExpr
   HsWrap {} -> notImplemented "HsWrap"
-  XExpr {} -> notImplemented "XExpr"
+  XExpr x -> noExtCon x
 
 p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
 p_patSynBind PSB {..} = do
@@ -813,15 +793,15 @@ p_patSynBind PSB {..} = do
           Unidirectional -> do
             txt "<-"
             breakpoint
-            p_pat psb_def
+            located psb_def p_pat
           ImplicitBidirectional -> do
             txt "="
             breakpoint
-            p_pat psb_def
+            located psb_def p_pat
           ExplicitBidirectional mgroup -> do
             txt "<-"
             breakpoint
-            p_pat psb_def
+            located psb_def p_pat
             newline
             txt "where"
             newline
@@ -855,7 +835,7 @@ p_patSynBind PSB {..} = do
           space
           p_rdrName r
       inci rhs
-p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
+p_patSynBind (XPatSynBind x) = noExtCon x
 
 p_case ::
   Data body =>
@@ -922,40 +902,37 @@ p_let render localBinds e = sitcc $ do
 
 p_pat :: Pat GhcPs -> R ()
 p_pat = \case
-  -- Note: starting from GHC 8.8, 'LPat' == 'Pat'. Located 'Pat's are always
+  WildPat NoExtField -> txt "_"
-  -- constructed with the 'XPat' constructor, containing a @Located Pat@.
+  VarPat NoExtField name -> p_rdrName name
-  XPat pat -> located pat p_pat
+  LazyPat NoExtField pat -> do
-  WildPat NoExt -> txt "_"
-  VarPat NoExt name -> p_rdrName name
-  LazyPat NoExt pat -> do
     txt "~"
-    p_pat pat
+    located pat p_pat
-  AsPat NoExt name pat -> do
+  AsPat NoExtField name pat -> do
     p_rdrName name
     txt "@"
-    p_pat pat
+    located pat p_pat
-  ParPat NoExt pat ->
+  ParPat NoExtField pat ->
-    locatedPat pat (parens S . p_pat)
+    located pat (parens S . p_pat)
-  BangPat NoExt pat -> do
+  BangPat NoExtField pat -> do
     txt "!"
-    p_pat pat
+    located pat p_pat
-  ListPat NoExt pats ->
+  ListPat NoExtField pats ->
-    brackets S . sitcc $ sep (comma >> breakpoint) p_pat pats
+    brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
-  TuplePat NoExt pats boxing -> do
+  TuplePat NoExtField pats boxing -> do
     let f =
           case boxing of
             Boxed -> parens S
             Unboxed -> parensHash S
-    f . sitcc $ sep (comma >> breakpoint) (sitcc . p_pat) pats
+    f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
-  SumPat NoExt pat tag arity ->
+  SumPat NoExtField pat tag arity ->
-    p_unboxedSum S tag arity (p_pat pat)
+    p_unboxedSum S tag arity (located pat p_pat)
   ConPatIn pat details ->
     case details of
       PrefixCon xs -> sitcc $ do
         p_rdrName pat
         unless (null xs) $ do
           breakpoint
-          inci . sitcc $ sep breakpoint (sitcc . p_pat) xs
+          inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs
       RecCon (HsRecFields fields dotdot) -> do
         p_rdrName pat
         breakpoint
@@ -965,36 +942,37 @@ p_pat = \case
         inci . braces N . sitcc . sep (comma >> breakpoint) f $
           case dotdot of
             Nothing -> Just <$> fields
-            Just n -> (Just <$> take n fields) ++ [Nothing]
+            Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
       InfixCon l r -> do
         switchLayout [getLoc l, getLoc r] $ do
-          p_pat l
+          located l p_pat
           breakpoint
           inci $ do
             p_rdrName pat
             space
-            p_pat r
+            located r p_pat
   ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?
-  ViewPat NoExt expr pat -> sitcc $ do
+  ViewPat NoExtField expr pat -> sitcc $ do
     located expr p_hsExpr
     space
     txt "->"
     breakpoint
-    inci (p_pat pat)
+    inci (located pat p_pat)
-  SplicePat NoExt splice -> p_hsSplice splice
+  SplicePat NoExtField splice -> p_hsSplice splice
-  LitPat NoExt p -> atom p
+  LitPat NoExtField p -> atom p
-  NPat NoExt v _ _ -> located v (atom . ol_val)
+  NPat NoExtField v _ _ -> located v (atom . ol_val)
-  NPlusKPat NoExt n k _ _ _ -> sitcc $ do
+  NPlusKPat NoExtField n k _ _ _ -> sitcc $ do
     p_rdrName n
     breakpoint
     inci $ do
       txt "+"
       space
       located k (atom . ol_val)
-  SigPat NoExt pat hswc -> do
+  SigPat NoExtField pat hswc -> do
-    p_pat pat
+    located pat p_pat
     p_typeAscription hswc
   CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage
+  XPat x -> noExtCon x
 
 p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
 p_pat_hsRecField HsRecField {..} = do
@@ -1004,7 +982,7 @@ p_pat_hsRecField HsRecField {..} = do
     space
     txt "="
     breakpoint
-    inci (p_pat hsRecFieldArg)
+    inci (located hsRecFieldArg p_pat)
 
 p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
 p_unboxedSum s tag arity m = do
@@ -1025,9 +1003,9 @@ p_unboxedSum s tag arity m = do
 
 p_hsSplice :: HsSplice GhcPs -> R ()
 p_hsSplice = \case
-  HsTypedSplice NoExt deco _ expr -> p_hsSpliceTH True expr deco
+  HsTypedSplice NoExtField deco _ expr -> p_hsSpliceTH True expr deco
-  HsUntypedSplice NoExt deco _ expr -> p_hsSpliceTH False expr deco
+  HsUntypedSplice NoExtField deco _ expr -> p_hsSpliceTH False expr deco
-  HsQuasiQuote NoExt _ quoterName srcSpan str -> do
+  HsQuasiQuote NoExtField _ quoterName srcSpan str -> do
     txt "["
     p_rdrName (L srcSpan quoterName)
     txt "|"
@@ -1037,7 +1015,7 @@ p_hsSplice = \case
     txt "|]"
   HsSpliced {} -> notImplemented "HsSpliced"
   HsSplicedT {} -> notImplemented "HsSplicedT"
-  XSplice {} -> notImplemented "XSplice"
+  XSplice x -> noExtCon x
 
 p_hsSpliceTH ::
   -- | Typed splice?
@@ -1061,17 +1039,17 @@ p_hsSpliceTH isTyped expr = \case
 
 p_hsBracket :: HsBracket GhcPs -> R ()
 p_hsBracket = \case
-  ExpBr NoExt expr -> do
+  ExpBr NoExtField expr -> do
     anns <- getEnclosingAnns
     let name = case anns of
           AnnOpenEQ : _ -> ""
           _ -> "e"
     quote name (located expr p_hsExpr)
-  PatBr NoExt pat -> quote "p" (p_pat pat)
+  PatBr NoExtField pat -> located pat (quote "p" . p_pat)
-  DecBrL NoExt decls -> quote "d" (p_hsDecls Free decls)
+  DecBrL NoExtField decls -> quote "d" (p_hsDecls Free decls)
-  DecBrG NoExt _ -> notImplemented "DecBrG" -- result of renamer
+  DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer
-  TypBr NoExt ty -> quote "t" (located ty p_hsType)
+  TypBr NoExtField ty -> quote "t" (located ty p_hsType)
-  VarBr NoExt isSingleQuote name -> do
+  VarBr NoExtField isSingleQuote name -> do
     txt (bool "''" "'" isSingleQuote)
     -- HACK As you can see we use 'noLoc' here to be able to pass name into
     -- 'p_rdrName' since the latter expects a "located" thing. The problem
@@ -1086,13 +1064,13 @@ p_hsBracket = \case
             && not (doesNotNeedExtraParens name)
         wrapper = if isOperator then parens N else id
     wrapper $ p_rdrName (noLoc name)
-  TExpBr NoExt expr -> do
+  TExpBr NoExtField expr -> do
     txt "[||"
     breakpoint'
     located expr p_hsExpr
     breakpoint'
     txt "||]"
-  XBracket {} -> notImplemented "XBracket"
+  XBracket x -> noExtCon x
   where
     quote :: Text -> R () -> R ()
     quote name body = do
@@ -1171,9 +1149,9 @@ liftAppend (x : xs) [] = x : xs
 liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys
 
 getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
-getGRHSSpan (GRHS NoExt guards body) =
+getGRHSSpan (GRHS NoExtField guards body) =
   combineSrcSpans' $ getLoc body :| map getLoc guards
-getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"
+getGRHSSpan (XGRHS x) = noExtCon x
 
 -- | Place a thing that may have a hanging form. This function handles how
 -- to separate it from preceding expressions and whether to bump indentation
@@ -1194,67 +1172,63 @@ blockPlacement ::
   (body -> Placement) ->
   [LGRHS GhcPs (Located body)] ->
   Placement
-blockPlacement placer [L _ (GRHS NoExt _ (L _ x))] = placer x
+blockPlacement placer [L _ (GRHS NoExtField _ (L _ x))] = placer x
 blockPlacement _ _ = Normal
 
 -- | Check if given command has a hanging form.
 cmdPlacement :: HsCmd GhcPs -> Placement
 cmdPlacement = \case
-  HsCmdLam NoExt _ -> Hanging
+  HsCmdLam NoExtField _ -> Hanging
-  HsCmdCase NoExt _ _ -> Hanging
+  HsCmdCase NoExtField _ _ -> Hanging
-  HsCmdDo NoExt _ -> Hanging
+  HsCmdDo NoExtField _ -> Hanging
   _ -> Normal
 
 cmdTopPlacement :: HsCmdTop GhcPs -> Placement
 cmdTopPlacement = \case
-  HsCmdTop NoExt (L _ x) -> cmdPlacement x
+  HsCmdTop NoExtField (L _ x) -> cmdPlacement x
-  XCmdTop {} -> notImplemented "XCmdTop"
+  XCmdTop x -> noExtCon x
 
 -- | Check if given expression has a hanging form.
 exprPlacement :: HsExpr GhcPs -> Placement
 exprPlacement = \case
   -- Only hang lambdas with single line parameter lists
-  HsLam NoExt mg -> case mg of
+  HsLam NoExtField mg -> case mg of
-    MG _ (L _ [L _ (Match NoExt _ (x : xs) _)]) _
+    MG _ (L _ [L _ (Match NoExtField _ (x : xs) _)]) _
       | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) ->
         Hanging
     _ -> Normal
-  HsLamCase NoExt _ -> Hanging
+  HsLamCase NoExtField _ -> Hanging
-  HsCase NoExt _ _ -> Hanging
+  HsCase NoExtField _ _ -> Hanging
-  HsDo NoExt DoExpr _ -> Hanging
+  HsDo NoExtField DoExpr _ -> Hanging
-  HsDo NoExt MDoExpr _ -> Hanging
+  HsDo NoExtField MDoExpr _ -> Hanging
   -- If the rightmost expression in an operator chain is hanging, make the
   -- whole block hanging; so that we can use the common @f = foo $ do@
   -- style.
-  OpApp NoExt _ _ y -> exprPlacement (unLoc y)
+  OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
   -- Same thing for function applications (usually with -XBlockArguments)
-  HsApp NoExt _ y -> exprPlacement (unLoc y)
+  HsApp NoExtField _ y -> exprPlacement (unLoc y)
-  HsProc NoExt p _ ->
+  HsProc NoExtField p _ ->
-    -- https://gitlab.haskell.org/ghc/ghc/issues/17330
+    -- Indentation breaks if pattern is longer than one line and left
-    let loc = case p of
+    -- hanging. Consequently, only apply hanging when it is safe.
-          XPat pat -> getLoc pat
+    if isOneLineSpan (getLoc p)
-          _ -> error "exprPlacement: HsProc: Pat does not contain a location"
+      then Hanging
-     in -- Indentation breaks if pattern is longer than one line and left
+      else Normal
-        -- hanging. Consequently, only apply hanging when it is safe.
-        if isOneLineSpan loc
-          then Hanging
-          else Normal
   _ -> Normal
 
 withGuards :: [LGRHS GhcPs (Located body)] -> Bool
 withGuards = any (checkOne . unLoc)
   where
     checkOne :: GRHS GhcPs (Located body) -> Bool
-    checkOne (GRHS NoExt [] _) = False
+    checkOne (GRHS NoExtField [] _) = False
     checkOne _ = True
 
 exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)
+exprOpTree (L _ (OpApp NoExtField x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)
 exprOpTree n = OpNode n
 
 getOpName :: HsExpr GhcPs -> Maybe RdrName
 getOpName = \case
-  HsVar NoExt (L _ a) -> Just a
+  HsVar NoExtField (L _ a) -> Just a
   _ -> Nothing
 
 p_exprOpTree ::
@@ -1276,8 +1250,10 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
             OpNode (L _ n) -> exprPlacement n
             _ -> Normal
           else Normal
+      -- Distinguish holes used in infix notation.
+      -- eg. '1 _foo 2' and '1 `_foo` 2'
       opWrapper = case unLoc op of
-        EWildPat NoExt -> backticks
+        HsUnboundVar NoExtField _ -> backticks
         _ -> id
   layout <- getLayout
   let ub = case layout of
@@ -1332,7 +1308,7 @@ isRecordDot ::
   SrcSpan ->
   Bool
 isRecordDot op (RealSrcSpan ySpan) = case op of
-  HsVar NoExt (L (RealSrcSpan opSpan) opName) ->
+  HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
     isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
   _ -> False
 isRecordDot _ _ = False

src/Ormolu/Printer/Meat/Declaration/Warning.hs

@@ -13,17 +13,16 @@ import Data.Text (Text)
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
-import Ormolu.Utils
 
 p_warnDecls :: WarnDecls GhcPs -> R ()
-p_warnDecls (Warnings NoExt _ warnings) =
+p_warnDecls (Warnings NoExtField _ warnings) =
   traverse_ (located' p_warnDecl) warnings
-p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"
+p_warnDecls (XWarnDecls x) = noExtCon x
 
 p_warnDecl :: WarnDecl GhcPs -> R ()
-p_warnDecl (Warning NoExt functions warningTxt) =
+p_warnDecl (Warning NoExtField functions warningTxt) =
   p_topLevelWarning functions warningTxt
-p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
+p_warnDecl (XWarnDecl x) = noExtCon x
 
 p_moduleWarning :: WarningTxt -> R ()
 p_moduleWarning wtxt = do

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -11,10 +11,9 @@ where
 
 import Control.Monad
 import GHC
-import HsImpExp (IE (..))
+import GHC.Hs.ImpExp (IE (..))
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
-import Ormolu.Utils
 
 p_hsmodExports :: [LIE GhcPs] -> R ()
 p_hsmodExports [] = do
@@ -34,7 +33,9 @@ p_hsmodImport ImportDecl {..} = do
   space
   when ideclSafe (txt "safe")
   space
-  when ideclQualified (txt "qualified")
+  when
+    (isImportDeclQualified ideclQualified)
+    (txt "qualified")
   space
   case ideclPkgQual of
     Nothing -> return ()
@@ -62,22 +63,22 @@ p_hsmodImport ImportDecl {..} = do
           layout <- getLayout
           sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)
     newline
-p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"
+p_hsmodImport (XImportDecl x) = noExtCon x
 
 p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()
 p_lie encLayout (i, totalItems) = \case
-  IEVar NoExt l1 -> do
+  IEVar NoExtField l1 -> do
     located l1 p_ieWrappedName
     p_comma
-  IEThingAbs NoExt l1 -> do
+  IEThingAbs NoExtField l1 -> do
     located l1 p_ieWrappedName
     p_comma
-  IEThingAll NoExt l1 -> do
+  IEThingAll NoExtField l1 -> do
     located l1 p_ieWrappedName
     space
     txt "(..)"
     p_comma
-  IEThingWith NoExt l1 w xs _ -> sitcc $ do
+  IEThingWith NoExtField l1 w xs _ -> sitcc $ do
     located l1 p_ieWrappedName
     breakpoint
     inci $ do
@@ -91,16 +92,16 @@ p_lie encLayout (i, totalItems) = \case
             let (before, after) = splitAt n names
              in before ++ [txt ".."] ++ after
     p_comma
-  IEModuleContents NoExt l1 -> do
+  IEModuleContents NoExtField l1 -> do
     located l1 p_hsmodName
     p_comma
-  IEGroup NoExt n str -> do
+  IEGroup NoExtField n str -> do
     unless (i == 0) newline
     p_hsDocString (Asterisk n) False (noLoc str)
-  IEDoc NoExt str ->
+  IEDoc NoExtField str ->
     p_hsDocString Pipe False (noLoc str)
-  IEDocNamed NoExt str -> p_hsDocName str
+  IEDocNamed NoExtField str -> p_hsDocName str
-  XIE NoExt -> notImplemented "XIE"
+  XIE x -> noExtCon x
   where
     p_comma =
       case encLayout of

src/Ormolu/Printer/Meat/Type.hs

@@ -27,11 +27,11 @@ p_hsType t = p_hsType' (hasDocStrings t) t
 
 p_hsType' :: Bool -> HsType GhcPs -> R ()
 p_hsType' multilineArgs = \case
-  HsForAllTy NoExt bndrs t -> do
+  HsForAllTy NoExtField visibility bndrs t -> do
-    p_forallBndrs p_hsTyVarBndr bndrs
+    p_forallBndrs visibility p_hsTyVarBndr bndrs
     interArgBreak
     p_hsType' multilineArgs (unLoc t)
-  HsQualTy NoExt qs t -> do
+  HsQualTy NoExtField qs t -> do
     located qs p_hsContext
     space
     txt "=>"
@@ -40,7 +40,7 @@ p_hsType' multilineArgs = \case
       HsQualTy {} -> p_hsTypeR (unLoc t)
       HsFunTy {} -> p_hsTypeR (unLoc t)
       _ -> located t p_hsTypeR
-  HsTyVar NoExt p n -> do
+  HsTyVar NoExtField p n -> do
     case p of
       IsPromoted -> do
         txt "'"
@@ -49,7 +49,7 @@ p_hsType' multilineArgs = \case
           _ -> return ()
       NotPromoted -> return ()
     p_rdrName n
-  HsAppTy NoExt f x -> sitcc $ do
+  HsAppTy NoExtField f x -> sitcc $ do
     located f p_hsType
     breakpoint
     inci (located x p_hsType)
@@ -62,7 +62,7 @@ p_hsType' multilineArgs = \case
     inci $ do
       txt "@"
       located kd p_hsType
-  HsFunTy NoExt x y@(L _ y') -> do
+  HsFunTy NoExtField x y@(L _ y') -> do
     located x p_hsType
     space
     txt "->"
@@ -70,9 +70,9 @@ p_hsType' multilineArgs = \case
     case y' of
       HsFunTy {} -> p_hsTypeR y'
       _ -> located y p_hsTypeR
-  HsListTy NoExt t ->
+  HsListTy NoExtField t ->
     located t (brackets N . p_hsType)
-  HsTupleTy NoExt tsort xs ->
+  HsTupleTy NoExtField tsort xs ->
     let parens' =
           case tsort of
             HsUnboxedTuple -> parensHash N
@@ -81,33 +81,33 @@ p_hsType' multilineArgs = \case
             HsBoxedOrConstraintTuple -> parens N
      in parens' . sitcc $
           sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
-  HsSumTy NoExt xs ->
+  HsSumTy NoExtField xs ->
     parensHash N . sitcc $
       sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs
-  HsOpTy NoExt x op y ->
+  HsOpTy NoExtField x op y ->
     sitcc $
       let opTree = OpBranch (tyOpTree x) op (tyOpTree y)
        in p_tyOpTree (reassociateOpTree Just opTree)
-  HsParTy NoExt t ->
+  HsParTy NoExtField t ->
     parens N (located t p_hsType)
-  HsIParamTy NoExt n t -> sitcc $ do
+  HsIParamTy NoExtField n t -> sitcc $ do
     located n atom
     space
     txt "::"
     breakpoint
     inci (located t p_hsType)
-  HsStarTy NoExt _ -> txt "*"
+  HsStarTy NoExtField _ -> txt "*"
-  HsKindSig NoExt t k -> sitcc $ do
+  HsKindSig NoExtField t k -> sitcc $ do
     located t p_hsType
     space -- FIXME
     txt "::"
     space
     inci (located k p_hsType)
-  HsSpliceTy NoExt splice -> p_hsSplice splice
+  HsSpliceTy NoExtField splice -> p_hsSplice splice
-  HsDocTy NoExt t str -> do
+  HsDocTy NoExtField t str -> do
     p_hsDocString Pipe True str
     located t p_hsType
-  HsBangTy NoExt (HsSrcBang _ u s) t -> do
+  HsBangTy NoExtField (HsSrcBang _ u s) t -> do
     case u of
       SrcUnpack -> txt "{-# UNPACK #-}" >> space
       SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space
@@ -117,9 +117,9 @@ p_hsType' multilineArgs = \case
       SrcStrict -> txt "!"
       NoSrcStrict -> return ()
     located t p_hsType
-  HsRecTy NoExt fields ->
+  HsRecTy NoExtField fields ->
     p_conDeclFields fields
-  HsExplicitListTy NoExt p xs -> do
+  HsExplicitListTy NoExtField p xs -> do
     case p of
       IsPromoted -> txt "'"
       NotPromoted -> return ()
@@ -130,18 +130,18 @@ p_hsType' multilineArgs = \case
         (IsPromoted, L _ t : _) | isPromoted t -> space
         _ -> return ()
       sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
-  HsExplicitTupleTy NoExt xs -> do
+  HsExplicitTupleTy NoExtField xs -> do
     txt "'"
     parens N $ do
       case xs of
         L _ t : _ | isPromoted t -> space
         _ -> return ()
       sep (comma >> breakpoint) (located' p_hsType) xs
-  HsTyLit NoExt t ->
+  HsTyLit NoExtField t ->
     case t of
       HsStrTy (SourceText s) _ -> p_stringLit s
       a -> atom a
-  HsWildCardTy NoExt -> txt "_"
+  HsWildCardTy NoExtField -> txt "_"
   XHsType (NHsCoreTy t) -> atom t
   where
     isPromoted = \case
@@ -173,26 +173,29 @@ p_hsContext = \case
 
 p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
 p_hsTyVarBndr = \case
-  UserTyVar NoExt x ->
+  UserTyVar NoExtField x ->
     p_rdrName x
-  KindedTyVar NoExt l k -> parens N $ do
+  KindedTyVar NoExtField l k -> parens N $ do
     located l atom
     space
     txt "::"
     breakpoint
     inci (located k p_hsType)
-  XTyVarBndr NoExt -> notImplemented "XTyVarBndr"
+  XTyVarBndr x -> noExtCon x
 
 -- | Render several @forall@-ed variables.
-p_forallBndrs :: Data a => (a -> R ()) -> [Located a] -> R ()
+p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
-p_forallBndrs _ [] = txt "forall."
+p_forallBndrs ForallInvis _ [] = txt "forall."
-p_forallBndrs p tyvars =
+p_forallBndrs ForallVis _ [] = txt "forall ->"
+p_forallBndrs vis p tyvars =
   switchLayout (getLoc <$> tyvars) $ do
     txt "forall"
     breakpoint
     inci $ do
       sitcc $ sep breakpoint (sitcc . located' p) tyvars
-      txt "."
+      case vis of
+        ForallInvis -> txt "."
+        ForallVis -> space >> txt "->"
 
 p_conDeclFields :: [LConDeclField GhcPs] -> R ()
 p_conDeclFields xs =
@@ -211,10 +214,10 @@ p_conDeclField ConDeclField {..} = do
   txt "::"
   breakpoint
   sitcc . inci $ p_hsType (unLoc cd_fld_type)
-p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
+p_conDeclField (XConDeclField x) = noExtCon x
 
 tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
-tyOpTree (L _ (HsOpTy NoExt l op r)) =
+tyOpTree (L _ (HsOpTy NoExtField l op r)) =
   OpBranch (tyOpTree l) op (tyOpTree r)
 tyOpTree n = OpNode n
 
@@ -235,17 +238,17 @@ p_tyOpTree (OpBranch l op r) = do
 tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
 tyVarsToTypes = \case
   HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit
-  XLHsQTyVars {} -> notImplemented "XLHsQTyVars"
+  XLHsQTyVars x -> noExtCon x
 
 tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
 tyVarToType = \case
-  UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar
+  UserTyVar NoExtField tvar -> HsTyVar NoExtField NotPromoted tvar
-  KindedTyVar NoExt tvar kind ->
+  KindedTyVar NoExtField tvar kind ->
     -- Note: we always add parentheses because for whatever reason GHC does
     -- not use HsParTy for left-hand sides of declarations. Please see
     -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as
     -- long as 'tyVarToType' does not get applied to right-hand sides of
     -- declarations.
-    HsParTy NoExt $ noLoc $
+    HsParTy NoExtField $ noLoc $
-      HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind
+      HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind
-  XTyVarBndr {} -> notImplemented "XTyVarBndr"
+  XTyVarBndr x -> noExtCon x

src/Ormolu/Utils.hs

@@ -22,7 +22,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import GHC
-import HsDoc (HsDocString, unpackHDS)
+import GHC.Hs.Doc (HsDocString, unpackHDS)
 import qualified Outputable as GHC
 
 -- | Combine all source spans from the given list.