packages feed

hindent 6.1.1 → 6.2.0

raw patch · 98 files changed

+7208/−3117 lines, 98 filesdep +asyncdep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependencies added: async

Dependency ranges changed: ghc-lib-parser

API changes (from Hackage documentation)

+ HIndent: defaultExtensions :: [Extension]

Files

CHANGELOG.md view
@@ -4,18 +4,42 @@  ### Added -- Support for GHC 9.8 ([#775]).+### Changed +### Fixed++### Removed++## [6.2.0] - 2024-09-07++### Added++- Support for GHC 9.8 ([#775]) and GHC 9.10([#904]).+- Support for `ImportPostQualified` ([#875]).+- HIndent now formats multiple files in parallel ([#914]).+ ### Changed +- The formatting style of import declarations with constructors ([#829]).+- HIndent no longer inserts an empty line after a standalone kind signature ([#873]).+- Bumped Stack LTS to 22.26 ([#918]).+- HIndent re-assumes the default extensions are enabled ([#904]).+ ### Fixed  - Wrong default HIndent configuration in [`README.md`] ([#750]). - Fix the bug of panicking when the given source code has CPP lines and space-prefixed lines ([#780]). - Fix not pretty-printing multiple signatures in a `SPECIALISE` ([#784]).+- Fix the bug of not pretty-printing multiple module-level warning messages ([#822])+- Fix the bug of wrongly converting a `newtype` instance to a `data` one ([#839])+- Fix the bug of not pretty-printing multiple functional dependencies in a typeclass ([#843])+- Fix the bug of not pretty-printing data declarations with records and typeclass constraints ([#849])+- Fix the bug of not pretty-printing unboxed tuples ([#868])  ### Removed +- Support for GHC 8.10 ([#950])+ ## [6.1.0] - 2023-05-17  ### Added@@ -368,6 +392,17 @@ [@uhbif19]: https://github.com/uhbif19 [@toku-sa-n]: https://github.com/toku-sa-n +[#918]: https://github.com/mihaimaruseac/hindent/pull/918+[#914]: https://github.com/mihaimaruseac/hindent/pull/914+[#904]: https://github.com/mihaimaruseac/hindent/pull/904+[#875]: https://github.com/mihaimaruseac/hindent/pull/875+[#873]: https://github.com/mihaimaruseac/hindent/pull/873+[#868]: https://github.com/mihaimaruseac/hindent/pull/868+[#849]: https://github.com/mihaimaruseac/hindent/pull/849+[#843]: https://github.com/mihaimaruseac/hindent/pull/843+[#839]: https://github.com/mihaimaruseac/hindent/pull/839+[#829]: https://github.com/mihaimaruseac/hindent/pull/829+[#822]: https://github.com/mihaimaruseac/hindent/pull/822 [#784]: https://github.com/mihaimaruseac/hindent/pull/784 [#780]: https://github.com/mihaimaruseac/hindent/pull/780 [#775]: https://github.com/mihaimaruseac/hindent/pull/775
README.md view
@@ -58,7 +58,10 @@ force-trailing-newline: true sort-imports: true line-breaks: []-extensions: []+extensions: [+    "GHC2021",+    "ListTuplePuns",+] ```  By default, hindent preserves the newline or lack of newline in your input. With `force-trailing-newline`, it will make sure there is always a trailing newline.
TESTS.md view
@@ -60,6 +60,7 @@   , y   , Z   , P(x, z)+  , Q(..)   , module Foo   ) where ```@@ -77,22 +78,6 @@  ### Module-level pragmas -A `WARNING` for a module without an export list.--```haskell-module Foo {-# WARNING "Debug purpose only." #-} where-```--A `DEPRECATED` for a module with an export list.--```haskell-module Foo {-# DEPRECATED "Use Bar." #-}-  ( x-  , y-  , z-  ) where-```- A pragma's name is converted to the SHOUT_CASE.  ```haskell given@@ -183,6 +168,50 @@ static = 3 ``` +#### `WARNING`++Without messages and an export list.++```haskell+module Foo {-# WARNING [] #-} where+```++With a string without an export list.++```haskell+module Foo {-# WARNING "Debug purpose only." #-} where+```++With a list of reasons without an export list.++```haskell+module Foo {-# WARNING ["Debug purpose only.", "Okay?"] #-} where+```++#### `DEPRECATED`++Without messages and an export list.++```haskell+module Foo {-# DEPRECATED [] #-} where+```++With a string without an export list.++```haskell+module Foo {-# DEPRECATED "Use Bar." #-} where+```++With a list of reasons and an export list.++```haskell+module Foo {-# DEPRECATED ["Use Bar.", "Or use Baz."] #-}+  ( x+  , y+  , z+  ) where+```+ ## Imports, foreign imports, and foreign exports  Import lists@@ -275,10 +304,12 @@ An import declaration importing lots of data constructors  ```haskell-import Direction-  ( Direction(East, North, NorthEast, NorthWest, South, SouthEast,-          SouthWest, West)-  , allDirections+import Language+  ( Language(Ada, Ada, Assembly, C, CPlusPlus, CSharp, Clojure, Cobol, Dart, Elixir,+             Elm, Erlang, Fortran, Go, Groovy, Haskell, Java, JavaScript, Julia,+             Kotlin, Lisp, Lua, ObjectiveC, PHP, Pascal, Perl, Prolog, Python, Ruby,+             Rust, Scala)+  , allLanguages   ) ``` @@ -306,6 +337,14 @@ import qualified "base" Prelude as P ``` +`ImportQualifiedPost`++```haskell+{-# LANGUAGE ImportQualifiedPost #-}++import Data.Text qualified as T+```+ Importing a `#`  ```haskell@@ -378,6 +417,8 @@ {-# LANGUAGE StandaloneKindSignatures #-}  type Foo :: Type -> Type -> Type+data Foo a b =+  Foo a b ```  Default declaration@@ -552,6 +593,15 @@     } ``` +With associated newtypes++```haskell+-- https://github.com/mihaimaruseac/hindent/issues/837+instance Foo a where+  newtype Bar a =+    FooBar a+```+ #### With overlapping pragmas  `OVERLAPPING`@@ -784,10 +834,8 @@ Single  ```haskell--- https://github.com/mihaimaruseac/hindent/issues/278-data Link c1 c2 a c =-  forall b. (c1 a b, c2 b c) =>-            Link (Proxy b)+data D =+  forall a. D a ```  Multiple@@ -800,6 +848,46 @@   forall a b c. D a b c ``` +With an infix constructor++```haskell+data D =+  forall a. a :== a+```++#### Fields with contexts++Without a `forall`++```haskell+data Foo =+  Eq a => Foo a+```++With a `forall`++```haskell+-- https://github.com/mihaimaruseac/hindent/issues/278+data Link c1 c2 a c =+  forall b. (c1 a b, c2 b c) =>+            Link (Proxy b)+```++With an infix constructor without a `forall`++```haskell+data Foo =+  Eq a => a :== a+```++With an infix constructor with a `forall`++```haskell+data Foo =+  forall a. Eq a =>+            a :== a+```+ #### Derivings  With a single constructor@@ -1911,7 +1999,7 @@  #### Functional dependencies -Short+Single  ```haskell -- https://github.com/commercialhaskell/hindent/issues/323@@ -1919,6 +2007,12 @@   f :: a -> b ``` +Multiple dependencies in a line++```haskell+class Foo a b | a -> b, b -> a+```+ Long  ```haskell@@ -2745,6 +2839,17 @@ {-# LANGUAGE MagicHash #-}  a = "Foo"#+```++`UnboxedTuple`++```haskell+{-# LANGUAGE UnboxedTuples #-}++f :: (# Int, Int #) -> (# Int, Int #)+f t =+  case t of+    (# x, y #) -> (# x, y #) ```  `NumericUnderscores`
benchmarks/Main.hs view
@@ -32,7 +32,7 @@                (UTF8.toString desc)                (nf                   (either (error . show) id-                     . reformat HIndent.defaultConfig [] Nothing)+                     . reformat HIndent.defaultConfig defaultExtensions Nothing)                   code)                : go next         else go next
hindent.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           hindent-version:        6.1.1+version:        6.2.0 synopsis:       Extensible Haskell pretty printer description:    Extensible Haskell pretty printer. Both a library and an executable.                 See the GitHub page for usage \/ explanation: <https://github.com/mihaimaruseac/hindent>@@ -36,6 +36,80 @@       HIndent   other-modules:       HIndent.Applicative+      HIndent.Ast+      HIndent.Ast.Context+      HIndent.Ast.Declaration+      HIndent.Ast.Declaration.Annotation+      HIndent.Ast.Declaration.Annotation.Provenance+      HIndent.Ast.Declaration.Annotation.Role+      HIndent.Ast.Declaration.Bind+      HIndent.Ast.Declaration.Class+      HIndent.Ast.Declaration.Class.FunctionalDependency+      HIndent.Ast.Declaration.Class.NameAndTypeVariables+      HIndent.Ast.Declaration.Collection+      HIndent.Ast.Declaration.Data+      HIndent.Ast.Declaration.Data.Body+      HIndent.Ast.Declaration.Data.Deriving+      HIndent.Ast.Declaration.Data.Deriving.Clause+      HIndent.Ast.Declaration.Data.Deriving.Strategy+      HIndent.Ast.Declaration.Data.GADT.Constructor+      HIndent.Ast.Declaration.Data.GADT.Constructor.Signature+      HIndent.Ast.Declaration.Data.Haskell98.Constructor+      HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body+      HIndent.Ast.Declaration.Data.Header+      HIndent.Ast.Declaration.Data.NewOrData+      HIndent.Ast.Declaration.Data.Record.Field+      HIndent.Ast.Declaration.Default+      HIndent.Ast.Declaration.Family.Data+      HIndent.Ast.Declaration.Family.Type+      HIndent.Ast.Declaration.Family.Type.Injectivity+      HIndent.Ast.Declaration.Family.Type.ResultSignature+      HIndent.Ast.Declaration.Foreign+      HIndent.Ast.Declaration.Foreign.CallingConvention+      HIndent.Ast.Declaration.Foreign.Safety+      HIndent.Ast.Declaration.Instance.Class+      HIndent.Ast.Declaration.Instance.Class.OverlapMode+      HIndent.Ast.Declaration.Instance.Family.Data+      HIndent.Ast.Declaration.Instance.Family.Type+      HIndent.Ast.Declaration.Rule+      HIndent.Ast.Declaration.Rule.Binder+      HIndent.Ast.Declaration.Rule.Collection+      HIndent.Ast.Declaration.Signature+      HIndent.Ast.Declaration.Signature.BooleanFormula+      HIndent.Ast.Declaration.Signature.Fixity+      HIndent.Ast.Declaration.Signature.Fixity.Associativity+      HIndent.Ast.Declaration.Signature.Inline.Phase+      HIndent.Ast.Declaration.Signature.Inline.Spec+      HIndent.Ast.Declaration.Signature.StandaloneKind+      HIndent.Ast.Declaration.Splice+      HIndent.Ast.Declaration.StandAloneDeriving+      HIndent.Ast.Declaration.TypeSynonym+      HIndent.Ast.Declaration.TypeSynonym.Lhs+      HIndent.Ast.Declaration.Warning+      HIndent.Ast.Declaration.Warning.Collection+      HIndent.Ast.Declaration.Warning.Kind+      HIndent.Ast.Expression.Bracket+      HIndent.Ast.Expression.Splice+      HIndent.Ast.FileHeaderPragma+      HIndent.Ast.FileHeaderPragma.Collection+      HIndent.Ast.Import+      HIndent.Ast.Import.Collection+      HIndent.Ast.Import.Entry+      HIndent.Ast.Import.Entry.Collection+      HIndent.Ast.Import.ImportingOrHiding+      HIndent.Ast.Module+      HIndent.Ast.Module.Declaration+      HIndent.Ast.Module.Export.Collection+      HIndent.Ast.Module.Export.Entry+      HIndent.Ast.Module.Name+      HIndent.Ast.Module.Warning+      HIndent.Ast.Name.Infix+      HIndent.Ast.Name.Prefix+      HIndent.Ast.NodeComments+      HIndent.Ast.Role+      HIndent.Ast.Type+      HIndent.Ast.Type.Variable+      HIndent.Ast.WithComments       HIndent.ByteString       HIndent.CabalFile       HIndent.CodeBlock@@ -44,6 +118,8 @@       HIndent.Error       HIndent.Fixity       HIndent.GhcLibParserWrapper.GHC.Hs+      HIndent.GhcLibParserWrapper.GHC.Hs.ImpExp+      HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings       HIndent.Language       HIndent.LanguageExtension       HIndent.LanguageExtension.Conversion@@ -65,10 +141,7 @@       HIndent.Pretty.Combinators.String       HIndent.Pretty.Combinators.Switch       HIndent.Pretty.Combinators.Wrap-      HIndent.Pretty.Import-      HIndent.Pretty.Import.Sort       HIndent.Pretty.NodeComments-      HIndent.Pretty.Pragma       HIndent.Pretty.SigBindFamily       HIndent.Pretty.Types       HIndent.Printer@@ -77,16 +150,17 @@       Paths_hindent   hs-source-dirs:       src-  ghc-options: -Wall -O2+  ghc-options: -Wall -O2 -threaded   build-depends:       Cabal+    , async >=2.2.5     , base >=4.7 && <5     , bytestring     , containers     , directory     , exceptions     , filepath-    , ghc-lib-parser >=9.2 && <9.9+    , ghc-lib-parser >=9.2 && <9.11     , ghc-lib-parser-ex     , monad-loops     , mtl@@ -111,9 +185,10 @@       Paths_hindent   hs-source-dirs:       internal-  ghc-options: -Wall -O2+  ghc-options: -Wall -O2 -threaded   build-depends:       Cabal+    , async >=2.2.5     , base >=4.7 && <5     , bytestring     , containers@@ -121,7 +196,7 @@     , directory     , exceptions     , filepath-    , ghc-lib-parser >=9.2 && <9.9+    , ghc-lib-parser >=9.2 && <9.11     , ghc-lib-parser-ex     , monad-loops     , mtl@@ -145,16 +220,17 @@       Paths_hindent   hs-source-dirs:       app-  ghc-options: -Wall -O2+  ghc-options: -Wall -O2 -threaded   build-depends:       Cabal+    , async >=2.2.5     , base >=4.7 && <5     , bytestring     , containers     , directory     , exceptions     , filepath-    , ghc-lib-parser >=9.2 && <9.9+    , ghc-lib-parser >=9.2 && <9.11     , ghc-lib-parser-ex     , hindent     , monad-loops@@ -180,17 +256,18 @@       Paths_hindent   hs-source-dirs:       tests-  ghc-options: -Wall -O2+  ghc-options: -Wall -O2 -threaded   build-depends:       Cabal     , Diff+    , async >=2.2.5     , base >=4.7 && <5     , bytestring     , containers     , directory     , exceptions     , filepath-    , ghc-lib-parser >=9.2 && <9.9+    , ghc-lib-parser >=9.2 && <9.11     , ghc-lib-parser-ex     , hindent     , hindent-internal@@ -218,9 +295,10 @@       Paths_hindent   hs-source-dirs:       benchmarks-  ghc-options: -Wall -O2+  ghc-options: -Wall -O2 -threaded   build-depends:       Cabal+    , async >=2.2.5     , base >=4.7 && <5     , bytestring     , containers@@ -229,7 +307,7 @@     , directory     , exceptions     , filepath-    , ghc-lib-parser >=9.2 && <9.9+    , ghc-lib-parser >=9.2 && <9.11     , ghc-lib-parser-ex     , hindent     , hindent-internal
src/HIndent.hs view
@@ -15,6 +15,7 @@   , getConfig   , -- * Extension     Extension(..)+  , defaultExtensions   , -- * Error     ParseError(..)   , prettyParseError@@ -23,6 +24,7 @@   , HsModule'   ) where +import Control.Concurrent.Async import Control.Exception import Control.Monad import Data.ByteString (ByteString)@@ -39,6 +41,7 @@ import GHC.IO.Exception import GHC.Parser.Lexer hiding (buffer, options) import GHC.Types.SrcLoc+import HIndent.Ast import HIndent.ByteString import HIndent.CabalFile import HIndent.CodeBlock@@ -78,7 +81,7 @@         then S8.interact                (either (error . prettyParseError) id                   . reformat style exts Nothing)-        else forM_ paths $ \filepath -> do+        else forConcurrently_ paths $ \filepath -> do                cabalexts <- getCabalExtensionsForSourcePath filepath                text <- S.readFile filepath                case reformat style (cabalexts ++ exts) (Just filepath) text of@@ -181,5 +184,5 @@  -- | Print the module. prettyPrint :: Config -> HsModule' -> Builder-prettyPrint config m =-  runPrinterStyle config (pretty $ modifyASTForPrettyPrinting m)+prettyPrint config =+  runPrinterStyle config . pretty . mkModule . modifyASTForPrettyPrinting
+ src/HIndent/Ast.hs view
@@ -0,0 +1,17 @@+-- | This module defines the AST for Haskell code.+--+-- GHC provides its AST for Haskell code, but the structure it offers may change+-- with version updates. In other words, when directly using GHC's AST as the+-- AST for pretty-printing, updates in GHC require direct modifications to the+-- pretty-printing functions. On the other hand, when there is a need to change+-- the pretty-printing style, corresponding modifications to the functions are+-- also necessary. The presence of these two reasons for modification leads to a+-- suboptimal design state.+--+-- Therefore, this module defines a custom AST for HIndent, allowing flexibility+-- to adapt to changes in GHC's AST across different versions.+module HIndent.Ast+  ( mkModule+  ) where++import HIndent.Ast.Module
+ src/HIndent/Ast/Context.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Context+  ( Context+  , mkContext+  ) where++import HIndent.Ast.NodeComments+import HIndent.Ast.Type+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype Context =+  Context [WithComments Type]++instance CommentExtraction Context where+  nodeComments (Context _) = NodeComments [] [] []++instance Pretty Context where+  pretty' (Context xs) = hor <-|> ver+    where+      hor = parensConditional $ hCommaSep $ fmap pretty xs+        where+          parensConditional =+            case xs of+              [_] -> id+              _ -> parens+      ver =+        case xs of+          [] -> string "()"+          [x] -> pretty x+          _ -> vTuple $ fmap pretty xs++mkContext :: GHC.HsContext GHC.GhcPs -> Context+mkContext = Context . fmap (fmap mkType . fromGenLocated)
+ src/HIndent/Ast/Declaration.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration+  ( Declaration(..)+  , mkDeclaration+  , isSignature+  ) where++import Control.Applicative+import Data.Maybe+import HIndent.Ast.Declaration.Annotation+import HIndent.Ast.Declaration.Annotation.Role+import HIndent.Ast.Declaration.Bind+import HIndent.Ast.Declaration.Class+import HIndent.Ast.Declaration.Data+import HIndent.Ast.Declaration.Default+import HIndent.Ast.Declaration.Family.Data+import HIndent.Ast.Declaration.Family.Type+import HIndent.Ast.Declaration.Foreign+import HIndent.Ast.Declaration.Instance.Class+import HIndent.Ast.Declaration.Instance.Family.Data+import HIndent.Ast.Declaration.Instance.Family.Type+import HIndent.Ast.Declaration.Rule.Collection+import HIndent.Ast.Declaration.Signature+import HIndent.Ast.Declaration.Signature.StandaloneKind+import HIndent.Ast.Declaration.Splice+import HIndent.Ast.Declaration.StandAloneDeriving+import HIndent.Ast.Declaration.TypeSynonym+import HIndent.Ast.Declaration.Warning.Collection+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.NodeComments++data Declaration+  = DataFamily DataFamily+  | TypeFamily TypeFamily+  | DataDeclaration DataDeclaration+  | ClassDeclaration ClassDeclaration+  | TypeSynonym TypeSynonym+  | ClassInstance ClassInstance+  | DataFamilyInstance DataFamilyInstance+  | TypeFamilyInstance TypeFamilyInstance+  | StandAloneDeriving StandAloneDeriving+  | Bind Bind+  | Signature Signature+  | StandaloneKindSignature StandaloneKind+  | Default DefaultDeclaration+  | Foreign ForeignDeclaration+  | Warnings WarningCollection+  | Annotation Annotation+  | RuleDecl RuleCollection+  | Splice SpliceDeclaration+  | RoleAnnotDecl RoleAnnotation++instance CommentExtraction Declaration where+  nodeComments DataFamily {} = NodeComments [] [] []+  nodeComments TypeFamily {} = NodeComments [] [] []+  nodeComments DataDeclaration {} = NodeComments [] [] []+  nodeComments ClassDeclaration {} = NodeComments [] [] []+  nodeComments TypeSynonym {} = NodeComments [] [] []+  nodeComments ClassInstance {} = NodeComments [] [] []+  nodeComments DataFamilyInstance {} = NodeComments [] [] []+  nodeComments TypeFamilyInstance {} = NodeComments [] [] []+  nodeComments StandAloneDeriving {} = NodeComments [] [] []+  nodeComments Bind {} = NodeComments [] [] []+  nodeComments Signature {} = NodeComments [] [] []+  nodeComments StandaloneKindSignature {} = NodeComments [] [] []+  nodeComments Default {} = NodeComments [] [] []+  nodeComments Foreign {} = NodeComments [] [] []+  nodeComments Warnings {} = NodeComments [] [] []+  nodeComments Annotation {} = NodeComments [] [] []+  nodeComments RuleDecl {} = NodeComments [] [] []+  nodeComments Splice {} = NodeComments [] [] []+  nodeComments RoleAnnotDecl {} = NodeComments [] [] []++instance Pretty Declaration where+  pretty' (DataFamily x) = pretty x+  pretty' (TypeFamily x) = pretty x+  pretty' (DataDeclaration x) = pretty x+  pretty' (ClassDeclaration x) = pretty x+  pretty' (TypeSynonym x) = pretty x+  pretty' (ClassInstance x) = pretty x+  pretty' (DataFamilyInstance x) = pretty x+  pretty' (TypeFamilyInstance x) = pretty x+  pretty' (StandAloneDeriving x) = pretty x+  pretty' (Bind x) = pretty x+  pretty' (Signature x) = pretty x+  pretty' (StandaloneKindSignature x) = pretty x+  pretty' (Default x) = pretty x+  pretty' (Foreign x) = pretty x+  pretty' (Warnings x) = pretty x+  pretty' (Annotation x) = pretty x+  pretty' (RuleDecl x) = pretty x+  pretty' (Splice x) = pretty x+  pretty' (RoleAnnotDecl x) = pretty x++mkDeclaration :: GHC.HsDecl GHC.GhcPs -> Declaration+mkDeclaration (GHC.TyClD _ (GHC.FamDecl _ x)) =+  fromMaybe (error "Unreachable.")+    $ DataFamily <$> mkDataFamily x <|> TypeFamily <$> mkTypeFamily x+mkDeclaration (GHC.TyClD _ x@GHC.SynDecl {}) = TypeSynonym $ mkTypeSynonym x+mkDeclaration (GHC.TyClD _ x@GHC.DataDecl {}) =+  maybe (error "Unreachable.") DataDeclaration (mkDataDeclaration x)+mkDeclaration (GHC.TyClD _ x@GHC.ClassDecl {}) =+  maybe (error "Unreachable.") ClassDeclaration (mkClassDeclaration x)+mkDeclaration (GHC.InstD _ x@GHC.ClsInstD {}) =+  maybe (error "Unreachable.") ClassInstance (mkClassInstance x)+mkDeclaration (GHC.InstD _ GHC.DataFamInstD {GHC.dfid_inst = GHC.DataFamInstDecl {..}}) =+  DataFamilyInstance $ mkDataFamilyInstance dfid_eqn+mkDeclaration (GHC.InstD _ x@GHC.TyFamInstD {}) =+  maybe (error "Unreachable.") TypeFamilyInstance $ mkTypeFamilyInstance x+mkDeclaration (GHC.DerivD _ x) = StandAloneDeriving $ mkStandAloneDeriving x+mkDeclaration (GHC.ValD _ x) = Bind $ mkBind x+mkDeclaration (GHC.SigD _ x) = Signature $ mkSignature x+mkDeclaration (GHC.KindSigD _ x) = StandaloneKindSignature $ mkStandaloneKind x+mkDeclaration (GHC.DefD _ x) = Default $ mkDefaultDeclaration x+mkDeclaration (GHC.ForD _ x) = Foreign $ mkForeignDeclaration x+mkDeclaration (GHC.WarningD _ x) = Warnings $ mkWarningCollection x+mkDeclaration (GHC.AnnD _ x) = Annotation $ mkAnnotation x+mkDeclaration (GHC.RuleD _ x) = RuleDecl $ mkRuleCollection x+mkDeclaration (GHC.SpliceD _ x) = Splice $ mkSpliceDeclaration x+mkDeclaration (GHC.RoleAnnotD _ x) = RoleAnnotDecl $ mkRoleAnnotation x+mkDeclaration GHC.DocD {} =+  error+    "This node should never appear in the AST. If you see this error, please report it to the HIndent maintainers."++isSignature :: Declaration -> Bool+isSignature Signature {} = True+isSignature StandaloneKindSignature {} = True+isSignature _ = False
+ src/HIndent/Ast/Declaration/Annotation.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Annotation+  ( Annotation+  , mkAnnotation+  ) where++import HIndent.Ast.Declaration.Annotation.Provenance+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Annotation = Annotation+  { provenance :: Provenance+  , expr :: GHC.LHsExpr GHC.GhcPs+  }++instance CommentExtraction Annotation where+  nodeComments Annotation {} = NodeComments [] [] []++instance Pretty Annotation where+  pretty' Annotation {..} =+    spaced [string "{-# ANN", pretty provenance, pretty expr, string "#-}"]++mkAnnotation :: GHC.AnnDecl GHC.GhcPs -> Annotation+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+mkAnnotation (GHC.HsAnnotation _ prov expr) =+  Annotation {provenance = mkProvenance prov, ..}+#else+mkAnnotation (GHC.HsAnnotation _ _ prov expr) =+  Annotation {provenance = mkProvenance prov, ..}+#endif
+ src/HIndent/Ast/Declaration/Annotation/Provenance.hs view
@@ -0,0 +1,34 @@+module HIndent.Ast.Declaration.Annotation.Provenance+  ( Provenance+  , mkProvenance+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Provenance+  = Value (WithComments PrefixName)+  | Type (WithComments PrefixName)+  | Module++instance CommentExtraction Provenance where+  nodeComments Value {} = NodeComments [] [] []+  nodeComments Type {} = NodeComments [] [] []+  nodeComments Module = NodeComments [] [] []++instance Pretty Provenance where+  pretty' (Value x) = pretty x+  pretty' (Type x) = string "type " >> pretty x+  pretty' Module = string "module"++mkProvenance :: GHC.AnnProvenance GHC.GhcPs -> Provenance+mkProvenance (GHC.ValueAnnProvenance x) =+  Value $ fromGenLocated $ fmap mkPrefixName x+mkProvenance (GHC.TypeAnnProvenance x) =+  Type $ fromGenLocated $ fmap mkPrefixName x+mkProvenance GHC.ModuleAnnProvenance = Module
+ src/HIndent/Ast/Declaration/Annotation/Role.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Annotation.Role+  ( RoleAnnotation+  , mkRoleAnnotation+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Role+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data RoleAnnotation = RoleAnnotation+  { name :: WithComments PrefixName+  , roles :: [WithComments (Maybe Role)]+  }++instance CommentExtraction RoleAnnotation where+  nodeComments RoleAnnotation {} = NodeComments [] [] []++instance Pretty RoleAnnotation where+  pretty' RoleAnnotation {..} =+    spaced+      $ [string "type role", pretty name]+          ++ fmap (`prettyWith` maybe (string "_") pretty) roles++mkRoleAnnotation :: GHC.RoleAnnotDecl GHC.GhcPs -> RoleAnnotation+mkRoleAnnotation (GHC.RoleAnnotDecl _ nm rs) = RoleAnnotation {..}+  where+    name = fromGenLocated $ fmap mkPrefixName nm+    roles = fmap (fmap (fmap mkRole) . fromGenLocated) rs
+ src/HIndent/Ast/Declaration/Bind.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Bind+  ( Bind+  , mkBind+  ) where++import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Pretty.Types++-- The difference between `Function` and `Pattern` is the same as the difference+-- between `FunBind` and `PatBind` in GHC AST. See+-- https://hackage.haskell.org/package/ghc-lib-parser-9.8.2.20240223/docs/src/Language.Haskell.Syntax.Binds.html.+--+-- TODO: Merge them.+data Bind+  = Function+      { fun_matches :: GHC.MatchGroup GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)+      }+  | Pattern+      { lhs :: GHC.LPat GHC.GhcPs+      , rhs :: GHC.GRHSs GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)+      }+  | PatternSynonym+      { name :: GHC.LIdP GHC.GhcPs+      , parameters :: GHC.HsPatSynDetails GHC.GhcPs+      , direction :: GHC.HsPatSynDir GHC.GhcPs+      , definition :: GHC.LPat GHC.GhcPs+      }++instance CommentExtraction Bind where+  nodeComments Function {} = NodeComments [] [] []+  nodeComments Pattern {} = NodeComments [] [] []+  nodeComments PatternSynonym {} = NodeComments [] [] []++instance Pretty Bind where+  pretty' Function {..} = pretty fun_matches+  pretty' Pattern {..} = pretty lhs >> pretty rhs+  pretty' PatternSynonym {..} = do+    string "pattern "+    case parameters of+      GHC.InfixCon l r ->+        spaced+          [ pretty $ fmap mkPrefixName l+          , pretty $ fmap mkInfixName name+          , pretty $ fmap mkPrefixName r+          ]+      GHC.PrefixCon _ [] -> pretty $ fmap mkPrefixName name+      _ -> spaced [pretty $ fmap mkPrefixName name, pretty parameters]+    spacePrefixed [pretty direction, pretty $ fmap PatInsidePatDecl definition]+    case direction of+      GHC.ExplicitBidirectional matches -> do+        newline+        indentedBlock $ string "where " |=> pretty matches+      _ -> pure ()++mkBind :: GHC.HsBind GHC.GhcPs -> Bind+mkBind GHC.FunBind {..} = Function {..}+mkBind GHC.PatBind {..} = Pattern {..}+  where+    lhs = pat_lhs+    rhs = pat_rhs+mkBind (GHC.PatSynBind _ GHC.PSB {..}) = PatternSynonym {..}+  where+    name = psb_id+    parameters = psb_args+    direction = psb_dir+    definition = psb_def+mkBind _ = error "This AST node should not appear."
+ src/HIndent/Ast/Declaration/Class.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Class+  ( ClassDeclaration+  , mkClassDeclaration+  ) where++import Control.Monad+import Data.Maybe+import qualified GHC.Data.Bag as GHC+import HIndent.Applicative+import HIndent.Ast.Context+import HIndent.Ast.Declaration.Class.FunctionalDependency+import HIndent.Ast.Declaration.Class.NameAndTypeVariables+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Pretty.SigBindFamily++data ClassDeclaration = ClassDeclaration+  { context :: Maybe (WithComments Context)+  , nameAndTypeVariables :: NameAndTypeVariables+  , functionalDependencies :: [WithComments FunctionalDependency]+  , associatedThings :: [LSigBindFamily]+  }++instance CommentExtraction ClassDeclaration where+  nodeComments ClassDeclaration {} = NodeComments [] [] []++instance Pretty ClassDeclaration where+  pretty' ClassDeclaration {..} = do+    if isJust context+      then verHead+      else horHead <-|> verHead+    indentedBlock $ newlinePrefixed $ fmap pretty associatedThings+    where+      horHead = do+        string "class "+        pretty nameAndTypeVariables+        unless (null functionalDependencies)+          $ string " | " >> hCommaSep (fmap pretty functionalDependencies)+        unless (null associatedThings) $ string " where"+      verHead = do+        string "class " |=> do+          whenJust context $ \ctx -> pretty ctx >> string " =>" >> newline+          pretty nameAndTypeVariables+        unless (null functionalDependencies) $ do+          newline+          indentedBlock+            $ string "| " |=> vCommaSep (fmap pretty functionalDependencies)+        unless (null associatedThings)+          $ newline >> indentedBlock (string "where")++mkClassDeclaration :: GHC.TyClDecl GHC.GhcPs -> Maybe ClassDeclaration+mkClassDeclaration x@GHC.ClassDecl {..}+  | Just nameAndTypeVariables <- mkNameAndTypeVariables x =+    Just ClassDeclaration {..}+  where+    context = fmap (fmap mkContext . fromGenLocated) tcdCtxt+    functionalDependencies =+      fmap (fmap mkFunctionalDependency . fromGenLocated) tcdFDs+    associatedThings =+      mkSortedLSigBindFamilyList tcdSigs (GHC.bagToList tcdMeths) tcdATs [] []+mkClassDeclaration _ = Nothing
+ src/HIndent/Ast/Declaration/Class/FunctionalDependency.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Class.FunctionalDependency+  ( FunctionalDependency+  , mkFunctionalDependency+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data FunctionalDependency = FunctionalDependency+  { from :: [WithComments PrefixName]+  , to :: [WithComments PrefixName]+  }++instance CommentExtraction FunctionalDependency where+  nodeComments FunctionalDependency {} = NodeComments [] [] []++instance Pretty FunctionalDependency where+  pretty' (FunctionalDependency {..}) =+    spaced $ fmap pretty from ++ [string "->"] ++ fmap pretty to++mkFunctionalDependency :: GHC.FunDep GHC.GhcPs -> FunctionalDependency+mkFunctionalDependency (GHC.FunDep _ f t) = FunctionalDependency {..}+  where+    from = fmap (fromGenLocated . fmap mkPrefixName) f+    to = fmap (fromGenLocated . fmap mkPrefixName) t
+ src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Class.NameAndTypeVariables+  ( NameAndTypeVariables+  , mkNameAndTypeVariables+  ) where++import qualified GHC.Types.Fixity as GHC+import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data NameAndTypeVariables+  = Prefix+      { pName :: WithComments PrefixName -- Using `name` in both `Prefix` and `Infix` causes a type conflict.+      , typeVariables :: [WithComments TypeVariable]+      }+  | Infix+      { left :: WithComments TypeVariable+      , iName :: WithComments InfixName+      , right :: WithComments TypeVariable+      , remains :: [WithComments TypeVariable]+      }++instance CommentExtraction NameAndTypeVariables where+  nodeComments Prefix {} = NodeComments [] [] []+  nodeComments Infix {} = NodeComments [] [] []++instance Pretty NameAndTypeVariables where+  pretty' Prefix {..} = spaced $ pretty pName : fmap pretty typeVariables+  pretty' Infix {..} = do+    parens $ spaced [pretty left, pretty iName, pretty right]+    spacePrefixed $ fmap pretty remains++mkNameAndTypeVariables :: GHC.TyClDecl GHC.GhcPs -> Maybe NameAndTypeVariables+mkNameAndTypeVariables GHC.ClassDecl {tcdFixity = GHC.Prefix, ..} =+  Just Prefix {..}+  where+    pName = fromGenLocated $ fmap mkPrefixName tcdLName+    typeVariables =+      fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars+mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix+                                     , tcdTyVars = GHC.HsQTvs {hsq_explicit = h:t:xs}+                                     , ..+                                     } = Just Infix {..}+  where+    left = mkTypeVariable <$> fromGenLocated h+    iName = fromGenLocated $ fmap mkInfixName tcdLName+    right = mkTypeVariable <$> fromGenLocated t+    remains = fmap (fmap mkTypeVariable . fromGenLocated) xs+mkNameAndTypeVariables _ = Nothing
+ src/HIndent/Ast/Declaration/Collection.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module HIndent.Ast.Declaration.Collection+  ( DeclarationCollection+  , mkDeclarationCollection+  , hasDeclarations+  ) where++import Data.Maybe+import qualified GHC.Hs as GHC+import HIndent.Ast.Declaration+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype DeclarationCollection =+  DeclarationCollection [WithComments Declaration]++instance CommentExtraction DeclarationCollection where+  nodeComments DeclarationCollection {} = NodeComments [] [] []++instance Pretty DeclarationCollection where+  pretty' (DeclarationCollection decls) =+    mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp)+      $ addDeclSeparator decls+    where+      addDeclSeparator [] = []+      addDeclSeparator [x] = [(x, Nothing)]+      addDeclSeparator (x:xs) =+        (x, Just $ declSeparator $ getNode x) : addDeclSeparator xs+      declSeparator (isSignature -> True) = newline+      declSeparator _ = blankline++mkDeclarationCollection :: GHC.HsModule' -> DeclarationCollection+mkDeclarationCollection GHC.HsModule {..} =+  DeclarationCollection $ fmap mkDeclaration . fromGenLocated <$> hsmodDecls++hasDeclarations :: DeclarationCollection -> Bool+hasDeclarations (DeclarationCollection xs) = not $ null xs
+ src/HIndent/Ast/Declaration/Data.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data+  ( DataDeclaration+  , mkDataDeclaration+  ) where++import HIndent.Ast.Declaration.Data.Body+import HIndent.Ast.Declaration.Data.Header+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.NodeComments++data DataDeclaration = DataDeclaration+  { header :: Header+  , body :: DataBody+  }++instance CommentExtraction DataDeclaration where+  nodeComments DataDeclaration {} = NodeComments [] [] []++instance Pretty DataDeclaration where+  pretty' DataDeclaration {..} = pretty header >> pretty body++mkDataDeclaration :: GHC.TyClDecl GHC.GhcPs -> Maybe DataDeclaration+mkDataDeclaration decl@GHC.DataDecl {..} =+  DataDeclaration <$> mkHeader decl <*> pure (mkDataBody tcdDataDefn)+mkDataDeclaration _ = Nothing
+ src/HIndent/Ast/Declaration/Data/Body.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module HIndent.Ast.Declaration.Data.Body+  ( DataBody+  , mkDataBody+  ) where++import Control.Monad+import Data.Maybe+import GHC.Hs (HsDataDefn(dd_derivs))+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Applicative+import HIndent.Ast.Declaration.Data.Deriving.Clause+import HIndent.Ast.Declaration.Data.GADT.Constructor+import HIndent.Ast.Declaration.Data.Haskell98.Constructor+import HIndent.Ast.NodeComments hiding (fromEpAnn)+import HIndent.Ast.Type+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data DataBody+  = GADT+      { kind :: Maybe (WithComments Type)+      , constructors :: [WithComments GADTConstructor]+      }+  | Haskell98+      { constructorsH98 :: [WithComments Haskell98Constructor]+      , derivings :: DerivingClause+      }++instance CommentExtraction DataBody where+  nodeComments GADT {} = NodeComments [] [] []+  nodeComments Haskell98 {} = NodeComments [] [] []++instance Pretty DataBody where+  pretty' GADT {..} = do+    whenJust kind $ \x -> string " :: " >> pretty x+    string " where"+    indentedBlock $ newlinePrefixed $ fmap pretty constructors+  pretty' Haskell98 {..} = do+    case constructorsH98 of+      [] -> indentedBlock derivingsAfterNewline+      [x]+        | hasSingleRecordConstructor $ getNode x -> do+          string " = "+          pretty x+          when (hasDerivings derivings) $ space |=> pretty derivings+        | otherwise -> do+          string " ="+          newline+          indentedBlock $ pretty x >> derivingsAfterNewline+      _ ->+        indentedBlock $ do+          newline+          string "= " |=> vBarSep (fmap pretty constructorsH98)+          derivingsAfterNewline+    where+      derivingsAfterNewline =+        when (hasDerivings derivings) $ newline >> pretty derivings++mkDataBody :: GHC.HsDataDefn GHC.GhcPs -> DataBody+mkDataBody defn@GHC.HsDataDefn {..} =+  if isGADT defn+    then GADT+           { constructors =+               fromMaybe (error "Some constructors are not GADT ones.")+                 $ mapM (traverse mkGADTConstructor . fromGenLocated)+                 $ getConDecls defn+           , ..+           }+    else Haskell98+           { constructorsH98 =+               fmap+                 (fromMaybe+                    (error "Some constructors are not in the Haskell 98 style.")+                    . mkHaskell98Constructor)+                 . fromGenLocated+                 <$> getConDecls defn+           , ..+           }+  where+    kind = fmap mkType . fromGenLocated <$> dd_kindSig+    derivings = mkDerivingClause dd_derivs++isGADT :: GHC.HsDataDefn GHC.GhcPs -> Bool+isGADT (getConDecls -> (GHC.L _ GHC.ConDeclGADT {}:_)) = True+isGADT _ = False++getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs]+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+getConDecls GHC.HsDataDefn {..} =+  case dd_cons of+    GHC.NewTypeCon x -> [x]+    GHC.DataTypeCons _ xs -> xs+#else+getConDecls GHC.HsDataDefn {..} = dd_cons+#endif
+ src/HIndent/Ast/Declaration/Data/Deriving.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.Deriving+  ( Deriving+  , mkDeriving+  ) where++import qualified GHC.Types.SrcLoc as GHC+import HIndent.Applicative+import HIndent.Ast.Declaration.Data.Deriving.Strategy+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Deriving = Deriving+  { strategy :: Maybe (WithComments DerivingStrategy)+  , classes :: WithComments [GHC.LHsSigType GHC.GhcPs]+  }++instance CommentExtraction Deriving where+  nodeComments Deriving {} = NodeComments [] [] []++instance Pretty Deriving where+  pretty' Deriving {strategy = Just strategy, ..}+    | isViaStrategy (getNode strategy) = do+      spaced+        [ string "deriving"+        , prettyWith classes (hvTuple . fmap pretty)+        , pretty strategy+        ]+  pretty' Deriving {..} = do+    string "deriving "+    whenJust strategy $ \x -> pretty x >> space+    prettyWith classes (hvTuple . fmap pretty)++mkDeriving :: GHC.HsDerivingClause GHC.GhcPs -> Deriving+mkDeriving GHC.HsDerivingClause {..} = Deriving {..}+  where+    strategy =+      fmap (fmap mkDerivingStrategy . fromGenLocated) deriv_clause_strategy+    classes =+      case deriv_clause_tys of+        GHC.L ann (GHC.DctSingle _ ty) -> fromGenLocated (GHC.L ann [ty])+        GHC.L ann (GHC.DctMulti _ tys) -> fromGenLocated (GHC.L ann tys)
+ src/HIndent/Ast/Declaration/Data/Deriving/Clause.hs view
@@ -0,0 +1,29 @@+module HIndent.Ast.Declaration.Data.Deriving.Clause+  ( DerivingClause+  , mkDerivingClause+  , hasDerivings+  ) where++import HIndent.Ast.Declaration.Data.Deriving+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype DerivingClause =+  DerivingClause [WithComments Deriving]++instance CommentExtraction DerivingClause where+  nodeComments DerivingClause {} = NodeComments [] [] []++instance Pretty DerivingClause where+  pretty' (DerivingClause xs) = lined $ fmap pretty xs++mkDerivingClause :: GHC.HsDeriving GHC.GhcPs -> DerivingClause+mkDerivingClause = DerivingClause . fmap (fmap mkDeriving . fromGenLocated)++hasDerivings :: DerivingClause -> Bool+hasDerivings (DerivingClause []) = False+hasDerivings _ = True
+ src/HIndent/Ast/Declaration/Data/Deriving/Strategy.hs view
@@ -0,0 +1,39 @@+module HIndent.Ast.Declaration.Data.Deriving.Strategy+  ( DerivingStrategy+  , mkDerivingStrategy+  , isViaStrategy+  ) where++import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data DerivingStrategy+  = Stock+  | Anyclass+  | Newtype+  | Via (GHC.LHsSigType GHC.GhcPs)++instance CommentExtraction DerivingStrategy where+  nodeComments Stock {} = NodeComments [] [] []+  nodeComments Anyclass {} = NodeComments [] [] []+  nodeComments Newtype {} = NodeComments [] [] []+  nodeComments Via {} = NodeComments [] [] []++instance Pretty DerivingStrategy where+  pretty' Stock = string "stock"+  pretty' Anyclass = string "anyclass"+  pretty' Newtype = string "newtype"+  pretty' (Via x) = string "via " >> pretty x++mkDerivingStrategy :: GHC.DerivStrategy GHC.GhcPs -> DerivingStrategy+mkDerivingStrategy GHC.StockStrategy {} = Stock+mkDerivingStrategy GHC.AnyclassStrategy {} = Anyclass+mkDerivingStrategy GHC.NewtypeStrategy {} = Newtype+mkDerivingStrategy (GHC.ViaStrategy (GHC.XViaStrategyPs _ x)) = Via x++isViaStrategy :: DerivingStrategy -> Bool+isViaStrategy Via {} = True+isViaStrategy _ = False
+ src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.GADT.Constructor+  ( GADTConstructor+  , mkGADTConstructor+  ) where++import Data.Maybe+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.Context+import HIndent.Ast.Declaration.Data.GADT.Constructor.Signature+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+import qualified Data.List.NonEmpty as NE+#endif+data GADTConstructor = GADTConstructor+  { names :: [WithComments PrefixName]+  , bindings :: Maybe (WithComments [WithComments TypeVariable])+  , context :: Maybe (WithComments Context)+  , signature :: ConstructorSignature+  }++instance CommentExtraction GADTConstructor where+  nodeComments GADTConstructor {} = NodeComments [] [] []++instance Pretty GADTConstructor where+  pretty' (GADTConstructor {..}) = do+    hCommaSep $ fmap (`prettyWith` pretty) names+    hor <-|> ver+    where+      hor = string " :: " |=> body+      ver = newline >> indentedBlock (string ":: " |=> body)+      body =+        case (bindings, context) of+          (Just bs, Just ctx) -> withForallCtx bs ctx+          (Just bs, Nothing) -> withForallOnly bs+          (Nothing, Just ctx) -> withCtxOnly ctx+          (Nothing, Nothing) -> noForallCtx+      withForallCtx bs ctx = do+        string "forall"+        prettyWith bs (spacePrefixed . fmap pretty)+        dot+        (space >> pretty ctx) <-|> (newline >> pretty ctx)+        newline+        prefixed "=> " $ prettyVertically signature+      withForallOnly bs = do+        string "forall"+        prettyWith bs (spacePrefixed . fmap pretty)+        dot+        (space >> prettyHorizontally signature)+          <-|> (newline >> prettyVertically signature)+      withCtxOnly ctx =+        (pretty ctx >> string " => " >> prettyHorizontally signature)+          <-|> (pretty ctx >> prefixed "=> " (prettyVertically signature))+      noForallCtx = prettyHorizontally signature <-|> prettyVertically signature++mkGADTConstructor :: GHC.ConDecl GHC.GhcPs -> Maybe GADTConstructor+mkGADTConstructor decl@GHC.ConDeclGADT {..} = Just $ GADTConstructor {..}+  where+    names = fromMaybe (error "Couldn't get names.") $ getNames decl+    bindings =+      case con_bndrs of+        GHC.L _ GHC.HsOuterImplicit {} -> Nothing+        GHC.L l GHC.HsOuterExplicit {..} ->+          Just+            $ fromGenLocated+            $ fmap+                (fmap (fmap mkTypeVariable . fromGenLocated))+                (GHC.L l hso_bndrs)+    signature =+      fromMaybe (error "Couldn't get signature.") $ mkConstructorSignature decl+    context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt+mkGADTConstructor _ = Nothing++getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments PrefixName]+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+getNames GHC.ConDeclGADT {..} =+  Just $ NE.toList $ fmap (fromGenLocated . fmap mkPrefixName) con_names+#else+getNames GHC.ConDeclGADT {..} =+  Just $ fmap (fromGenLocated . fmap mkPrefixName) con_names+#endif+getNames _ = Nothing
+ src/HIndent/Ast/Declaration/Data/GADT/Constructor/Signature.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.GADT.Constructor.Signature+  ( ConstructorSignature+  , mkConstructorSignature+  , prettyHorizontally+  , prettyVertically+  ) where++import HIndent.Ast.Declaration.Data.Record.Field+import HIndent.Ast.NodeComments+import HIndent.Ast.Type+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Printer++data ConstructorSignature+  = ByArrows+      { parameters :: [WithComments Type]+      , result :: WithComments Type+      }+  | Record+      { fields :: WithComments [WithComments RecordField]+      , result :: WithComments Type+      }++instance CommentExtraction ConstructorSignature where+  nodeComments ByArrows {} = NodeComments [] [] []+  nodeComments Record {} = NodeComments [] [] []++prettyHorizontally :: ConstructorSignature -> Printer ()+prettyHorizontally ByArrows {..} =+  inter (string " -> ") $ fmap pretty parameters ++ [pretty result]+prettyHorizontally Record {..} =+  inter+    (string " -> ")+    [prettyWith fields (vFields' . fmap pretty), pretty result]++prettyVertically :: ConstructorSignature -> Printer ()+prettyVertically ByArrows {..} =+  prefixedLined "-> " $ fmap pretty parameters ++ [pretty result]+prettyVertically Record {..} =+  prefixedLined+    "-> "+    [prettyWith fields (vFields' . fmap pretty), pretty result]++mkConstructorSignature :: GHC.ConDecl GHC.GhcPs -> Maybe ConstructorSignature+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.PrefixConGADT _ xs, ..} =+  Just+    $ ByArrows+        { parameters =+            fmap (fmap mkType . fromGenLocated . GHC.hsScaledThing) xs+        , result = mkType <$> fromGenLocated con_res_ty+        }+#else+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.PrefixConGADT xs, ..} =+  Just+    $ ByArrows+        { parameters =+            fmap (fmap mkType . fromGenLocated . GHC.hsScaledThing) xs+        , result = mkType <$> fromGenLocated con_res_ty+        }+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT _ xs, ..} =+  Just+    $ Record+        { fields =+            fromGenLocated+              $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs+        , result = mkType <$> fromGenLocated con_res_ty+        }+#elif MIN_VERSION_ghc_lib_parser(9, 4, 0)+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT xs _, ..} =+  Just+    $ Record+        { fields =+            fromGenLocated+              $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs+        , result = mkType <$> fromGenLocated con_res_ty+        }+#else+mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT xs, ..} =+  Just+    $ Record+        { fields =+            fromGenLocated+              $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs+        , result = mkType <$> fromGenLocated con_res_ty+        }+#endif+mkConstructorSignature GHC.ConDeclH98 {} = Nothing
+ src/HIndent/Ast/Declaration/Data/Haskell98/Constructor.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.Haskell98.Constructor+  ( Haskell98Constructor+  , mkHaskell98Constructor+  , hasSingleRecordConstructor+  ) where++import HIndent.Applicative+import HIndent.Ast.Context+import HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Haskell98Constructor = Haskell98Constructor+  { existentialVariables :: [WithComments TypeVariable]+  , context :: Maybe (WithComments Context)+  , body :: Haskell98ConstructorBody+  }++instance CommentExtraction Haskell98Constructor where+  nodeComments Haskell98Constructor {} = NodeComments [] [] []++instance Pretty Haskell98Constructor where+  pretty' Haskell98Constructor {existentialVariables = [], ..} = do+    whenJust context $ \c -> pretty c >> string " => "+    pretty body+  pretty' Haskell98Constructor {..} = do+    string "forall "+    spaced (fmap pretty existentialVariables)+    string ". " |=> do+      whenJust context $ \c -> pretty c >> string " =>" >> newline+      pretty body++mkHaskell98Constructor :: GHC.ConDecl GHC.GhcPs -> Maybe Haskell98Constructor+mkHaskell98Constructor GHC.ConDeclH98 {..}+  | Just body <- mkHaskell98ConstructorBody GHC.ConDeclH98 {..} =+    Just Haskell98Constructor {..}+  where+    existentialVariables =+      if con_forall+        then fmap (fmap mkTypeVariable . fromGenLocated) con_ex_tvs+        else []+    context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt+mkHaskell98Constructor _ = Nothing++hasSingleRecordConstructor :: Haskell98Constructor -> Bool+hasSingleRecordConstructor = isRecord . body
+ src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body+  ( Haskell98ConstructorBody+  , mkHaskell98ConstructorBody+  , isRecord+  ) where++import HIndent.Ast.Declaration.Data.Record.Field+import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Haskell98ConstructorBody+  = Infix+      { iName :: WithComments InfixName -- Using `name` in all constructors causes a type clash+      , left :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)+      , right :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)+      }+  | Prefix+      { pName :: WithComments PrefixName+      , types :: [GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)]+      }+  | Record+      { rName :: WithComments PrefixName+      , records :: WithComments [WithComments RecordField]+      }++instance CommentExtraction Haskell98ConstructorBody where+  nodeComments Infix {} = NodeComments [] [] []+  nodeComments Prefix {} = NodeComments [] [] []+  nodeComments Record {} = NodeComments [] [] []++instance Pretty Haskell98ConstructorBody where+  pretty' Infix {..} = spaced [pretty left, pretty iName, pretty right]+  pretty' Prefix {..} = pretty pName >> hor <-|> ver+    where+      hor = spacePrefixed $ fmap pretty types+      ver = indentedBlock $ newlinePrefixed $ fmap pretty types+  pretty' Record {..} = do+    pretty rName+    prettyWith records $ \r ->+      newline >> indentedBlock (vFields $ fmap pretty r)++mkHaskell98ConstructorBody ::+     GHC.ConDecl GHC.GhcPs -> Maybe Haskell98ConstructorBody+mkHaskell98ConstructorBody GHC.ConDeclH98 { con_args = GHC.InfixCon left right+                                          , ..+                                          } = Just Infix {..}+  where+    iName = fromGenLocated $ fmap mkInfixName con_name+mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.PrefixCon _ types, ..} =+  Just Prefix {..}+  where+    pName = fromGenLocated $ fmap mkPrefixName con_name+mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.RecCon rs, ..} =+  Just Record {..}+  where+    rName = fromGenLocated $ fmap mkPrefixName con_name+    records =+      fromGenLocated $ fmap (fmap (fmap mkRecordField . fromGenLocated)) rs+mkHaskell98ConstructorBody GHC.ConDeclGADT {} = Nothing++isRecord :: Haskell98ConstructorBody -> Bool+isRecord Record {} = True+isRecord _ = False
+ src/HIndent/Ast/Declaration/Data/Header.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.Header+  ( Header+  , mkHeader+  ) where++import HIndent.Applicative+import HIndent.Ast.Context+import HIndent.Ast.Declaration.Data.NewOrData+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Header = Header+  { newOrData :: NewOrData+  , name :: WithComments PrefixName+  , context :: Maybe (WithComments Context)+  , typeVariables :: [WithComments TypeVariable]+  }++instance CommentExtraction Header where+  nodeComments Header {} = NodeComments [] [] []++instance Pretty Header where+  pretty' Header {..} = do+    (pretty newOrData >> space) |=> do+      whenJust context $ \c -> pretty c >> string " =>" >> newline+      pretty name+    spacePrefixed $ fmap pretty typeVariables++mkHeader :: GHC.TyClDecl GHC.GhcPs -> Maybe Header+mkHeader GHC.DataDecl {tcdDataDefn = defn@GHC.HsDataDefn {..}, ..} =+  Just Header {..}+  where+    newOrData = mkNewOrData defn+    context = fmap (fmap mkContext . fromGenLocated) dd_ctxt+    name = fromGenLocated $ fmap mkPrefixName tcdLName+    typeVariables =+      fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars+mkHeader _ = Nothing
+ src/HIndent/Ast/Declaration/Data/NewOrData.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.NewOrData+  ( NewOrData+  , mkNewOrData+  ) where++import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data NewOrData+  = Newtype+  | Data++instance CommentExtraction NewOrData where+  nodeComments Newtype = NodeComments [] [] []+  nodeComments Data = NodeComments [] [] []++instance Pretty NewOrData where+  pretty' Newtype = string "newtype"+  pretty' Data = string "data"++mkNewOrData :: GHC.HsDataDefn GHC.GhcPs -> NewOrData+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+mkNewOrData GHC.HsDataDefn {..}+  | GHC.NewTypeCon _ <- dd_cons = Newtype+  | GHC.DataTypeCons _ _ <- dd_cons = Data+#else+mkNewOrData GHC.HsDataDefn {..}+  | GHC.NewType <- dd_ND = Newtype+  | GHC.DataType <- dd_ND = Data+#endif
+ src/HIndent/Ast/Declaration/Data/Record/Field.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Data.Record.Field+  ( RecordField+  , mkRecordField+  ) where++import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data RecordField = RecordField+  { names :: [GHC.LFieldOcc GHC.GhcPs]+  , ty :: GHC.LBangType GHC.GhcPs+  }++instance CommentExtraction RecordField where+  nodeComments RecordField {} = NodeComments [] [] []++instance Pretty RecordField where+  pretty' RecordField {..} =+    spaced [hCommaSep $ fmap pretty names, string "::", pretty ty]++mkRecordField :: GHC.ConDeclField GHC.GhcPs -> RecordField+mkRecordField GHC.ConDeclField {..} = RecordField {..}+  where+    names = cd_fld_names+    ty = cd_fld_type
+ src/HIndent/Ast/Declaration/Default.hs view
@@ -0,0 +1,23 @@+module HIndent.Ast.Declaration.Default+  ( DefaultDeclaration+  , mkDefaultDeclaration+  ) where++import qualified GHC.Hs as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype DefaultDeclaration =+  DefaultDeclaration [GHC.LHsType GHC.GhcPs]++instance CommentExtraction DefaultDeclaration where+  nodeComments DefaultDeclaration {} = NodeComments [] [] []++instance Pretty DefaultDeclaration where+  pretty' (DefaultDeclaration xs) =+    spaced [string "default", hTuple $ fmap pretty xs]++mkDefaultDeclaration :: GHC.DefaultDecl GHC.GhcPs -> DefaultDeclaration+mkDefaultDeclaration (GHC.DefaultDecl _ xs) = DefaultDeclaration xs
+ src/HIndent/Ast/Declaration/Family/Data.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Family.Data+  ( DataFamily+  , mkDataFamily+  ) where++import Control.Monad+import qualified GHC.Types.Basic as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Applicative+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments hiding (fromEpAnn)+import HIndent.Ast.Type+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data DataFamily = DataFamily+  { isTopLevel :: Bool+  , name :: WithComments PrefixName+  , typeVariables :: [WithComments TypeVariable]+  , signature :: Maybe (WithComments Type)+  }++instance CommentExtraction DataFamily where+  nodeComments DataFamily {} = NodeComments [] [] []++instance Pretty DataFamily where+  pretty' DataFamily {..} = do+    string "data "+    when isTopLevel $ string "family "+    pretty name+    spacePrefixed $ fmap pretty typeVariables+    whenJust signature $ \sig -> space >> pretty sig++mkDataFamily :: GHC.FamilyDecl GHC.GhcPs -> Maybe DataFamily+mkDataFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}+  | GHC.DataFamily <- fdInfo+  , Nothing <- fdInjectivityAnn = Just DataFamily {..}+  | otherwise = Nothing+  where+    isTopLevel =+      case fdTopLevel of+        GHC.TopLevel -> True+        GHC.NotTopLevel -> False+    name = fromGenLocated $ fmap mkPrefixName fdLName+    typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit+    signature =+      case GHC.unLoc fdResultSig of+        GHC.NoSig {} -> Nothing+        GHC.KindSig _ kind -> Just $ mkType <$> fromGenLocated kind+        GHC.TyVarSig {} ->+          error+            "Data family should never have this AST node. If you see this error, please report it to the HIndent maintainers."
+ src/HIndent/Ast/Declaration/Family/Type.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Family.Type+  ( TypeFamily+  , mkTypeFamily+  ) where++import Control.Monad+import qualified GHC.Types.Basic as GHC+import HIndent.Applicative+import HIndent.Ast.Declaration.Family.Type.Injectivity+import HIndent.Ast.Declaration.Family.Type.ResultSignature+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments hiding (fromEpAnn)+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data TypeFamily = TypeFamily+  { isTopLevel :: Bool+  , name :: WithComments PrefixName+  , typeVariables :: [WithComments TypeVariable]+  , signature :: WithComments ResultSignature+  , injectivity :: Maybe (WithComments Injectivity)+  , equations :: Maybe [GHC.LTyFamInstEqn GHC.GhcPs]+  }++instance CommentExtraction TypeFamily where+  nodeComments TypeFamily {} = NodeComments [] [] []++instance Pretty TypeFamily where+  pretty' TypeFamily {..} = do+    string "type "+    when isTopLevel $ string "family "+    pretty name+    spacePrefixed $ fmap pretty typeVariables+    pretty signature+    whenJust injectivity $ \x -> string " | " >> pretty x+    whenJust equations $ \xs ->+      string " where" >> newline >> indentedBlock (lined $ fmap pretty xs)++mkTypeFamily :: GHC.FamilyDecl GHC.GhcPs -> Maybe TypeFamily+mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}+  | GHC.DataFamily <- fdInfo = Nothing+  | otherwise = Just TypeFamily {..}+  where+    isTopLevel =+      case fdTopLevel of+        GHC.TopLevel -> True+        GHC.NotTopLevel -> False+    name = fromGenLocated $ fmap mkPrefixName fdLName+    typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit+    signature = mkResultSignature <$> fromGenLocated fdResultSig+    injectivity = fmap (fmap mkInjectivity . fromGenLocated) fdInjectivityAnn+    equations =+      case fdInfo of+        GHC.DataFamily -> error "Not a TypeFamily"+        GHC.OpenTypeFamily -> Nothing+        GHC.ClosedTypeFamily Nothing -> Just []+        GHC.ClosedTypeFamily (Just xs) -> Just xs
+ src/HIndent/Ast/Declaration/Family/Type/Injectivity.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Family.Type.Injectivity+  ( Injectivity+  , mkInjectivity+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Injectivity = Injectivity+  { from :: WithComments PrefixName+  , to :: [WithComments PrefixName]+  }++instance CommentExtraction Injectivity where+  nodeComments Injectivity {} = NodeComments [] [] []++instance Pretty Injectivity where+  pretty' Injectivity {..} = spaced $ pretty from : string "->" : fmap pretty to++mkInjectivity :: GHC.InjectivityAnn GHC.GhcPs -> Injectivity+mkInjectivity (GHC.InjectivityAnn _ f t) = Injectivity {..}+  where+    from = fromGenLocated $ fmap mkPrefixName f+    to = fmap (fromGenLocated . fmap mkPrefixName) t
+ src/HIndent/Ast/Declaration/Family/Type/ResultSignature.hs view
@@ -0,0 +1,34 @@+module HIndent.Ast.Declaration.Family.Type.ResultSignature+  ( ResultSignature(..)+  , mkResultSignature+  ) where++import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data ResultSignature+  = NoSig+  | Kind (GHC.LHsKind GHC.GhcPs)+  | TypeVariable (WithComments TypeVariable)++instance CommentExtraction ResultSignature where+  nodeComments NoSig = NodeComments [] [] []+  nodeComments Kind {} = NodeComments [] [] []+  nodeComments TypeVariable {} = NodeComments [] [] []++instance Pretty ResultSignature where+  pretty' NoSig = return ()+  pretty' (Kind x) = string " :: " >> pretty x+  pretty' (TypeVariable x) = string " = " >> pretty x++mkResultSignature :: GHC.FamilyResultSig GHC.GhcPs -> ResultSignature+mkResultSignature (GHC.NoSig _) = NoSig+mkResultSignature (GHC.KindSig _ x) = Kind x+mkResultSignature (GHC.TyVarSig _ x) = TypeVariable var+  where+    var = mkTypeVariable <$> fromGenLocated x
+ src/HIndent/Ast/Declaration/Foreign.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Foreign+  ( ForeignDeclaration+  , mkForeignDeclaration+  ) where++import Data.Maybe+import qualified GHC.Types.ForeignCall as GHC+import qualified GHC.Types.SourceText as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.Declaration.Foreign.CallingConvention+import HIndent.Ast.Declaration.Foreign.Safety+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 8, 0)+import qualified GHC.Data.FastString as GHC+#endif+data ForeignDeclaration+  = ForeignImport+      { convention :: CallingConvention+      , safety :: Safety+      , srcIdent :: Maybe String+      , dstIdent :: WithComments PrefixName+      , signature :: GHC.LHsSigType GHC.GhcPs+      }+  | ForeignExport+      { convention :: CallingConvention+      , srcIdent :: Maybe String+      , dstIdent :: WithComments PrefixName+      , signature :: GHC.LHsSigType GHC.GhcPs+      }++instance CommentExtraction ForeignDeclaration where+  nodeComments ForeignImport {} = NodeComments [] [] []+  nodeComments ForeignExport {} = NodeComments [] [] []++instance Pretty ForeignDeclaration where+  pretty' ForeignImport {..} =+    spaced+      $ [string "foreign import", pretty convention, pretty safety]+          ++ maybeToList (fmap string srcIdent)+          ++ [pretty dstIdent, string "::", pretty signature]+  pretty' ForeignExport {..} =+    spaced+      $ [string "foreign export", pretty convention]+          ++ maybeToList (fmap string srcIdent)+          ++ [pretty dstIdent, string "::", pretty signature]++mkForeignDeclaration :: GHC.ForeignDecl GHC.GhcPs -> ForeignDeclaration+#if MIN_VERSION_ghc_lib_parser(9, 8, 0)+mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ src) (GHC.L _ conv) (GHC.L _ sfty) _ _)+                                       , ..+                                       } = ForeignImport {..}+  where+    convention = mkCallingConvention conv+    safety = mkSafety sfty+    srcIdent =+      case src of+        GHC.SourceText s -> Just $ GHC.unpackFS s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ src) (GHC.L _ (GHC.CExportStatic _ _ conv)))+                                       , ..+                                       } = ForeignExport {..}+  where+    convention = mkCallingConvention conv+    srcIdent =+      case src of+        GHC.SourceText s -> Just $ GHC.unpackFS s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)+mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ src) (GHC.L _ conv) (GHC.L _ sfty) _ _)+                                       , ..+                                       } = ForeignImport {..}+  where+    convention = mkCallingConvention conv+    safety = mkSafety sfty+    srcIdent =+      case src of+        GHC.SourceText s -> Just s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ src) (GHC.L _ (GHC.CExportStatic _ _ conv)))+                                       , ..+                                       } = ForeignExport {..}+  where+    convention = mkCallingConvention conv+    srcIdent =+      case src of+        GHC.SourceText s -> Just s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+#else+mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ conv) (GHC.L _ sfty) _ _ (GHC.L _ src))+                                       , ..+                                       } = ForeignImport {..}+  where+    convention = mkCallingConvention conv+    safety = mkSafety sfty+    srcIdent =+      case src of+        GHC.SourceText s -> Just s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ (GHC.CExportStatic _ _ conv)) (GHC.L _ src))+                                       , ..+                                       } = ForeignExport {..}+  where+    convention = mkCallingConvention conv+    srcIdent =+      case src of+        GHC.SourceText s -> Just s+        _ -> Nothing+    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name+    signature = fd_sig_ty+#endif
+ src/HIndent/Ast/Declaration/Foreign/CallingConvention.hs view
@@ -0,0 +1,34 @@+module HIndent.Ast.Declaration.Foreign.CallingConvention+  ( CallingConvention+  , mkCallingConvention+  ) where++import qualified GHC.Types.ForeignCall as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data CallingConvention+  = CCall+  | CApi+  | StdCall+  | Prim+  | JavaScript++instance CommentExtraction CallingConvention where+  nodeComments _ = NodeComments [] [] []++instance Pretty CallingConvention where+  pretty' CCall = string "ccall"+  pretty' CApi = string "capi"+  pretty' StdCall = string "stdcall"+  pretty' Prim = string "prim"+  pretty' JavaScript = string "javascript"++mkCallingConvention :: GHC.CCallConv -> CallingConvention+mkCallingConvention GHC.CCallConv = CCall+mkCallingConvention GHC.StdCallConv = StdCall+mkCallingConvention GHC.CApiConv = CApi+mkCallingConvention GHC.PrimCallConv = Prim+mkCallingConvention GHC.JavaScriptCallConv = JavaScript
+ src/HIndent/Ast/Declaration/Foreign/Safety.hs view
@@ -0,0 +1,28 @@+module HIndent.Ast.Declaration.Foreign.Safety+  ( Safety+  , mkSafety+  ) where++import qualified GHC.Types.ForeignCall as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Safety+  = Safe+  | Interruptible+  | Unsafe++instance CommentExtraction Safety where+  nodeComments _ = NodeComments [] [] []++instance Pretty Safety where+  pretty' Safe = string "safe"+  pretty' Interruptible = string "interruptible"+  pretty' Unsafe = string "unsafe"++mkSafety :: GHC.Safety -> Safety+mkSafety GHC.PlaySafe = Safe+mkSafety GHC.PlayInterruptible = Interruptible+mkSafety GHC.PlayRisky = Unsafe
+ src/HIndent/Ast/Declaration/Instance/Class.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Instance.Class+  ( ClassInstance+  , mkClassInstance+  ) where++import Control.Monad+import qualified GHC.Data.Bag as GHC+import HIndent.Applicative+import HIndent.Ast.Declaration.Instance.Class.OverlapMode+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Pretty.SigBindFamily+import HIndent.Pretty.Types++data ClassInstance = ClassInstance+  { overlapMode :: Maybe (WithComments OverlapMode)+  , cid_sigs :: [GHC.LSig GHC.GhcPs]+  , cid_binds :: GHC.LHsBinds GHC.GhcPs+  , cid_tyfam_insts :: [GHC.LTyFamInstDecl GHC.GhcPs]+  , cid_datafam_insts :: [GHC.LDataFamInstDecl GHC.GhcPs]+  , cid_poly_ty :: GHC.LHsSigType GHC.GhcPs+  }++instance CommentExtraction ClassInstance where+  nodeComments ClassInstance {} = NodeComments [] [] []++instance Pretty ClassInstance where+  pretty' (ClassInstance {..}) = do+    string "instance " |=> do+      whenJust overlapMode $ \x -> do+        pretty x+        space+      pretty (fmap HsSigTypeInsideInstDecl cid_poly_ty)+        |=> unless (null sigsAndMethods) (string " where")+    unless (null sigsAndMethods) $ do+      newline+      indentedBlock $ lined $ fmap pretty sigsAndMethods+    where+      sigsAndMethods =+        mkSortedLSigBindFamilyList+          cid_sigs+          (GHC.bagToList cid_binds)+          []+          cid_tyfam_insts+          cid_datafam_insts++mkClassInstance :: GHC.InstDecl GHC.GhcPs -> Maybe ClassInstance+mkClassInstance GHC.ClsInstD {cid_inst = GHC.ClsInstDecl {..}} =+  Just $ ClassInstance {..}+  where+    overlapMode = fmap (fmap mkOverlapMode . fromGenLocated) cid_overlap_mode+mkClassInstance _ = Nothing
+ src/HIndent/Ast/Declaration/Instance/Class/OverlapMode.hs view
@@ -0,0 +1,36 @@+module HIndent.Ast.Declaration.Instance.Class.OverlapMode+  ( OverlapMode+  , mkOverlapMode+  ) where++import qualified GHC.Types.Basic as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators.String+import HIndent.Pretty.NodeComments++data OverlapMode+  = Overlappable+  | Overlapping+  | Overlaps+  | Incoherent++instance CommentExtraction OverlapMode where+  nodeComments Overlappable = NodeComments [] [] []+  nodeComments Overlapping = NodeComments [] [] []+  nodeComments Overlaps = NodeComments [] [] []+  nodeComments Incoherent = NodeComments [] [] []++instance Pretty OverlapMode where+  pretty' Overlappable = string "{-# OVERLAPPABLE #-}"+  pretty' Overlapping = string "{-# OVERLAPPING #-}"+  pretty' Overlaps = string "{-# OVERLAPS #-}"+  pretty' Incoherent = string "{-# INCOHERENT #-}"++mkOverlapMode :: GHC.OverlapMode -> OverlapMode+mkOverlapMode GHC.NoOverlap {} =+  error "This AST node should never appear in the tree"+mkOverlapMode GHC.Overlappable {} = Overlappable+mkOverlapMode GHC.Overlapping {} = Overlapping+mkOverlapMode GHC.Overlaps {} = Overlaps+mkOverlapMode GHC.Incoherent {} = Incoherent
+ src/HIndent/Ast/Declaration/Instance/Family/Data.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE RecordWildCards, CPP #-}++module HIndent.Ast.Declaration.Instance.Family.Data+  ( DataFamilyInstance+  , mkDataFamilyInstance+  ) where++import qualified GHC.Hs as GG+import HIndent.Ast.Declaration.Data.Body+import HIndent.Ast.Declaration.Data.NewOrData+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+data DataFamilyInstance = DataFamilyInstance+  { newOrData :: NewOrData+  , name :: WithComments PrefixName+  , types :: GHC.HsFamEqnPats GHC.GhcPs+  , body :: DataBody+  }+#else+data DataFamilyInstance = DataFamilyInstance+  { newOrData :: NewOrData+  , name :: WithComments PrefixName+  , types :: GHC.HsTyPats GHC.GhcPs+  , body :: DataBody+  }+#endif+instance CommentExtraction DataFamilyInstance where+  nodeComments DataFamilyInstance {} = NodeComments [] [] []++instance Pretty DataFamilyInstance where+  pretty' DataFamilyInstance {..} = do+    spaced+      $ pretty newOrData : string "instance" : pretty name : fmap pretty types+    pretty body++mkDataFamilyInstance ::+     GHC.FamEqn GHC.GhcPs (GHC.HsDataDefn GHC.GhcPs) -> DataFamilyInstance+mkDataFamilyInstance GHC.FamEqn {..} = DataFamilyInstance {..}+  where+    newOrData = mkNewOrData feqn_rhs+    name = fromGenLocated $ fmap mkPrefixName feqn_tycon+    types = feqn_pats+    body = mkDataBody feqn_rhs
+ src/HIndent/Ast/Declaration/Instance/Family/Type.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE RecordWildCards, CPP #-}++module HIndent.Ast.Declaration.Instance.Family.Type+  ( TypeFamilyInstance+  , mkTypeFamilyInstance+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+data TypeFamilyInstance = TypeFamilyInstance+  { name :: WithComments PrefixName+  , types :: GHC.HsFamEqnPats GHC.GhcPs+  , bind :: GHC.LHsType GHC.GhcPs+  }+#else+data TypeFamilyInstance = TypeFamilyInstance+  { name :: WithComments PrefixName+  , types :: GHC.HsTyPats GHC.GhcPs+  , bind :: GHC.LHsType GHC.GhcPs+  }+#endif+instance CommentExtraction TypeFamilyInstance where+  nodeComments TypeFamilyInstance {} = NodeComments [] [] []++instance Pretty TypeFamilyInstance where+  pretty' TypeFamilyInstance {..} = do+    spaced $ string "type instance" : pretty name : fmap pretty types+    string " = "+    pretty bind++mkTypeFamilyInstance :: GHC.InstDecl GHC.GhcPs -> Maybe TypeFamilyInstance+mkTypeFamilyInstance GHC.TyFamInstD {GHC.tfid_inst = GHC.TyFamInstDecl {GHC.tfid_eqn = GHC.FamEqn {..}}} =+  Just $ TypeFamilyInstance {..}+  where+    name = fromGenLocated $ fmap mkPrefixName feqn_tycon+    types = feqn_pats+    bind = feqn_rhs+mkTypeFamilyInstance _ = Nothing
+ src/HIndent/Ast/Declaration/Rule.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Rule+  ( RuleDeclaration+  , mkRuleDeclaration+  ) where++import qualified GHC.Core as GHC+import qualified GHC.Data.FastString as GHC+import HIndent.Ast.Declaration.Rule.Binder+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data RuleDeclaration = RuleDeclaration+  { name :: WithComments GHC.RuleName+  , binders :: [WithComments RuleBinder]+  , lhs :: WithComments (GHC.HsExpr GHC.GhcPs)+  , rhs :: WithComments (GHC.HsExpr GHC.GhcPs)+  }++instance CommentExtraction RuleDeclaration where+  nodeComments RuleDeclaration {} = NodeComments [] [] []++instance Pretty RuleDeclaration where+  pretty' (RuleDeclaration {..}) =+    spaced+      [ prettyWith name (doubleQuotes . string . GHC.unpackFS)+      , prettyLhs+      , string "="+      , pretty rhs+      ]+    where+      prettyLhs =+        if null binders+          then pretty lhs+          else do+            string "forall "+            spaced $ fmap pretty binders+            dot+            space+            pretty lhs++mkRuleDeclaration :: GHC.RuleDecl GHC.GhcPs -> RuleDeclaration+mkRuleDeclaration rule@GHC.HsRule {..} = RuleDeclaration {..}+  where+    name = getName rule+    binders = fmap (fmap mkRuleBinder . fromGenLocated) rd_tmvs+    lhs = fromGenLocated rd_lhs+    rhs = fromGenLocated rd_rhs++getName :: GHC.RuleDecl GHC.GhcPs -> WithComments GHC.RuleName+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+getName = fromGenLocated . GHC.rd_name+#else+getName = fromGenLocated . fmap snd . GHC.rd_name+#endif
+ src/HIndent/Ast/Declaration/Rule/Binder.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Rule.Binder+  ( RuleBinder+  , mkRuleBinder+  ) where++import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data RuleBinder = RuleBinder+  { name :: WithComments PrefixName+  , signature :: Maybe (WithComments (GHC.HsType GHC.GhcPs))+  }++instance CommentExtraction RuleBinder where+  nodeComments RuleBinder {} = NodeComments [] [] []++instance Pretty RuleBinder where+  pretty' RuleBinder {signature = Nothing, ..} = pretty name+  pretty' RuleBinder {signature = Just sig, ..} =+    parens $ spaced [pretty name, string "::", pretty sig]++mkRuleBinder :: GHC.RuleBndr GHC.GhcPs -> RuleBinder+mkRuleBinder (GHC.RuleBndr _ n) = RuleBinder {..}+  where+    signature = Nothing+    name = fromGenLocated $ fmap mkPrefixName n+mkRuleBinder (GHC.RuleBndrSig _ n GHC.HsPS {..}) = RuleBinder {..}+  where+    signature = Just $ fromGenLocated hsps_body+    name = fromGenLocated $ fmap mkPrefixName n
+ src/HIndent/Ast/Declaration/Rule/Collection.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Rule.Collection+  ( RuleCollection+  , mkRuleCollection+  ) where++import HIndent.Ast.Declaration.Rule+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype RuleCollection =+  RuleCollection [WithComments RuleDeclaration]++instance CommentExtraction RuleCollection where+  nodeComments RuleCollection {} = NodeComments [] [] []++instance Pretty RuleCollection where+  pretty' (RuleCollection xs) =+    lined $ string "{-# RULES" : fmap pretty xs ++ [string " #-}"]++mkRuleCollection :: GHC.RuleDecls GHC.GhcPs -> RuleCollection+mkRuleCollection GHC.HsRules {..} =+  RuleCollection $ fmap (fmap mkRuleDeclaration . fromGenLocated) rds_rules
+ src/HIndent/Ast/Declaration/Signature.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Signature+  ( Signature+  , mkSignature+  ) where++import qualified GHC.Types.Basic as GHC+import HIndent.Applicative+import HIndent.Ast.Declaration.Signature.BooleanFormula+import HIndent.Ast.Declaration.Signature.Fixity+import HIndent.Ast.Declaration.Signature.Inline.Phase+import HIndent.Ast.Declaration.Signature.Inline.Spec+import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Pretty.Types++-- We want to use the same name for `parameters` and `signature`, but GHC+-- doesn't allow it.+data Signature+  = Type+      { names :: [WithComments PrefixName]+      , parameters :: GHC.LHsSigWcType GHC.GhcPs+      }+  | Pattern+      { names :: [WithComments PrefixName]+      , signature :: GHC.LHsSigType GHC.GhcPs+      }+  | DefaultClassMethod+      { names :: [WithComments PrefixName]+      , signature :: GHC.LHsSigType GHC.GhcPs+      }+  | ClassMethod+      { names :: [WithComments PrefixName]+      , signature :: GHC.LHsSigType GHC.GhcPs+      }+  | Fixity+      { opNames :: [WithComments InfixName] -- Using `names` causes a type conflict.+      , fixity :: Fixity+      }+  | Inline+      { name :: WithComments PrefixName+      , spec :: InlineSpec+      , phase :: Maybe InlinePhase+      }+  | Specialise+      { name :: WithComments PrefixName+      , sigs :: [GHC.LHsSigType GHC.GhcPs]+      }+  | SpecialiseInstance (GHC.LHsSigType GHC.GhcPs)+  | Minimal (WithComments BooleanFormula)+  | Scc (WithComments PrefixName)+  | Complete (WithComments [WithComments PrefixName])++instance CommentExtraction Signature where+  nodeComments Type {} = NodeComments [] [] []+  nodeComments Pattern {} = NodeComments [] [] []+  nodeComments DefaultClassMethod {} = NodeComments [] [] []+  nodeComments ClassMethod {} = NodeComments [] [] []+  nodeComments Fixity {} = NodeComments [] [] []+  nodeComments Inline {} = NodeComments [] [] []+  nodeComments Specialise {} = NodeComments [] [] []+  nodeComments SpecialiseInstance {} = NodeComments [] [] []+  nodeComments Minimal {} = NodeComments [] [] []+  nodeComments Scc {} = NodeComments [] [] []+  nodeComments Complete {} = NodeComments [] [] []++instance Pretty Signature where+  pretty' Type {..} = do+    printFunName+    string " ::"+    horizontal <-|> vertical+    where+      horizontal = do+        space+        pretty $ HsSigTypeInsideDeclSig <$> GHC.hswc_body parameters+      vertical = do+        headLen <- printerLength printFunName+        indentSpaces <- getIndentSpaces+        if headLen < indentSpaces+          then space+                 |=> pretty+                       (HsSigTypeInsideDeclSig <$> GHC.hswc_body parameters)+          else do+            newline+            indentedBlock+              $ indentedWithSpace 3+              $ pretty+              $ HsSigTypeInsideDeclSig <$> GHC.hswc_body parameters+      printFunName = hCommaSep $ fmap pretty names+  pretty' Pattern {..} =+    spaced+      [ string "pattern"+      , hCommaSep $ fmap pretty names+      , string "::"+      , pretty signature+      ]+  pretty' DefaultClassMethod {..} =+    spaced+      [ string "default"+      , hCommaSep $ fmap pretty names+      , string "::"+      , printCommentsAnd signature pretty+      ]+  pretty' ClassMethod {..} = do+    hCommaSep $ fmap pretty names+    string " ::"+    hor <-|> ver+    where+      hor =+        space >> printCommentsAnd signature (pretty . HsSigTypeInsideDeclSig)+      ver = do+        newline+        indentedBlock+          $ indentedWithSpace 3+          $ printCommentsAnd signature (pretty . HsSigTypeInsideDeclSig)+  pretty' Fixity {..} = spaced [pretty fixity, hCommaSep $ fmap pretty opNames]+  pretty' Inline {..} = do+    string "{-# "+    pretty spec+    whenJust phase $ \x -> space >> pretty x+    space+    pretty name+    string " #-}"+  pretty' Specialise {..} =+    spaced+      [ string "{-# SPECIALISE"+      , pretty name+      , string "::"+      , hCommaSep $ fmap pretty sigs+      , string "#-}"+      ]+  pretty' (SpecialiseInstance sig) =+    spaced [string "{-# SPECIALISE instance", pretty sig, string "#-}"]+  pretty' (Minimal xs) =+    string "{-# MINIMAL " |=> do+      pretty xs+      string " #-}"+  pretty' (Scc name) = spaced [string "{-# SCC", pretty name, string "#-}"]+  pretty' (Complete names) =+    spaced+      [ string "{-# COMPLETE"+      , prettyWith names (hCommaSep . fmap pretty)+      , string "#-}"+      ]++mkSignature :: GHC.Sig GHC.GhcPs -> Signature+mkSignature (GHC.TypeSig _ ns parameters) = Type {..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+mkSignature (GHC.PatSynSig _ ns signature) = Pattern {..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+mkSignature (GHC.ClassOpSig _ True ns signature) = DefaultClassMethod {..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+mkSignature (GHC.ClassOpSig _ False ns signature) = ClassMethod {..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+mkSignature (GHC.FixSig _ (GHC.FixitySig _ ops fy)) = Fixity {..}+  where+    fixity = mkFixity fy+    opNames = fmap (fromGenLocated . fmap mkInfixName) ops+mkSignature (GHC.InlineSig _ n GHC.InlinePragma {..}) = Inline {..}+  where+    name = fromGenLocated $ fmap mkPrefixName n+    spec = mkInlineSpec inl_inline+    phase = mkInlinePhase inl_act+mkSignature (GHC.SpecSig _ n sigs _) = Specialise {..}+  where+    name = fromGenLocated $ fmap mkPrefixName n+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkSignature (GHC.SCCFunSig _ n _) = Scc name+  where+    name = fromGenLocated $ fmap mkPrefixName n+mkSignature (GHC.CompleteMatchSig _ ns _) = Complete names+  where+    names = mkWithComments $ fmap (fromGenLocated . fmap mkPrefixName) ns+#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)+mkSignature (GHC.SCCFunSig _ n _) = Scc name+  where+    name = fromGenLocated $ fmap mkPrefixName n+mkSignature (GHC.CompleteMatchSig _ ns _) = Complete names+  where+    names = fromGenLocated $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) ns+#elif MIN_VERSION_ghc_lib_parser(9, 4, 0)+mkSignature (GHC.SCCFunSig _ _ name _) =+  Scc $ fromGenLocated $ fmap mkPrefixName name+mkSignature (GHC.CompleteMatchSig _ _ names _) =+  Complete+    $ fromGenLocated+    $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) names+#else+mkSignature (GHC.SCCFunSig _ _ name _) =+  Scc $ fromGenLocated $ fmap mkPrefixName name+mkSignature (GHC.CompleteMatchSig _ _ names _) =+  Complete+    $ fromGenLocated+    $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) names+#endif+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+mkSignature (GHC.SpecInstSig _ sig) = SpecialiseInstance sig+mkSignature (GHC.MinimalSig _ xs) =+  Minimal $ mkBooleanFormula <$> fromGenLocated xs+#else+mkSignature (GHC.SpecInstSig _ _ sig) = SpecialiseInstance sig+mkSignature (GHC.MinimalSig _ _ xs) =+  Minimal $ mkBooleanFormula <$> fromGenLocated xs+mkSignature GHC.IdSig {} =+  error "`ghc-lib-parser` never generates this AST node."+#endif
+ src/HIndent/Ast/Declaration/Signature/BooleanFormula.hs view
@@ -0,0 +1,39 @@+module HIndent.Ast.Declaration.Signature.BooleanFormula+  ( BooleanFormula+  , mkBooleanFormula+  ) where++import qualified GHC.Data.BooleanFormula as GHC+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data BooleanFormula+  = Var (WithComments PrefixName)+  | And [WithComments BooleanFormula]+  | Or [WithComments BooleanFormula]+  | Parens (WithComments BooleanFormula)++instance CommentExtraction BooleanFormula where+  nodeComments Var {} = NodeComments [] [] []+  nodeComments And {} = NodeComments [] [] []+  nodeComments Or {} = NodeComments [] [] []+  nodeComments Parens {} = NodeComments [] [] []++instance Pretty BooleanFormula where+  pretty' (Var x) = pretty x+  pretty' (And xs) = hvCommaSep $ fmap pretty xs+  pretty' (Or xs) = hvBarSep $ fmap pretty xs+  pretty' (Parens x) = parens $ pretty x++mkBooleanFormula :: GHC.BooleanFormula (GHC.LIdP GHC.GhcPs) -> BooleanFormula+mkBooleanFormula (GHC.Var x) = Var $ fromGenLocated $ fmap mkPrefixName x+mkBooleanFormula (GHC.And xs) =+  And $ fmap (fmap mkBooleanFormula . fromGenLocated) xs+mkBooleanFormula (GHC.Or xs) =+  Or $ fmap (fmap mkBooleanFormula . fromGenLocated) xs+mkBooleanFormula (GHC.Parens x) = Parens $ mkBooleanFormula <$> fromGenLocated x
+ src/HIndent/Ast/Declaration/Signature/Fixity.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Signature.Fixity+  ( Fixity+  , mkFixity+  ) where++import qualified GHC.Types.Fixity as GHC+import HIndent.Ast.Declaration.Signature.Fixity.Associativity+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Fixity = Fixity+  { level :: Int+  , associativity :: Associativity+  }++instance CommentExtraction Fixity where+  nodeComments Fixity {} = NodeComments [] [] []++instance Pretty Fixity where+  pretty' Fixity {..} = spaced [pretty associativity, string $ show level]++mkFixity :: GHC.Fixity -> Fixity+mkFixity (GHC.Fixity _ level associativity) =+  Fixity level (mkAssociativity associativity)
+ src/HIndent/Ast/Declaration/Signature/Fixity/Associativity.hs view
@@ -0,0 +1,30 @@+module HIndent.Ast.Declaration.Signature.Fixity.Associativity+  ( Associativity+  , mkAssociativity+  ) where++import qualified GHC.Types.Fixity as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Associativity+  = LeftAssoc+  | RightAssoc+  | None++instance CommentExtraction Associativity where+  nodeComments LeftAssoc = NodeComments [] [] []+  nodeComments RightAssoc = NodeComments [] [] []+  nodeComments None = NodeComments [] [] []++instance Pretty Associativity where+  pretty' LeftAssoc = string "infixl"+  pretty' RightAssoc = string "infixr"+  pretty' None = string "infix"++mkAssociativity :: GHC.FixityDirection -> Associativity+mkAssociativity GHC.InfixL = LeftAssoc+mkAssociativity GHC.InfixR = RightAssoc+mkAssociativity GHC.InfixN = None
+ src/HIndent/Ast/Declaration/Signature/Inline/Phase.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Signature.Inline.Phase+  ( InlinePhase+  , mkInlinePhase+  ) where++import qualified GHC.Types.Basic as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data BeforeOrAfter+  = Before+  | After++data InlinePhase = InlinePhase+  { beforeOrAfter :: BeforeOrAfter+  , phase :: Int+  }++instance CommentExtraction InlinePhase where+  nodeComments InlinePhase {} = NodeComments [] [] []++instance Pretty InlinePhase where+  pretty' InlinePhase {beforeOrAfter = Before, ..} =+    brackets (string $ '~' : show phase)+  pretty' InlinePhase {beforeOrAfter = After, ..} =+    brackets (string $ show phase)++mkInlinePhase :: GHC.Activation -> Maybe InlinePhase+mkInlinePhase (GHC.ActiveBefore _ phase) = Just $ InlinePhase Before phase+mkInlinePhase (GHC.ActiveAfter _ phase) = Just $ InlinePhase After phase+mkInlinePhase _ = Nothing
+ src/HIndent/Ast/Declaration/Signature/Inline/Spec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Declaration.Signature.Inline.Spec+  ( InlineSpec+  , mkInlineSpec+  ) where++import qualified GHC.Types.Basic as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data InlineSpec+  = Inline+  | Inlinable+  | NoInline+  | Opaque++instance CommentExtraction InlineSpec where+  nodeComments Inline = NodeComments [] [] []+  nodeComments Inlinable = NodeComments [] [] []+  nodeComments NoInline = NodeComments [] [] []+  nodeComments Opaque = NodeComments [] [] []++instance Pretty InlineSpec where+  pretty' Inline = string "INLINE"+  pretty' Inlinable = string "INLINABLE"+  pretty' NoInline = string "NOINLINE"+  pretty' Opaque = string "OPAQUE"++mkInlineSpec :: GHC.InlineSpec -> InlineSpec+mkInlineSpec GHC.Inline {} = Inline+mkInlineSpec GHC.Inlinable {} = Inlinable+mkInlineSpec GHC.NoInline {} = NoInline+mkInlineSpec GHC.NoUserInlinePrag = error "NoUserInlinePrag is not supported"+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+mkInlineSpec GHC.Opaque {} = Opaque+#endif
+ src/HIndent/Ast/Declaration/Signature/StandaloneKind.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Signature.StandaloneKind+  ( StandaloneKind+  , mkStandaloneKind+  ) where++import qualified GHC.Hs as GHC+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data StandaloneKind = StandaloneKind+  { name :: WithComments PrefixName+  , kind :: GHC.LHsSigType GHC.GhcPs+  }++instance CommentExtraction StandaloneKind where+  nodeComments StandaloneKind {} = NodeComments [] [] []++instance Pretty StandaloneKind where+  pretty' StandaloneKind {..} =+    spaced [string "type", pretty name, string "::", pretty kind]++mkStandaloneKind :: GHC.StandaloneKindSig GHC.GhcPs -> StandaloneKind+mkStandaloneKind (GHC.StandaloneKindSig _ n kind) = StandaloneKind {..}+  where+    name = fromGenLocated $ fmap mkPrefixName n
+ src/HIndent/Ast/Declaration/Splice.hs view
@@ -0,0 +1,23 @@+module HIndent.Ast.Declaration.Splice+  ( SpliceDeclaration+  , mkSpliceDeclaration+  ) where++import HIndent.Ast.Expression.Splice+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.NodeComments++newtype SpliceDeclaration =+  SpliceDeclaration (GHC.SpliceDecl GHC.GhcPs)++instance CommentExtraction SpliceDeclaration where+  nodeComments SpliceDeclaration {} = NodeComments [] [] []++instance Pretty SpliceDeclaration where+  pretty' (SpliceDeclaration (GHC.SpliceDecl _ sp _)) =+    pretty $ fmap mkSplice sp++mkSpliceDeclaration :: GHC.SpliceDecl GHC.GhcPs -> SpliceDeclaration+mkSpliceDeclaration = SpliceDeclaration
+ src/HIndent/Ast/Declaration/StandAloneDeriving.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.StandAloneDeriving+  ( StandAloneDeriving+  , mkStandAloneDeriving+  ) where++import HIndent.Applicative+import HIndent.Ast.Declaration.Data.Deriving.Strategy+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data StandAloneDeriving = StandAloneDeriving+  { strategy :: Maybe (WithComments DerivingStrategy)+  , className :: GHC.LHsSigType GHC.GhcPs+  }++instance CommentExtraction StandAloneDeriving where+  nodeComments StandAloneDeriving {} = NodeComments [] [] []++instance Pretty StandAloneDeriving where+  pretty' StandAloneDeriving {strategy = Just strategy, ..}+    | isViaStrategy (getNode strategy) =+      spaced+        [ string "deriving"+        , pretty strategy+        , string "instance"+        , pretty className+        ]+  pretty' StandAloneDeriving {..} = do+    string "deriving "+    whenJust strategy $ \x -> pretty x >> space+    string "instance "+    pretty className++mkStandAloneDeriving :: GHC.DerivDecl GHC.GhcPs -> StandAloneDeriving+mkStandAloneDeriving GHC.DerivDecl {deriv_type = GHC.HsWC {..}, ..} =+  StandAloneDeriving {..}+  where+    strategy = fmap (fmap mkDerivingStrategy . fromGenLocated) deriv_strategy+    className = hswc_body
+ src/HIndent/Ast/Declaration/TypeSynonym.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.TypeSynonym+  ( TypeSynonym+  , mkTypeSynonym+  ) where++import HIndent.Ast.Declaration.TypeSynonym.Lhs+import HIndent.Ast.NodeComments+import HIndent.Ast.Type+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data TypeSynonym = TypeSynonym+  { lhs :: TypeSynonymLhs+  , rhs :: WithComments Type+  }++instance CommentExtraction TypeSynonym where+  nodeComments TypeSynonym {} = NodeComments [] [] []++instance Pretty TypeSynonym where+  pretty' TypeSynonym {..} = do+    string "type "+    pretty lhs+    hor <-|> ver+    where+      hor = string " = " >> pretty rhs+      ver = newline >> indentedBlock (string "= " |=> pretty rhs)++mkTypeSynonym :: GHC.TyClDecl GHC.GhcPs -> TypeSynonym+mkTypeSynonym synonym@GHC.SynDecl {..} = TypeSynonym {..}+  where+    lhs = mkTypeSynonymLhs synonym+    rhs = mkType <$> fromGenLocated tcdRhs+mkTypeSynonym _ = error "Not a type synonym."
+ src/HIndent/Ast/Declaration/TypeSynonym/Lhs.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.TypeSynonym.Lhs+  ( TypeSynonymLhs+  , mkTypeSynonymLhs+  ) where++import qualified GHC.Types.Fixity as GHC+import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data TypeSynonymLhs+  = Prefix+      { pName :: WithComments PrefixName -- Using `name` in both `Prefix` and `Infix` causes a type conflict.+      , typeVariables :: [WithComments TypeVariable]+      }+  | Infix+      { left :: WithComments TypeVariable+      , iName :: WithComments InfixName+      , right :: WithComments TypeVariable+      }++instance CommentExtraction TypeSynonymLhs where+  nodeComments Prefix {} = NodeComments [] [] []+  nodeComments Infix {} = NodeComments [] [] []++instance Pretty TypeSynonymLhs where+  pretty' Prefix {..} = spaced $ pretty pName : fmap pretty typeVariables+  pretty' Infix {..} = spaced [pretty left, pretty iName, pretty right]++mkTypeSynonymLhs :: GHC.TyClDecl GHC.GhcPs -> TypeSynonymLhs+mkTypeSynonymLhs GHC.SynDecl {tcdFixity = GHC.Prefix, ..} = Prefix {..}+  where+    pName = fromGenLocated $ fmap mkPrefixName tcdLName+    typeVariables =+      fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars+mkTypeSynonymLhs GHC.SynDecl {tcdFixity = GHC.Infix, ..} =+  case GHC.hsq_explicit tcdTyVars of+    [l, r] -> Infix {..}+      where left = mkTypeVariable <$> fromGenLocated l+            iName = fromGenLocated $ fmap mkInfixName tcdLName+            right = mkTypeVariable <$> fromGenLocated r+    _ -> error "Unexpected number of type variables for infix type synonym."+mkTypeSynonymLhs _ = error "Not a type synonym."
+ src/HIndent/Ast/Declaration/Warning.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Declaration.Warning+  ( WarningDeclaration+  , mkWarningDeclaration+  ) where++import qualified GHC.Types.SourceText as GHC+import HIndent.Ast.Declaration.Warning.Kind+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data WarningDeclaration = WarningDeclaration+  { names :: [WithComments PrefixName]+  , kind :: Kind+  , reasons :: [WithComments GHC.StringLiteral]+  }++instance CommentExtraction WarningDeclaration where+  nodeComments _ = NodeComments [] [] []++instance Pretty WarningDeclaration where+  pretty' WarningDeclaration {..} = do+    lined+      [ string "{-# " >> pretty kind+      , spaced [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons]+      , string " #-}"+      ]++mkWarningDeclaration :: GHC.WarnDecl GHC.GhcPs -> WarningDeclaration+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =+  WarningDeclaration {kind = Deprecated, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ _ rs)) =+  WarningDeclaration {kind = Warning, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =+  WarningDeclaration {kind = Deprecated, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ _ rs)) =+  WarningDeclaration {kind = Warning, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =+  WarningDeclaration {kind = Deprecated, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =+  WarningDeclaration {kind = Warning, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs+#else+mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =+  WarningDeclaration {kind = Deprecated, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap fromGenLocated rs+mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =+  WarningDeclaration {kind = Warning, ..}+  where+    names = fmap (fromGenLocated . fmap mkPrefixName) ns+    reasons = fmap fromGenLocated rs+#endif
+ src/HIndent/Ast/Declaration/Warning/Collection.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Declaration.Warning.Collection+  ( WarningCollection+  , mkWarningCollection+  ) where++import HIndent.Ast.Declaration.Warning+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype WarningCollection =+  WarningCollection [WithComments WarningDeclaration]++instance CommentExtraction WarningCollection where+  nodeComments WarningCollection {} = NodeComments [] [] []++instance Pretty WarningCollection where+  pretty' (WarningCollection xs) = lined $ fmap pretty xs++mkWarningCollection :: GHC.WarnDecls GHC.GhcPs -> WarningCollection+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+mkWarningCollection (GHC.Warnings _ xs) =+  WarningCollection $ fmap (fmap mkWarningDeclaration . fromGenLocated) xs+#else+mkWarningCollection (GHC.Warnings _ _ xs) =+  WarningCollection $ fmap (fmap mkWarningDeclaration . fromGenLocated) xs+#endif
+ src/HIndent/Ast/Declaration/Warning/Kind.hs view
@@ -0,0 +1,19 @@+module HIndent.Ast.Declaration.Warning.Kind+  ( Kind(..)+  ) where++import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Kind+  = Warning+  | Deprecated++instance CommentExtraction Kind where+  nodeComments _ = NodeComments [] [] []++instance Pretty Kind where+  pretty' Warning = string "WARNING"+  pretty' Deprecated = string "DEPRECATED"
+ src/HIndent/Ast/Expression/Bracket.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Expression.Bracket+  ( Bracket+  , mkBracket+  ) where++import HIndent.Ast.Declaration+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Bracket+  = TypedExpression (GHC.LHsExpr GHC.GhcPs)+  | UntypedExpression (GHC.LHsExpr GHC.GhcPs)+  | Pattern (GHC.LPat GHC.GhcPs)+  | Declaration [WithComments Declaration]+  | Type (GHC.LHsType GHC.GhcPs)+  | Variable Bool (WithComments PrefixName)++instance CommentExtraction Bracket where+  nodeComments TypedExpression {} = NodeComments [] [] []+  nodeComments UntypedExpression {} = NodeComments [] [] []+  nodeComments Pattern {} = NodeComments [] [] []+  nodeComments Declaration {} = NodeComments [] [] []+  nodeComments Type {} = NodeComments [] [] []+  nodeComments Variable {} = NodeComments [] [] []++instance Pretty Bracket where+  pretty' (TypedExpression x) = typedBrackets $ pretty x+  pretty' (UntypedExpression x) = brackets $ wrapWithBars $ pretty x+  pretty' (Pattern x) = brackets $ string "p" >> wrapWithBars (pretty x)+  pretty' (Declaration decls) =+    brackets $ string "d| " |=> lined (fmap pretty decls) >> string " |"+  pretty' (Type x) = brackets $ string "t" >> wrapWithBars (pretty x)+  pretty' (Variable True var) = string "'" >> pretty var+  pretty' (Variable False var) = string "''" >> pretty var+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+mkBracket :: GHC.HsQuote GHC.GhcPs -> Bracket+#else+mkBracket :: GHC.HsBracket GHC.GhcPs -> Bracket+#endif+mkBracket (GHC.ExpBr _ x) = UntypedExpression x+mkBracket (GHC.PatBr _ x) = Pattern x+mkBracket (GHC.DecBrL _ x) =+  Declaration $ fmap (fmap mkDeclaration . fromGenLocated) x+mkBracket (GHC.TypBr _ x) = Type x+mkBracket (GHC.VarBr _ b x) = Variable b $ fromGenLocated $ fmap mkPrefixName x+mkBracket (GHC.DecBrG {}) = error "This AST node should never appear."+#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)+mkBracket (GHC.TExpBr _ x) = TypedExpression x+#endif
+ src/HIndent/Ast/Expression/Splice.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Expression.Splice+  ( Splice+  , mkSplice+  ) where++import qualified GHC.Data.FastString as GHC+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+import qualified GHC.Types.SrcLoc as GHC+#endif+data Splice+  = Typed (GHC.LHsExpr GHC.GhcPs)+  | UntypedDollar (GHC.LHsExpr GHC.GhcPs)+  | UntypedBare (GHC.LHsExpr GHC.GhcPs)+  | QuasiQuote PrefixName GHC.FastString++instance CommentExtraction Splice where+  nodeComments Typed {} = NodeComments [] [] []+  nodeComments UntypedDollar {} = NodeComments [] [] []+  nodeComments UntypedBare {} = NodeComments [] [] []+  nodeComments QuasiQuote {} = NodeComments [] [] []++instance Pretty Splice where+  pretty' (Typed x) = string "$$" >> pretty x+  pretty' (UntypedDollar x) = string "$" >> pretty x+  pretty' (UntypedBare x) = pretty x+  pretty' (QuasiQuote l r) =+    brackets $ do+      pretty l+      wrapWithBars+        $ indentedWithFixedLevel 0+        $ sequence_+        $ printers [] ""+        $ GHC.unpackFS r+    where+      printers ps s [] = reverse (string (reverse s) : ps)+      printers ps s ('\n':xs) =+        printers (newline : string (reverse s) : ps) "" xs+      printers ps s (x:xs) = printers ps (x : s) xs+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+mkSplice :: GHC.HsUntypedSplice GHC.GhcPs -> Splice+mkSplice (GHC.HsUntypedSpliceExpr _ x) = UntypedDollar x+mkSplice (GHC.HsQuasiQuote _ l (GHC.L _ r)) = QuasiQuote (mkPrefixName l) r+#else+mkSplice :: GHC.HsSplice GHC.GhcPs -> Splice+mkSplice (GHC.HsTypedSplice _ _ _ body) = Typed body+mkSplice (GHC.HsUntypedSplice _ GHC.DollarSplice _ body) = UntypedDollar body+mkSplice (GHC.HsUntypedSplice _ GHC.BareSplice _ body) = UntypedBare body+mkSplice (GHC.HsQuasiQuote _ _ l _ r) = QuasiQuote (mkPrefixName l) r+mkSplice GHC.HsSpliced {} = error "This AST node should never appear."+#endif
+ src/HIndent/Ast/FileHeaderPragma.hs view
@@ -0,0 +1,43 @@+module HIndent.Ast.FileHeaderPragma+  ( FileHeaderPragma+  , mkFileHeaderPragma+  ) where++import Data.Bifunctor+import Data.Char+import Data.List+import Data.List.Split+import qualified GHC.Hs as GHC+import HIndent.Ast.NodeComments+import HIndent.Pragma+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype FileHeaderPragma =+  FileHeaderPragma String++instance CommentExtraction FileHeaderPragma where+  nodeComments _ = NodeComments [] [] []++instance Pretty FileHeaderPragma where+  pretty' (FileHeaderPragma x) = string x++mkFileHeaderPragma :: GHC.EpaCommentTok -> Maybe FileHeaderPragma+mkFileHeaderPragma =+  fmap (FileHeaderPragma . uncurry constructPragma) . extractPragma++-- | This function returns a 'Just' value with the pragma+-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it+-- returns a 'Nothing'.+extractPragma :: GHC.EpaCommentTok -> Maybe (String, [String])+extractPragma (GHC.EpaBlockComment c) =+  second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c+  where+    strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace+extractPragma _ = Nothing++-- | Construct a pragma.+constructPragma :: String -> [String] -> String+constructPragma optionOrPragma xs =+  "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"
+ src/HIndent/Ast/FileHeaderPragma/Collection.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.FileHeaderPragma.Collection+  ( FileHeaderPragmaCollection+  , mkFileHeaderPragmaCollection+  , hasPragmas+  ) where++import Data.Maybe+import Generics.SYB+import HIndent.Ast.FileHeaderPragma+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype FileHeaderPragmaCollection =+  FileHeaderPragmaCollection [FileHeaderPragma]++instance CommentExtraction FileHeaderPragmaCollection where+  nodeComments _ = NodeComments [] [] []++instance Pretty FileHeaderPragmaCollection where+  pretty' (FileHeaderPragmaCollection xs) = lined $ fmap pretty xs++mkFileHeaderPragmaCollection :: GHC.HsModule' -> FileHeaderPragmaCollection+mkFileHeaderPragmaCollection =+  FileHeaderPragmaCollection+    . mapMaybe mkFileHeaderPragma+    . collectBlockComments++hasPragmas :: FileHeaderPragmaCollection -> Bool+hasPragmas (FileHeaderPragmaCollection xs) = not $ null xs++collectBlockComments :: GHC.HsModule' -> [GHC.EpaCommentTok]+collectBlockComments = listify isBlockComment . GHC.getModuleAnn++-- | Checks if the given comment is a block one.+isBlockComment :: GHC.EpaCommentTok -> Bool+isBlockComment GHC.EpaBlockComment {} = True+isBlockComment _ = False
+ src/HIndent/Ast/Import.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Import+  ( Import+  , mkImport+  , sortByName+  ) where++import Control.Monad+import Data.Function+import Data.List+import qualified GHC.Types.SourceText as GHC+import qualified GHC.Unit as GHC+import HIndent.Applicative+import HIndent.Ast.Import.Entry.Collection+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import qualified HIndent.GhcLibParserWrapper.GHC.Hs.ImpExp as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data QualificationPosition+  = Pre+  | Post+  deriving (Eq)++data Qualification = Qualification+  { qualifiedAs :: Maybe (GHC.XRec GHC.GhcPs GHC.ModuleName)+  , position :: QualificationPosition+  } deriving (Eq)++data Import = Import+  { moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName+  , isSafe :: Bool+  , isBoot :: Bool+  , qualification :: Maybe Qualification+  , packageName :: Maybe GHC.StringLiteral+  , importEntries :: Maybe (WithComments ImportEntryCollection)+  }++instance CommentExtraction Import where+  nodeComments Import {} = NodeComments [] [] []++instance Pretty Import where+  pretty' Import {..} = do+    string "import "+    when isBoot $ string "{-# SOURCE #-} "+    when isSafe $ string "safe "+    when (fmap position qualification == Just Pre) $ string "qualified "+    whenJust packageName $ \name -> pretty name >> space+    pretty moduleName+    when (fmap position qualification == Just Post) $ string " qualified"+    case qualification of+      Just Qualification {qualifiedAs = Just name} ->+        string " as " >> pretty name+      _ -> pure ()+    whenJust importEntries pretty++mkImport :: GHC.ImportDecl GHC.GhcPs -> Import+mkImport decl@GHC.ImportDecl {..} = Import {..}+  where+    moduleName = ideclName+    isSafe = ideclSafe+    isBoot = ideclSource == GHC.IsBoot+    qualification =+      case (ideclQualified, ideclAs, ideclQualified) of+        (GHC.NotQualified, _, _) -> Nothing+        (_, Nothing, GHC.QualifiedPre) ->+          Just Qualification {qualifiedAs = Nothing, position = Pre}+        (_, Nothing, GHC.QualifiedPost) ->+          Just Qualification {qualifiedAs = Nothing, position = Post}+        (_, Just name, GHC.QualifiedPre) ->+          Just Qualification {qualifiedAs = Just name, position = Pre}+        (_, Just name, GHC.QualifiedPost) ->+          Just Qualification {qualifiedAs = Just name, position = Post}+    packageName = GHC.getPackageName decl+    importEntries = mkImportEntryCollection decl++sortByName :: [WithComments Import] -> [WithComments Import]+sortByName = fmap sortExplicitImportsInDecl . sortByModuleName++-- | This function sorts import declarations by their module names.+sortByModuleName :: [WithComments Import] -> [WithComments Import]+sortByModuleName = sortBy (compare `on` showOutputable . moduleName . getNode)++-- | This function sorts explicit imports in the given import declaration+-- by their names.+sortExplicitImportsInDecl :: WithComments Import -> WithComments Import+sortExplicitImportsInDecl = fmap f+  where+    f (Import {importEntries = Just xs, ..}) =+      Import {importEntries = Just sorted, ..}+      where+        sorted = fmap sortEntriesByName xs+    f x = x
+ src/HIndent/Ast/Import/Collection.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Import.Collection+  ( ImportCollection+  , mkImportCollection+  , hasImports+  ) where++import Control.Monad.RWS+import Data.Function+import Data.List+import qualified GHC.Hs as GHC+import GHC.Stack+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.Import+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import HIndent.Config+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Printer++newtype ImportCollection =+  ImportCollection [[WithComments Import]]++instance CommentExtraction ImportCollection where+  nodeComments ImportCollection {} = NodeComments [] [] []++instance Pretty ImportCollection where+  pretty' (ImportCollection xs) =+    importDecls >>= blanklined . fmap outputImportGroup+    where+      outputImportGroup = lined . fmap pretty+      importDecls =+        gets (configSortImports . psConfig) >>= \case+          True -> pure $ fmap sortByName xs+          False -> pure xs++mkImportCollection :: GHC.HsModule' -> ImportCollection+mkImportCollection GHC.HsModule {..} =+  ImportCollection+    $ fmap+        (fmap (fmap mkImport . fromGenLocated))+        (extractImports' hsmodImports)++hasImports :: ImportCollection -> Bool+hasImports (ImportCollection xs) = not $ null xs++-- | Extracts import declarations from the given module. Adjacent import+-- declarations are grouped as a single list.+extractImports' :: [GHC.LImportDecl GHC.GhcPs] -> [[GHC.LImportDecl GHC.GhcPs]]+extractImports' = groupImports . sortImportsByLocation++-- | Combines adjacent import declarations into a single list.+groupImports :: [GHC.LImportDecl GHC.GhcPs] -> [[GHC.LImportDecl GHC.GhcPs]]+groupImports = groupImports' []+  where+    groupImports' ::+         [[GHC.LImportDecl GHC.GhcPs]]+      -> [GHC.LImportDecl GHC.GhcPs]+      -> [[GHC.LImportDecl GHC.GhcPs]]+    groupImports' xs [] = xs+    groupImports' [] (x:xs) = groupImports' [[x]] xs+    groupImports' [[]] (x:xs) = groupImports' [[x]] xs+    groupImports' ([]:x:xs) (y:ys) = groupImports' ([y] : x : xs) ys+    groupImports' ((z:zs):xs) (y:ys)+      | z `isAdjacentTo` y = groupImports' ((y : z : zs) : xs) ys+      | otherwise = groupImports' ([y] : (z : zs) : xs) ys+    a `isAdjacentTo` b =+      GHC.srcSpanEndLine (sp a) + 1 == GHC.srcSpanStartLine (sp b)+        || GHC.srcSpanEndLine (sp b) + 1 == GHC.srcSpanStartLine (sp a)+    sp x =+      case GHC.locA $ GHC.getLoc x of+        GHC.RealSrcSpan x' _ -> x'+        _ -> error "Src span unavailable."++-- | This function sorts imports by their start line numbers.+sortImportsByLocation ::+     [GHC.LImportDecl GHC.GhcPs] -> [GHC.LImportDecl GHC.GhcPs]+sortImportsByLocation = sortBy (flip compare `on` lineIdx)+  where+    lineIdx = startLine . GHC.locA . GHC.getLoc++-- | This function returns the start line of the given 'SrcSpan'. If it is+-- not available, it raises an error.+startLine :: HasCallStack => GHC.SrcSpan -> Int+startLine (GHC.RealSrcSpan x _) = GHC.srcSpanStartLine x+startLine (GHC.UnhelpfulSpan _) = error "The src span is unavailable."
+ src/HIndent/Ast/Import/Entry.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Import.Entry+  ( ImportEntry+  , mkImportEntry+  , sortVariantsAndExplicitImports+  ) where++import Data.Char+import Data.Function+import Data.List+import qualified GHC.Hs as GHC+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+data ImportEntry+  = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)+  | WithSpecificConstructors+      { name :: GHC.LIEWrappedName GHC.GhcPs+      , constructors :: [GHC.LIEWrappedName GHC.GhcPs]+      }+  | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)+#else+data ImportEntry+  = SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))+  | WithSpecificConstructors+      { name :: GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)+      , constructors :: [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]+      }+  | WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))+#endif+instance CommentExtraction ImportEntry where+  nodeComments _ = NodeComments [] [] []++instance Pretty ImportEntry where+  pretty' (SingleIdentifier wrapped) = pretty wrapped+  pretty' (WithAllConstructors wrapped) = pretty wrapped >> string "(..)"+  pretty' WithSpecificConstructors {..} =+    pretty name >> hFillingTuple (fmap pretty constructors)++mkImportEntry :: GHC.IE GHC.GhcPs -> ImportEntry+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkImportEntry (GHC.IEVar _ name _) = SingleIdentifier name+mkImportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name+mkImportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name+mkImportEntry (GHC.IEThingWith _ name _ constructors _) =+  WithSpecificConstructors {..}+#else+mkImportEntry (GHC.IEVar _ name) = SingleIdentifier name+mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name+mkImportEntry (GHC.IEThingAll _ name) = WithAllConstructors name+mkImportEntry (GHC.IEThingWith _ name _ constructors) =+  WithSpecificConstructors {..}+#endif+mkImportEntry _ = undefined++sortVariantsAndExplicitImports ::+     [WithComments ImportEntry] -> [WithComments ImportEntry]+sortVariantsAndExplicitImports = fmap sortVariants . sortExplicitImports++-- | This function sorts variants (e.g., data constructors and class+-- methods) in the given explicit import by their names.+sortVariants :: WithComments ImportEntry -> WithComments ImportEntry+sortVariants = fmap f+  where+    f WithSpecificConstructors {..} =+      WithSpecificConstructors+        {constructors = sortBy (compare `on` showOutputable) constructors, ..}+    f x = x++-- | This function sorts the given explicit imports by their names.+sortExplicitImports :: [WithComments ImportEntry] -> [WithComments ImportEntry]+sortExplicitImports = sortBy (compareImportEntities `on` getNode)++-- | This function compares two import declarations by their module names.+compareImportEntities :: ImportEntry -> ImportEntry -> Ordering+compareImportEntities = compareIdentifier `on` showOutputable . getModuleName+-- | This function returns a 'Just' value with the module name extracted+-- from the import declaration. Otherwise, it returns a 'Nothing'.+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+getModuleName :: ImportEntry -> GHC.LIEWrappedName GHC.GhcPs+#else+getModuleName :: ImportEntry -> GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)+#endif+getModuleName (SingleIdentifier wrapped) = wrapped+getModuleName (WithAllConstructors wrapped) = wrapped+getModuleName (WithSpecificConstructors wrapped _) = wrapped++-- | This function compares two identifiers in order of capitals, symbols,+-- and lowers.+compareIdentifier :: String -> String -> Ordering+compareIdentifier as@(a:_) bs@(b:_) =+  case compareChar a b of+    EQ -> compareSameIdentifierType as bs+    x -> x+compareIdentifier _ _ = error "Either identifier is an empty string."++-- | Almost similar to 'compare' but ignores parentheses for symbol+-- identifiers as they are enclosed by parentheses.+compareSameIdentifierType :: String -> String -> Ordering+compareSameIdentifierType "" "" = EQ+compareSameIdentifierType "" _ = LT+compareSameIdentifierType _ "" = GT+compareSameIdentifierType ('(':as) bs = compareSameIdentifierType as bs+compareSameIdentifierType (')':as) bs = compareSameIdentifierType as bs+compareSameIdentifierType as ('(':bs) = compareSameIdentifierType as bs+compareSameIdentifierType as (')':bs) = compareSameIdentifierType as bs+compareSameIdentifierType (a:as) (b:bs) =+  case compare a b of+    EQ -> compareSameIdentifierType as bs+    x -> x++-- | This function compares two characters by their types (capital, symbol,+-- and lower). If both are the same type, then it compares them by the+-- usual ordering.+compareChar :: Char -> Char -> Ordering+compareChar a b =+  case compare at bt of+    EQ -> compare a b+    x -> x+  where+    at = charToLetterType a+    bt = charToLetterType b++-- | This function returns a 'LetterType' based on the given character.+charToLetterType :: Char -> LetterType+charToLetterType c+  | isLower c = Lower+  | isUpper c = Capital+  | otherwise = Symbol++-- | The letter type of a 'Char'.+--+-- The order of constructors is important. HIndent sorts explicit imports+-- from ones starting from a capital letter (e.g., data constructors),+-- symbol identifiers, and functions.+data LetterType+  = Capital+  | Symbol+  | Lower+  deriving (Eq, Ord)
+ src/HIndent/Ast/Import/Entry/Collection.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Import.Entry.Collection+  ( ImportEntryCollection+  , mkImportEntryCollection+  , sortEntriesByName+  ) where++import Control.Monad+import qualified GHC.Hs as GHC+import HIndent.Ast.Import.Entry+import HIndent.Ast.Import.ImportingOrHiding+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data ImportEntryCollection = ImportEntryCollection+  { entries :: [WithComments ImportEntry]+  , kind :: ImportingOrHiding+  }++instance CommentExtraction ImportEntryCollection where+  nodeComments ImportEntryCollection {} = NodeComments [] [] []++instance Pretty ImportEntryCollection where+  pretty' ImportEntryCollection {..} = do+    when (kind == Hiding) $ string " hiding"+    (space >> hTuple (fmap pretty entries))+      <-|> (newline >> indentedBlock (vTuple $ fmap pretty entries))++mkImportEntryCollection ::+     GHC.ImportDecl GHC.GhcPs -> Maybe (WithComments ImportEntryCollection)+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+mkImportEntryCollection GHC.ImportDecl {..} =+  case ideclImportList of+    Nothing -> Nothing+    Just (GHC.Exactly, xs) ->+      Just+        $ fmap (\entries -> ImportEntryCollection {kind = Importing, ..})+        $ fromGenLocated+        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs+    Just (GHC.EverythingBut, xs) ->+      Just+        $ fmap (\entries -> ImportEntryCollection {kind = Hiding, ..})+        $ fromGenLocated+        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs+#else+mkImportEntryCollection GHC.ImportDecl {..} =+  case ideclHiding of+    Nothing -> Nothing+    Just (False, xs) ->+      Just+        $ fmap (\entries -> ImportEntryCollection {kind = Importing, ..})+        $ fromGenLocated+        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs+    Just (True, xs) ->+      Just+        $ fmap (\entries -> ImportEntryCollection {kind = Hiding, ..})+        $ fromGenLocated+        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs+#endif+sortEntriesByName :: ImportEntryCollection -> ImportEntryCollection+sortEntriesByName ImportEntryCollection {..} =+  ImportEntryCollection {entries = sortVariantsAndExplicitImports entries, ..}
+ src/HIndent/Ast/Import/ImportingOrHiding.hs view
@@ -0,0 +1,8 @@+module HIndent.Ast.Import.ImportingOrHiding+  ( ImportingOrHiding(..)+  ) where++data ImportingOrHiding+  = Importing+  | Hiding+  deriving (Eq)
+ src/HIndent/Ast/Module.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Module+  ( Module+  , mkModule+  ) where++import Data.Maybe+import HIndent.Ast.Declaration.Collection+import HIndent.Ast.FileHeaderPragma.Collection+import HIndent.Ast.Import.Collection+import HIndent.Ast.Module.Declaration+import HIndent.Ast.NodeComments hiding (fromEpAnn)+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Module = Module+  { pragmas :: FileHeaderPragmaCollection+  , moduleDeclaration :: Maybe ModuleDeclaration+  , imports :: ImportCollection+  , declarations :: DeclarationCollection+  }++instance CommentExtraction Module where+  nodeComments Module {} = NodeComments [] [] []++instance Pretty Module where+  pretty' Module {..}+    | isEmpty = pure ()+    | otherwise = blanklined printers >> newline+    where+      isEmpty =+        not (hasPragmas pragmas)+          && isNothing moduleDeclaration+          && not (hasImports imports)+          && not (hasDeclarations declarations)+      printers =+        catMaybes+          [ toMaybe (hasPragmas pragmas) (pretty pragmas)+          , fmap pretty moduleDeclaration+          , toMaybe (hasImports imports) (pretty imports)+          , toMaybe (hasDeclarations declarations) (pretty declarations)+          ]+      toMaybe cond x =+        if cond+          then Just x+          else Nothing++mkModule :: GHC.HsModule' -> WithComments Module+mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..}+  where+    pragmas = mkFileHeaderPragmaCollection m+    moduleDeclaration = mkModuleDeclaration m+    imports = mkImportCollection m+    declarations = mkDeclarationCollection m
+ src/HIndent/Ast/Module/Declaration.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Module.Declaration+  ( ModuleDeclaration+  , mkModuleDeclaration+  ) where++import HIndent.Applicative+import HIndent.Ast.Module.Export.Collection+import HIndent.Ast.Module.Name+import HIndent.Ast.Module.Warning+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data ModuleDeclaration = ModuleDeclaration+  { name :: WithComments ModuleName+  , warning :: Maybe (WithComments ModuleWarning)+  , exports :: Maybe (WithComments ExportCollection)+  }++instance CommentExtraction ModuleDeclaration where+  nodeComments ModuleDeclaration {} = NodeComments [] [] []++instance Pretty ModuleDeclaration where+  pretty' ModuleDeclaration {..} = do+    pretty name+    whenJust warning $ \x -> do+      space+      pretty x+    whenJust exports $ \x -> do+      newline+      indentedBlock $ pretty x+    string " where"++mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration+mkModuleDeclaration m =+  case GHC.hsmodName m of+    Nothing -> Nothing+    Just name' -> Just ModuleDeclaration {..}+      where name = mkModuleName <$> fromGenLocated name'+            warning = mkModuleWarning m+            exports = mkExportCollection m
+ src/HIndent/Ast/Module/Export/Collection.hs view
@@ -0,0 +1,28 @@+module HIndent.Ast.Module.Export.Collection+  ( ExportCollection+  , mkExportCollection+  ) where++import HIndent.Ast.Module.Export.Entry+import HIndent.Ast.NodeComments hiding (fromEpAnn)+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype ExportCollection =+  ExportCollection [WithComments ExportEntry]++instance CommentExtraction ExportCollection where+  nodeComments (ExportCollection _) = NodeComments [] [] []++instance Pretty ExportCollection where+  pretty' (ExportCollection xs) = vTuple $ fmap pretty xs++mkExportCollection :: GHC.HsModule' -> Maybe (WithComments ExportCollection)+mkExportCollection =+  fmap+    (fmap (ExportCollection . fmap (fmap mkExportEntry . fromGenLocated))+       . fromGenLocated)+    . GHC.hsmodExports
+ src/HIndent/Ast/Module/Export/Entry.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE CPP #-}++module HIndent.Ast.Module.Export.Entry+  ( ExportEntry+  , mkExportEntry+  ) where++import GHC.Stack+import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Unit as GHC+import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+data ExportEntry+  = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)+  | WithSpecificConstructors+      (GHC.LIEWrappedName GHC.GhcPs)+      [GHC.LIEWrappedName GHC.GhcPs]+  | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)+  | ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)+#else+data ExportEntry+  = SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))+  | WithSpecificConstructors+      (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))+      [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]+  | WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))+  | ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)+#endif+instance CommentExtraction ExportEntry where+  nodeComments SingleIdentifier {} = NodeComments [] [] []+  nodeComments WithSpecificConstructors {} = NodeComments [] [] []+  nodeComments WithAllConstructors {} = NodeComments [] [] []+  nodeComments ByModule {} = NodeComments [] [] []++instance Pretty ExportEntry where+  pretty' (SingleIdentifier s) = pretty s+  pretty' (WithSpecificConstructors s xs) = pretty s >> hTuple (fmap pretty xs)+  pretty' (WithAllConstructors s) = pretty s >> string "(..)"+  pretty' (ByModule s) = string "module " >> pretty s++mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier name+mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name+mkExportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name+mkExportEntry (GHC.IEThingWith _ name _ constructors _) =+  WithSpecificConstructors name constructors+#else+mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name+mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name+mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name+mkExportEntry (GHC.IEThingWith _ name _ constructors) =+  WithSpecificConstructors name constructors+#endif+mkExportEntry (GHC.IEModuleContents _ name) = ByModule name+mkExportEntry GHC.IEGroup {} = neverAppears+mkExportEntry GHC.IEDoc {} = neverAppears+mkExportEntry GHC.IEDocNamed {} = neverAppears++neverAppears :: HasCallStack => a+neverAppears =+  error+    "This AST node should never appear in the GHC AST. If you see this error message, please report a bug to the HIndent maintainers."
+ src/HIndent/Ast/Module/Name.hs view
@@ -0,0 +1,22 @@+module HIndent.Ast.Module.Name+  ( ModuleName+  , mkModuleName+  ) where++import qualified GHC.Unit as GHC+import HIndent.Ast.NodeComments+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++newtype ModuleName =+  ModuleName String++instance CommentExtraction ModuleName where+  nodeComments _ = NodeComments [] [] []++instance Pretty ModuleName where+  pretty' (ModuleName x) = string "module " >> string x++mkModuleName :: GHC.ModuleName -> ModuleName+mkModuleName = ModuleName . GHC.moduleNameString
+ src/HIndent/Ast/Module/Warning.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Module.Warning+  ( ModuleWarning+  , mkModuleWarning+  ) where++import qualified GHC.Types.SourceText as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.Declaration.Warning.Kind+import HIndent.Ast.NodeComments+import HIndent.Ast.WithComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC+import HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+data ModuleWarning = ModuleWarning+  { messages :: [GHC.LocatedE+                   (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]+  , kind :: Kind+  }+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)+data ModuleWarning = ModuleWarning+  { messages :: [GHC.Located+                   (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]+  , kind :: Kind+  }+#else+data ModuleWarning = ModuleWarning+  { messages :: [GHC.GenLocated GHC.SrcSpan GHC.StringLiteral]+  , kind :: Kind+  }+#endif+instance CommentExtraction ModuleWarning where+  nodeComments _ = NodeComments [] [] []++instance Pretty ModuleWarning where+  pretty' ModuleWarning {..} =+    spaced [string "{-#", pretty kind, prettyMsgs, string "#-}"]+    where+      prettyMsgs =+        case messages of+          [x] -> pretty x+          xs -> hList $ fmap pretty xs++mkModuleWarning :: GHC.HsModule' -> Maybe (WithComments ModuleWarning)+mkModuleWarning =+  fmap (fromGenLocated . fmap fromWarningTxt) . GHC.getDeprecMessage++fromWarningTxt :: GHC.WarningTxt' -> ModuleWarning+#if MIN_VERSION_ghc_lib_parser(9, 8, 1)+fromWarningTxt (GHC.WarningTxt _ _ messages) = ModuleWarning {..}+  where+    kind = Warning+#else+fromWarningTxt (GHC.WarningTxt _ messages) = ModuleWarning {..}+  where+    kind = Warning+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+fromWarningTxt (GHC.DeprecatedTxt _ messages) = ModuleWarning {..}+  where+    kind = Deprecated+#else+fromWarningTxt (GHC.DeprecatedTxt _ messages) = ModuleWarning {..}+  where+    kind = Deprecated+#endif
+ src/HIndent/Ast/Name/Infix.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Name.Infix+  ( InfixName+  , mkInfixName+  ) where++import Data.Maybe+import qualified GHC.Types.Name as GHC+import qualified GHC.Types.Name.Reader as GHC+import qualified GHC.Unit.Module as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data InfixName = InfixName+  { name :: GHC.OccName+  , moduleName :: Maybe GHC.ModuleName+  , backtick :: Bool+  }++instance CommentExtraction InfixName where+  nodeComments InfixName {} = NodeComments [] [] []++instance Pretty InfixName where+  pretty' InfixName {..} =+    wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ pretty name]+    where+      wrap =+        if backtick+          then backticks+          else id++mkInfixName :: GHC.RdrName -> InfixName+mkInfixName (GHC.Unqual name) = InfixName name Nothing (backticksNeeded name)+mkInfixName (GHC.Qual modName name) =+  InfixName name (Just modName) (backticksNeeded name)+mkInfixName (GHC.Orig {}) =+  error "This AST node should not appear in the parser output."+mkInfixName (GHC.Exact name) =+  InfixName (GHC.occName name) Nothing (backticksNeeded $ GHC.occName name)++backticksNeeded :: GHC.OccName -> Bool+backticksNeeded = not . GHC.isSymOcc
+ src/HIndent/Ast/Name/Prefix.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Name.Prefix+  ( PrefixName+  , mkPrefixName+  ) where++import Data.Maybe+import qualified GHC.Types.Name as GHC+import qualified GHC.Types.Name.Reader as GHC+import qualified GHC.Unit.Module as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data PrefixName = PrefixName+  { name :: String+  , moduleName :: Maybe GHC.ModuleName+  , parentheses :: Bool+  }++instance CommentExtraction PrefixName where+  nodeComments PrefixName {} = NodeComments [] [] []++instance Pretty PrefixName where+  pretty' PrefixName {..} =+    wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ string name]+    where+      wrap =+        if parentheses+          then parens+          else id++mkPrefixName :: GHC.RdrName -> PrefixName+mkPrefixName (GHC.Unqual name) =+  PrefixName (showOutputable name) Nothing (parensNeeded name)+mkPrefixName (GHC.Qual modName name) =+  PrefixName (showOutputable name) (Just modName) (parensNeeded name)+mkPrefixName (GHC.Orig {}) =+  error "This AST node should not appear in the parser output."+mkPrefixName (GHC.Exact name) =+  PrefixName (showOutputable name) Nothing (parensNeeded $ GHC.occName name)++parensNeeded :: GHC.OccName -> Bool+parensNeeded = GHC.isSymOcc
+ src/HIndent/Ast/NodeComments.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.NodeComments+  ( NodeComments(..)+  , fromEpAnn+  ) where++import qualified GHC.Hs as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Pragma++-- | Comments belonging to an AST node.+data NodeComments = NodeComments+  { commentsBefore :: [GHC.LEpaComment]+  , commentsOnSameLine :: [GHC.LEpaComment]+  , commentsAfter :: [GHC.LEpaComment]+  }++instance Semigroup NodeComments where+  x <> y =+    NodeComments+      { commentsBefore = commentsBefore x <> commentsBefore y+      , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y+      , commentsAfter = commentsAfter x <> commentsAfter y+      }++instance Monoid NodeComments where+  mempty =+    NodeComments+      {commentsBefore = [], commentsOnSameLine = [], commentsAfter = []}++fromEpAnn :: GHC.EpAnn a -> NodeComments+fromEpAnn = fromEpAnn' . filterOutEofAndPragmasFromAnn++fromEpAnn' :: GHC.EpAnn a -> NodeComments+fromEpAnn' GHC.EpAnn {..} = NodeComments {..}+  where+    commentsBefore = GHC.priorComments comments+    commentsOnSameLine =+      filter isCommentOnSameLine $ GHC.getFollowingComments comments+    commentsAfter =+      filter (not . isCommentOnSameLine) $ GHC.getFollowingComments comments+    isCommentOnSameLine (GHC.L comAnn _) =+      GHC.srcSpanEndLine (GHC.anchor entry)+        == GHC.srcSpanStartLine (GHC.anchor comAnn)+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)+fromEpAnn' GHC.EpAnnNotUsed = NodeComments [] [] []+#endif+filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann+filterOutEofAndPragmasFromAnn GHC.EpAnn {..} =+  GHC.EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)+filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed+#endif+filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments+filterOutEofAndPragmasFromComments comments =+  GHC.EpaCommentsBalanced+    { priorComments = filterOutEofAndPragmas $ GHC.priorComments comments+    , followingComments =+        filterOutEofAndPragmas $ GHC.getFollowingComments comments+    }++filterOutEofAndPragmas ::+     [GHC.GenLocated l GHC.EpaComment] -> [GHC.GenLocated l GHC.EpaComment]+filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment++isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)+isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) =+  False+#endif+isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment tok _)) =+  not $ isPragma tok
+ src/HIndent/Ast/Role.hs view
@@ -0,0 +1,30 @@+module HIndent.Ast.Role+  ( Role+  , mkRole+  ) where++import qualified GHC.Core.TyCon as GHC+import HIndent.Ast.NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data Role+  = Nominal+  | Representational+  | Phantom++instance CommentExtraction Role where+  nodeComments Nominal = NodeComments [] [] []+  nodeComments Representational = NodeComments [] [] []+  nodeComments Phantom = NodeComments [] [] []++instance Pretty Role where+  pretty' Nominal = string "nominal"+  pretty' Representational = string "representational"+  pretty' Phantom = string "phantom"++mkRole :: GHC.Role -> Role+mkRole GHC.Nominal = Nominal+mkRole GHC.Representational = Representational+mkRole GHC.Phantom = Phantom
+ src/HIndent/Ast/Type.hs view
@@ -0,0 +1,21 @@+module HIndent.Ast.Type+  ( Type+  , mkType+  ) where++import HIndent.Ast.NodeComments+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.NodeComments++newtype Type =+  Type (GHC.HsType GHC.GhcPs)++instance CommentExtraction Type where+  nodeComments (Type _) = NodeComments [] [] []++instance Pretty Type where+  pretty' (Type x) = pretty x++mkType :: GHC.HsType GHC.GhcPs -> Type+mkType = Type
+ src/HIndent/Ast/Type/Variable.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE RecordWildCards #-}++module HIndent.Ast.Type.Variable+  ( TypeVariable+  , mkTypeVariable+  ) where++import qualified GHC.Hs as GHC+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type+import HIndent.Ast.WithComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments++data TypeVariable = TypeVariable+  { name :: WithComments PrefixName+  , kind :: Maybe (WithComments Type)+  }++instance CommentExtraction TypeVariable where+  nodeComments TypeVariable {} = NodeComments [] [] []++instance Pretty TypeVariable where+  pretty' TypeVariable {kind = Just kind, ..} =+    parens $ pretty name >> string " :: " >> pretty kind+  pretty' TypeVariable {kind = Nothing, ..} = pretty name++mkTypeVariable :: GHC.HsTyVarBndr a GHC.GhcPs -> TypeVariable+mkTypeVariable (GHC.UserTyVar _ _ n) = TypeVariable {..}+  where+    name = fromGenLocated $ fmap mkPrefixName n+    kind = Nothing+mkTypeVariable (GHC.KindedTyVar _ _ n k) = TypeVariable {..}+  where+    name = fromGenLocated $ fmap mkPrefixName n+    kind = Just $ mkType <$> fromGenLocated k
+ src/HIndent/Ast/WithComments.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module HIndent.Ast.WithComments+  ( WithComments+  , prettyWith+  , fromGenLocated+  , fromEpAnn+  , mkWithComments+  , getNode+  ) where++import Control.Monad+import Control.Monad.RWS+import qualified GHC.Hs as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.NodeComments (NodeComments(..))+import qualified HIndent.Ast.NodeComments as NodeComments+import {-# SOURCE #-} HIndent.Pretty+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import HIndent.Printer++data WithComments a = WithComments+  { comments :: NodeComments+  , node :: a+  } deriving (Foldable, Traversable)++instance Functor WithComments where+  fmap f WithComments {..} = WithComments comments (f node)++instance CommentExtraction (WithComments a) where+  nodeComments WithComments {..} = comments++instance (Pretty a) => Pretty (WithComments a) where+  pretty' WithComments {..} = pretty' node++-- | Prints comments included in the location information and then the+-- AST node body.+prettyWith :: WithComments a -> (a -> Printer ()) -> Printer ()+prettyWith WithComments {..} f = do+  printCommentsBefore comments+  f node+  printCommentOnSameLine comments+  printCommentsAfter comments++-- | Prints comments that are before the given AST node.+printCommentsBefore :: NodeComments -> Printer ()+printCommentsBefore p =+  forM_ (commentsBefore p) $ \(GHC.L loc c) -> do+    let col = fromIntegral $ GHC.srcSpanStartCol (GHC.anchor loc) - 1+    indentedWithFixedLevel col $ pretty c+    newline++-- | Prints comments that are on the same line as the given AST node.+printCommentOnSameLine :: NodeComments -> Printer ()+printCommentOnSameLine (commentsOnSameLine -> (c:cs)) = do+  col <- gets psColumn+  if col == 0+    then indentedWithFixedLevel+           (fromIntegral $ GHC.srcSpanStartCol $ GHC.anchor $ GHC.getLoc c)+           $ spaced+           $ fmap pretty+           $ c : cs+    else spacePrefixed $ fmap pretty $ c : cs+  eolCommentsArePrinted+printCommentOnSameLine _ = return ()++-- | Prints comments that are after the given AST node.+printCommentsAfter :: NodeComments -> Printer ()+printCommentsAfter p =+  case commentsAfter p of+    [] -> return ()+    xs -> do+      isThereCommentsOnSameLine <- gets psEolComment+      unless isThereCommentsOnSameLine newline+      forM_ xs $ \(GHC.L loc c) -> do+        let col = fromIntegral $ GHC.srcSpanStartCol (GHC.anchor loc) - 1+        indentedWithFixedLevel col $ pretty c+        eolCommentsArePrinted++fromGenLocated :: (CommentExtraction l) => GHC.GenLocated l a -> WithComments a+fromGenLocated (GHC.L l a) = WithComments (nodeComments l) a++fromEpAnn :: GHC.EpAnn a -> b -> WithComments b+fromEpAnn ann = WithComments (NodeComments.fromEpAnn ann)++mkWithComments :: a -> WithComments a+mkWithComments = WithComments mempty++getNode :: WithComments a -> a+getNode = node
src/HIndent/CabalFile.hs view
@@ -21,7 +21,7 @@ import Distribution.PackageDescription.Parse #endif import HIndent.Language-import HIndent.LanguageExtension+import HIndent.LanguageExtension hiding (defaultExtensions) import HIndent.LanguageExtension.Conversion import HIndent.LanguageExtension.Types import Language.Haskell.Extension hiding (Extension)
src/HIndent/GhcLibParserWrapper/GHC/Hs.hs view
@@ -1,15 +1,31 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}  -- | Wrapper for 'GHC.Hs' module HIndent.GhcLibParserWrapper.GHC.Hs   ( module GHC.Hs   , HsModule'+  , getModuleAnn+  , getDeprecMessage   ) where  import GHC.Hs+import HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings -- | The wrapper for `HsModule`-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) type HsModule' = HsModule GhcPs #else type HsModule' = HsModule+#endif+getModuleAnn :: HsModule' -> EpAnn AnnsModule+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+getModuleAnn HsModule {hsmodExt = XModulePs {..}} = hsmodAnn+#else+getModuleAnn HsModule {..} = hsmodAnn+#endif+getDeprecMessage :: HsModule' -> Maybe (LocatedP WarningTxt')+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+getDeprecMessage HsModule {hsmodExt = XModulePs {..}} = hsmodDeprecMessage+#else+getDeprecMessage HsModule {..} = hsmodDeprecMessage #endif
+ src/HIndent/GhcLibParserWrapper/GHC/Hs/ImpExp.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++module HIndent.GhcLibParserWrapper.GHC.Hs.ImpExp+  ( module GHC.Hs.ImpExp+  , getPackageName+  ) where++import qualified GHC.Hs as GHC+import GHC.Hs.ImpExp+import qualified GHC.Types.SourceText as GHC+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+import qualified GHC.Types.PkgQual as GHC+#endif+getPackageName :: GHC.ImportDecl GHC.GhcPs -> Maybe GHC.StringLiteral+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+getPackageName GHC.ImportDecl {GHC.ideclPkgQual = GHC.RawPkgQual name} =+  Just name+getPackageName GHC.ImportDecl {GHC.ideclPkgQual = GHC.NoRawPkgQual} = Nothing+#else+getPackageName GHC.ImportDecl {..} = ideclPkgQual+#endif
+ src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings+  ( module GHC.Unit.Module.Warnings+  , WarningTxt'+  ) where++import GHC.Unit.Module.Warnings+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+import GHC.Hs++type WarningTxt' = WarningTxt GhcPs+#else+type WarningTxt' = WarningTxt+#endif
src/HIndent/LanguageExtension.hs view
@@ -7,6 +7,7 @@   , extensionImplies   , collectLanguageExtensionsFromSource   , getExtensions+  , defaultExtensions   ) where  import Data.Char@@ -18,7 +19,9 @@ import HIndent.LanguageExtension.Types import HIndent.Pragma import Text.Regex.TDFA-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+import qualified GHC.LanguageExtensions.Type as GLP+#endif -- | This function returns a list of extensions that the passed language -- (e.g., GHC2021) enables. implicitExtensions :: GLP.Language -> [Extension]@@ -46,7 +49,7 @@  -- | Consume an extensions list from arguments. getExtensions :: [String] -> [Extension]-getExtensions = foldr f []+getExtensions = foldr f defaultExtensions   where     f "Haskell98" _ = []     f x a =@@ -61,9 +64,7 @@ -- This function ignores language extensions not supported by Cabal. collectLanguageExtensionsSpecifiedViaLanguagePragma :: String -> [Extension] collectLanguageExtensionsSpecifiedViaLanguagePragma =-  mapMaybe (strToExt . stripSpaces)-    . concatMap (splitOn ",")-    . fmap snd+  concatMap ((mapMaybe (strToExt . stripSpaces) . splitOn ",") . snd)     . filter ((== "LANGUAGE") . fst)     . extractPragmasFromCode @@ -71,9 +72,10 @@ -- or @OPTIONS_GHC@ pragmas collectLanguageExtensionsFromSourceViaOptionsPragma :: String -> [Extension] collectLanguageExtensionsFromSourceViaOptionsPragma =-  mapMaybe (strToExt . stripSpaces)-    . concatMap extractLanguageExtensionsFromOptions-    . fmap snd+  concatMap+    (mapMaybe (strToExt . stripSpaces)+       . extractLanguageExtensionsFromOptions+       . snd)     . filter ((`elem` ["OPTIONS", "OPTIONS_GHC"]) . fst)     . extractPragmasFromCode @@ -91,3 +93,11 @@ -- | Removes spaces before and after the string. stripSpaces :: String -> String stripSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace++defaultExtensions :: [Extension]+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+defaultExtensions =+  EnableExtension GLP.ListTuplePuns : implicitExtensions GLP.GHC2021+#else+defaultExtensions = implicitExtensions GLP.GHC2021+#endif
src/HIndent/ModulePreprocessing.hs view
@@ -16,6 +16,7 @@ import Data.List import Data.Maybe import GHC.Hs+import GHC.Stack import GHC.Types.SrcLoc import Generics.SYB hiding (GT, typeOf, typeRep) import HIndent.Fixity@@ -23,7 +24,9 @@ import HIndent.ModulePreprocessing.CommentRelocation import Language.Haskell.GhclibParserEx.Fixity import Type.Reflection-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+import qualified GHC.Data.Strict as Strict+#endif -- | This function modifies the given module AST for pretty-printing. -- -- Pretty-printing a module without calling this function for it before may@@ -32,7 +35,8 @@ modifyASTForPrettyPrinting m = relocateComments (beforeRelocation m) allComments   where     beforeRelocation =-      resetLGRHSEndPositionInModule+      resetListCompRange+        . resetLGRHSEndPositionInModule         . removeAllDocDs         . closeEpAnnOfHsFunTy         . closeEpAnnOfMatchMExt@@ -44,14 +48,43 @@         . sortExprLStmt         . fixFixities     allComments = listify (not . isEofComment . ac_tok . unLoc) m-    isEofComment EpaEofComment = True-    isEofComment _ = False  -- | This function modifies the given module AST to apply fixities of infix -- operators defined in the 'base' package. fixFixities :: HsModule' -> HsModule' fixFixities = applyFixities fixities +-- | This function modifies the range of `HsDo` with `ListComp` so that it+-- includes the whole list comprehension.+--+-- This function is necessary for `ghc-lib-parser>=9.10.1` because `HsDo`+-- no longer includes brackets of list comprehensions in its range.+resetListCompRange :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+resetListCompRange = everywhere (mkT resetListCompRange')+  where+    resetListCompRange' :: HsExpr GhcPs -> HsExpr GhcPs+    resetListCompRange' (HsDo al@AnnList { al_open = Just (AddEpAnn _ (EpaSpan (RealSrcSpan open _)))+                                         , al_close = Just (AddEpAnn _ (EpaSpan (RealSrcSpan close _)))+                                         } ListComp (L EpAnn {..} xs)) =+      HsDo+        al+        ListComp+        (L EpAnn+             { entry =+                 EpaSpan+                   $ RealSrcSpan+                       (mkRealSrcSpan+                          (realSrcSpanStart open)+                          (realSrcSpanEnd close))+                       Strict.Nothing+             , ..+             }+           xs)+    resetListCompRange' x = x+#else+resetListCompRange = id+#endif -- | This function sets an 'LGRHS's end position to the end position of the -- last RHS in the 'grhssGRHSs'. --@@ -82,6 +115,10 @@ -- | This function replaces all 'EpAnnNotUsed's in 'SrcSpanAnn''s with -- 'EpAnn's to make it possible to locate comments on them. replaceAllNotUsedAnns :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- 'EpAnnNotUsed' is not used since 9.10.1.+replaceAllNotUsedAnns = id+#else replaceAllNotUsedAnns = everywhere app   where     app ::@@ -110,10 +147,24 @@     emptyNameAnn = NameAnnTrailing []     emptyAddEpAnn = AddEpAnn AnnAnyclass emptyEpaLocation     emptyEpaLocation = EpaDelta (SameLine 0) []-+#endif -- | This function sets the start column of 'hsmodName' of the given -- 'HsModule' to 1 to correctly locate comments above the module name. resetModuleNameColumn :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+resetModuleNameColumn m@HsModule {hsmodName = Just (L epa@EpAnn {..} name)} =+  m {hsmodName = Just (L newAnn name)}+  where+    newAnn = epa {entry = realSpanAsAnchor newSpan}+    newSpan =+      mkRealSrcSpan+        (mkRealSrcLoc (srcSpanFile anc) (srcSpanStartLine anc) 1)+        (realSrcSpanEnd anc)+    anc =+      case entry of+        EpaSpan (RealSrcSpan a _) -> a+        _ -> error "resetModuleNameColumn: not a RealSrcSpan"+#else resetModuleNameColumn m@HsModule {hsmodName = Just (L (SrcSpanAnn epa@EpAnn {..} sp) name)} =   m {hsmodName = Just (L (SrcSpanAnn newAnn sp) name)}   where@@ -123,6 +174,7 @@         (mkRealSrcLoc (srcSpanFile anc) (srcSpanStartLine anc) 1)         (realSrcSpanEnd anc)     anc = anchor entry+#endif resetModuleNameColumn m = m  -- | This function replaces the 'EpAnn' of 'fun_id' in 'FunBind' with@@ -132,13 +184,18 @@ -- also contains the name, and we use the latter one. This function -- prevents comments from being located in 'fun_id'. closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another+-- way to close 'EpAnn's.+closeEpAnnOfFunBindFunId = id+#else closeEpAnnOfFunBindFunId = everywhere (mkT closeEpAnn)   where     closeEpAnn :: HsBind GhcPs -> HsBind GhcPs     closeEpAnn bind@FunBind {fun_id = (L (SrcSpanAnn _ l) name)} =       bind {fun_id = L (SrcSpanAnn EpAnnNotUsed l) name}     closeEpAnn x = x-+#endif -- | This function replaces the 'EpAnn' of 'm_ext' in 'Match' with -- 'EpAnnNotUsed. --@@ -146,6 +203,11 @@ -- information is also stored inside the 'Match'. This function removes the -- duplication not to locate comments on a wrong point. closeEpAnnOfMatchMExt :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another+-- way to close 'EpAnn's.+closeEpAnnOfMatchMExt = id+#else closeEpAnnOfMatchMExt = everywhere closeEpAnn   where     closeEpAnn ::@@ -157,23 +219,33 @@       , Just HRefl <- eqTypeRep g (typeRep @Match)       , Just HRefl <- eqTypeRep h (typeRep @GhcPs) = x {m_ext = EpAnnNotUsed}       | otherwise = x-+#endif -- | This function replaces the 'EpAnn' of the first argument of 'HsFunTy' -- of 'HsType'. -- -- 'HsFunTy' should not have any comments. Instead, its LHS and RHS should -- have them. closeEpAnnOfHsFunTy :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another+-- way to close 'EpAnn's.+closeEpAnnOfHsFunTy = id+#else closeEpAnnOfHsFunTy = everywhere (mkT closeEpAnn)   where     closeEpAnn :: HsType GhcPs -> HsType GhcPs     closeEpAnn (HsFunTy _ p l r) = HsFunTy EpAnnNotUsed p l r     closeEpAnn x = x-+#endif -- | This function replaces all 'EpAnn's that contain placeholder anchors -- to locate comments correctly. A placeholder anchor is an anchor pointing -- on (-1, -1). closePlaceHolderEpAnns :: HsModule' -> HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another+-- way to close 'EpAnn's.+closePlaceHolderEpAnns = id+#else closePlaceHolderEpAnns = everywhere closeEpAnn   where     closeEpAnn ::@@ -186,7 +258,7 @@       , (EpAnn (Anchor sp _) _ _) <- x       , srcSpanEndLine sp == -1 && srcSpanEndCol sp == -1 = EpAnnNotUsed       | otherwise = x-+#endif -- | This function removes all 'DocD's from the given module. They have -- haddocks, but the same information is stored in 'EpaCommentTok's. Thus, -- we need to remove the duplication.@@ -203,7 +275,19 @@ -- See the documentation of 'resetLGRHSEndPositionInModule' for the reason. resetLGRHSEndPosition ::      LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+resetLGRHSEndPosition (L locAnn (GRHS ext@EpAnn {..} stmt body)) =+  let lastPosition =+        maximum $ realSrcSpanEnd . getAnc <$> listify collectAnchor body+      newSpan = mkRealSrcSpan (realSrcSpanStart $ getAnc entry) lastPosition+      newLocAnn = locAnn {entry = realSpanAsAnchor newSpan}+      newAnn = ext {entry = realSpanAsAnchor newSpan}+   in L newLocAnn (GRHS newAnn stmt body)+  where+    collectAnchor :: Anchor -> Bool+    collectAnchor (EpaSpan RealSrcSpan {}) = True+    collectAnchor _ = False+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) resetLGRHSEndPosition (L (SrcSpanAnn locAnn@EpAnn {} sp) (GRHS ext@EpAnn {..} stmt body)) =   let lastPosition =         maximum $ realSrcSpanEnd . anchor <$> listify collectAnchor body@@ -227,3 +311,16 @@     collectAnchor _ = True #endif resetLGRHSEndPosition x = x++isEofComment :: EpaCommentTok -> Bool+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)+isEofComment EpaEofComment = True+#endif+isEofComment _ = False+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+getAnc :: HasCallStack => EpaLocation' a -> RealSrcSpan+getAnc (EpaSpan (RealSrcSpan x _)) = x+getAnc _ = undefined+#else+getAnc = anchor+#endif
src/HIndent/ModulePreprocessing/CommentRelocation.hs view
@@ -1,5 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs, CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -43,14 +44,15 @@ import Data.Foldable import Data.Function import Data.List+import Data.Traversable import GHC.Data.Bag import GHC.Types.SrcLoc import Generics.SYB hiding (GT, typeOf, typeRep) import HIndent.GhcLibParserWrapper.GHC.Hs-import HIndent.Pretty.Pragma+import HIndent.Pragma import HIndent.Pretty.SigBindFamily import Type.Reflection-#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+#if MIN_VERSION_GLASGOW_HASKELL(9, 6, 0, 0) import Control.Monad #endif -- | A wrapper type used in everywhereMEpAnnsBackwards' to collect all@@ -79,6 +81,7 @@         >=> relocateCommentsTopLevelWhereClause         >=> relocateCommentsAfter         >=> assertAllCommentsAreConsumed+        >=> moveCommentsFromFunIdToMcFun     assertAllCommentsAreConsumed x = do       cs <- get       assert (null cs) (pure x)@@ -97,7 +100,7 @@ relocatePragmas m = pure m -- | This function locates comments that are located before pragmas to the -- module's EPA.-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) relocateCommentsBeforePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs) relocateCommentsBeforePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = ann}}   | pragmaExists m = do@@ -105,8 +108,21 @@     pure m {hsmodExt = xmod {hsmodAnn = newAnn}}   | otherwise = pure m   where+    startPosOfPragmas =+      let loc = getLoc $ head $ priorComments $ comments ann+       in case loc of+            EpaSpan (RealSrcSpan sp _) -> sp+            _ -> undefined+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+relocateCommentsBeforePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)+relocateCommentsBeforePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = ann}}+  | pragmaExists m = do+    newAnn <- insertCommentsByPos (< startPosOfPragmas) insertPriorComments ann+    pure m {hsmodExt = xmod {hsmodAnn = newAnn}}+  | otherwise = pure m+  where     startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann-#else +#else relocateCommentsBeforePragmas :: HsModule -> WithComments HsModule relocateCommentsBeforePragmas m@HsModule {hsmodAnn = ann}   | pragmaExists m = do@@ -116,6 +132,7 @@   where     startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) -- | This function locates comments that are located before each element of -- an export list. relocateCommentsInExportList :: HsModule' -> WithComments HsModule'@@ -133,6 +150,196 @@     elemSetter xs HsModule {hsmodExports = Just (L sp _), ..} =       HsModule {hsmodExports = Just (L sp xs), ..}     elemSetter _ x = x+    annGetter (L ann _) = ann+    annSetter newAnn (L _ x) = L newAnn x+    cond HsModule {hsmodExports = Just (L EpAnn {entry = EpaSpan (RealSrcSpan listAnc _)} _)} (L EpAnn {entry = EpaSpan (RealSrcSpan elemAnc _)} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnc+        && realSrcSpanStart listAnc < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | Locates comments before each case branch.+relocateCommentsInCase :: HsModule' -> WithComments HsModule'+relocateCommentsInCase =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]+    elemGetter (L _ (HsCase _ _ (MG {mg_alts = L _ xs}))) = xs+    elemGetter _ = []+    elemSetter xs (L sp (HsCase ext expr (MG {mg_alts = L sp' _, ..}))) =+      L sp (HsCase ext expr (MG {mg_alts = L sp' xs, ..}))+    elemSetter _ x = x+    annGetter (L ann _) = ann+    annSetter newAnn (L _ x) = L newAnn x+    cond (L EpAnn {entry = EpaSpan (RealSrcSpan caseAnchor _)} _) (L EpAnn {entry = EpaSpan (RealSrcSpan branchAnchor _)} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine branchAnchor+        && realSrcSpanStart caseAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | Locates comments before each class element.+relocateCommentsInClass :: HsModule' -> WithComments HsModule'+relocateCommentsInClass =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsDecl GhcPs -> [LSigBindFamily]+    elemGetter (L _ (TyClD _ ClassDecl {..})) =+      mkSortedLSigBindFamilyList+        tcdSigs+        (bagToList tcdMeths)+        tcdATs+        tcdATDefs+        []+    elemGetter _ = []+    elemSetter xs (L sp (TyClD ext ClassDecl {..})) = L sp (TyClD ext newDecl)+      where+        newDecl =+          ClassDecl+            { tcdSigs = sigs+            , tcdMeths = listToBag binds+            , tcdATs = typeFamilies+            , tcdATDefs = tyFamInsts+            , ..+            }+        (sigs, binds, typeFamilies, tyFamInsts, _) =+          destructLSigBindFamilyList xs+    elemSetter _ x = x+    annGetter (L ann _) = ann+    annSetter newAnn (L _ x) = L newAnn x+    cond (L EpAnn {entry = EpaSpan (RealSrcSpan classAnchor _)} _) (L EpAnn {entry = EpaSpan (RealSrcSpan elemAnchor _)} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor+        && realSrcSpanStart classAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | Locates comments before each statement in a do expression.+relocateCommentsInDoExpr :: HsModule' -> WithComments HsModule'+relocateCommentsInDoExpr =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsExpr GhcPs -> [ExprLStmt GhcPs]+    elemGetter (L _ (HsDo _ DoExpr {} (L _ xs))) = xs+    elemGetter (L _ (HsDo _ MDoExpr {} (L _ xs))) = xs+    elemGetter _ = []+    elemSetter xs (L sp (HsDo ext flavor@DoExpr {} (L sp' _))) =+      L sp (HsDo ext flavor (L sp' xs))+    elemSetter xs (L sp (HsDo ext flavor@MDoExpr {} (L sp' _))) =+      L sp (HsDo ext flavor (L sp' xs))+    elemSetter _ x = x+    annGetter (L ann _) = ann+    annSetter newAnn (L _ x) = L newAnn x+    cond (L EpAnn {entry = EpaSpan (RealSrcSpan doAnchor _)} _) (L EpAnn {entry = EpaSpan (RealSrcSpan elemAnchor _)} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor+        && realSrcSpanStart doAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | This function locates comments located before top-level declarations.+relocateCommentsBeforeTopLevelDecls :: HsModule' -> WithComments HsModule'+relocateCommentsBeforeTopLevelDecls = everywhereM (applyM f)+  where+    f epa@EpAnn {..}+      | EpaSpan (RealSrcSpan anc _) <- entry =+        insertCommentsByPos (isBefore anc) insertPriorComments epa+      | otherwise = pure epa+    isBefore anc comAnc =+      srcSpanStartCol anc == 1+        && srcSpanStartCol comAnc == 1+        && srcSpanStartLine comAnc < srcSpanStartLine anc++-- | This function scans the given AST from bottom to top and locates+-- comments that are on the same line as the node.  Comments are stored in+-- the 'followingComments' of 'EpaCommentsBalanced'.+relocateCommentsSameLine :: HsModule' -> WithComments HsModule'+relocateCommentsSameLine = everywhereMEpAnnsBackwards f+  where+    f epa@EpAnn {..}+      | EpaSpan (RealSrcSpan anc _) <- entry =+        insertCommentsByPos (isOnSameLine anc) insertFollowingComments epa+      | otherwise = pure epa+    isOnSameLine anc comAnc =+      srcSpanStartLine comAnc == srcSpanStartLine anc+        && srcSpanStartLine comAnc == srcSpanEndLine anc++-- | This function locates comments above the top-level declarations in+-- a 'where' clause in the topmost declaration.+relocateCommentsTopLevelWhereClause :: HsModule' -> WithComments HsModule'+relocateCommentsTopLevelWhereClause m@HsModule {..} = do+  hsmodDecls' <- mapM relocateCommentsDeclWhereClause hsmodDecls+  pure m {hsmodDecls = hsmodDecls'}+  where+    relocateCommentsDeclWhereClause (L l (ValD ext fb@(FunBind {fun_matches = MG {..}}))) = do+      mg_alts' <- mapM (mapM relocateCommentsMatch) mg_alts+      pure $ L l (ValD ext fb {fun_matches = MG {mg_alts = mg_alts', ..}})+    relocateCommentsDeclWhereClause x = pure x+    relocateCommentsMatch (L l match@Match {m_grhss = gs@GRHSs {grhssLocalBinds = (HsValBinds ext (ValBinds ext' binds sigs))}}) = do+      (binds', sigs') <- relocateCommentsBindsSigs binds sigs+      let localBinds = HsValBinds ext (ValBinds ext' binds' sigs')+      pure $ L l match {m_grhss = gs {grhssLocalBinds = localBinds}}+    relocateCommentsMatch x = pure x+    relocateCommentsBindsSigs ::+         LHsBindsLR GhcPs GhcPs+      -> [LSig GhcPs]+      -> WithComments (LHsBindsLR GhcPs GhcPs, [LSig GhcPs])+    relocateCommentsBindsSigs binds sigs = do+      bindsSigs' <- mapM addCommentsBeforeEpAnn bindsSigs+      pure (listToBag $ filterLBind bindsSigs', filterLSig bindsSigs')+      where+        bindsSigs = mkSortedLSigBindFamilyList sigs (bagToList binds) [] [] []+    addCommentsBeforeEpAnn (L epa@EpAnn {..} x)+      | EpaSpan (RealSrcSpan anc _) <- entry = do+        cs <- get+        let (notAbove, above) =+              partitionAboveNotAbove (sortCommentsByLocation cs) anc+            epa' = epa {comments = insertPriorComments comments above}+        put notAbove+        pure $ L epa' x+      | otherwise = undefined+    addCommentsBeforeEpAnn x = pure x+    partitionAboveNotAbove cs sp =+      fst+        $ foldr'+            (\c@(L l _) ((ls, rs), lastSpan) ->+               case l of+                 EpaSpan (RealSrcSpan anc _) ->+                   if anc `isAbove` lastSpan+                     then ((ls, c : rs), anc)+                     else ((c : ls, rs), lastSpan)+                 _ -> undefined)+            (([], []), sp)+            cs+    isAbove comAnc anc =+      srcSpanStartCol comAnc == srcSpanStartCol anc+        && srcSpanEndLine comAnc + 1 == srcSpanStartLine anc+#else+-- | This function locates comments that are located before each element of+-- an export list.+relocateCommentsInExportList :: HsModule' -> WithComments HsModule'+relocateCommentsInExportList =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: HsModule' -> [LIE GhcPs]+    elemGetter HsModule {hsmodExports = Just (L _ xs)} = xs+    elemGetter _ = []+    elemSetter xs HsModule {hsmodExports = Just (L sp _), ..} =+      HsModule {hsmodExports = Just (L sp xs), ..}+    elemSetter _ x = x     annGetter (L SrcSpanAnn {..} _) = ann     annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x     cond HsModule {hsmodExports = Just (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = listAnc}}} _)} (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnc}}} _) comAnc =@@ -301,17 +508,24 @@     isAbove comAnc anc =       srcSpanStartCol comAnc == srcSpanStartCol anc         && srcSpanEndLine comAnc + 1 == srcSpanStartLine anc-+#endif -- | This function scans the given AST from bottom to top and locates -- comments in the comment pool after each node on it. relocateCommentsAfter :: HsModule' -> WithComments HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) relocateCommentsAfter = everywhereMEpAnnsBackwards f   where     f epa@EpAnn {..} =       insertCommentsByPos (isAfter $ anchor entry) insertFollowingComments epa+    isAfter anc comAnc = srcSpanEndLine anc <= srcSpanStartLine comAnc+#else+relocateCommentsAfter = everywhereMEpAnnsBackwards f+  where+    f epa@EpAnn {..} =+      insertCommentsByPos (isAfter $ anchor entry) insertFollowingComments epa     f EpAnnNotUsed = pure EpAnnNotUsed     isAfter anc comAnc = srcSpanEndLine anc <= srcSpanStartLine comAnc-+#endif -- | Locates comments before each element in a parent. relocateCommentsBeforeEachElement ::      forall a b c. Typeable a@@ -366,8 +580,9 @@ insertComments cond inserter epa@EpAnn {..} = do   coms <- drainComments cond   pure $ epa {comments = inserter comments coms}+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1) insertComments _ _ EpAnnNotUsed = pure EpAnnNotUsed-+#endif -- | This function inserts comments to `priorComments`. insertPriorComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments insertPriorComments (EpaComments prior) cs =@@ -461,14 +676,66 @@               _ -> error "Unmatches"           | otherwise = pure x +-- | This function moves comments in `fun_id` of `FunBind` to+-- `mc_fun` of `HsMatchContext`.+--+-- This is a workaround for the issue that `EpAnn`s in `mc_fun` cannot be+-- closed since 9.10.1.+moveCommentsFromFunIdToMcFun :: HsModule' -> WithComments HsModule'+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+moveCommentsFromFunIdToMcFun = pure . everywhere (mkT f)+  where+    f :: HsBind GhcPs -> HsBind GhcPs+    f fb@FunBind { fun_id = L EpAnn {comments = from, ..} fid+                 , fun_matches = MG {mg_alts = L l alts, ..}+                 } =+      fb+        { fun_id = L EpAnn {comments = EpaCommentsBalanced [] [], ..} fid+        , fun_matches = MG {mg_alts = L l alts', ..}+        }+      where+        alts' =+          fmap+            (\(L l' x) ->+               case x of+                 Match {m_ctxt = FunRhs {mc_fun = L EpAnn {..} fun, ..}, ..} ->+                   L+                     l'+                     Match+                       { m_ctxt =+                           FunRhs+                             {mc_fun = L EpAnn {comments = from, ..} fun, ..}+                       , ..+                       }+                 x'' -> L l' x'')+            alts+    f x = x+#else+moveCommentsFromFunIdToMcFun = pure+#endif -- | This function sorts comments by its location. sortCommentsByLocation :: [LEpaComment] -> [LEpaComment] sortCommentsByLocation = sortBy (compare `on` anchor . getLoc)  -- | This function compares given EPAs by their end positions. compareEpaByEndPosition :: EpAnn a -> EpAnn b -> Ordering+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+compareEpaByEndPosition (EpAnn (EpaSpan a) _ _) (EpAnn (EpaSpan b) _ _) =+  case (a, b) of+    (RealSrcSpan a' _, RealSrcSpan b' _) ->+      compare (realSrcSpanEnd a') (realSrcSpanEnd b')+    (UnhelpfulSpan _, UnhelpfulSpan _) -> EQ+    (_, UnhelpfulSpan _) -> GT+    (UnhelpfulSpan _, _) -> LT compareEpaByEndPosition (EpAnn a _ _) (EpAnn b _ _) =+  case (a, b) of+    (EpaDelta {}, EpaDelta {}) -> EQ+    (_, EpaDelta {}) -> GT+    (EpaDelta {}, _) -> LT+#else+compareEpaByEndPosition (EpAnn a _ _) (EpAnn b _ _) =   on compare (realSrcSpanEnd . anchor) a b compareEpaByEndPosition EpAnnNotUsed EpAnnNotUsed = EQ compareEpaByEndPosition _ EpAnnNotUsed = GT compareEpaByEndPosition EpAnnNotUsed _ = LT+#endif
src/HIndent/Pragma.hs view
@@ -4,11 +4,19 @@ module HIndent.Pragma   ( extractPragmasFromCode   , extractPragmaNameAndElement-  , pragmaRegex+  , pragmaExists+  , isPragma   ) where +import Data.Bifunctor+import Data.Char+import Data.Generics+import Data.List+import Data.List.Split import Data.Maybe+import GHC.Hs import GHC.Parser.Lexer+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Parse import Text.Regex.TDFA hiding (empty) @@ -37,6 +45,12 @@     Just (name, element) extractPragmaNameAndElement _ = Nothing +-- | This function returns a 'True' if the passed 'EpaCommentTok' is+-- a pragma. Otherwise, it returns a 'False'.+isPragma :: EpaCommentTok -> Bool+isPragma (EpaBlockComment c) = match pragmaRegex c+isPragma _ = False+ -- | A regex to match against a pragma. pragmaRegex :: Regex pragmaRegex =@@ -62,3 +76,40 @@     , newSyntax = True     , lastStarGreedy = True     }++-- | This function returns a 'True' if the module has pragmas.+-- Otherwise, it returns a 'False'.+pragmaExists :: HsModule' -> Bool+pragmaExists = not . null . collectPragmas++-- | This function collects pragma comments from the+-- given module and modifies them into 'String's.+--+-- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ ->+-- @LANGUAGE@).+collectPragmas :: HsModule' -> [String]+collectPragmas =+  fmap (uncurry constructPragma)+    . mapMaybe extractPragma+    . listify isBlockComment+    . getModuleAnn++-- | This function returns a 'Just' value with the pragma+-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it+-- returns a 'Nothing'.+extractPragma :: EpaCommentTok -> Maybe (String, [String])+extractPragma (EpaBlockComment c) =+  second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c+  where+    strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace+extractPragma _ = Nothing++-- | Construct a pragma.+constructPragma :: String -> [String] -> String+constructPragma optionOrPragma xs =+  "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"++-- | Checks if the given comment is a block one.+isBlockComment :: EpaCommentTok -> Bool+isBlockComment EpaBlockComment {} = True+isBlockComment _ = False
src/HIndent/Pretty.hs view
@@ -16,2683 +16,1866 @@ -- using an AST: parsing, renaming, and type checking, and GHC uses these -- constructors only in remaining and type checking. module HIndent.Pretty-  ( pretty-  ) where--import Control.Monad-import Control.Monad.RWS-import Data.Maybe-import Data.Void-import GHC.Core.Coercion-import GHC.Core.InstEnv-import GHC.Data.Bag-import GHC.Data.BooleanFormula-import GHC.Data.FastString-import GHC.Hs-import GHC.Stack-import GHC.Types.Basic-import GHC.Types.Fixity-import GHC.Types.ForeignCall-import GHC.Types.Name-import GHC.Types.Name.Reader-import GHC.Types.SourceText-import GHC.Types.SrcLoc-import GHC.Unit.Module.Warnings-import HIndent.Applicative-import HIndent.Config-import HIndent.Fixity-import HIndent.Pretty.Combinators-import HIndent.Pretty.Import-import HIndent.Pretty.NodeComments-import HIndent.Pretty.Pragma-import HIndent.Pretty.SigBindFamily-import HIndent.Pretty.Types-import HIndent.Printer-import Language.Haskell.GhclibParserEx.GHC.Hs.Expr-import Text.Show.Unicode-#if MIN_VERSION_ghc_lib_parser(9,6,1)-import qualified Data.Foldable as NonEmpty-import GHC.Core.DataCon-#endif-#if !MIN_VERSION_ghc_lib_parser(9,6,1)-import GHC.Unit-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-import GHC.Types.PkgQual-#endif--- | This function pretty-prints the given AST node with comments.-pretty :: Pretty a => a -> Printer ()-pretty p = do-  printCommentsBefore p-  pretty' p-  printCommentOnSameLine p-  printCommentsAfter p---- | Prints comments included in the location information and then the--- AST node body.-printCommentsAnd ::-     (CommentExtraction l) => GenLocated l e -> (e -> Printer ()) -> Printer ()-printCommentsAnd (L l e) f = do-  printCommentsBefore l-  f e-  printCommentOnSameLine l-  printCommentsAfter l---- | Prints comments that are before the given AST node.-printCommentsBefore :: CommentExtraction a => a -> Printer ()-printCommentsBefore p =-  forM_ (commentsBefore $ nodeComments p) $ \(L loc c) -> do-    let col = fromIntegral $ srcSpanStartCol (anchor loc) - 1-    indentedWithFixedLevel col $ pretty c-    newline---- | Prints comments that are on the same line as the given AST node.-printCommentOnSameLine :: CommentExtraction a => a -> Printer ()-printCommentOnSameLine (commentsOnSameLine . nodeComments -> (c:cs)) = do-  col <- gets psColumn-  if col == 0-    then indentedWithFixedLevel-           (fromIntegral $ srcSpanStartCol $ anchor $ getLoc c)-           $ spaced-           $ fmap pretty-           $ c : cs-    else spacePrefixed $ fmap pretty $ c : cs-  eolCommentsArePrinted-printCommentOnSameLine _ = return ()---- | Prints comments that are after the given AST node.-printCommentsAfter :: CommentExtraction a => a -> Printer ()-printCommentsAfter p =-  case commentsAfter $ nodeComments p of-    [] -> return ()-    xs -> do-      isThereCommentsOnSameLine <- gets psEolComment-      unless isThereCommentsOnSameLine newline-      forM_ xs $ \(L loc c) -> do-        let col = fromIntegral $ srcSpanStartCol (anchor loc) - 1-        indentedWithFixedLevel col $ pretty c-        eolCommentsArePrinted---- | Pretty print including comments.------ 'FastString' does not implement this class because it may contain @\n@s--- and each type that may contain a 'FastString' value needs their own--- handlings.-class CommentExtraction a =>-      Pretty a-  where-  pretty' :: a -> Printer ()--- Do nothing if there are no pragmas, module headers, imports, or--- declarations. Otherwise, extra blank lines will be inserted if only--- comments are present in the source code. See--- https://github.com/mihaimaruseac/hindent/issues/586#issuecomment-1374992624.-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (HsModule GhcPs) where-  pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []}-    | not (pragmaExists m) = pure ()-  pretty' m = blanklined printers >> newline-    where-      printers = snd <$> filter fst pairs-      pairs =-        [ (pragmaExists m, prettyPragmas m)-        , (moduleDeclExists m, prettyModuleDecl m)-        , (importsExist m, prettyImports)-        , (declsExist m, prettyDecls)-        ]-      prettyModuleDecl :: HsModule GhcPs -> Printer ()-      prettyModuleDecl HsModule {hsmodName = Nothing} =-        error "The module declaration does not exist."-      prettyModuleDecl HsModule { hsmodName = Just name-                                , hsmodExports = Nothing-                                , hsmodExt = XModulePs {..}-                                } = do-        pretty $ fmap ModuleNameWithPrefix name-        whenJust hsmodDeprecMessage $ \x -> do-          space-          pretty $ fmap ModuleDeprecatedPragma x-        string " where"-      prettyModuleDecl HsModule { hsmodName = Just name-                                , hsmodExports = Just exports-                                , hsmodExt = XModulePs {..}-                                } = do-        pretty $ fmap ModuleNameWithPrefix name-        whenJust hsmodDeprecMessage $ \x -> do-          space-          pretty $ fmap ModuleDeprecatedPragma x-        newline-        indentedBlock $ do-          printCommentsAnd exports (vTuple . fmap pretty)-          string " where"-      moduleDeclExists HsModule {hsmodName = Nothing} = False-      moduleDeclExists _ = True-      prettyDecls =-        mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp)-          $ addDeclSeparator-          $ hsmodDecls m-      addDeclSeparator [] = []-      addDeclSeparator [x] = [(x, Nothing)]-      addDeclSeparator (x:xs) =-        (x, Just $ declSeparator $ unLoc x) : addDeclSeparator xs-      declSeparator (SigD _ TypeSig {}) = newline-      declSeparator (SigD _ InlineSig {}) = newline-      declSeparator (SigD _ PatSynSig {}) = newline-      declSeparator _ = blankline-      declsExist = not . null . hsmodDecls-      prettyImports = importDecls >>= blanklined . fmap outputImportGroup-      outputImportGroup = lined . fmap pretty-      importDecls =-        gets (configSortImports . psConfig) >>= \case-          True -> pure $ extractImportsSorted m-          False -> pure $ extractImports m-#else-instance Pretty HsModule where-  pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []}-    | not (pragmaExists m) = pure ()-  pretty' m = blanklined printers >> newline-    where-      printers = snd <$> filter fst pairs-      pairs =-        [ (pragmaExists m, prettyPragmas m)-        , (moduleDeclExists m, prettyModuleDecl m)-        , (importsExist m, prettyImports)-        , (declsExist m, prettyDecls)-        ]-      prettyModuleDecl HsModule {hsmodName = Nothing} =-        error "The module declaration does not exist."-      prettyModuleDecl HsModule { hsmodName = Just name-                                , hsmodExports = Nothing-                                , ..-                                } = do-        pretty $ fmap ModuleNameWithPrefix name-        whenJust hsmodDeprecMessage $ \x -> do-          space-          pretty $ fmap ModuleDeprecatedPragma x-        string " where"-      prettyModuleDecl HsModule { hsmodName = Just name-                                , hsmodExports = Just exports-                                , ..-                                } = do-        pretty $ fmap ModuleNameWithPrefix name-        whenJust hsmodDeprecMessage $ \x -> do-          space-          pretty $ fmap ModuleDeprecatedPragma x-        newline-        indentedBlock $ do-          printCommentsAnd exports (vTuple . fmap pretty)-          string " where"-      moduleDeclExists HsModule {hsmodName = Nothing} = False-      moduleDeclExists _ = True-      prettyDecls =-        mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp)-          $ addDeclSeparator-          $ hsmodDecls m-      addDeclSeparator [] = []-      addDeclSeparator [x] = [(x, Nothing)]-      addDeclSeparator (x:xs) =-        (x, Just $ declSeparator $ unLoc x) : addDeclSeparator xs-      declSeparator (SigD _ TypeSig {}) = newline-      declSeparator (SigD _ InlineSig {}) = newline-      declSeparator (SigD _ PatSynSig {}) = newline-      declSeparator _ = blankline-      declsExist = not . null . hsmodDecls-      prettyImports = importDecls >>= blanklined . fmap outputImportGroup-      outputImportGroup = lined . fmap pretty-      importDecls =-        gets (configSortImports . psConfig) >>= \case-          True -> pure $ extractImportsSorted m-          False -> pure $ extractImports m-#endif-instance (CommentExtraction l, Pretty e) => Pretty (GenLocated l e) where-  pretty' (L _ e) = pretty e--instance Pretty (HsDecl GhcPs) where-  pretty' (TyClD _ d) = pretty d-  pretty' (InstD _ inst) = pretty inst-  pretty' (DerivD _ x) = pretty x-  pretty' (ValD _ bind) = pretty bind-  pretty' (SigD _ s) = pretty s-  pretty' (KindSigD _ x) = pretty x-  pretty' (DefD _ x) = pretty x-  pretty' (ForD _ x) = pretty x-  pretty' (WarningD _ x) = pretty x-  pretty' (AnnD _ x) = pretty x-  pretty' (RuleD _ x) = pretty x-  pretty' (SpliceD _ sp) = pretty sp-  pretty' DocD {} = docNode-  pretty' (RoleAnnotD _ x) = pretty x--instance Pretty (TyClDecl GhcPs) where-  pretty' = prettyTyClDecl--prettyTyClDecl :: TyClDecl GhcPs -> Printer ()-prettyTyClDecl (FamDecl _ x) = pretty x-prettyTyClDecl SynDecl {..} = do-  string "type "-  case tcdFixity of-    Prefix -> spaced $ pretty tcdLName : fmap pretty (hsq_explicit tcdTyVars)-    Infix ->-      case hsq_explicit tcdTyVars of-        (l:r:xs) -> do-          spaced [pretty l, pretty $ fmap InfixOp tcdLName, pretty r]-          forM_ xs $ \x -> do-            space-            pretty x-        _ -> error "Not enough parameters are given."-  hor <-|> ver-  where-    hor = string " = " >> pretty tcdRhs-    ver = newline >> indentedBlock (string "= " |=> pretty tcdRhs)-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyTyClDecl DataDecl {..} = do-  printDataNewtype |=> do-    whenJust (dd_ctxt tcdDataDefn) $ \x -> do-      pretty $ Context x-      string " =>"-      newline-    pretty tcdLName-  spacePrefixed $ pretty <$> hsq_explicit tcdTyVars-  pretty tcdDataDefn-  where-    printDataNewtype =-      case dd_cons tcdDataDefn of-        DataTypeCons {} -> string "data "-        NewTypeCon {} -> string "newtype "-#elif MIN_VERSION_ghc_lib_parser(9,4,1)-prettyTyClDecl DataDecl {..} = do-  printDataNewtype |=> do-    whenJust (dd_ctxt tcdDataDefn) $ \x -> do-      pretty $ Context x-      string " =>"-      newline-    pretty tcdLName-  spacePrefixed $ pretty <$> hsq_explicit tcdTyVars-  pretty tcdDataDefn-  where-    printDataNewtype =-      case dd_ND tcdDataDefn of-        DataType -> string "data "-        NewType -> string "newtype "-#else-prettyTyClDecl DataDecl {..} = do-  printDataNewtype |=> do-    whenJust (dd_ctxt tcdDataDefn) $ \_ -> do-      pretty $ Context $ dd_ctxt tcdDataDefn-      string " =>"-      newline-    pretty tcdLName-  spacePrefixed $ pretty <$> hsq_explicit tcdTyVars-  pretty tcdDataDefn-  where-    printDataNewtype =-      case dd_ND tcdDataDefn of-        DataType -> string "data "-        NewType -> string "newtype "-#endif-prettyTyClDecl ClassDecl {..} = do-  if isJust tcdCtxt-    then verHead-    else horHead <-|> verHead-  indentedBlock $ newlinePrefixed $ fmap pretty sigsMethodsFamilies-  where-    horHead = do-      string "class "-      printNameAndTypeVariables-      unless (null tcdFDs) $ do-        string " | "-        forM_ tcdFDs $ \x@(L _ FunDep {}) ->-          printCommentsAnd x $ \(FunDep _ from to) ->-            spaced $ fmap pretty from ++ [string "->"] ++ fmap pretty to-      unless (null sigsMethodsFamilies) $ string " where"-    verHead = do-      string "class " |=> do-        whenJust tcdCtxt $ \ctx -> do-          printCommentsAnd ctx $ \case-            [] -> string "()"-            [x] -> pretty x-            xs -> hvTuple $ fmap pretty xs-          string " =>"-          newline-        printNameAndTypeVariables-      unless (null tcdFDs) $ do-        newline-        indentedBlock-          $ string "| "-              |=> vCommaSep-                    (flip fmap tcdFDs $ \x@(L _ FunDep {}) ->-                       printCommentsAnd x $ \(FunDep _ from to) ->-                         spaced-                           $ fmap pretty from ++ [string "->"] ++ fmap pretty to)-      unless (null sigsMethodsFamilies) $ do-        newline-        indentedBlock $ string "where"-    printNameAndTypeVariables =-      case tcdFixity of-        Prefix ->-          spaced $ pretty tcdLName : fmap pretty (hsq_explicit tcdTyVars)-        Infix ->-          case hsq_explicit tcdTyVars of-            (l:r:xs) -> do-              parens-                $ spaced [pretty l, pretty $ fmap InfixOp tcdLName, pretty r]-              spacePrefixed $ fmap pretty xs-            _ -> error "Not enough parameters are given."-    sigsMethodsFamilies =-      mkSortedLSigBindFamilyList tcdSigs (bagToList tcdMeths) tcdATs [] []--instance Pretty (InstDecl GhcPs) where-  pretty' ClsInstD {..} = pretty cid_inst-  pretty' DataFamInstD {..} = pretty dfid_inst-  pretty' TyFamInstD {..} = pretty $ TopLevelTyFamInstDecl tfid_inst--instance Pretty (HsBind GhcPs) where-  pretty' = prettyHsBind--prettyHsBind :: HsBind GhcPs -> Printer ()-prettyHsBind FunBind {..} = pretty fun_matches-prettyHsBind PatBind {..} = pretty pat_lhs >> pretty pat_rhs-prettyHsBind VarBind {} = notGeneratedByParser-#if !MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsBind AbsBinds {} = notGeneratedByParser-#endif-prettyHsBind (PatSynBind _ x) = pretty x-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (Sig GhcPs) where-  pretty' (TypeSig _ funName params) = do-    printFunName-    string " ::"-    horizontal <-|> vertical-    where-      horizontal = do-        space-        pretty $ HsSigTypeInsideDeclSig <$> hswc_body params-      vertical = do-        headLen <- printerLength printFunName-        indentSpaces <- getIndentSpaces-        if headLen < indentSpaces-          then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)-          else do-            newline-            indentedBlock-              $ indentedWithSpace 3-              $ pretty-              $ HsSigTypeInsideDeclSig <$> hswc_body params-      printFunName = hCommaSep $ fmap pretty funName-  pretty' (PatSynSig _ names sig) =-    spaced-      [string "pattern", hCommaSep $ fmap pretty names, string "::", pretty sig]-  pretty' (ClassOpSig _ True funNames params) =-    spaced-      [ string "default"-      , hCommaSep $ fmap pretty funNames-      , string "::"-      , printCommentsAnd params pretty-      ]-  pretty' (ClassOpSig _ False funNames params) = do-    hCommaSep $ fmap pretty funNames-    string " ::"-    hor <-|> ver-    where-      hor = space >> printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)-      ver = do-        newline-        indentedBlock-          $ indentedWithSpace 3-          $ printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)-  pretty' (FixSig _ x) = pretty x-  pretty' (InlineSig _ name detail) =-    spaced [string "{-#", pretty detail, pretty name, string "#-}"]-  pretty' (SpecSig _ name sigs _) =-    spaced-      [ string "{-# SPECIALISE"-      , pretty name-      , string "::"-      , hCommaSep $ fmap pretty sigs-      , string "#-}"-      ]-  pretty' (SpecInstSig _ sig) =-    spaced [string "{-# SPECIALISE instance", pretty sig, string "#-}"]-  pretty' (MinimalSig _ xs) =-    string "{-# MINIMAL " |=> do-      pretty xs-      string " #-}"-  pretty' (SCCFunSig _ name _) =-    spaced [string "{-# SCC", pretty name, string "#-}"]-  pretty' (CompleteMatchSig _ names _) =-    spaced-      [ string "{-# COMPLETE"-      , printCommentsAnd names (hCommaSep . fmap pretty)-      , string "#-}"-      ]-#else-instance Pretty (Sig GhcPs) where-  pretty' (TypeSig _ funName params) = do-    printFunName-    string " ::"-    horizontal <-|> vertical-    where-      horizontal = do-        space-        pretty $ HsSigTypeInsideDeclSig <$> hswc_body params-      vertical = do-        headLen <- printerLength printFunName-        indentSpaces <- getIndentSpaces-        if headLen < indentSpaces-          then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)-          else do-            newline-            indentedBlock-              $ indentedWithSpace 3-              $ pretty-              $ HsSigTypeInsideDeclSig <$> hswc_body params-      printFunName = hCommaSep $ fmap pretty funName-  pretty' (PatSynSig _ names sig) =-    spaced-      [string "pattern", hCommaSep $ fmap pretty names, string "::", pretty sig]-  pretty' (ClassOpSig _ True funNames params) =-    spaced-      [ string "default"-      , hCommaSep $ fmap pretty funNames-      , string "::"-      , printCommentsAnd params pretty-      ]-  pretty' (ClassOpSig _ False funNames params) = do-    hCommaSep $ fmap pretty funNames-    string " ::"-    hor <-|> ver-    where-      hor = space >> printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)-      ver = do-        newline-        indentedBlock-          $ indentedWithSpace 3-          $ printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)-  pretty' IdSig {} = notGeneratedByParser-  pretty' (FixSig _ x) = pretty x-  pretty' (InlineSig _ name detail) =-    spaced [string "{-#", pretty detail, pretty name, string "#-}"]-  pretty' (SpecSig _ name sigs _) =-    spaced-      [ string "{-# SPECIALISE"-      , pretty name-      , string "::"-      , hCommaSep $ fmap pretty sigs-      , string "#-}"-      ]-  pretty' (SpecInstSig _ _ sig) =-    spaced [string "{-# SPECIALISE instance", pretty sig, string "#-}"]-  pretty' (MinimalSig _ _ xs) =-    string "{-# MINIMAL " |=> do-      pretty xs-      string " #-}"-  pretty' (SCCFunSig _ _ name _) =-    spaced [string "{-# SCC", pretty name, string "#-}"]-  pretty' (CompleteMatchSig _ _ names _) =-    spaced-      [ string "{-# COMPLETE"-      , printCommentsAnd names (hCommaSep . fmap pretty)-      , string "#-}"-      ]-#endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (HsDataDefn GhcPs) where-  pretty' HsDataDefn {..} =-    if isGADT-      then do-        whenJust dd_kindSig $ \x -> do-          string " :: "-          pretty x-        string " where"-        indentedBlock $ newlinePrefixed $ fmap pretty cons-      else do-        case cons of-          [] -> indentedBlock derivingsAfterNewline-          [x@(L _ ConDeclH98 {con_args = RecCon {}})] -> do-            string " = "-            pretty x-            unless (null dd_derivs) $ space |=> printDerivings-          [x] -> do-            string " ="-            newline-            indentedBlock $ do-              pretty x-              derivingsAfterNewline-          _ ->-            indentedBlock $ do-              newline-              string "= " |=> vBarSep (fmap pretty cons)-              derivingsAfterNewline-    where-      cons =-        case dd_cons of-          NewTypeCon x -> [x]-          DataTypeCons _ xs -> xs-      isGADT =-        case dd_cons of-          (DataTypeCons _ (L _ ConDeclGADT {}:_)) -> True-          _ -> False-      derivingsAfterNewline =-        unless (null dd_derivs) $ newline >> printDerivings-      printDerivings = lined $ fmap pretty dd_derivs-#else-instance Pretty (HsDataDefn GhcPs) where-  pretty' HsDataDefn {..} =-    if isGADT-      then do-        whenJust dd_kindSig $ \x -> do-          string " :: "-          pretty x-        string " where"-        indentedBlock $ newlinePrefixed $ fmap pretty dd_cons-      else do-        case dd_cons of-          [] -> indentedBlock derivingsAfterNewline-          [x@(L _ ConDeclH98 {con_args = RecCon {}})] -> do-            string " = "-            pretty x-            unless (null dd_derivs) $ space |=> printDerivings-          [x] -> do-            string " ="-            newline-            indentedBlock $ do-              pretty x-              derivingsAfterNewline-          _ ->-            indentedBlock $ do-              newline-              string "= " |=> vBarSep (fmap pretty dd_cons)-              derivingsAfterNewline-    where-      isGADT =-        case dd_cons of-          (L _ ConDeclGADT {}:_) -> True-          _ -> False-      derivingsAfterNewline =-        unless (null dd_derivs) $ newline >> printDerivings-      printDerivings = lined $ fmap pretty dd_derivs-#endif-instance Pretty (ClsInstDecl GhcPs) where-  pretty' ClsInstDecl {..} = do-    string "instance " |=> do-      whenJust cid_overlap_mode $ \x -> do-        pretty x-        space-      pretty (fmap HsSigTypeInsideInstDecl cid_poly_ty)-        |=> unless (null sigsAndMethods) (string " where")-    unless (null sigsAndMethods) $ do-      newline-      indentedBlock $ lined $ fmap pretty sigsAndMethods-    where-      sigsAndMethods =-        mkSortedLSigBindFamilyList-          cid_sigs-          (bagToList cid_binds)-          []-          cid_tyfam_insts-          cid_datafam_insts--instance Pretty (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' MG {..} = printCommentsAnd mg_alts (lined . fmap pretty)--instance Pretty (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where-  pretty' MG {..} = printCommentsAnd mg_alts (lined . fmap pretty)--instance Pretty (HsExpr GhcPs) where-  pretty' = prettyHsExpr--prettyHsExpr :: HsExpr GhcPs -> Printer ()-prettyHsExpr (HsVar _ bind) = pretty $ fmap PrefixOp bind-prettyHsExpr (HsUnboundVar _ x) = pretty x-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyHsExpr (HsOverLabel _ _ l) = string "#" >> string (unpackFS l)-#else-prettyHsExpr (HsOverLabel _ l) = string "#" >> string (unpackFS l)-#endif-prettyHsExpr (HsIPVar _ var) = string "?" >> pretty var-prettyHsExpr (HsOverLit _ x) = pretty x-prettyHsExpr (HsLit _ l) = pretty l-prettyHsExpr (HsLam _ body) = pretty body-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsExpr (HsLamCase _ LamCase matches) = pretty $ LambdaCase matches Case-prettyHsExpr (HsLamCase _ LamCases matches) = pretty $ LambdaCase matches Cases-#else-prettyHsExpr (HsLamCase _ matches) = pretty $ LambdaCase matches Case-#endif-prettyHsExpr (HsApp _ l r) = horizontal <-|> vertical-  where-    horizontal = spaced [pretty l, pretty r]-    vertical = do-      let (f, args) =-            case flatten l ++ [r] of-              [] -> error "Invalid function application."-              (f':args') -> (f', args')-      col <- gets psColumn-      spaces <- getIndentSpaces-      pretty f-      col' <- gets psColumn-      let diff =-            col'-              - col-              - if col == 0-                  then spaces-                  else 0-      if diff + 1 <= spaces-        then space-        else newline-      spaces' <- getIndentSpaces-      indentedWithSpace spaces' $ lined $ fmap pretty args-    flatten :: LHsExpr GhcPs -> [LHsExpr GhcPs]-    flatten (L (SrcSpanAnn (EpAnn _ _ cs) _) (HsApp _ l' r')) =-      flatten l' ++ [insertComments cs r']-    flatten x = [x]-    insertComments :: EpAnnComments -> LHsExpr GhcPs -> LHsExpr GhcPs-    insertComments cs (L s@SrcSpanAnn {ann = e@EpAnn {comments = cs'}} r') =-      L (s {ann = e {comments = cs <> cs'}}) r'-    insertComments _ x = x-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyHsExpr (HsAppType _ l _ r) = do-  pretty l-  string " @"-  pretty r-#else-prettyHsExpr (HsAppType _ l r) = do-  pretty l-  string " @"-  pretty r-#endif-prettyHsExpr (OpApp _ l o r) = pretty (InfixApp l o r)-prettyHsExpr (NegApp _ x _) = string "-" >> pretty x-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsExpr (HsPar _ _ expr _) = parens $ pretty expr-#else-prettyHsExpr (HsPar _ expr) = parens $ pretty expr-#endif-prettyHsExpr (SectionL _ l o) = spaced [pretty l, pretty (InfixExpr o)]-prettyHsExpr (SectionR _ o r) = (pretty (InfixExpr o) >> space) |=> pretty r-prettyHsExpr (ExplicitTuple _ full _) = horizontal <-|> vertical-  where-    horizontal = hTuple $ fmap pretty full-    vertical =-      parens-        $ prefixedLined ","-        $ fmap (\e -> unless (isMissing e) (space |=> pretty e)) full-    isMissing Missing {} = True-    isMissing _ = False-prettyHsExpr (ExplicitSum _ position numElem expr) = do-  string "(#"-  forM_ [1 .. numElem] $ \idx -> do-    if idx == position-      then string " " >> pretty expr >> string " "-      else string " "-    when (idx < numElem) $ string "|"-  string "#)"-prettyHsExpr (HsCase _ cond arms) = do-  string "case " |=> do-    pretty cond-    string " of"-  if null $ unLoc $ mg_alts arms-    then string " {}"-    else do-      newline-      indentedBlock $ pretty arms-prettyHsExpr (HsIf _ cond t f) = do-  string "if " |=> pretty cond-  indentedBlock $ newlinePrefixed [branch "then " t, branch "else " f]-  where-    branch :: String -> LHsExpr GhcPs -> Printer ()-    branch str e =-      case e of-        (L _ (HsDo _ (DoExpr m) xs)) -> doStmt (QualifiedDo m Do) xs-        (L _ (HsDo _ (MDoExpr m) xs)) -> doStmt (QualifiedDo m Mdo) xs-        _ -> string str |=> pretty e-      where-        doStmt qDo stmts = do-          string str-          pretty qDo-          newline-          indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)-prettyHsExpr (HsMultiIf _ guards) =-  string "if "-    |=> lined (fmap (pretty . fmap (GRHSExpr GRHSExprMultiWayIf)) guards)-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsExpr (HsLet _ _ binds _ exprs) = pretty $ LetIn binds exprs-#else-prettyHsExpr (HsLet _ binds exprs) = pretty $ LetIn binds exprs-#endif-prettyHsExpr (HsDo _ ListComp {} (L _ [])) =-  error "Not enough arguments are passed to pretty-print a list comprehension."-prettyHsExpr (HsDo _ ListComp {} (L l (lhs:rhs))) =-  pretty $ L l $ ListComprehension lhs rhs--- While the name contains 'Monad', 'MonadComp' is for list comprehensions.-prettyHsExpr (HsDo _ MonadComp {} (L _ [])) =-  error "Not enough arguments are passed to pretty-print a list comprehension."-prettyHsExpr (HsDo _ MonadComp {} (L l (lhs:rhs))) =-  pretty $ L l $ ListComprehension lhs rhs-prettyHsExpr (HsDo _ (DoExpr m) (L l xs)) =-  pretty $ L l $ DoExpression xs (QualifiedDo m Do)-prettyHsExpr (HsDo _ (MDoExpr m) (L l xs)) =-  pretty $ L l $ DoExpression xs (QualifiedDo m Mdo)-prettyHsExpr (HsDo _ GhciStmtCtxt {} _) = error "We're not using GHCi, are we?"-prettyHsExpr (ExplicitList _ xs) = horizontal <-|> vertical-  where-    horizontal = brackets $ hCommaSep $ fmap pretty xs-    vertical = vList $ fmap pretty xs-prettyHsExpr (RecordCon _ name fields) = horizontal <-|> vertical-  where-    horizontal = spaced [pretty name, pretty fields]-    vertical = do-      pretty name-      (space >> pretty fields) <-|> (newline >> indentedBlock (pretty fields))-#if MIN_VERSION_ghc_lib_parser(9,8,1)-prettyHsExpr (RecordUpd _ name fields) = hor <-|> ver-  where-    hor = spaced [pretty name, printHorFields fields]-    ver = do-      pretty name-      newline-      indentedBlock $ printHorFields fields <-|> printVerFields fields-    printHorFields RegularRecUpdFields {..} =-      hFields $ fmap (`printCommentsAnd` horField) recUpdFields-    printHorFields OverloadedRecUpdFields {..} =-      hFields $ fmap (`printCommentsAnd` horField) olRecUpdFields-    printVerFields RegularRecUpdFields {..} =-      vFields $ fmap printField recUpdFields-    printVerFields OverloadedRecUpdFields {..} =-      vFields $ fmap printField olRecUpdFields-    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField-    horField HsFieldBind {..} = do-      pretty hfbLHS-      string " = "-      pretty hfbRHS-    verField HsFieldBind {..} = do-      pretty hfbLHS-      string " ="-      newline-      indentedBlock $ pretty hfbRHS-#elif MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsExpr (RecordUpd _ name fields) = hor <-|> ver-  where-    hor = spaced [pretty name, either printHorFields printHorFields fields]-    ver = do-      pretty name-      newline-      indentedBlock-        $ either printHorFields printHorFields fields-            <-|> either printVerFields printVerFields fields-    printHorFields ::-         (Pretty a, Pretty b, CommentExtraction l)-      => [GenLocated l (HsFieldBind a b)]-      -> Printer ()-    printHorFields = hFields . fmap (`printCommentsAnd` horField)-    printVerFields ::-         (Pretty a, Pretty b, CommentExtraction l)-      => [GenLocated l (HsFieldBind a b)]-      -> Printer ()-    printVerFields = vFields . fmap printField-    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField-    horField HsFieldBind {..} = do-      pretty hfbLHS-      string " = "-      pretty hfbRHS-    verField HsFieldBind {..} = do-      pretty hfbLHS-      string " ="-      newline-      indentedBlock $ pretty hfbRHS-#else-prettyHsExpr (RecordUpd _ name fields) = hor <-|> ver-  where-    hor = spaced [pretty name, either printHorFields printHorFields fields]-    ver = do-      pretty name-      newline-      indentedBlock-        $ either printHorFields printHorFields fields-            <-|> either printVerFields printVerFields fields-    printHorFields ::-         (Pretty a, Pretty b, CommentExtraction l)-      => [GenLocated l (HsRecField' a b)]-      -> Printer ()-    printHorFields = hFields . fmap (`printCommentsAnd` horField)-    printVerFields ::-         (Pretty a, Pretty b, CommentExtraction l)-      => [GenLocated l (HsRecField' a b)]-      -> Printer ()-    printVerFields = vFields . fmap printField-    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField-    horField HsRecField {..} = do-      pretty hsRecFieldLbl-      string " = "-      pretty hsRecFieldArg-    verField HsRecField {..} = do-      pretty hsRecFieldLbl-      string " ="-      newline-      indentedBlock $ pretty hsRecFieldArg-#endif-prettyHsExpr (HsGetField _ e f) = do-  pretty e-  dot-  pretty f-prettyHsExpr HsProjection {..} =-  parens-    $ forM_ proj_flds-    $ \x -> do-        string "."-        pretty x-prettyHsExpr (ExprWithTySig _ e sig) = do-  pretty e-  string " :: "-  pretty $ hswc_body sig-prettyHsExpr (ArithSeq _ _ x) = pretty x-#if !MIN_VERSION_ghc_lib_parser(9,6,1)-prettyHsExpr (HsSpliceE _ x) = pretty x-#endif-prettyHsExpr (HsProc _ pat x@(L _ (HsCmdTop _ (L _ (HsCmdDo _ xs))))) = do-  spaced [string "proc", pretty pat, string "-> do"]-  newline-  indentedBlock-    $ printCommentsAnd x (const (printCommentsAnd xs (lined . fmap pretty)))-prettyHsExpr (HsProc _ pat body) = hor <-|> ver-  where-    hor = spaced [string "proc", pretty pat, string "->", pretty body]-    ver = do-      spaced [string "proc", pretty pat, string "->"]-      newline-      indentedBlock (pretty body)-prettyHsExpr (HsStatic _ x) = spaced [string "static", pretty x]-prettyHsExpr (HsPragE _ p x) = spaced [pretty p, pretty x]-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsExpr HsRecSel {} = notGeneratedByParser-prettyHsExpr (HsTypedBracket _ inner) = typedBrackets $ pretty inner-prettyHsExpr (HsUntypedBracket _ inner) = pretty inner-#else-prettyHsExpr HsConLikeOut {} = notGeneratedByParser-prettyHsExpr HsRecFld {} = notGeneratedByParser-prettyHsExpr (HsDo _ ArrowExpr {} _) = notGeneratedByParser-prettyHsExpr (HsDo _ PatGuard {} _) = notGeneratedByParser-prettyHsExpr (HsDo _ ParStmtCtxt {} _) = notGeneratedByParser-prettyHsExpr (HsDo _ TransStmtCtxt {} _) = notGeneratedByParser-prettyHsExpr HsTick {} = forHpc-prettyHsExpr HsBinTick {} = forHpc-prettyHsExpr (HsBracket _ inner) = pretty inner-prettyHsExpr HsRnBracketOut {} = notGeneratedByParser-prettyHsExpr HsTcBracketOut {} = notGeneratedByParser-#endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyHsExpr (HsTypedSplice _ x) = string "$$" >> pretty x-prettyHsExpr (HsUntypedSplice _ x) = pretty x-#endif-instance Pretty LambdaCase where-  pretty' (LambdaCase matches caseOrCases) = do-    case caseOrCases of-      Case -> string "\\case"-      Cases -> string "\\cases"-    if null $ unLoc $ mg_alts matches-      then string " {}"-      else do-        newline-        indentedBlock $ pretty matches--instance Pretty (HsSigType GhcPs) where-  pretty' = pretty' . HsSigType' HsTypeForNormalDecl HsTypeNoDir--instance Pretty HsSigType' where-  pretty' (HsSigTypeInsideDeclSig HsSig {..}) =-    case sig_bndrs of-      HsOuterExplicit _ xs -> do-        string "forall "-        spaced $ fmap pretty xs-        dot-        case unLoc sig_body of-          HsQualTy {..} ->-            printCommentsAnd sig_body $ \_ ->-              let hor = do-                    space-                    pretty $ HorizontalContext hst_ctxt-                  ver = do-                    newline-                    pretty $ VerticalContext hst_ctxt-               in do-                    hor <-|> ver-                    newline-                    prefixed "=> "-                      $ prefixedLined "-> "-                      $ pretty <$> flatten hst_body-          _ ->-            let hor = space >> pretty (fmap HsTypeInsideDeclSig sig_body)-                ver =-                  newline >> prefixedLined "-> " (pretty <$> flatten sig_body)-             in hor <-|> ver-      _ -> pretty $ fmap HsTypeInsideDeclSig sig_body-    where-      flatten :: LHsType GhcPs -> [LHsType GhcPs]-      flatten (L _ (HsFunTy _ _ l r)) = flatten l ++ flatten r-      flatten x = [x]-  pretty' (HsSigTypeInsideVerticalFuncSig HsSig {..}) =-    case sig_bndrs of-      HsOuterExplicit _ xs -> do-        string "forall "-        spaced $ fmap pretty xs-        dot-        printCommentsAnd sig_body $ \case-          HsQualTy {..} -> do-            (space >> pretty (HorizontalContext hst_ctxt))-              <-|> (newline >> pretty (VerticalContext hst_ctxt))-            newline-            prefixed "=> " $ pretty hst_body-          x -> pretty $ HsTypeInsideDeclSig x-      _ -> pretty $ fmap HsTypeInsideDeclSig sig_body-  pretty' (HsSigType' for dir HsSig {..}) = do-    case sig_bndrs of-      HsOuterExplicit _ xs -> do-        string "forall "-        spaced $ fmap pretty xs-        dot-        space-      _ -> return ()-    pretty $ HsType' for dir <$> sig_body--instance Pretty (ConDecl GhcPs) where-  pretty' = prettyConDecl--prettyConDecl :: ConDecl GhcPs -> Printer ()-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyConDecl ConDeclGADT {..} = do-  hCommaSep $ fmap pretty $ NonEmpty.toList con_names-  hor <-|> ver-  where-    hor = string " :: " |=> body-    ver = do-      newline-      indentedBlock (string ":: " |=> body)-    body =-      case (forallNeeded, con_mb_cxt) of-        (True, Just ctx) -> withForallCtx ctx-        (True, Nothing) -> withForallOnly-        (False, Just ctx) -> withCtxOnly ctx-        (False, Nothing) -> noForallCtx-    withForallOnly = do-      pretty con_bndrs-      (space >> horArgs) <-|> (newline >> verArgs)-    noForallCtx = horArgs <-|> verArgs-    withForallCtx ctx = do-      pretty con_bndrs-      (space >> pretty (Context ctx)) <-|> (newline >> pretty (Context ctx))-      newline-      prefixed "=> " verArgs-    withCtxOnly ctx =-      (pretty (Context ctx) >> string " => " >> horArgs)-        <-|> (pretty (Context ctx) >> prefixed "=> " verArgs)-    horArgs =-      case con_g_args of-        PrefixConGADT xs ->-          inter (string " -> ")-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs _ -> inter (string " -> ") [recArg xs, pretty con_res_ty]-    verArgs =-      case con_g_args of-        PrefixConGADT xs ->-          prefixedLined "-> "-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs _ -> prefixedLined "-> " [recArg xs, pretty con_res_ty]-    recArg xs = printCommentsAnd xs $ \xs' -> vFields' $ fmap pretty xs'-    forallNeeded =-      case unLoc con_bndrs of-        HsOuterImplicit {} -> False-        HsOuterExplicit {} -> True-#else-prettyConDecl ConDeclGADT {..} = do-  hCommaSep $ fmap pretty con_names-  hor <-|> ver-  where-    hor = string " :: " |=> body-    ver = do-      newline-      indentedBlock (string ":: " |=> body)-    body =-      case (forallNeeded, con_mb_cxt) of-        (True, Just ctx) -> withForallCtx ctx-        (True, Nothing) -> withForallOnly-        (False, Just ctx) -> withCtxOnly ctx-        (False, Nothing) -> noForallCtx-    withForallOnly = do-      pretty con_bndrs-      (space >> horArgs) <-|> (newline >> verArgs)-    noForallCtx = horArgs <-|> verArgs-#if MIN_VERSION_ghc_lib_parser(9,4,1)-    withForallCtx ctx = do-      pretty con_bndrs-      (space >> pretty (Context ctx)) <-|> (newline >> pretty (Context ctx))-      newline-      prefixed "=> " verArgs-    -    withCtxOnly ctx =-      (pretty (Context ctx) >> string " => " >> horArgs)-        <-|> (pretty (Context ctx) >> prefixed "=> " verArgs)-    -    horArgs =-      case con_g_args of-        PrefixConGADT xs ->-          inter (string " -> ")-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs _ -> inter (string " -> ") [recArg xs, pretty con_res_ty]-    -    verArgs =-      case con_g_args of-        PrefixConGADT xs ->-          prefixedLined "-> "-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs _ -> prefixedLined "-> " [recArg xs, pretty con_res_ty]-#else-    withForallCtx _ = do-      pretty con_bndrs-      (space >> pretty (Context con_mb_cxt))-        <-|> (newline >> pretty (Context con_mb_cxt))-      newline-      prefixed "=> " verArgs-    -    withCtxOnly _ =-      (pretty (Context con_mb_cxt) >> string " => " >> horArgs)-        <-|> (pretty (Context con_mb_cxt) >> prefixed "=> " verArgs)-    -    horArgs =-      case con_g_args of-        PrefixConGADT xs ->-          inter (string " -> ")-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs -> inter (string " -> ") [recArg xs, pretty con_res_ty]-    -    verArgs =-      case con_g_args of-        PrefixConGADT xs ->-          prefixedLined "-> "-            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]-        RecConGADT xs -> prefixedLined "-> " [recArg xs, pretty con_res_ty]-#endif-    recArg xs = printCommentsAnd xs $ \xs' -> vFields' $ fmap pretty xs'-    -    forallNeeded =-      case unLoc con_bndrs of-        HsOuterImplicit {} -> False-        HsOuterExplicit {} -> True-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyConDecl ConDeclH98 {con_forall = True, ..} =-  (do-     string "forall "-     spaced $ fmap pretty con_ex_tvs-     string ". ")-    |=> (do-           whenJust con_mb_cxt $ \c -> do-             pretty $ Context c-             string " =>"-             newline-           pretty con_name-           pretty con_args)-#else-prettyConDecl ConDeclH98 {con_forall = True, ..} =-  (do-     string "forall "-     spaced $ fmap pretty con_ex_tvs-     string ". ")-    |=> (do-           whenJust con_mb_cxt $ \_ -> do-             pretty $ Context con_mb_cxt-             string " =>"-             newline-           pretty con_name-           pretty con_args)-#endif-prettyConDecl ConDeclH98 {con_forall = False, ..} =-  case con_args of-    (InfixCon l r) ->-      spaced [pretty l, pretty $ fmap InfixOp con_name, pretty r]-    _ -> do-      pretty con_name-      pretty con_args--instance Pretty (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' = prettyMatchExpr--prettyMatchExpr :: Match GhcPs (LHsExpr GhcPs) -> Printer ()-prettyMatchExpr Match {m_ctxt = LambdaExpr, ..} = do-  string "\\"-  unless (null m_pats)-    $ case unLoc $ head m_pats of-        LazyPat {} -> space-        BangPat {} -> space-        _ -> return ()-  spaced $ fmap pretty m_pats-  pretty $ GRHSsExpr GRHSExprLambda m_grhss-prettyMatchExpr Match {m_ctxt = CaseAlt, ..} = do-  mapM_ pretty m_pats-  pretty $ GRHSsExpr GRHSExprCase m_grhss-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyMatchExpr Match {m_ctxt = LamCaseAlt {}, ..} = do-  spaced $ fmap pretty m_pats-  pretty $ GRHSsExpr GRHSExprCase m_grhss-#endif-prettyMatchExpr Match {..} =-  case mc_fixity m_ctxt of-    Prefix -> do-      pretty m_ctxt-      spacePrefixed $ fmap pretty m_pats-      pretty m_grhss-    Infix -> do-      case (m_pats, m_ctxt) of-        (l:r:xs, FunRhs {..}) -> do-          spaced-            $ [pretty l, pretty $ fmap InfixOp mc_fun, pretty r]-                ++ fmap pretty xs-          pretty m_grhss-        _ -> error "Not enough parameters are passed."--instance Pretty (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where-  pretty' = prettyMatchProc--prettyMatchProc :: Match GhcPs (LHsCmd GhcPs) -> Printer ()-prettyMatchProc Match {m_ctxt = LambdaExpr, ..} = do-  string "\\"-  unless (null m_pats)-    $ case unLoc $ head m_pats of-        LazyPat {} -> space-        BangPat {} -> space-        _ -> return ()-  spaced $ fmap pretty m_pats ++ [pretty m_grhss]-prettyMatchProc Match {m_ctxt = CaseAlt, ..} =-  spaced [mapM_ pretty m_pats, pretty m_grhss]-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyMatchProc Match {m_ctxt = LamCaseAlt {}, ..} = do-  spaced [mapM_ pretty m_pats, pretty m_grhss]-#endif-prettyMatchProc _ = notGeneratedByParser--instance Pretty (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' (LastStmt _ x _ _) = pretty x-  pretty' (BindStmt _ pat body) = do-    pretty pat-    string " <-"-    hor <-|> ver-    where-      hor = space >> pretty body-      ver = newline >> indentedBlock (pretty body)-  pretty' ApplicativeStmt {} = notGeneratedByParser-  pretty' (BodyStmt _ (L loc (OpApp _ l o r)) _ _) =-    pretty (L loc (InfixApp l o r))-  pretty' (BodyStmt _ body _ _) = pretty body-  pretty' (LetStmt _ l) = string "let " |=> pretty l-  pretty' (ParStmt _ xs _ _) = hvBarSep $ fmap pretty xs-  pretty' TransStmt {..} =-    vCommaSep $ fmap pretty trS_stmts ++ [string "then " >> pretty trS_using]-  pretty' RecStmt {..} =-    string "rec " |=> printCommentsAnd recS_stmts (lined . fmap pretty)--instance Pretty (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where-  pretty' (LastStmt _ x _ _) = pretty x-  pretty' (BindStmt _ pat body) = hor <-|> ver-    where-      hor = spaced [pretty pat, string "<-", pretty body]-      ver = do-        pretty pat-        string " <-"-        newline-        indentedBlock $ pretty body-  pretty' ApplicativeStmt {} = notGeneratedByParser-  pretty' (BodyStmt _ body _ _) = pretty body-  pretty' (LetStmt _ l) = string "let " |=> pretty l-  pretty' (ParStmt _ xs _ _) = hvBarSep $ fmap pretty xs-  pretty' TransStmt {..} =-    vCommaSep $ fmap pretty trS_stmts ++ [string "then " >> pretty trS_using]-  pretty' RecStmt {..} =-    string "rec " |=> printCommentsAnd recS_stmts (lined . fmap pretty)--instance Pretty StmtLRInsideVerticalList where-  pretty' (StmtLRInsideVerticalList (ParStmt _ xs _ _)) =-    vBarSep $ fmap (pretty . ParStmtBlockInsideVerticalList) xs-  pretty' (StmtLRInsideVerticalList x) = pretty x---- | For pattern matching.-instance Pretty (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))) where-  pretty' HsRecFields {..} = horizontal <-|> vertical-    where-      horizontal =-        case rec_dotdot of-          Just _ -> braces $ string ".."-          Nothing -> hFields $ fmap pretty rec_flds-      vertical = vFields $ fmap pretty rec_flds---- | For record updates-instance Pretty (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' HsRecFields {..} = hvFields fieldPrinters-    where-      fieldPrinters =-        fmap pretty rec_flds-          ++ maybeToList (fmap (const (string "..")) rec_dotdot)--instance Pretty (HsType GhcPs) where-  pretty' = pretty' . HsType' HsTypeForNormalDecl HsTypeNoDir--instance Pretty HsType' where-  pretty' (HsTypeInsideVerticalFuncSig (HsFunTy _ _ a b)) = do-    pretty $ HsTypeInsideVerticalFuncSig <$> a-    newline-    prefixed "-> " $ pretty $ HsTypeInsideVerticalFuncSig <$> b-  pretty' (HsTypeInsideDeclSig HsQualTy {..}) = hor <-|> ver-    where-      hor = spaced [pretty $ Context hst_ctxt, string "=>", pretty hst_body]-      ver = do-        pretty $ Context hst_ctxt-        newline-        prefixed "=> " $ pretty $ fmap HsTypeInsideVerticalFuncSig hst_body-  pretty' (HsTypeInsideDeclSig (HsFunTy _ _ a b)) = hor <-|> ver-    where-      hor = spaced [pretty a, string "->", pretty b]-      ver = do-        pretty $ fmap HsTypeInsideVerticalFuncSig a-        newline-        prefixed "-> " $ pretty $ fmap HsTypeInsideVerticalFuncSig b-  pretty' (HsTypeInsideInstDecl HsQualTy {..}) = hor <-|> ver-    where-      hor = spaced [pretty (Context hst_ctxt), string "=>", pretty hst_body]-      ver = do-        pretty (Context hst_ctxt)-        string " =>"-        newline-        pretty hst_body-  pretty' (HsTypeWithVerticalAppTy (HsAppTy _ l r)) = do-    pretty $ fmap HsTypeWithVerticalAppTy l-    newline-    indentedBlock $ pretty $ fmap HsTypeWithVerticalAppTy r-  pretty' (HsType' _ _ x) = prettyHsType x--prettyHsType :: HsType GhcPs -> Printer ()-prettyHsType (HsForAllTy _ tele body) = (pretty tele >> space) |=> pretty body-prettyHsType HsQualTy {..} = hor <-|> ver-  where-    hor = spaced [pretty $ Context hst_ctxt, string "=>", pretty hst_body]-    ver = do-      pretty $ Context hst_ctxt-      lined [string " =>", indentedBlock $ pretty hst_body]-prettyHsType (HsTyVar _ NotPromoted x) = pretty x-prettyHsType (HsTyVar _ IsPromoted x) = string "'" >> pretty x-prettyHsType x@(HsAppTy _ l r) = hor <-|> ver-  where-    hor = spaced $ fmap pretty [l, r]-    ver = pretty $ HsTypeWithVerticalAppTy x-#if MIN_VERSION_ghc_lib_parser(9,8,1)-prettyHsType (HsAppKindTy _ l _ r) = pretty l >> string " @" >> pretty r-#else-prettyHsType (HsAppKindTy _ l r) = pretty l >> string " @" >> pretty r-#endif-prettyHsType (HsFunTy _ _ a b) = (pretty a >> string " -> ") |=> pretty b-prettyHsType (HsListTy _ xs) = brackets $ pretty xs-prettyHsType (HsTupleTy _ HsUnboxedTuple []) = string "(# #)"-prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple []) = string "()"-prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hvUnboxedTuple' $ fmap pretty xs-prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) =-  hvTuple' $ fmap pretty xs-prettyHsType (HsSumTy _ xs) = hvUnboxedSum' $ fmap pretty xs--- For `HsOpTy`, we do not need a single quote for the infix operator. An--- explicit promotion is necessary if there is a data constructor and--- a type with the same name. However, infix data constructors never--- share their names with types because types cannot contain symbols.--- Thus there is no ambiguity.-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsType (HsOpTy _ _ l op r) = do-  lineBreak <- gets (configLineBreaks . psConfig)-  if showOutputable op `elem` lineBreak-    then do-      pretty l-      newline-      pretty $ fmap InfixOp op-      space-      pretty r-    else spaced [pretty l, pretty $ fmap InfixOp op, pretty r]-#else-prettyHsType (HsOpTy _ l op r) = do-  lineBreak <- gets (configLineBreaks . psConfig)-  if showOutputable op `elem` lineBreak-    then do-      pretty l-      newline-      pretty $ fmap InfixOp op-      space-      pretty r-    else spaced [pretty l, pretty $ fmap InfixOp op, pretty r]-#endif-prettyHsType (HsParTy _ inside) = parens $ pretty inside-prettyHsType (HsIParamTy _ x ty) =-  spaced [string "?" >> pretty x, string "::", pretty ty]-prettyHsType HsStarTy {} = string "*"-prettyHsType (HsKindSig _ t k) = spaced [pretty t, string "::", pretty k]-prettyHsType (HsSpliceTy _ sp) = pretty sp-prettyHsType HsDocTy {} = docNode-prettyHsType (HsBangTy _ pack x) = pretty pack >> pretty x-prettyHsType (HsRecTy _ xs) = hvFields $ fmap pretty xs-prettyHsType (HsExplicitListTy _ _ xs) =-  case xs of-    [] -> string "'[]"-    _ -> hvPromotedList $ fmap pretty xs-prettyHsType (HsExplicitTupleTy _ xs) = hPromotedTuple $ fmap pretty xs-prettyHsType (HsTyLit _ x) = pretty x-prettyHsType HsWildCardTy {} = string "_"-prettyHsType XHsType {} = notGeneratedByParser--instance Pretty (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' = pretty' . GRHSsExpr GRHSExprNormal--instance Pretty GRHSsExpr where-  pretty' (GRHSsExpr {grhssExpr = GRHSs {..}, ..}) = do-    mapM_ (pretty . fmap (GRHSExpr grhssExprType)) grhssGRHSs-    case (grhssLocalBinds, grhssExprType) of-      (HsValBinds {}, GRHSExprCase) ->-        indentedBlock $ do-          newline-          string "where " |=> pretty grhssLocalBinds-      (HsValBinds epa lr, _) ->-        indentedWithSpace 2-          $ newlinePrefixed-              [ string "where"-              , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)-              ]-      _ -> return ()--instance Pretty (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where-  pretty' GRHSs {..} = do-    mapM_ (pretty . fmap GRHSProc) grhssGRHSs-    case grhssLocalBinds of-      (HsValBinds epa lr) ->-        indentedWithSpace 2-          $ newlinePrefixed-              [ string "where"-              , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)-              ]-      _ -> return ()--instance Pretty (HsMatchContext GhcPs) where-  pretty' = prettyHsMatchContext--prettyHsMatchContext :: HsMatchContext GhcPs -> Printer ()-prettyHsMatchContext FunRhs {..} = pretty mc_strictness >> pretty mc_fun-prettyHsMatchContext LambdaExpr = return ()-prettyHsMatchContext CaseAlt = return ()-prettyHsMatchContext IfAlt {} = notGeneratedByParser-prettyHsMatchContext ArrowMatchCtxt {} = notGeneratedByParser-prettyHsMatchContext PatBindRhs {} = notGeneratedByParser-prettyHsMatchContext PatBindGuards {} = notGeneratedByParser-prettyHsMatchContext RecUpd {} = notGeneratedByParser-prettyHsMatchContext StmtCtxt {} = notGeneratedByParser-prettyHsMatchContext ThPatSplice {} = notGeneratedByParser-prettyHsMatchContext ThPatQuote {} = notGeneratedByParser-prettyHsMatchContext PatSyn {} = notGeneratedByParser-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsMatchContext LamCaseAlt {} = notUsedInParsedStage-#endif-instance Pretty (ParStmtBlock GhcPs GhcPs) where-  pretty' (ParStmtBlock _ xs _ _) = hvCommaSep $ fmap pretty xs--instance Pretty ParStmtBlockInsideVerticalList where-  pretty' (ParStmtBlockInsideVerticalList (ParStmtBlock _ xs _ _)) =-    vCommaSep $ fmap pretty xs--instance Pretty RdrName where-  pretty' = pretty . PrefixOp--instance Pretty (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' = pretty' . GRHSExpr GRHSExprNormal--instance Pretty GRHSExpr where-  pretty' (GRHSExpr {grhsExpr = (GRHS _ [] body), ..}) = do-    space-    rhsSeparator grhsExprType-    case unLoc body of-      HsDo _ (DoExpr m) stmts ->-        printCommentsAnd body (const (doExpr (QualifiedDo m Do) stmts))-      HsDo _ (MDoExpr m) stmts ->-        printCommentsAnd body (const (doExpr (QualifiedDo m Mdo) stmts))-      OpApp _ (L _ (HsDo _ DoExpr {} _)) _ _ -> space >> pretty body-      OpApp _ (L _ (HsDo _ MDoExpr {} _)) _ _ -> space >> pretty body-      _ ->-        let hor = space >> pretty body-            ver = newline >> indentedBlock (pretty body)-         in hor <-|> ver-    where-      doExpr qDo stmts = do-        space-        pretty qDo-        newline-        indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)-  pretty' (GRHSExpr {grhsExpr = (GRHS _ guards body), ..}) = do-    unless (grhsExprType == GRHSExprMultiWayIf) newline-    (if grhsExprType == GRHSExprMultiWayIf-       then id-       else indentedBlock) $ do-      string "| " |=> vCommaSep (fmap pretty guards)-      space-      rhsSeparator grhsExprType-      printCommentsAnd body $ \case-        HsDo _ (DoExpr m) stmts -> doExpr (QualifiedDo m Do) stmts-        HsDo _ (MDoExpr m) stmts -> doExpr (QualifiedDo m Mdo) stmts-        x ->-          let hor = space >> pretty x-              ver = newline >> indentedBlock (pretty x)-           in hor <-|> ver-    where-      doExpr qDo stmts = do-        space-        pretty qDo-        newline-        indentedBlock (printCommentsAnd stmts (lined . fmap pretty))--instance Pretty GRHSProc where-  pretty' (GRHSProc (GRHS _ guards body)) =-    if null guards-      then bodyPrinter-      else do-        newline-        indentedBlock $ do-          string "| " |=> vCommaSep (fmap pretty guards)-          space-          bodyPrinter-    where-      bodyPrinter = do-        string "->"-        printCommentsAnd body $ \case-          HsCmdDo _ stmts ->-            let hor = space >> printCommentsAnd stmts (lined . fmap pretty)-                ver = do-                  newline-                  indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)-             in hor <-|> ver-          x ->-            let hor = space >> pretty x-                ver = newline >> indentedBlock (pretty x)-             in hor <-|> ver--instance Pretty EpaCommentTok where-  pretty' (EpaLineComment c) = string c-  pretty' (EpaBlockComment c) =-    case lines c of-      [] -> pure ()-      [x] -> string x-      (x:xs) -> do-        string x-        newline-        -- 'indentedWithFixedLevel 0' is used because an 'EpaBlockComment'-        -- contains indent spaces for all lines except the first one.-        indentedWithFixedLevel 0 $ lined $ fmap string xs-  pretty' _ = docNode--instance Pretty (SpliceDecl GhcPs) where-  pretty' (SpliceDecl _ sp _) = pretty sp-#if !MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (HsSplice GhcPs) where-  pretty' (HsTypedSplice _ _ _ body) = string "$$" >> pretty body-  pretty' (HsUntypedSplice _ DollarSplice _ body) = string "$" >> pretty body-  pretty' (HsUntypedSplice _ BareSplice _ body) = pretty body-  -- The body of a quasi-quote must not be changed by a formatter.-  -- Changing it will modify the actual behavior of the code.-  pretty' (HsQuasiQuote _ _ l _ r) =-    brackets $ do-      pretty l-      wrapWithBars-        $ indentedWithFixedLevel 0-        $ sequence_-        $ printers [] ""-        $ unpackFS r-    where-      printers ps s [] = reverse (string (reverse s) : ps)-      printers ps s ('\n':xs) =-        printers (newline : string (reverse s) : ps) "" xs-      printers ps s (x:xs) = printers ps (x : s) xs-  pretty' HsSpliced {} = notGeneratedByParser-#endif-instance Pretty (Pat GhcPs) where-  pretty' = prettyPat--instance Pretty PatInsidePatDecl where-  pretty' (PatInsidePatDecl (ConPat {pat_args = (InfixCon l r), ..})) =-    spaced [pretty l, pretty $ fmap InfixOp pat_con, pretty r]-  pretty' (PatInsidePatDecl x) = pretty x--prettyPat :: Pat GhcPs -> Printer ()-prettyPat WildPat {} = string "_"-prettyPat (VarPat _ x) = pretty x-prettyPat (LazyPat _ x) = string "~" >> pretty x-#if MIN_VERSION_ghc_lib_parser(9,6,1)-prettyPat (AsPat _ a _ b) = pretty a >> string "@" >> pretty b-#else-prettyPat (AsPat _ a b) = pretty a >> string "@" >> pretty b-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyPat (ParPat _ _ inner _) = parens $ pretty inner-#else-prettyPat (ParPat _ inner) = parens $ pretty inner-#endif-prettyPat (BangPat _ x) = string "!" >> pretty x-prettyPat (ListPat _ xs) = hList $ fmap pretty xs-prettyPat (TuplePat _ pats Boxed) = hTuple $ fmap pretty pats-prettyPat (TuplePat _ pats Unboxed) = hUnboxedTuple $ fmap pretty pats-prettyPat (SumPat _ x position numElem) = do-  string "(#"-  forM_ [1 .. numElem] $ \idx -> do-    if idx == position-      then string " " >> pretty x >> string " "-      else string " "-    when (idx < numElem) $ string "|"-  string "#)"-prettyPat ConPat {..} =-  case pat_args of-    PrefixCon _ as -> do-      pretty $ fmap PrefixOp pat_con-      spacePrefixed $ fmap pretty as-    RecCon rec -> (pretty pat_con >> space) |=> pretty (RecConPat rec)-    InfixCon a b -> do-      pretty a-      unlessSpecialOp (unLoc pat_con) space-      pretty $ fmap InfixOp pat_con-      unlessSpecialOp (unLoc pat_con) space-      pretty b-prettyPat (ViewPat _ l r) = spaced [pretty l, string "->", pretty r]-prettyPat (SplicePat _ x) = pretty x-prettyPat (LitPat _ x) = pretty x-prettyPat (NPat _ x _ _) = pretty x-prettyPat (NPlusKPat _ n k _ _ _) = pretty n >> string "+" >> pretty k-prettyPat (SigPat _ l r) = spaced [pretty l, string "::", pretty r]--instance Pretty RecConPat where-  pretty' (RecConPat HsRecFields {..}) =-    case fieldPrinters of-      [] -> string "{}"-      [x] -> braces x-      xs -> hvFields xs-    where-      fieldPrinters =-        fmap (pretty . fmap RecConField) rec_flds-          ++ maybeToList (fmap (const (string "..")) rec_dotdot)-#if !MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty (HsBracket GhcPs) where-  pretty' (ExpBr _ expr) = brackets $ wrapWithBars $ pretty expr-  pretty' (PatBr _ expr) = brackets $ string "p" >> wrapWithBars (pretty expr)-  pretty' (DecBrL _ decls) =-    brackets $ string "d| " |=> lined (fmap pretty decls) >> string " |"-  pretty' DecBrG {} = notGeneratedByParser-  pretty' (TypBr _ expr) = brackets $ string "t" >> wrapWithBars (pretty expr)-  pretty' (VarBr _ True var) = string "'" >> pretty var-  pretty' (VarBr _ False var) = string "''" >> pretty var-  pretty' (TExpBr _ x) = typedBrackets $ pretty x-#endif-instance Pretty SigBindFamily where-  pretty' (Sig x) = pretty x-  pretty' (Bind x) = pretty x-  pretty' (TypeFamily x) = pretty x-  pretty' (TyFamInst x) = pretty x-  pretty' (DataFamInst x) = pretty $ DataFamInstDeclInsideClassInst x--instance Pretty EpaComment where-  pretty' EpaComment {..} = pretty ac_tok--instance Pretty (HsLocalBindsLR GhcPs GhcPs) where-  pretty' (HsValBinds _ lr) = pretty lr-  pretty' (HsIPBinds _ x) = pretty x-  pretty' EmptyLocalBinds {} =-    error-      "This branch indicates that the bind is empty, but since calling this code means that let or where has already been output, it cannot be handled here. It should be handled higher up in the AST."--instance Pretty (HsValBindsLR GhcPs GhcPs) where-  pretty' (ValBinds _ methods sigs) = lined $ fmap pretty sigsAndMethods-    where-      sigsAndMethods =-        mkSortedLSigBindFamilyList sigs (bagToList methods) [] [] []-  pretty' XValBindsLR {} = notUsedInParsedStage--instance Pretty (HsTupArg GhcPs) where-  pretty' (Present _ e) = pretty e-  pretty' Missing {} = pure () -- This appears in a tuple section.-#if MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty RecConField where-  pretty' (RecConField HsFieldBind {..}) = do-    pretty hfbLHS-    unless hfbPun $ do-      string " = "-      pretty hfbRHS-#else--- | For pattern matching against a record.-instance Pretty-           (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))) where-  pretty' HsRecField {..} =-    (pretty hsRecFieldLbl >> string " = ") |=> pretty hsRecFieldArg---- | For record updates.-instance Pretty-           (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' HsRecField {..} = do-    pretty hsRecFieldLbl-    unless hsRecPun $ do-      string " ="-      horizontal <-|> vertical-    where-      horizontal = space >> pretty hsRecFieldArg-      vertical = newline >> indentedBlock (pretty hsRecFieldArg)-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)--- | For pattern matchings against records.-instance Pretty-           (HsFieldBind-              (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))-              (GenLocated SrcSpanAnnA (Pat GhcPs))) where-  pretty' HsFieldBind {..} = (pretty hfbLHS >> string " = ") |=> pretty hfbRHS---- | For record updates.-instance Pretty-           (HsFieldBind-              (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))-              (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where-  pretty' HsFieldBind {..} = do-    pretty hfbLHS-    unless hfbPun $ do-      string " ="-      horizontal <-|> vertical-    where-      horizontal = space >> pretty hfbRHS-      vertical = newline >> indentedBlock (pretty hfbRHS)-#else-instance Pretty RecConField where-  pretty' (RecConField HsRecField {..}) = do-    pretty hsRecFieldLbl-    unless hsRecPun $ do-      string " = "-      pretty hsRecFieldArg-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty (FieldOcc GhcPs) where-  pretty' FieldOcc {..} = pretty foLabel-#else-instance Pretty (FieldOcc GhcPs) where-  pretty' FieldOcc {..} = pretty rdrNameFieldOcc-#endif--- HsConDeclH98Details-instance Pretty-           (HsConDetails-              Void-              (HsScaled GhcPs (GenLocated SrcSpanAnnA (BangType GhcPs)))-              (GenLocated-                 SrcSpanAnnL-                 [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])) where-  pretty' (PrefixCon _ xs) = horizontal <-|> vertical-    where-      horizontal = spacePrefixed $ fmap pretty xs-      vertical = indentedBlock $ newlinePrefixed $ fmap pretty xs-  pretty' (RecCon x) =-    printCommentsAnd x $ \rec -> do-      newline-      indentedBlock $ vFields $ fmap pretty rec-  pretty' InfixCon {} =-    error-      "Cannot handle here because 'InfixCon' does not have the information of its constructor."--instance Pretty a => Pretty (HsScaled GhcPs a) where-  pretty' (HsScaled _ x) = pretty x--instance Pretty (ConDeclField GhcPs) where-  pretty' ConDeclField {..}-    -- Here, we *ignore* the 'cd_fld_doc' field because doc strings are-    -- also stored as comments, and printing both results in duplicated-    -- comments.-   = do-    hCommaSep $ fmap pretty cd_fld_names-    string " :: "-    pretty cd_fld_type--instance Pretty InfixExpr where-  pretty' (InfixExpr (L _ (HsVar _ bind))) = pretty $ fmap InfixOp bind-  pretty' (InfixExpr x) = pretty' x--instance Pretty InfixApp where-  pretty' InfixApp {..} = horizontal <-|> vertical-    where-      horizontal = spaced [pretty lhs, pretty (InfixExpr op), pretty rhs]-      vertical =-        case findFixity op of-          Fixity _ _ InfixL -> leftAssoc-          Fixity _ _ InfixR -> rightAssoc-          Fixity _ _ InfixN -> noAssoc-      leftAssoc = prettyOps allOperantsAndOperatorsLeftAssoc-      rightAssoc = prettyOps allOperantsAndOperatorsRightAssoc-      noAssoc-        | L _ (OpApp _ _ o _) <- lhs-        , isSameAssoc o = leftAssoc-        | otherwise = rightAssoc-      prettyOps [l, o, L _ (HsDo _ (DoExpr m) xs)] = do-        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Do]-        newline-        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)-      prettyOps [l, o, L _ (HsDo _ (MDoExpr m) xs)] = do-        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Mdo]-        newline-        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)-      prettyOps [l, o, r@(L _ HsLam {})] = do-        spaced [pretty l, pretty $ InfixExpr o, pretty r]-      prettyOps [l, o, r@(L _ HsLamCase {})] = do-        spaced [pretty l, pretty $ InfixExpr o, pretty r]-      prettyOps (l:xs) = do-        pretty l-        newline-        indentedBlock $ f xs-        where-          f (o:r:rems) = do-            (pretty (InfixExpr o) >> space) |=> pretty r-            unless (null rems) $ do-              newline-              f rems-          f _ =-            error-              "The number of the sum of operants and operators should be odd."-      prettyOps _ = error "Too short list."-      findFixity o = fromMaybe defaultFixity $ lookup (varToStr o) fixities-      allOperantsAndOperatorsLeftAssoc = reverse $ rhs : op : collect lhs-        where-          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]-          collect (L _ (OpApp _ l o r))-            | isSameAssoc o = r : o : collect l-          collect x = [x]-      allOperantsAndOperatorsRightAssoc = lhs : op : collect rhs-        where-          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]-          collect (L _ (OpApp _ l o r))-            | isSameAssoc o = l : o : collect r-          collect x = [x]-      isSameAssoc (findFixity -> Fixity _ lv d) = lv == level && d == dir-      Fixity _ level dir = findFixity op--instance Pretty a => Pretty (BooleanFormula a) where-  pretty' (Var x) = pretty x-  pretty' (And xs) = hvCommaSep $ fmap pretty xs-  pretty' (Or xs) = hvBarSep $ fmap pretty xs-  pretty' (Parens x) = parens $ pretty x--instance Pretty (FieldLabelStrings GhcPs) where-  pretty' (FieldLabelStrings xs) = hDotSep $ fmap pretty xs--instance Pretty (AmbiguousFieldOcc GhcPs) where-  pretty' (Unambiguous _ name) = pretty name-  pretty' (Ambiguous _ name) = pretty name-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (ImportDecl GhcPs) where-  pretty' decl@ImportDecl {..} = do-    string "import "-    when (ideclSource == IsBoot) $ string "{-# SOURCE #-} "-    when ideclSafe $ string "safe "-    unless (ideclQualified == NotQualified) $ string "qualified "-    whenJust (packageName decl) $ \x -> do-      pretty x-      space-    pretty ideclName-    whenJust ideclAs $ \x -> do-      string " as "-      pretty x-    whenJust ideclImportList $ \(x, ps) -> do-      when (x == EverythingBut) (string " hiding")-      (string " " >> printCommentsAnd ps (hTuple . fmap pretty))-        <-|> (newline-                >> indentedBlock (printCommentsAnd ps (vTuple . fmap pretty)))-#else-instance Pretty (ImportDecl GhcPs) where-  pretty' decl@ImportDecl {..} = do-    string "import "-    when (ideclSource == IsBoot) $ string "{-# SOURCE #-} "-    when ideclSafe $ string "safe "-    unless (ideclQualified == NotQualified) $ string "qualified "-    whenJust (packageName decl) $ \x -> do-      pretty x-      space-    pretty ideclName-    whenJust ideclAs $ \x -> do-      string " as "-      pretty x-    whenJust ideclHiding $ \(x, ps) -> do-      when x (string " hiding")-      (string " " >> printCommentsAnd ps (hTuple . fmap pretty))-        <-|> (newline-                >> indentedBlock (printCommentsAnd ps (vTuple . fmap pretty)))-#endif-packageName :: ImportDecl GhcPs -> Maybe StringLiteral-#if MIN_VERSION_ghc_lib_parser(9,4,1)-packageName (ideclPkgQual -> RawPkgQual name) = Just name-packageName _ = Nothing-#else-packageName = ideclPkgQual-#endif-instance Pretty (HsDerivingClause GhcPs) where-  pretty' HsDerivingClause { deriv_clause_strategy = Just strategy@(L _ ViaStrategy {})-                           , ..-                           } =-    spaced [string "deriving", pretty deriv_clause_tys, pretty strategy]-  pretty' HsDerivingClause {..} = do-    string "deriving "-    whenJust deriv_clause_strategy $ \x -> do-      pretty x-      space-    pretty deriv_clause_tys--instance Pretty (DerivClauseTys GhcPs) where-  pretty' (DctSingle _ ty) = parens $ pretty ty-  pretty' (DctMulti _ ts) = hvTuple $ fmap pretty ts--instance Pretty OverlapMode where-  pretty' NoOverlap {} = notUsedInParsedStage-  pretty' Overlappable {} = string "{-# OVERLAPPABLE #-}"-  pretty' Overlapping {} = string "{-# OVERLAPPING #-}"-  pretty' Overlaps {} = string "{-# OVERLAPS #-}"-  pretty' Incoherent {} = string "{-# INCOHERENT #-}"--instance Pretty StringLiteral where-  pretty' = output---- | This instance is for type family declarations inside a class declaration.-instance Pretty (FamilyDecl GhcPs) where-  pretty' FamilyDecl {..} = do-    string-      $ case fdInfo of-          DataFamily -> "data"-          OpenTypeFamily -> "type"-          ClosedTypeFamily {} -> "type"-    case fdTopLevel of-      TopLevel -> string " family "-      NotTopLevel -> space-    pretty fdLName-    spacePrefixed $ pretty <$> hsq_explicit fdTyVars-    case unLoc fdResultSig of-      NoSig {} -> pure ()-      TyVarSig {} -> do-        string " = "-        pretty fdResultSig-      _ -> do-        space-        pretty fdResultSig-    whenJust fdInjectivityAnn $ \x -> do-      string " | "-      pretty x-    case fdInfo of-      ClosedTypeFamily (Just xs) -> do-        string " where"-        newline-        indentedBlock $ lined $ fmap pretty xs-      _ -> pure ()--instance Pretty (FamilyResultSig GhcPs) where-  pretty' NoSig {} = pure ()-  pretty' (KindSig _ x) = string ":: " >> pretty x-  pretty' (TyVarSig _ x) = pretty x--instance Pretty (HsTyVarBndr a GhcPs) where-  pretty' (UserTyVar _ _ x) = pretty x-  pretty' (KindedTyVar _ _ name ty) =-    parens $ spaced [pretty name, string "::", pretty ty]--instance Pretty (InjectivityAnn GhcPs) where-  pretty' (InjectivityAnn _ from to) =-    spaced $ pretty from : string "->" : fmap pretty to--instance Pretty (ArithSeqInfo GhcPs) where-  pretty' (From from) = brackets $ spaced [pretty from, string ".."]-  pretty' (FromThen from next) =-    brackets $ spaced [pretty from >> comma >> pretty next, string ".."]-  pretty' (FromTo from to) =-    brackets $ spaced [pretty from, string "..", pretty to]-  pretty' (FromThenTo from next to) =-    brackets-      $ spaced [pretty from >> comma >> pretty next, string "..", pretty to]--instance Pretty (HsForAllTelescope GhcPs) where-  pretty' HsForAllVis {..} = do-    string "forall "-    spaced $ fmap pretty hsf_vis_bndrs-    dot-  pretty' HsForAllInvis {..} = do-    string "forall "-    spaced $ fmap pretty hsf_invis_bndrs-    dot--instance Pretty InfixOp where-  pretty' (InfixOp (Unqual name)) = backticksIfNotSymbol name $ pretty name-  pretty' (InfixOp (Qual modName name)) =-    backticksIfNotSymbol name $ do-      pretty modName-      string "."-      pretty name-  pretty' (InfixOp Orig {}) = notUsedInParsedStage-  pretty' (InfixOp (Exact name)) = backticksIfNotSymbol occ $ pretty occ-    where-      occ = occName name--instance Pretty PrefixOp where-  pretty' (PrefixOp (Unqual name)) = parensIfSymbol name $ pretty name-  pretty' (PrefixOp (Qual modName name)) =-    parensIfSymbol name $ do-      pretty modName-      string "."-      pretty name-  pretty' (PrefixOp Orig {}) = notUsedInParsedStage-  pretty' (PrefixOp (Exact name)) = parensIfSymbol occ $ output name-    where-      occ = occName name--instance Pretty Context where-  pretty' (Context xs) =-    pretty (HorizontalContext xs) <-|> pretty (VerticalContext xs)-#if MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty HorizontalContext where-  pretty' (HorizontalContext xs) =-    constraintsParens $ printCommentsAnd xs (hCommaSep . fmap pretty)-    where-      constraintsParens =-        case xs of-          (L _ []) -> parens-          (L _ [_]) -> id-          _ -> parens--instance Pretty VerticalContext where-  pretty' (VerticalContext full@(L _ [])) =-    printCommentsAnd full (const $ string "()")-  pretty' (VerticalContext full@(L _ [x])) =-    printCommentsAnd full (const $ pretty x)-  pretty' (VerticalContext xs) = printCommentsAnd xs (vTuple . fmap pretty)-#else-instance Pretty HorizontalContext where-  pretty' (HorizontalContext xs) =-    constraintsParens $ mapM_ (`printCommentsAnd` (hCommaSep . fmap pretty)) xs-    where-      constraintsParens =-        case xs of-          Nothing -> id-          Just (L _ []) -> parens-          Just (L _ [_]) -> id-          Just _ -> parens--instance Pretty VerticalContext where-  pretty' (VerticalContext Nothing) = pure ()-  pretty' (VerticalContext (Just (L _ []))) = string "()"-  pretty' (VerticalContext (Just full@(L _ [x]))) =-    printCommentsAnd full (const $ pretty x)-  pretty' (VerticalContext (Just xs)) =-    printCommentsAnd xs (vTuple . fmap pretty)-#endif--- Wrap a value of this type with 'ModulenameWithPrefix' to print it with--- the "module " prefix.-instance Pretty ModuleName where-  pretty' = output--instance Pretty ModuleNameWithPrefix where-  pretty' (ModuleNameWithPrefix name) = spaced [string "module", pretty name]--instance Pretty (IE GhcPs) where-  pretty' (IEVar _ name) = pretty name-  pretty' (IEThingAbs _ name) = pretty name-  pretty' (IEThingAll _ name) = do-    pretty name-    string "(..)"-  -- FIXME: Currently, pretty-printing a 'IEThingWith' uses-  -- 'ghc-lib-parser''s pretty-printer. However, we should avoid it because-  -- 'ghc-lib-parser' may suddenly change how it prints, resulting in-  -- unexpected test failures.-  pretty' x@IEThingWith {} =-    case lines $ showOutputable x of-      [] -> pure ()-      [x'] -> string x'-      xs -> do-        string $ head xs-        indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> tail xs-  pretty' (IEModuleContents _ name) = pretty $ fmap ModuleNameWithPrefix name-  pretty' IEGroup {} = docNode-  pretty' IEDoc {} = docNode-  pretty' IEDocNamed {} = docNode--instance Pretty (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where-  pretty' FamEqn {..} = do-    pretty feqn_tycon-    spacePrefixed $ fmap pretty feqn_pats-    string " = "-    pretty feqn_rhs---- | Pretty-print a data instance.-instance Pretty (FamEqn GhcPs (HsDataDefn GhcPs)) where-  pretty' = pretty' . FamEqnTopLevel--instance Pretty FamEqn' where-  pretty' FamEqn' {famEqn = FamEqn {..}, ..} = do-    spaced $ string prefix : pretty feqn_tycon : fmap pretty feqn_pats-    pretty feqn_rhs-    where-      prefix =-        case famEqnFor of-          DataFamInstDeclForTopLevel -> "data instance"-          DataFamInstDeclForInsideClassInst -> "data"--- | HsArg (LHsType GhcPs) (LHsType GhcPs)-#if MIN_VERSION_ghc_lib_parser(9,8,1)-instance Pretty-           (HsArg-              GhcPs-              (GenLocated SrcSpanAnnA (HsType GhcPs))-              (GenLocated SrcSpanAnnA (HsType GhcPs))) where-  pretty' (HsValArg x) = pretty x-  pretty' (HsTypeArg _ x) = string "@" >> pretty x-  pretty' HsArgPar {} = notUsedInParsedStage-#else-instance Pretty-           (HsArg-              (GenLocated SrcSpanAnnA (HsType GhcPs))-              (GenLocated SrcSpanAnnA (HsType GhcPs))) where-  pretty' (HsValArg x) = pretty x-  pretty' (HsTypeArg _ x) = string "@" >> pretty x-  pretty' HsArgPar {} = notUsedInParsedStage-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty (HsQuote GhcPs) where-  pretty' (ExpBr _ x) = brackets $ wrapWithBars $ pretty x-  pretty' (PatBr _ x) = brackets $ string "p" >> wrapWithBars (pretty x)-  pretty' (DecBrL _ decls) =-    brackets $ string "d| " |=> lined (fmap pretty decls) >> string " |"-  pretty' DecBrG {} = notUsedInParsedStage-  pretty' (TypBr _ x) = brackets $ string "t" >> wrapWithBars (pretty x)-  pretty' (VarBr _ True x) = string "'" >> pretty x-  pretty' (VarBr _ False x) = string "''" >> pretty x-#endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (WarnDecls GhcPs) where-  pretty' (Warnings _ x) = lined $ fmap pretty x-#else-instance Pretty (WarnDecls GhcPs) where-  pretty' (Warnings _ _ x) = lined $ fmap pretty x-#endif-#if MIN_VERSION_ghc_lib_parser(9,8,1)-instance Pretty (WarnDecl GhcPs) where-  pretty' (Warning _ names deprecatedOrWarning) =-    case deprecatedOrWarning of-      DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons-      WarningTxt _ _ reasons -> prettyWithTitleReasons "WARNING" reasons-    where-      prettyWithTitleReasons title reasons =-        lined-          [ string $ "{-# " ++ title-          , spaced-              [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons]-          , string " #-}"-          ]-#else-instance Pretty (WarnDecl GhcPs) where-  pretty' (Warning _ names deprecatedOrWarning) =-    case deprecatedOrWarning of-      DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons-      WarningTxt _ reasons -> prettyWithTitleReasons "WARNING" reasons-    where-      prettyWithTitleReasons title reasons =-        lined-          [ string $ "{-# " ++ title-          , spaced-              [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons]-          , string " #-}"-          ]-#endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty (WithHsDocIdentifiers StringLiteral GhcPs) where-  pretty' WithHsDocIdentifiers {..} = pretty hsDocString-#endif--#if MIN_VERSION_ghc_lib_parser(9,6,1)--- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'-instance Pretty (IEWrappedName GhcPs) where-  pretty' (IEName _ name) = pretty name-  pretty' (IEPattern _ name) = spaced [string "pattern", pretty name]-  pretty' (IEType _ name) = string "type " >> pretty name-#else--- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'-instance Pretty (IEWrappedName RdrName) where-  pretty' (IEName name) = pretty name-  pretty' (IEPattern _ name) = spaced [string "pattern", pretty name]-  pretty' (IEType _ name) = string "type " >> pretty name-#endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (DotFieldOcc GhcPs) where-  pretty' DotFieldOcc {..} = printCommentsAnd dfoLabel pretty-#elif MIN_VERSION_ghc_lib_parser(9,4,1)-instance Pretty (DotFieldOcc GhcPs) where-  pretty' DotFieldOcc {..} = printCommentsAnd dfoLabel (string . unpackFS)-#else-instance Pretty (HsFieldLabel GhcPs) where-  pretty' HsFieldLabel {..} = printCommentsAnd hflLabel (string . unpackFS)-#endif-instance Pretty (RuleDecls GhcPs) where-  pretty' HsRules {..} =-    lined $ string "{-# RULES" : fmap pretty rds_rules ++ [string " #-}"]-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (RuleDecl GhcPs) where-  pretty' HsRule {..} =-    spaced-      [ printCommentsAnd rd_name (doubleQuotes . string . unpackFS)-      , lhs-      , string "="-      , pretty rd_rhs-      ]-    where-      lhs =-        if null rd_tmvs-          then pretty rd_lhs-          else do-            string "forall "-            spaced $ fmap pretty rd_tmvs-            dot-            space-            pretty rd_lhs-#else-instance Pretty (RuleDecl GhcPs) where-  pretty' HsRule {..} =-    spaced-      [ printCommentsAnd rd_name (doubleQuotes . string . unpackFS . snd)-      , lhs-      , string "="-      , pretty rd_rhs-      ]-    where-      lhs =-        if null rd_tmvs-          then pretty rd_lhs-          else do-            string "forall "-            spaced $ fmap pretty rd_tmvs-            dot-            space-            pretty rd_lhs-#endif-instance Pretty OccName where-  pretty' = output--instance Pretty (DerivDecl GhcPs) where-  pretty' DerivDecl { deriv_strategy = (Just deriv_strategy@(L _ ViaStrategy {}))-                    , ..-                    } =-    spaced-      [ string "deriving"-      , pretty deriv_strategy-      , string "instance"-      , pretty deriv_type-      ]-  pretty' DerivDecl {..} = do-    string "deriving "-    whenJust deriv_strategy $ \x -> do-      pretty x-      space-    string "instance "-    pretty deriv_type---- | 'Pretty' for 'LHsSigWcType GhcPs'.-instance Pretty-           (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))) where-  pretty' HsWC {..} = pretty hswc_body---- | 'Pretty' for 'LHsWcType'-instance Pretty (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where-  pretty' HsWC {..} = pretty hswc_body--instance Pretty (StandaloneKindSig GhcPs) where-  pretty' (StandaloneKindSig _ name kind) =-    spaced [string "type", pretty name, string "::", pretty kind]--instance Pretty (DefaultDecl GhcPs) where-  pretty' (DefaultDecl _ xs) =-    spaced [string "default", hTuple $ fmap pretty xs]--instance Pretty (ForeignDecl GhcPs) where-  pretty' ForeignImport {..} =-    spaced-      [ string "foreign import"-      , pretty fd_fi-      , pretty fd_name-      , string "::"-      , pretty fd_sig_ty-      ]-  pretty' ForeignExport {..} =-    spaced-      [ string "foreign export"-      , pretty fd_fe-      , pretty fd_name-      , string "::"-      , pretty fd_sig_ty-      ]-#if MIN_VERSION_ghc_lib_parser(9,8,0)-instance Pretty (ForeignImport GhcPs) where-  pretty' (CImport (L _ (SourceText s)) conv safety _ _) =-    spaced [pretty conv, pretty safety, output s]-  pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety]-#elif MIN_VERSION_ghc_lib_parser(9,6,0)-instance Pretty (ForeignImport GhcPs) where-  pretty' (CImport (L _ (SourceText s)) conv safety _ _ ) =-    spaced [pretty conv, pretty safety, string s]-  pretty' (CImport _ conv safety _  _) = spaced [pretty conv, pretty safety]-#else-instance Pretty ForeignImport where-  pretty' (CImport conv safety _ _ (L _ (SourceText s))) =-    spaced [pretty conv, pretty safety, string s]-  pretty' (CImport conv safety _ _ _) = spaced [pretty conv, pretty safety]-#endif--#if MIN_VERSION_ghc_lib_parser(9,8,0)-instance Pretty (ForeignExport GhcPs) where-  pretty' (CExport (L _ (SourceText s)) conv) = spaced [pretty conv, output s]-  pretty' (CExport _ conv) = pretty conv-#elif MIN_VERSION_ghc_lib_parser(9,6,0)-instance Pretty (ForeignExport GhcPs) where-  pretty' (CExport (L _ (SourceText s)) conv) = spaced [pretty conv, string s]-  pretty' (CExport _ conv) = pretty conv-#else-instance Pretty ForeignExport where-  pretty' (CExport conv (L _ (SourceText s))) = spaced [pretty conv, string s]-  pretty' (CExport conv _) = pretty conv-#endif-instance Pretty CExportSpec where-  pretty' (CExportStatic _ _ x) = pretty x--instance Pretty Safety where-  pretty' PlaySafe = string "safe"-  pretty' PlayInterruptible = string "interruptible"-  pretty' PlayRisky = string "unsafe"-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (AnnDecl GhcPs) where-  pretty' (HsAnnotation _ (ValueAnnProvenance name) expr) =-    spaced [string "{-# ANN", pretty name, pretty expr, string "#-}"]-  pretty' (HsAnnotation _ (TypeAnnProvenance name) expr) =-    spaced [string "{-# ANN type", pretty name, pretty expr, string "#-}"]-  pretty' (HsAnnotation _ ModuleAnnProvenance expr) =-    spaced [string "{-# ANN module", pretty expr, string "#-}"]-#else-instance Pretty (AnnDecl GhcPs) where-  pretty' (HsAnnotation _ _ (ValueAnnProvenance name) expr) =-    spaced [string "{-# ANN", pretty name, pretty expr, string "#-}"]-  pretty' (HsAnnotation _ _ (TypeAnnProvenance name) expr) =-    spaced [string "{-# ANN type", pretty name, pretty expr, string "#-}"]-  pretty' (HsAnnotation _ _ ModuleAnnProvenance expr) =-    spaced [string "{-# ANN module", pretty expr, string "#-}"]-#endif-instance Pretty (RoleAnnotDecl GhcPs) where-  pretty' (RoleAnnotDecl _ name roles) =-    spaced-      $ [string "type role", pretty name]-          ++ fmap (maybe (string "_") pretty . unLoc) roles--instance Pretty Role where-  pretty' Nominal = string "nominal"-  pretty' Representational = string "representational"-  pretty' Phantom = string "phantom"--instance Pretty (TyFamInstDecl GhcPs) where-  pretty' TyFamInstDecl {..} = string "type " >> pretty tfid_eqn--instance Pretty TopLevelTyFamInstDecl where-  pretty' (TopLevelTyFamInstDecl TyFamInstDecl {..}) =-    string "type instance " >> pretty tfid_eqn--instance Pretty (DataFamInstDecl GhcPs) where-  pretty' = pretty' . DataFamInstDeclTopLevel--instance Pretty DataFamInstDecl' where-  pretty' DataFamInstDecl' {dataFamInstDecl = DataFamInstDecl {..}, ..} =-    pretty $ FamEqn' dataFamInstDeclFor dfid_eqn--instance Pretty (PatSynBind GhcPs GhcPs) where-  pretty' PSB {..} = do-    string "pattern "-    case psb_args of-      InfixCon l r -> spaced [pretty l, pretty $ fmap InfixOp psb_id, pretty r]-      PrefixCon _ [] -> pretty psb_id-      _ -> spaced [pretty psb_id, pretty psb_args]-    spacePrefixed [pretty psb_dir, pretty $ fmap PatInsidePatDecl psb_def]-    case psb_dir of-      ExplicitBidirectional matches -> do-        newline-        indentedBlock $ string "where " |=> pretty matches-      _ -> pure ()---- | 'Pretty' for 'HsPatSynDetails'.-instance Pretty-           (HsConDetails-              Void-              (GenLocated SrcSpanAnnN RdrName)-              [RecordPatSynField GhcPs]) where-  pretty' (PrefixCon _ xs) = spaced $ fmap pretty xs-  pretty' (RecCon rec) = hFields $ fmap pretty rec-  pretty' InfixCon {} =-    error-      "Cannot handle here because `InfixCon` does not have the information of the constructor."--instance Pretty (FixitySig GhcPs) where-  pretty' (FixitySig _ names fixity) =-    spaced [pretty fixity, hCommaSep $ fmap (pretty . fmap InfixOp) names]--instance Pretty Fixity where-  pretty' (Fixity _ level dir) = spaced [pretty dir, string $ show level]--instance Pretty FixityDirection where-  pretty' InfixL = string "infixl"-  pretty' InfixR = string "infixr"-  pretty' InfixN = string "infix"--instance Pretty InlinePragma where-  pretty' InlinePragma {..} = do-    pretty inl_inline-    case inl_act of-      ActiveBefore _ x -> space >> brackets (string $ "~" ++ show x)-      ActiveAfter _ x -> space >> brackets (string $ show x)-      _ -> pure ()--instance Pretty InlineSpec where-  pretty' = prettyInlineSpec--prettyInlineSpec :: InlineSpec -> Printer ()-prettyInlineSpec Inline {} = string "INLINE"-prettyInlineSpec Inlinable {} = string "INLINABLE"-prettyInlineSpec NoInline {} = string "NOINLINE"-prettyInlineSpec NoUserInlinePrag =-  error-    "This branch is executed if the inline pragma is not written, but executing this branch means that the pragma is already about to be output, which indicates something goes wrong."-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyInlineSpec Opaque {} = string "OPAQUE"-#endif-instance Pretty (HsPatSynDir GhcPs) where-  pretty' Unidirectional = string "<-"-  pretty' ImplicitBidirectional = string "="-  pretty' ExplicitBidirectional {} = string "<-"--instance Pretty (HsOverLit GhcPs) where-  pretty' OverLit {..} = pretty ol_val--instance Pretty OverLitVal where-  pretty' (HsIntegral x) = pretty x-  pretty' (HsFractional x) = pretty x-  pretty' (HsIsString _ x) = string $ unpackFS x-#if MIN_VERSION_ghc_lib_parser(9,8,1)-instance Pretty IntegralLit where-  pretty' IL {il_text = SourceText s} = output s-  pretty' IL {..} = string $ show il_value-#else-instance Pretty IntegralLit where-  pretty' IL {il_text = SourceText s} = string s-  pretty' IL {..} = string $ show il_value-#endif-instance Pretty FractionalLit where-  pretty' = output--instance Pretty (HsLit GhcPs) where-  pretty' x@(HsChar _ _) = output x-  pretty' x@HsCharPrim {} = output x-  pretty' HsInt {} = notUsedInParsedStage-  pretty' (HsIntPrim _ x) = string $ show x ++ "#"-  pretty' HsWordPrim {} = notUsedInParsedStage-  pretty' HsInt64Prim {} = notUsedInParsedStage-  pretty' HsWord64Prim {} = notUsedInParsedStage-  pretty' HsInteger {} = notUsedInParsedStage-  pretty' HsRat {} = notUsedInParsedStage-  pretty' (HsFloatPrim _ x) = pretty x >> string "#"-  pretty' HsDoublePrim {} = notUsedInParsedStage-  pretty' x =-    case x of-      HsString {} -> prettyString-      HsStringPrim {} -> prettyString-    where-      prettyString =-        case lines $ showOutputable x of-          [] -> pure ()-          [l] -> string l-          (s:ss) ->-            string "" |=> do-              string s-              newline-              indentedWithSpace (-1)-                $ lined-                $ fmap (string . dropWhile (/= '\\')) ss-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (HsPragE GhcPs) where-  pretty' (HsPragSCC _ x) = spaced [string "{-# SCC", pretty x, string "#-}"]-#else-instance Pretty (HsPragE GhcPs) where-  pretty' (HsPragSCC _ _ x) = spaced [string "{-# SCC", pretty x, string "#-}"]-#endif-instance Pretty HsIPName where-  pretty' (HsIPName x) = string $ unpackFS x-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty (HsTyLit GhcPs) where-  pretty' (HsNumTy _ x) = string $ show x-  pretty' (HsStrTy _ x) = string $ ushow x-  pretty' (HsCharTy _ x) = string $ show x-#else-instance Pretty HsTyLit where-  pretty' (HsNumTy _ x) = string $ show x-  pretty' (HsStrTy _ x) = string $ ushow x-  pretty' (HsCharTy _ x) = string $ show x-#endif-instance Pretty (HsPatSigType GhcPs) where-  pretty' HsPS {..} = pretty hsps_body--instance Pretty (HsIPBinds GhcPs) where-  pretty' (IPBinds _ xs) = lined $ fmap pretty xs--instance Pretty (IPBind GhcPs) where-  pretty' = prettyIPBind--prettyIPBind :: IPBind GhcPs -> Printer ()-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyIPBind (IPBind _ l r) =-  spaced [string "?" >> pretty l, string "=", pretty r]-#else-prettyIPBind (IPBind _ (Right _) _) = notUsedInParsedStage-prettyIPBind (IPBind _ (Left l) r) =-  spaced [string "?" >> pretty l, string "=", pretty r]-#endif-instance Pretty (DerivStrategy GhcPs) where-  pretty' StockStrategy {} = string "stock"-  pretty' AnyclassStrategy {} = string "anyclass"-  pretty' NewtypeStrategy {} = string "newtype"-  pretty' (ViaStrategy x) = string "via " >> pretty x--instance Pretty XViaStrategyPs where-  pretty' (XViaStrategyPs _ ty) = pretty ty--instance Pretty (RecordPatSynField GhcPs) where-  pretty' RecordPatSynField {..} = pretty recordPatSynField--instance Pretty (HsCmdTop GhcPs) where-  pretty' (HsCmdTop _ cmd) = pretty cmd--instance Pretty (HsCmd GhcPs) where-  pretty' = prettyHsCmd--prettyHsCmd :: HsCmd GhcPs -> Printer ()-prettyHsCmd (HsCmdArrApp _ f arg HsHigherOrderApp True) =-  spaced [pretty f, string "-<<", pretty arg]-prettyHsCmd (HsCmdArrApp _ f arg HsHigherOrderApp False) =-  spaced [pretty arg, string ">>-", pretty f]-prettyHsCmd (HsCmdArrApp _ f arg HsFirstOrderApp True) =-  spaced [pretty f, string "-<", pretty arg]-prettyHsCmd (HsCmdArrApp _ f arg HsFirstOrderApp False) =-  spaced [pretty arg, string ">-", pretty f]-prettyHsCmd (HsCmdArrForm _ f _ _ args) =-  bananaBrackets $ spaced $ pretty f : fmap pretty args-prettyHsCmd (HsCmdApp _ f arg) = spaced [pretty f, pretty arg]-prettyHsCmd (HsCmdLam _ x) = pretty x-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsCmd (HsCmdPar _ _ x _) = parens $ pretty x-#else-prettyHsCmd (HsCmdPar _ x) = parens $ pretty x-#endif-prettyHsCmd (HsCmdCase _ cond arms) = do-  spaced [string "case", pretty cond, string "of"]-  newline-  indentedBlock $ pretty arms-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsCmd (HsCmdLamCase _ _ arms) = do-  string "\\case"-  newline-  indentedBlock $ pretty arms-#else-prettyHsCmd (HsCmdLamCase _ arms) = do-  string "\\case"-  newline-  indentedBlock $ pretty arms-#endif-prettyHsCmd (HsCmdIf _ _ cond t f) = do-  string "if "-  pretty cond-  newline-  indentedBlock $ lined [string "then " >> pretty t, string "else " >> pretty f]-#if MIN_VERSION_ghc_lib_parser(9,4,1)-prettyHsCmd (HsCmdLet _ _ binds _ expr) =-  lined [string "let " |=> pretty binds, string " in " |=> pretty expr]-#else-prettyHsCmd (HsCmdLet _ binds expr) =-  lined [string "let " |=> pretty binds, string " in " |=> pretty expr]-#endif-prettyHsCmd (HsCmdDo _ stmts) = do-  string "do"-  newline-  indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)--instance Pretty ListComprehension where-  pretty' ListComprehension {..} = horizontal <-|> vertical-    where-      horizontal =-        brackets-          $ spaced-              [ pretty listCompLhs-              , string "|"-              , hCommaSep $ fmap pretty listCompRhs-              ]-      vertical = do-        string "[ "-        pretty $ fmap StmtLRInsideVerticalList listCompLhs-        newline-        forM_ (stmtsAndPrefixes listCompRhs) $ \(p, x) -> do-          string p |=> pretty (fmap StmtLRInsideVerticalList x)-          newline-        string "]"-      stmtsAndPrefixes l = ("| ", head l) : fmap (", ", ) (tail l)--instance Pretty DoExpression where-  pretty' DoExpression {..} = do-    pretty qualifiedDo-    newline-    indentedBlock $ lined $ fmap pretty doStmts--instance Pretty DoOrMdo where-  pretty' Do = string "do"-  pretty' Mdo = string "mdo"--instance Pretty QualifiedDo where-  pretty' (QualifiedDo (Just m) d) = do-    pretty m-    string "."-    pretty d-  pretty' (QualifiedDo Nothing d) = pretty d--instance Pretty LetIn where-  pretty' LetIn {..} =-    lined [string "let " |=> pretty letBinds, string " in " |=> pretty inExpr]--instance Pretty (RuleBndr GhcPs) where-  pretty' (RuleBndr _ name) = pretty name-  pretty' (RuleBndrSig _ name sig) =-    parens $ spaced [pretty name, string "::", pretty sig]--instance Pretty CCallConv where-  pretty' CCallConv = string "ccall"-  pretty' CApiConv = string "capi"-  pretty' StdCallConv = string "stdcall"-  pretty' PrimCallConv = string "prim"-  pretty' JavaScriptCallConv = string "javascript"-#if MIN_VERSION_ghc_lib_parser(9,8,1)-instance Pretty ModuleDeprecatedPragma where-  pretty' (ModuleDeprecatedPragma (WarningTxt _ _ xs)) =-    spaced [string "{-# WARNING", spaced $ fmap pretty xs, string "#-}"]-  pretty' (ModuleDeprecatedPragma (DeprecatedTxt _ xs)) =-    spaced [string "{-# DEPRECATED", spaced $ fmap pretty xs, string "#-}"]-#else-instance Pretty ModuleDeprecatedPragma where-  pretty' (ModuleDeprecatedPragma (WarningTxt _ xs)) =-    spaced [string "{-# WARNING", spaced $ fmap pretty xs, string "#-}"]-  pretty' (ModuleDeprecatedPragma (DeprecatedTxt _ xs)) =-    spaced [string "{-# DEPRECATED", spaced $ fmap pretty xs, string "#-}"]-#endif-instance Pretty HsSrcBang where-  pretty' (HsSrcBang _ unpack strictness) = do-    pretty unpack-    unless (unpack == NoSrcUnpack) space-    pretty strictness--instance Pretty SrcUnpackedness where-  pretty' SrcUnpack = string "{-# UNPACK #-}"-  pretty' SrcNoUnpack = string "{-# NOUNPACK #-}"-  pretty' NoSrcUnpack = pure ()--instance Pretty SrcStrictness where-  pretty' SrcLazy = string "~"-  pretty' SrcStrict = string "!"-  pretty' NoSrcStrict = pure ()--instance Pretty (HsOuterSigTyVarBndrs GhcPs) where-  pretty' HsOuterImplicit {} = pure ()-  pretty' HsOuterExplicit {..} = do-    string "forall"-    spacePrefixed $ fmap pretty hso_bndrs-    dot-#if MIN_VERSION_ghc_lib_parser(9,6,1)-instance Pretty FieldLabelString where-  pretty' = output--instance Pretty (HsUntypedSplice GhcPs) where-  pretty' (HsUntypedSpliceExpr _ x) = string "$" >> pretty x-  -- The body of a quasi-quote must not be changed by a formatter.-  -- Changing it will modify the actual behavior of the code.-  ---  -- TODO: Remove duplicated code-  pretty' (HsQuasiQuote _ l r) =-    brackets $ do-      pretty l-      printCommentsAnd-        r-        (wrapWithBars-           . indentedWithFixedLevel 0-           . sequence_-           . printers [] ""-           . unpackFS)-    where-      printers ps s [] = reverse (string (reverse s) : ps)-      printers ps s ('\n':xs) =-        printers (newline : string (reverse s) : ps) "" xs-      printers ps s (x:xs) = printers ps (x : s) xs-#endif--- | Marks an AST node as never appearing in an AST.------ Some AST node types are only defined in `ghc-lib-parser` and not--- generated by it.-notGeneratedByParser :: HasCallStack => a-notGeneratedByParser = error "`ghc-lib-parser` never generates this AST node."---- | Marks an AST node as related to Haddock comments.------ The parser parses haddock comments as normal ones, meaning AST nodes--- related to haddock never appear in an AST.-docNode :: HasCallStack => a-docNode =-  error-    "This AST node is related to Haddocks, but haddock comments are treated as normal ones, and this node should never appear in an AST."---- | Marks an AST node as never appearing in the AST.------ Some AST node types are only used in the renaming or type-checking phase.-notUsedInParsedStage :: HasCallStack => a-notUsedInParsedStage =-  error-    "This AST should never appears in an AST. It only appears in the renaming or type checked stages."-#if !MIN_VERSION_ghc_lib_parser(9,4,1)--- | Marks an AST node as it is used only for Haskell Program Coverage.-forHpc :: HasCallStack => a-forHpc = error "This AST type is for the use of Haskell Program Coverage."+  ( Pretty(..)+  , pretty+  , printCommentsAnd+  ) where++import Control.Monad+import Control.Monad.RWS+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe+import Data.Void+import qualified GHC.Data.Bag as GHC+import qualified GHC.Data.FastString as GHC+import qualified GHC.Hs as GHC+import GHC.Stack+import qualified GHC.Types.Basic as GHC+import qualified GHC.Types.Fixity as GHC+import qualified GHC.Types.Name as GHC+import qualified GHC.Types.Name.Reader as GHC+import qualified GHC.Types.SourceText as GHC+import qualified GHC.Types.SrcLoc as GHC+import HIndent.Ast.Declaration.Bind+import HIndent.Ast.Declaration.Data.Body+import HIndent.Ast.Declaration.Data.Record.Field+import HIndent.Ast.Declaration.Family.Type+import HIndent.Ast.Declaration.Signature+import HIndent.Ast.Expression.Bracket+import HIndent.Ast.Expression.Splice+import HIndent.Ast.Name.Infix+import HIndent.Ast.Name.Prefix+import HIndent.Ast.NodeComments+import HIndent.Ast.Type.Variable+import HIndent.Ast.WithComments+import HIndent.Config+import HIndent.Fixity+import HIndent.Pretty.Combinators+import HIndent.Pretty.NodeComments+import qualified HIndent.Pretty.SigBindFamily as SBF+import HIndent.Pretty.Types+import HIndent.Printer+import qualified Language.Haskell.GhclibParserEx.GHC.Hs.Expr as GHC+import Text.Show.Unicode+#if MIN_VERSION_ghc_lib_parser(9,6,1)+import qualified GHC.Core.DataCon as GHC+#endif+#if !MIN_VERSION_ghc_lib_parser(9,6,1)+import qualified GHC.Unit as GHC+#endif+-- | This function pretty-prints the given AST node with comments.+pretty :: Pretty a => a -> Printer ()+pretty p = do+  printCommentsBefore p+  pretty' p+  printCommentOnSameLine p+  printCommentsAfter p++-- | Prints comments included in the location information and then the+-- AST node body.+printCommentsAnd ::+     (CommentExtraction l)+  => GHC.GenLocated l e+  -> (e -> Printer ())+  -> Printer ()+printCommentsAnd (GHC.L l e) f = do+  printCommentsBefore l+  f e+  printCommentOnSameLine l+  printCommentsAfter l++-- | Prints comments that are before the given AST node.+printCommentsBefore :: CommentExtraction a => a -> Printer ()+printCommentsBefore p =+  forM_ (commentsBefore $ nodeComments p) $ \(GHC.L loc c) -> do+    let col = fromIntegral $ GHC.srcSpanStartCol (getAnc loc) - 1+    indentedWithFixedLevel col $ pretty c+    newline++-- | Prints comments that are on the same line as the given AST node.+printCommentOnSameLine :: CommentExtraction a => a -> Printer ()+printCommentOnSameLine (commentsOnSameLine . nodeComments -> (c:cs)) = do+  col <- gets psColumn+  if col == 0+    then indentedWithFixedLevel+           (fromIntegral $ GHC.srcSpanStartCol $ getAnc $ GHC.getLoc c)+           $ spaced+           $ fmap pretty+           $ c : cs+    else spacePrefixed $ fmap pretty $ c : cs+  eolCommentsArePrinted+printCommentOnSameLine _ = return ()++-- | Prints comments that are after the given AST node.+printCommentsAfter :: CommentExtraction a => a -> Printer ()+printCommentsAfter p =+  case commentsAfter $ nodeComments p of+    [] -> return ()+    xs -> do+      isThereCommentsOnSameLine <- gets psEolComment+      unless isThereCommentsOnSameLine newline+      forM_ xs $ \(GHC.L loc c) -> do+        let col = fromIntegral $ GHC.srcSpanStartCol (getAnc loc) - 1+        indentedWithFixedLevel col $ pretty c+        eolCommentsArePrinted++-- | Pretty print including comments.+--+-- 'FastString' does not implement this class because it may contain @\n@s+-- and each type that may contain a 'FastString' value needs their own+-- handlings.+class CommentExtraction a =>+      Pretty a+  where+  pretty' :: a -> Printer ()++-- Do nothing if there are no pragmas, module headers, imports, or+-- declarations. Otherwise, extra blank lines will be inserted if only+-- comments are present in the source code. See+-- https://github.com/mihaimaruseac/hindent/issues/586#issuecomment-1374992624.+instance (CommentExtraction l, Pretty e) => Pretty (GHC.GenLocated l e) where+  pretty' (GHC.L _ e) = pretty e++instance Pretty+           (GHC.MatchGroup+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' GHC.MG {..} = printCommentsAnd mg_alts (lined . fmap pretty)++instance Pretty+           (GHC.MatchGroup+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where+  pretty' GHC.MG {..} = printCommentsAnd mg_alts (lined . fmap pretty)++instance Pretty (GHC.HsExpr GHC.GhcPs) where+  pretty' = prettyHsExpr++prettyHsExpr :: GHC.HsExpr GHC.GhcPs -> Printer ()+prettyHsExpr (GHC.HsVar _ bind) = pretty $ fmap mkPrefixName bind+#if MIN_VERSION_ghc_lib_parser(9, 6, 0)+prettyHsExpr (GHC.HsUnboundVar _ x) = pretty $ mkPrefixName x+#else+prettyHsExpr (GHC.HsUnboundVar _ x) = pretty x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+prettyHsExpr (GHC.HsOverLabel _ _ l) = string "#" >> string (GHC.unpackFS l)+#else+prettyHsExpr (GHC.HsOverLabel _ l) = string "#" >> string (GHC.unpackFS l)+#endif+prettyHsExpr (GHC.HsIPVar _ var) = string "?" >> pretty var+prettyHsExpr (GHC.HsOverLit _ x) = pretty x+prettyHsExpr (GHC.HsLit _ l) = pretty l+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsExpr (GHC.HsLam _ GHC.LamSingle body) = pretty body+prettyHsExpr (GHC.HsLam _ GHC.LamCase body) = pretty $ LambdaCase body Case+prettyHsExpr (GHC.HsLam _ GHC.LamCases body) = pretty $ LambdaCase body Cases+#else+prettyHsExpr (GHC.HsLam _ body) = pretty body+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- No `HsLamCase` since 9.10.1.+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)+prettyHsExpr (GHC.HsLamCase _ GHC.LamCase matches) =+  pretty $ LambdaCase matches Case+prettyHsExpr (GHC.HsLamCase _ GHC.LamCases matches) =+  pretty $ LambdaCase matches Cases+#else+prettyHsExpr (GHC.HsLamCase _ matches) = pretty $ LambdaCase matches Case+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsExpr (GHC.HsApp _ l r) = horizontal <-|> vertical+  where+    horizontal = spaced [pretty l, pretty r]+    vertical = do+      let (f, args) =+            case flatten l ++ [r] of+              [] -> error "Invalid function application."+              (f':args') -> (f', args')+      col <- gets psColumn+      spaces <- getIndentSpaces+      pretty f+      col' <- gets psColumn+      let diff =+            col'+              - col+              - if col == 0+                  then spaces+                  else 0+      if diff + 1 <= spaces+        then space+        else newline+      spaces' <- getIndentSpaces+      indentedWithSpace spaces' $ lined $ fmap pretty args+    flatten :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+    flatten (GHC.L (GHC.EpAnn _ _ cs) (GHC.HsApp _ l' r')) =+      flatten l' ++ [insertComments cs r']+    flatten x = [x]+    insertComments ::+         GHC.EpAnnComments -> GHC.LHsExpr GHC.GhcPs -> GHC.LHsExpr GHC.GhcPs+    insertComments cs (GHC.L s@GHC.EpAnn {comments = cs'} r') =+      GHC.L (s {GHC.comments = cs <> cs'}) r'+    insertComments _ x = x+#else+prettyHsExpr (GHC.HsApp _ l r) = horizontal <-|> vertical+  where+    horizontal = spaced [pretty l, pretty r]+    vertical = do+      let (f, args) =+            case flatten l ++ [r] of+              [] -> error "Invalid function application."+              (f':args') -> (f', args')+      col <- gets psColumn+      spaces <- getIndentSpaces+      pretty f+      col' <- gets psColumn+      let diff =+            col'+              - col+              - if col == 0+                  then spaces+                  else 0+      if diff + 1 <= spaces+        then space+        else newline+      spaces' <- getIndentSpaces+      indentedWithSpace spaces' $ lined $ fmap pretty args+    flatten :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+    flatten (GHC.L (GHC.SrcSpanAnn (GHC.EpAnn _ _ cs) _) (GHC.HsApp _ l' r')) =+      flatten l' ++ [insertComments cs r']+    flatten x = [x]+    insertComments ::+         GHC.EpAnnComments -> GHC.LHsExpr GHC.GhcPs -> GHC.LHsExpr GHC.GhcPs+    insertComments cs (GHC.L s@GHC.SrcSpanAnn {GHC.ann = e@GHC.EpAnn {comments = cs'}} r') =+      GHC.L (s {GHC.ann = e {GHC.comments = cs <> cs'}}) r'+    insertComments _ x = x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsExpr (GHC.HsAppType _ l _ r) = do+  pretty l+  string " @"+  pretty r+#else+prettyHsExpr (GHC.HsAppType _ l r) = do+  pretty l+  string " @"+  pretty r+#endif+prettyHsExpr (GHC.OpApp _ l o r) = pretty (InfixApp l o r)+prettyHsExpr (GHC.NegApp _ x _) = string "-" >> pretty x+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsExpr (GHC.HsPar _ _ expr _) = parens $ pretty expr+#else+prettyHsExpr (GHC.HsPar _ expr) = parens $ pretty expr+#endif+prettyHsExpr (GHC.SectionL _ l o) = spaced [pretty l, pretty (InfixExpr o)]+prettyHsExpr (GHC.SectionR _ o r) = (pretty (InfixExpr o) >> space) |=> pretty r+prettyHsExpr (GHC.ExplicitTuple _ full boxity) = horizontal <-|> vertical+  where+    horizontal = parH $ fmap pretty full+    vertical =+      parV+        $ prefixedLined ","+        $ fmap (\e -> unless (isMissing e) (space |=> pretty e)) full+    isMissing GHC.Missing {} = True+    isMissing _ = False+    parH =+      case boxity of+        GHC.Boxed -> hTuple+        GHC.Unboxed -> hUnboxedTuple+    parV =+      case boxity of+        GHC.Boxed -> parens+        GHC.Unboxed -> unboxedParens+prettyHsExpr (GHC.ExplicitSum _ position numElem expr) = do+  string "(#"+  forM_ [1 .. numElem] $ \idx -> do+    if idx == position+      then string " " >> pretty expr >> string " "+      else string " "+    when (idx < numElem) $ string "|"+  string "#)"+prettyHsExpr (GHC.HsCase _ cond arms) = do+  string "case " |=> do+    pretty cond+    string " of"+  if null $ GHC.unLoc $ GHC.mg_alts arms+    then string " {}"+    else do+      newline+      indentedBlock $ pretty arms+prettyHsExpr (GHC.HsIf _ cond t f) = do+  string "if " |=> pretty cond+  indentedBlock $ newlinePrefixed [branch "then " t, branch "else " f]+  where+    branch :: String -> GHC.LHsExpr GHC.GhcPs -> Printer ()+    branch str e =+      case e of+        (GHC.L _ (GHC.HsDo _ (GHC.DoExpr m) xs)) -> doStmt (QualifiedDo m Do) xs+        (GHC.L _ (GHC.HsDo _ (GHC.MDoExpr m) xs)) ->+          doStmt (QualifiedDo m Mdo) xs+        _ -> string str |=> pretty e+      where+        doStmt qDo stmts = do+          string str+          pretty qDo+          newline+          indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)+prettyHsExpr (GHC.HsMultiIf _ guards) =+  string "if "+    |=> lined (fmap (pretty . fmap (GRHSExpr GRHSExprMultiWayIf)) guards)+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsExpr (GHC.HsLet _ _ binds _ exprs) = pretty $ LetIn binds exprs+#else+prettyHsExpr (GHC.HsLet _ binds exprs) = pretty $ LetIn binds exprs+#endif+prettyHsExpr (GHC.HsDo _ GHC.ListComp {} (GHC.L _ [])) =+  error "Not enough arguments are passed to pretty-print a list comprehension."+prettyHsExpr (GHC.HsDo _ GHC.ListComp {} (GHC.L _ [_])) =+  error "Not enough arguments are passed to pretty-print a list comprehension."+prettyHsExpr (GHC.HsDo _ GHC.ListComp {} (GHC.L l (lhs:rhs:rhss))) =+  pretty $ GHC.L l $ ListComprehension lhs (rhs :| rhss)+-- While the name contains 'Monad', 'MonadComp' is for list comprehensions.+prettyHsExpr (GHC.HsDo _ GHC.MonadComp {} (GHC.L _ [])) =+  error "Not enough arguments are passed to pretty-print a list comprehension."+prettyHsExpr (GHC.HsDo _ GHC.MonadComp {} (GHC.L _ [_])) =+  error "Not enough arguments are passed to pretty-print a list comprehension."+prettyHsExpr (GHC.HsDo _ GHC.MonadComp {} (GHC.L l (lhs:rhs:rhss))) =+  pretty $ GHC.L l $ ListComprehension lhs (rhs :| rhss)+prettyHsExpr (GHC.HsDo _ (GHC.DoExpr m) (GHC.L l xs)) =+  pretty $ GHC.L l $ DoExpression xs (QualifiedDo m Do)+prettyHsExpr (GHC.HsDo _ (GHC.MDoExpr m) (GHC.L l xs)) =+  pretty $ GHC.L l $ DoExpression xs (QualifiedDo m Mdo)+prettyHsExpr (GHC.HsDo _ GHC.GhciStmtCtxt {} _) =+  error "We're not using GHCi, are we?"+prettyHsExpr (GHC.ExplicitList _ xs) = horizontal <-|> vertical+  where+    horizontal = brackets $ hCommaSep $ fmap pretty xs+    vertical = vList $ fmap pretty xs+prettyHsExpr (GHC.RecordCon _ name fields) = horizontal <-|> vertical+  where+    horizontal = spaced [pretty $ fmap mkPrefixName name, pretty fields]+    vertical = do+      pretty $ fmap mkPrefixName name+      (space >> pretty fields) <-|> (newline >> indentedBlock (pretty fields))+#if MIN_VERSION_ghc_lib_parser(9,8,1)+prettyHsExpr (GHC.RecordUpd _ name fields) = hor <-|> ver+  where+    hor = spaced [pretty name, printHorFields fields]+    ver = do+      pretty name+      newline+      indentedBlock $ printHorFields fields <-|> printVerFields fields+    printHorFields GHC.RegularRecUpdFields {..} =+      hFields $ fmap (`printCommentsAnd` horField) recUpdFields+    printHorFields GHC.OverloadedRecUpdFields {..} =+      hFields $ fmap (`printCommentsAnd` horField) olRecUpdFields+    printVerFields GHC.RegularRecUpdFields {..} =+      vFields $ fmap printField recUpdFields+    printVerFields GHC.OverloadedRecUpdFields {..} =+      vFields $ fmap printField olRecUpdFields+    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField+    horField GHC.HsFieldBind {..} = do+      pretty hfbLHS+      string " = "+      pretty hfbRHS+    verField GHC.HsFieldBind {..} = do+      pretty hfbLHS+      string " ="+      newline+      indentedBlock $ pretty hfbRHS+#elif MIN_VERSION_ghc_lib_parser(9,4,1)+prettyHsExpr (GHC.RecordUpd _ name fields) = hor <-|> ver+  where+    hor = spaced [pretty name, either printHorFields printHorFields fields]+    ver = do+      pretty name+      newline+      indentedBlock+        $ either printHorFields printHorFields fields+            <-|> either printVerFields printVerFields fields+    printHorFields ::+         (Pretty a, Pretty b, CommentExtraction l)+      => [GHC.GenLocated l (GHC.HsFieldBind a b)]+      -> Printer ()+    printHorFields = hFields . fmap (`printCommentsAnd` horField)+    printVerFields ::+         (Pretty a, Pretty b, CommentExtraction l)+      => [GHC.GenLocated l (GHC.HsFieldBind a b)]+      -> Printer ()+    printVerFields = vFields . fmap printField+    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField+    horField GHC.HsFieldBind {..} = do+      pretty hfbLHS+      string " = "+      pretty hfbRHS+    verField GHC.HsFieldBind {..} = do+      pretty hfbLHS+      string " ="+      newline+      indentedBlock $ pretty hfbRHS+#else+prettyHsExpr (GHC.RecordUpd _ name fields) = hor <-|> ver+  where+    hor = spaced [pretty name, either printHorFields printHorFields fields]+    ver = do+      pretty name+      newline+      indentedBlock+        $ either printHorFields printHorFields fields+            <-|> either printVerFields printVerFields fields+    printHorFields ::+         (Pretty a, Pretty b, CommentExtraction l)+      => [GHC.GenLocated l (GHC.HsRecField' a b)]+      -> Printer ()+    printHorFields = hFields . fmap (`printCommentsAnd` horField)+    printVerFields ::+         (Pretty a, Pretty b, CommentExtraction l)+      => [GHC.GenLocated l (GHC.HsRecField' a b)]+      -> Printer ()+    printVerFields = vFields . fmap printField+    printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField+    horField GHC.HsRecField {..} = do+      pretty hsRecFieldLbl+      string " = "+      pretty hsRecFieldArg+    verField GHC.HsRecField {..} = do+      pretty hsRecFieldLbl+      string " ="+      newline+      indentedBlock $ pretty hsRecFieldArg+#endif+prettyHsExpr (GHC.HsGetField _ e f) = do+  pretty e+  dot+  pretty f+prettyHsExpr GHC.HsProjection {..} =+  parens+    $ forM_ proj_flds+    $ \x -> do+        string "."+        pretty x+prettyHsExpr (GHC.ExprWithTySig _ e sig) = do+  pretty e+  string " :: "+  pretty $ GHC.hswc_body sig+prettyHsExpr (GHC.ArithSeq _ _ x) = pretty x+#if !MIN_VERSION_ghc_lib_parser(9,6,1)+prettyHsExpr (GHC.HsSpliceE _ x) = pretty $ mkSplice x+#endif+prettyHsExpr (GHC.HsProc _ pat x@(GHC.L _ (GHC.HsCmdTop _ (GHC.L _ (GHC.HsCmdDo _ xs))))) = do+  spaced [string "proc", pretty pat, string "-> do"]+  newline+  indentedBlock+    $ printCommentsAnd x (const (printCommentsAnd xs (lined . fmap pretty)))+prettyHsExpr (GHC.HsProc _ pat body) = hor <-|> ver+  where+    hor = spaced [string "proc", pretty pat, string "->", pretty body]+    ver = do+      spaced [string "proc", pretty pat, string "->"]+      newline+      indentedBlock (pretty body)+prettyHsExpr (GHC.HsStatic _ x) = spaced [string "static", pretty x]+prettyHsExpr (GHC.HsPragE _ p x) = spaced [pretty p, pretty x]+#if MIN_VERSION_ghc_lib_parser(9,4,1)+prettyHsExpr GHC.HsRecSel {} = notGeneratedByParser+prettyHsExpr (GHC.HsTypedBracket _ inner) = typedBrackets $ pretty inner+prettyHsExpr (GHC.HsUntypedBracket _ inner) = pretty $ mkBracket inner+#else+prettyHsExpr GHC.HsConLikeOut {} = notGeneratedByParser+prettyHsExpr GHC.HsRecFld {} = notGeneratedByParser+prettyHsExpr (GHC.HsDo _ GHC.ArrowExpr {} _) = notGeneratedByParser+prettyHsExpr (GHC.HsDo _ GHC.PatGuard {} _) = notGeneratedByParser+prettyHsExpr (GHC.HsDo _ GHC.ParStmtCtxt {} _) = notGeneratedByParser+prettyHsExpr (GHC.HsDo _ GHC.TransStmtCtxt {} _) = notGeneratedByParser+prettyHsExpr GHC.HsTick {} = forHpc+prettyHsExpr GHC.HsBinTick {} = forHpc+prettyHsExpr (GHC.HsBracket _ inner) = pretty $ mkBracket inner+prettyHsExpr GHC.HsRnBracketOut {} = notGeneratedByParser+prettyHsExpr GHC.HsTcBracketOut {} = notGeneratedByParser+#endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+prettyHsExpr (GHC.HsTypedSplice _ x) = string "$$" >> pretty x+prettyHsExpr (GHC.HsUntypedSplice _ x) = pretty $ mkSplice x+#endif+instance Pretty LambdaCase where+  pretty' (LambdaCase matches caseOrCases) = do+    case caseOrCases of+      Case -> string "\\case"+      Cases -> string "\\cases"+    if null $ GHC.unLoc $ GHC.mg_alts matches+      then string " {}"+      else do+        newline+        indentedBlock $ pretty matches++instance Pretty (GHC.HsSigType GHC.GhcPs) where+  pretty' = pretty' . HsSigType' HsTypeForNormalDecl HsTypeNoDir++instance Pretty HsSigType' where+  pretty' (HsSigTypeInsideDeclSig GHC.HsSig {..}) =+    case sig_bndrs of+      GHC.HsOuterExplicit _ xs -> do+        string "forall "+        spaced $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) xs+        dot+        case GHC.unLoc sig_body of+          GHC.HsQualTy {..} ->+            printCommentsAnd sig_body $ \_ ->+              let hor = do+                    space+                    pretty $ HorizontalContext hst_ctxt+                  ver = do+                    newline+                    pretty $ VerticalContext hst_ctxt+               in do+                    hor <-|> ver+                    newline+                    prefixed "=> "+                      $ prefixedLined "-> "+                      $ pretty <$> flatten hst_body+          _ ->+            let hor = space >> pretty (fmap HsTypeInsideDeclSig sig_body)+                ver =+                  newline >> prefixedLined "-> " (pretty <$> flatten sig_body)+             in hor <-|> ver+      _ -> pretty $ fmap HsTypeInsideDeclSig sig_body+    where+      flatten :: GHC.LHsType GHC.GhcPs -> [GHC.LHsType GHC.GhcPs]+      flatten (GHC.L _ (GHC.HsFunTy _ _ l r)) = flatten l ++ flatten r+      flatten x = [x]+  pretty' (HsSigTypeInsideVerticalFuncSig GHC.HsSig {..}) =+    case sig_bndrs of+      GHC.HsOuterExplicit _ xs -> do+        string "forall "+        spaced $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) xs+        dot+        printCommentsAnd sig_body $ \case+          GHC.HsQualTy {..} -> do+            (space >> pretty (HorizontalContext hst_ctxt))+              <-|> (newline >> pretty (VerticalContext hst_ctxt))+            newline+            prefixed "=> " $ pretty hst_body+          x -> pretty $ HsTypeInsideDeclSig x+      _ -> pretty $ fmap HsTypeInsideDeclSig sig_body+  pretty' (HsSigType' for dir GHC.HsSig {..}) = do+    case sig_bndrs of+      GHC.HsOuterExplicit _ xs -> do+        string "forall "+        spaced $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) xs+        dot+        space+      _ -> return ()+    pretty $ HsType' for dir <$> sig_body++instance Pretty+           (GHC.Match+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' = prettyMatchExpr++prettyMatchExpr :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> Printer ()+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyMatchExpr GHC.Match {m_ctxt = GHC.LamAlt GHC.LamSingle, ..} = do+  string "\\"+  case m_pats of+    p:_ ->+      case GHC.unLoc p of+        GHC.LazyPat {} -> space+        GHC.BangPat {} -> space+        _ -> return ()+    _ -> return ()+  spaced $ fmap pretty m_pats+  pretty $ GRHSsExpr GRHSExprLambda m_grhss+prettyMatchExpr GHC.Match {m_ctxt = GHC.LamAlt GHC.LamCase, ..} = do+  spaced $ fmap pretty m_pats+  pretty $ GRHSsExpr GRHSExprCase m_grhss+prettyMatchExpr GHC.Match {m_ctxt = GHC.LamAlt GHC.LamCases, ..} = do+  spaced $ fmap pretty m_pats+  pretty $ GRHSsExpr GRHSExprCase m_grhss+#else+prettyMatchExpr GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do+  string "\\"+  case m_pats of+    p:_ ->+      case GHC.unLoc p of+        GHC.LazyPat {} -> space+        GHC.BangPat {} -> space+        _ -> return ()+    _ -> return ()+  spaced $ fmap pretty m_pats+  pretty $ GRHSsExpr GRHSExprLambda m_grhss+#endif+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyMatchExpr GHC.Match {m_ctxt = GHC.LamCaseAlt {}, ..} = do+  spaced $ fmap pretty m_pats+  pretty $ GRHSsExpr GRHSExprCase m_grhss+#endif+prettyMatchExpr GHC.Match {m_ctxt = GHC.CaseAlt, ..} = do+  mapM_ pretty m_pats+  pretty $ GRHSsExpr GRHSExprCase m_grhss+prettyMatchExpr GHC.Match {..} =+  case GHC.mc_fixity m_ctxt of+    GHC.Prefix -> do+      pretty m_ctxt+      spacePrefixed $ fmap pretty m_pats+      pretty m_grhss+    GHC.Infix -> do+      case (m_pats, m_ctxt) of+        (l:r:xs, GHC.FunRhs {..}) -> do+          spaced+            $ [pretty l, pretty $ fmap mkInfixName mc_fun, pretty r]+                ++ fmap pretty xs+          pretty m_grhss+        _ -> error "Not enough parameters are passed."++instance Pretty+           (GHC.Match+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where+  pretty' = prettyMatchProc++prettyMatchProc :: GHC.Match GHC.GhcPs (GHC.LHsCmd GHC.GhcPs) -> Printer ()+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyMatchProc GHC.Match {m_ctxt = GHC.LamAlt GHC.LamSingle, ..} = do+  string "\\"+  case m_pats of+    p:_ ->+      case GHC.unLoc p of+        GHC.LazyPat {} -> space+        GHC.BangPat {} -> space+        _ -> return ()+    _ -> return ()+  spaced $ fmap pretty m_pats ++ [pretty m_grhss]+prettyMatchProc GHC.Match {m_ctxt = GHC.LamAlt GHC.LamCase, ..} = do+  spaced [mapM_ pretty m_pats, pretty m_grhss]+prettyMatchProc GHC.Match {m_ctxt = GHC.LamAlt GHC.LamCases, ..} = do+  spaced [mapM_ pretty m_pats, pretty m_grhss]+#else+prettyMatchProc GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do+  string "\\"+  case m_pats of+    p:_ ->+      case GHC.unLoc p of+        GHC.LazyPat {} -> space+        GHC.BangPat {} -> space+        _ -> return ()+    _ -> return ()+  spaced $ fmap pretty m_pats ++ [pretty m_grhss]+#endif+prettyMatchProc GHC.Match {m_ctxt = GHC.CaseAlt, ..} =+  spaced [mapM_ pretty m_pats, pretty m_grhss]+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyMatchProc GHC.Match {m_ctxt = GHC.LamCaseAlt {}, ..} = do+  spaced [mapM_ pretty m_pats, pretty m_grhss]+#endif+prettyMatchProc _ = notGeneratedByParser++instance Pretty+           (GHC.StmtLR+              GHC.GhcPs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' (GHC.LastStmt _ x _ _) = pretty x+  pretty' (GHC.BindStmt _ pat body) = do+    pretty pat+    string " <-"+    hor <-|> ver+    where+      hor = space >> pretty body+      ver = newline >> indentedBlock (pretty body)+  pretty' GHC.ApplicativeStmt {} = notGeneratedByParser+  pretty' (GHC.BodyStmt _ (GHC.L loc (GHC.OpApp _ l o r)) _ _) =+    pretty (GHC.L loc (InfixApp l o r))+  pretty' (GHC.BodyStmt _ body _ _) = pretty body+  pretty' (GHC.LetStmt _ l) = string "let " |=> pretty l+  pretty' (GHC.ParStmt _ xs _ _) = hvBarSep $ fmap pretty xs+  pretty' GHC.TransStmt {..} =+    vCommaSep $ fmap pretty trS_stmts ++ [string "then " >> pretty trS_using]+  pretty' GHC.RecStmt {..} =+    string "rec " |=> printCommentsAnd recS_stmts (lined . fmap pretty)++instance Pretty+           (GHC.StmtLR+              GHC.GhcPs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where+  pretty' (GHC.LastStmt _ x _ _) = pretty x+  pretty' (GHC.BindStmt _ pat body) = hor <-|> ver+    where+      hor = spaced [pretty pat, string "<-", pretty body]+      ver = do+        pretty pat+        string " <-"+        newline+        indentedBlock $ pretty body+  pretty' GHC.ApplicativeStmt {} = notGeneratedByParser+  pretty' (GHC.BodyStmt _ body _ _) = pretty body+  pretty' (GHC.LetStmt _ l) = string "let " |=> pretty l+  pretty' (GHC.ParStmt _ xs _ _) = hvBarSep $ fmap pretty xs+  pretty' GHC.TransStmt {..} =+    vCommaSep $ fmap pretty trS_stmts ++ [string "then " >> pretty trS_using]+  pretty' GHC.RecStmt {..} =+    string "rec " |=> printCommentsAnd recS_stmts (lined . fmap pretty)++instance Pretty StmtLRInsideVerticalList where+  pretty' (StmtLRInsideVerticalList (GHC.ParStmt _ xs _ _)) =+    vBarSep $ fmap (pretty . ParStmtBlockInsideVerticalList) xs+  pretty' (StmtLRInsideVerticalList x) = pretty x++-- | For pattern matching.+instance Pretty+           (GHC.HsRecFields+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where+  pretty' GHC.HsRecFields {..} = horizontal <-|> vertical+    where+      horizontal =+        case rec_dotdot of+          Just _ -> braces $ string ".."+          Nothing -> hFields $ fmap pretty rec_flds+      vertical = vFields $ fmap pretty rec_flds++-- | For record updates+instance Pretty+           (GHC.HsRecFields+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' GHC.HsRecFields {..} = hvFields fieldPrinters+    where+      fieldPrinters =+        fmap pretty rec_flds+          ++ maybeToList (fmap (const (string "..")) rec_dotdot)++instance Pretty (GHC.HsType GHC.GhcPs) where+  pretty' = pretty' . HsType' HsTypeForNormalDecl HsTypeNoDir++instance Pretty HsType' where+  pretty' (HsTypeInsideVerticalFuncSig (GHC.HsFunTy _ _ a b)) = do+    pretty $ HsTypeInsideVerticalFuncSig <$> a+    newline+    prefixed "-> " $ pretty $ HsTypeInsideVerticalFuncSig <$> b+  pretty' (HsTypeInsideDeclSig GHC.HsQualTy {..}) = hor <-|> ver+    where+      hor = spaced [pretty $ Context hst_ctxt, string "=>", pretty hst_body]+      ver = do+        pretty $ Context hst_ctxt+        newline+        prefixed "=> " $ pretty $ fmap HsTypeInsideVerticalFuncSig hst_body+  pretty' (HsTypeInsideDeclSig (GHC.HsFunTy _ _ a b)) = hor <-|> ver+    where+      hor = spaced [pretty a, string "->", pretty b]+      ver = do+        pretty $ fmap HsTypeInsideVerticalFuncSig a+        newline+        prefixed "-> " $ pretty $ fmap HsTypeInsideVerticalFuncSig b+  pretty' (HsTypeInsideInstDecl GHC.HsQualTy {..}) = hor <-|> ver+    where+      hor = spaced [pretty (Context hst_ctxt), string "=>", pretty hst_body]+      ver = do+        pretty (Context hst_ctxt)+        string " =>"+        newline+        pretty hst_body+  pretty' (HsTypeWithVerticalAppTy (GHC.HsAppTy _ l r)) = do+    pretty $ fmap HsTypeWithVerticalAppTy l+    newline+    indentedBlock $ pretty $ fmap HsTypeWithVerticalAppTy r+  pretty' (HsType' _ _ x) = prettyHsType x++prettyHsType :: GHC.HsType GHC.GhcPs -> Printer ()+prettyHsType (GHC.HsForAllTy _ tele body) =+  (pretty tele >> space) |=> pretty body+prettyHsType GHC.HsQualTy {..} = hor <-|> ver+  where+    hor = spaced [pretty $ Context hst_ctxt, string "=>", pretty hst_body]+    ver = do+      pretty $ Context hst_ctxt+      lined [string " =>", indentedBlock $ pretty hst_body]+prettyHsType (GHC.HsTyVar _ GHC.NotPromoted x) = pretty $ fmap mkPrefixName x+prettyHsType (GHC.HsTyVar _ GHC.IsPromoted x) =+  string "'" >> pretty (fmap mkPrefixName x)+prettyHsType x@(GHC.HsAppTy _ l r) = hor <-|> ver+  where+    hor = spaced $ fmap pretty [l, r]+    ver = pretty $ HsTypeWithVerticalAppTy x+#if MIN_VERSION_ghc_lib_parser(9, 8, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsType (GHC.HsAppKindTy _ l _ r) = pretty l >> string " @" >> pretty r+#else+prettyHsType (GHC.HsAppKindTy _ l r) = pretty l >> string " @" >> pretty r+#endif+prettyHsType (GHC.HsFunTy _ _ a b) = (pretty a >> string " -> ") |=> pretty b+prettyHsType (GHC.HsListTy _ xs) = brackets $ pretty xs+prettyHsType (GHC.HsTupleTy _ GHC.HsUnboxedTuple []) = string "(# #)"+prettyHsType (GHC.HsTupleTy _ GHC.HsBoxedOrConstraintTuple []) = string "()"+prettyHsType (GHC.HsTupleTy _ GHC.HsUnboxedTuple xs) =+  hvUnboxedTuple' $ fmap pretty xs+prettyHsType (GHC.HsTupleTy _ GHC.HsBoxedOrConstraintTuple xs) =+  hvTuple' $ fmap pretty xs+prettyHsType (GHC.HsSumTy _ xs) = hvUnboxedSum' $ fmap pretty xs+-- For `HsOpTy`, we do not need a single quote for the infix operator. An+-- explicit promotion is necessary if there is a data constructor and+-- a type with the same name. However, infix data constructors never+-- share their names with types because types cannot contain symbols.+-- Thus there is no ambiguity.+#if MIN_VERSION_ghc_lib_parser(9,4,1)+prettyHsType (GHC.HsOpTy _ _ l op r) = do+  lineBreak <- gets (configLineBreaks . psConfig)+  if showOutputable op `elem` lineBreak+    then do+      pretty l+      newline+      pretty $ fmap mkInfixName op+      space+      pretty r+    else spaced [pretty l, pretty $ fmap mkInfixName op, pretty r]+#else+prettyHsType (GHC.HsOpTy _ l op r) = do+  lineBreak <- gets (configLineBreaks . psConfig)+  if showOutputable op `elem` lineBreak+    then do+      pretty l+      newline+      pretty $ fmap mkInfixName op+      space+      pretty r+    else spaced [pretty l, pretty $ fmap mkInfixName op, pretty r]+#endif+prettyHsType (GHC.HsParTy _ inside) = parens $ pretty inside+prettyHsType (GHC.HsIParamTy _ x ty) =+  spaced [string "?" >> pretty x, string "::", pretty ty]+prettyHsType GHC.HsStarTy {} = string "*"+prettyHsType (GHC.HsKindSig _ t k) = spaced [pretty t, string "::", pretty k]+prettyHsType (GHC.HsSpliceTy _ sp) = pretty $ mkSplice sp+prettyHsType GHC.HsDocTy {} = docNode+prettyHsType (GHC.HsBangTy _ pack x) = pretty pack >> pretty x+prettyHsType (GHC.HsRecTy _ xs) =+  hvFields $ fmap (pretty . fmap mkRecordField . fromGenLocated) xs+prettyHsType (GHC.HsExplicitListTy _ _ xs) =+  case xs of+    [] -> string "'[]"+    _ -> hvPromotedList $ fmap pretty xs+prettyHsType (GHC.HsExplicitTupleTy _ xs) = hPromotedTuple $ fmap pretty xs+prettyHsType (GHC.HsTyLit _ x) = pretty x+prettyHsType GHC.HsWildCardTy {} = string "_"+prettyHsType GHC.XHsType {} = notGeneratedByParser++instance Pretty+           (GHC.GRHSs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' = pretty' . GRHSsExpr GRHSExprNormal++instance Pretty GRHSsExpr where+  pretty' (GRHSsExpr {grhssExpr = GHC.GRHSs {..}, ..}) = do+    mapM_ (pretty . fmap (GRHSExpr grhssExprType)) grhssGRHSs+    case (grhssLocalBinds, grhssExprType) of+      (GHC.HsValBinds {}, GRHSExprCase) ->+        indentedBlock $ do+          newline+          string "where " |=> pretty grhssLocalBinds+      (GHC.HsValBinds epa lr, _) ->+        indentedWithSpace 2+          $ newlinePrefixed+              [ string "where"+              , printCommentsAnd (GHC.L epa lr) (indentedWithSpace 2 . pretty)+              ]+      _ -> return ()++instance Pretty+           (GHC.GRHSs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where+  pretty' GHC.GRHSs {..} = do+    mapM_ (pretty . fmap GRHSProc) grhssGRHSs+    case grhssLocalBinds of+      (GHC.HsValBinds epa lr) ->+        indentedWithSpace 2+          $ newlinePrefixed+              [ string "where"+              , printCommentsAnd (GHC.L epa lr) (indentedWithSpace 2 . pretty)+              ]+      _ -> return ()+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance Pretty+           (GHC.HsMatchContext (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)) where+  pretty' = prettyHsMatchContext++prettyHsMatchContext ::+     GHC.HsMatchContext (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)+  -> Printer ()+prettyHsMatchContext GHC.FunRhs {..} =+  pretty mc_strictness >> pretty (fmap mkPrefixName mc_fun)+prettyHsMatchContext GHC.CaseAlt = return ()+prettyHsMatchContext GHC.IfAlt {} = notGeneratedByParser+prettyHsMatchContext GHC.ArrowMatchCtxt {} = notGeneratedByParser+prettyHsMatchContext GHC.PatBindRhs {} = notGeneratedByParser+prettyHsMatchContext GHC.PatBindGuards {} = notGeneratedByParser+prettyHsMatchContext GHC.RecUpd {} = notGeneratedByParser+prettyHsMatchContext GHC.StmtCtxt {} = notGeneratedByParser+prettyHsMatchContext GHC.ThPatSplice {} = notGeneratedByParser+prettyHsMatchContext GHC.ThPatQuote {} = notGeneratedByParser+prettyHsMatchContext GHC.PatSyn {} = notGeneratedByParser+#else+instance Pretty (GHC.HsMatchContext GHC.GhcPs) where+  pretty' = prettyHsMatchContext++prettyHsMatchContext :: GHC.HsMatchContext GHC.GhcPs -> Printer ()+prettyHsMatchContext GHC.FunRhs {..} =+  pretty mc_strictness >> pretty (fmap mkPrefixName mc_fun)+prettyHsMatchContext GHC.LambdaExpr = return ()+prettyHsMatchContext GHC.CaseAlt = return ()+prettyHsMatchContext GHC.IfAlt {} = notGeneratedByParser+prettyHsMatchContext GHC.ArrowMatchCtxt {} = notGeneratedByParser+prettyHsMatchContext GHC.PatBindRhs {} = notGeneratedByParser+prettyHsMatchContext GHC.PatBindGuards {} = notGeneratedByParser+prettyHsMatchContext GHC.RecUpd {} = notGeneratedByParser+prettyHsMatchContext GHC.StmtCtxt {} = notGeneratedByParser+prettyHsMatchContext GHC.ThPatSplice {} = notGeneratedByParser+prettyHsMatchContext GHC.ThPatQuote {} = notGeneratedByParser+prettyHsMatchContext GHC.PatSyn {} = notGeneratedByParser+#if MIN_VERSION_ghc_lib_parser(9, 4, 1)+prettyHsMatchContext GHC.LamCaseAlt {} = notUsedInParsedStage+#endif+#endif+instance Pretty (GHC.ParStmtBlock GHC.GhcPs GHC.GhcPs) where+  pretty' (GHC.ParStmtBlock _ xs _ _) = hvCommaSep $ fmap pretty xs++instance Pretty ParStmtBlockInsideVerticalList where+  pretty' (ParStmtBlockInsideVerticalList (GHC.ParStmtBlock _ xs _ _)) =+    vCommaSep $ fmap pretty xs++instance Pretty+           (GHC.GRHS+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' = pretty' . GRHSExpr GRHSExprNormal++instance Pretty GRHSExpr where+  pretty' (GRHSExpr {grhsExpr = (GHC.GRHS _ [] body), ..}) = do+    space+    rhsSeparator grhsExprType+    case GHC.unLoc body of+      GHC.HsDo _ (GHC.DoExpr m) stmts ->+        printCommentsAnd body (const (doExpr (QualifiedDo m Do) stmts))+      GHC.HsDo _ (GHC.MDoExpr m) stmts ->+        printCommentsAnd body (const (doExpr (QualifiedDo m Mdo) stmts))+      GHC.OpApp _ (GHC.L _ (GHC.HsDo _ GHC.DoExpr {} _)) _ _ ->+        space >> pretty body+      GHC.OpApp _ (GHC.L _ (GHC.HsDo _ GHC.MDoExpr {} _)) _ _ ->+        space >> pretty body+      _ ->+        let hor = space >> pretty body+            ver = newline >> indentedBlock (pretty body)+         in hor <-|> ver+    where+      doExpr qDo stmts = do+        space+        pretty qDo+        newline+        indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)+  pretty' (GRHSExpr {grhsExpr = (GHC.GRHS _ guards body), ..}) = do+    unless (grhsExprType == GRHSExprMultiWayIf) newline+    (if grhsExprType == GRHSExprMultiWayIf+       then id+       else indentedBlock) $ do+      string "| " |=> vCommaSep (fmap pretty guards)+      space+      rhsSeparator grhsExprType+      printCommentsAnd body $ \case+        GHC.HsDo _ (GHC.DoExpr m) stmts -> doExpr (QualifiedDo m Do) stmts+        GHC.HsDo _ (GHC.MDoExpr m) stmts -> doExpr (QualifiedDo m Mdo) stmts+        x ->+          let hor = space >> pretty x+              ver = newline >> indentedBlock (pretty x)+           in hor <-|> ver+    where+      doExpr qDo stmts = do+        space+        pretty qDo+        newline+        indentedBlock (printCommentsAnd stmts (lined . fmap pretty))++instance Pretty GRHSProc where+  pretty' (GRHSProc (GHC.GRHS _ guards body)) =+    if null guards+      then bodyPrinter+      else do+        newline+        indentedBlock $ do+          string "| " |=> vCommaSep (fmap pretty guards)+          space+          bodyPrinter+    where+      bodyPrinter = do+        string "->"+        printCommentsAnd body $ \case+          GHC.HsCmdDo _ stmts ->+            let hor = space >> printCommentsAnd stmts (lined . fmap pretty)+                ver = do+                  newline+                  indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)+             in hor <-|> ver+          x ->+            let hor = space >> pretty x+                ver = newline >> indentedBlock (pretty x)+             in hor <-|> ver++instance Pretty GHC.EpaCommentTok where+  pretty' (GHC.EpaLineComment c) = string c+  pretty' (GHC.EpaBlockComment c) =+    case lines c of+      [] -> pure ()+      [x] -> string x+      (x:xs) -> do+        string x+        newline+        -- 'indentedWithFixedLevel 0' is used because an 'EpaBlockComment'+        -- contains indent spaces for all lines except the first one.+        indentedWithFixedLevel 0 $ lined $ fmap string xs+  pretty' _ = docNode++instance Pretty (GHC.Pat GHC.GhcPs) where+  pretty' = prettyPat++instance Pretty PatInsidePatDecl where+  pretty' (PatInsidePatDecl (GHC.ConPat {pat_args = (GHC.InfixCon l r), ..})) =+    spaced [pretty l, pretty $ fmap mkInfixName pat_con, pretty r]+  pretty' (PatInsidePatDecl x) = pretty x++prettyPat :: GHC.Pat GHC.GhcPs -> Printer ()+prettyPat GHC.WildPat {} = string "_"+prettyPat (GHC.VarPat _ x) = pretty $ fmap mkPrefixName x+prettyPat (GHC.LazyPat _ x) = string "~" >> pretty x+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyPat (GHC.AsPat _ a _ b) =+  pretty (fmap mkPrefixName a) >> string "@" >> pretty b+#else+prettyPat (GHC.AsPat _ a b) =+  pretty (fmap mkPrefixName a) >> string "@" >> pretty b+#endif+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyPat (GHC.ParPat _ _ inner _) = parens $ pretty inner+#else+prettyPat (GHC.ParPat _ inner) = parens $ pretty inner+#endif+prettyPat (GHC.BangPat _ x) = string "!" >> pretty x+prettyPat (GHC.ListPat _ xs) = hList $ fmap pretty xs+prettyPat (GHC.TuplePat _ pats GHC.Boxed) = hTuple $ fmap pretty pats+prettyPat (GHC.TuplePat _ pats GHC.Unboxed) = hUnboxedTuple $ fmap pretty pats+prettyPat (GHC.SumPat _ x position numElem) = do+  string "(#"+  forM_ [1 .. numElem] $ \idx -> do+    if idx == position+      then string " " >> pretty x >> string " "+      else string " "+    when (idx < numElem) $ string "|"+  string "#)"+prettyPat GHC.ConPat {..} =+  case pat_args of+    GHC.PrefixCon _ as -> do+      pretty $ fmap mkPrefixName pat_con+      spacePrefixed $ fmap pretty as+    GHC.RecCon rec ->+      (pretty (fmap mkPrefixName pat_con) >> space) |=> pretty (RecConPat rec)+    GHC.InfixCon a b -> do+      pretty a+      unlessSpecialOp (GHC.unLoc pat_con) space+      pretty $ fmap mkInfixName pat_con+      unlessSpecialOp (GHC.unLoc pat_con) space+      pretty b+prettyPat (GHC.ViewPat _ l r) = spaced [pretty l, string "->", pretty r]+prettyPat (GHC.SplicePat _ x) = pretty $ mkSplice x+prettyPat (GHC.LitPat _ x) = pretty x+prettyPat (GHC.NPat _ x _ _) = pretty x+prettyPat (GHC.NPlusKPat _ n k _ _ _) =+  pretty (fmap mkPrefixName n) >> string "+" >> pretty k+prettyPat (GHC.SigPat _ l r) = spaced [pretty l, string "::", pretty r]++instance Pretty RecConPat where+  pretty' (RecConPat GHC.HsRecFields {..}) =+    case fieldPrinters of+      [] -> string "{}"+      [x] -> braces x+      xs -> hvFields xs+    where+      fieldPrinters =+        fmap (pretty . fmap RecConField) rec_flds+          ++ maybeToList (fmap (const (string "..")) rec_dotdot)++instance Pretty SBF.SigBindFamily where+  pretty' (SBF.Sig x) = pretty $ mkSignature x+  pretty' (SBF.Bind x) = pretty $ mkBind x+  pretty' (SBF.TypeFamily x)+    | Just fam <- mkTypeFamily x = pretty fam+    | otherwise = error "Unreachable"+  pretty' (SBF.TyFamInst x) = pretty x+  pretty' (SBF.DataFamInst x) = pretty $ DataFamInstDeclInsideClassInst x++instance Pretty GHC.EpaComment where+  pretty' GHC.EpaComment {..} = pretty ac_tok++instance Pretty (GHC.HsLocalBindsLR GHC.GhcPs GHC.GhcPs) where+  pretty' (GHC.HsValBinds _ lr) = pretty lr+  pretty' (GHC.HsIPBinds _ x) = pretty x+  pretty' GHC.EmptyLocalBinds {} =+    error+      "This branch indicates that the bind is empty, but since calling this code means that let or where has already been output, it cannot be handled here. It should be handled higher up in the AST."++instance Pretty (GHC.HsValBindsLR GHC.GhcPs GHC.GhcPs) where+  pretty' (GHC.ValBinds _ methods sigs) = lined $ fmap pretty sigsAndMethods+    where+      sigsAndMethods =+        SBF.mkSortedLSigBindFamilyList sigs (GHC.bagToList methods) [] [] []+  pretty' GHC.XValBindsLR {} = notUsedInParsedStage++instance Pretty (GHC.HsTupArg GHC.GhcPs) where+  pretty' (GHC.Present _ e) = pretty e+  pretty' GHC.Missing {} = pure () -- This appears in a tuple section.+#if MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty RecConField where+  pretty' (RecConField GHC.HsFieldBind {..}) = do+    pretty hfbLHS+    unless hfbPun $ do+      string " = "+      pretty hfbRHS+#else+-- | For pattern matching against a record.+instance Pretty+           (GHC.HsRecField'+              (GHC.FieldOcc GHC.GhcPs)+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where+  pretty' GHC.HsRecField {..} =+    (pretty hsRecFieldLbl >> string " = ") |=> pretty hsRecFieldArg++-- | For record updates.+instance Pretty+           (GHC.HsRecField'+              (GHC.FieldOcc GHC.GhcPs)+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' GHC.HsRecField {..} = do+    pretty hsRecFieldLbl+    unless hsRecPun $ do+      string " ="+      horizontal <-|> vertical+    where+      horizontal = space >> pretty hsRecFieldArg+      vertical = newline >> indentedBlock (pretty hsRecFieldArg)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- | For pattern matchings against records.+instance Pretty+           (GHC.HsFieldBind+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.FieldOcc GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where+  pretty' GHC.HsFieldBind {..} =+    (pretty hfbLHS >> string " = ") |=> pretty hfbRHS++-- | For record updates.+instance Pretty+           (GHC.HsFieldBind+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.FieldOcc GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' GHC.HsFieldBind {..} = do+    pretty hfbLHS+    unless hfbPun $ do+      string " ="+      horizontal <-|> vertical+    where+      horizontal = space >> pretty hfbRHS+      vertical = newline >> indentedBlock (pretty hfbRHS)+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)+-- | For pattern matchings against records.+instance Pretty+           (GHC.HsFieldBind+              (GHC.GenLocated (GHC.SrcAnn GHC.NoEpAnns) (GHC.FieldOcc GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where+  pretty' GHC.HsFieldBind {..} =+    (pretty hfbLHS >> string " = ") |=> pretty hfbRHS++-- | For record updates.+instance Pretty+           (GHC.HsFieldBind+              (GHC.GenLocated (GHC.SrcAnn GHC.NoEpAnns) (GHC.FieldOcc GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where+  pretty' GHC.HsFieldBind {..} = do+    pretty hfbLHS+    unless hfbPun $ do+      string " ="+      horizontal <-|> vertical+    where+      horizontal = space >> pretty hfbRHS+      vertical = newline >> indentedBlock (pretty hfbRHS)+#else+instance Pretty RecConField where+  pretty' (RecConField GHC.HsRecField {..}) = do+    pretty hsRecFieldLbl+    unless hsRecPun $ do+      string " = "+      pretty hsRecFieldArg+#endif+#if MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty (GHC.FieldOcc GHC.GhcPs) where+  pretty' GHC.FieldOcc {..} = pretty $ fmap mkPrefixName foLabel+#else+instance Pretty (GHC.FieldOcc GHC.GhcPs) where+  pretty' GHC.FieldOcc {..} = pretty $ fmap mkPrefixName rdrNameFieldOcc+#endif+instance Pretty a => Pretty (GHC.HsScaled GHC.GhcPs a) where+  pretty' (GHC.HsScaled _ x) = pretty x++instance Pretty InfixExpr where+  pretty' (InfixExpr (GHC.L _ (GHC.HsVar _ bind))) =+    pretty $ fmap mkInfixName bind+  pretty' (InfixExpr x) = pretty' x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance Pretty InfixApp where+  pretty' InfixApp {..} = horizontal <-|> vertical+    where+      horizontal = spaced [pretty lhs, pretty (InfixExpr op), pretty rhs]+      vertical =+        case findFixity op of+          GHC.Fixity _ _ GHC.InfixL -> leftAssoc+          GHC.Fixity _ _ GHC.InfixR -> rightAssoc+          GHC.Fixity _ _ GHC.InfixN -> noAssoc+      leftAssoc = prettyOps allOperantsAndOperatorsLeftAssoc+      rightAssoc = prettyOps allOperantsAndOperatorsRightAssoc+      noAssoc+        | GHC.L _ (GHC.OpApp _ _ o _) <- lhs+        , isSameAssoc o = leftAssoc+        | otherwise = rightAssoc+      prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.DoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Do]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.MDoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Mdo]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, r@(GHC.L _ GHC.HsLam {})] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty r]+      prettyOps (l:xs) = do+        pretty l+        newline+        indentedBlock $ f xs+        where+          f (o:r:rems) = do+            (pretty (InfixExpr o) >> space) |=> pretty r+            unless (null rems) $ do+              newline+              f rems+          f _ =+            error+              "The number of the sum of operants and operators should be odd."+      prettyOps _ = error "Too short list."+      findFixity o =+        fromMaybe GHC.defaultFixity $ lookup (GHC.varToStr o) fixities+      allOperantsAndOperatorsLeftAssoc = reverse $ rhs : op : collect lhs+        where+          collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+          collect (GHC.L _ (GHC.OpApp _ l o r))+            | isSameAssoc o = r : o : collect l+          collect x = [x]+      allOperantsAndOperatorsRightAssoc = lhs : op : collect rhs+        where+          collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+          collect (GHC.L _ (GHC.OpApp _ l o r))+            | isSameAssoc o = l : o : collect r+          collect x = [x]+      isSameAssoc (findFixity -> GHC.Fixity _ lv d) = lv == level && d == dir+      GHC.Fixity _ level dir = findFixity op+#else+instance Pretty InfixApp where+  pretty' InfixApp {..} = horizontal <-|> vertical+    where+      horizontal = spaced [pretty lhs, pretty (InfixExpr op), pretty rhs]+      vertical =+        case findFixity op of+          GHC.Fixity _ _ GHC.InfixL -> leftAssoc+          GHC.Fixity _ _ GHC.InfixR -> rightAssoc+          GHC.Fixity _ _ GHC.InfixN -> noAssoc+      leftAssoc = prettyOps allOperantsAndOperatorsLeftAssoc+      rightAssoc = prettyOps allOperantsAndOperatorsRightAssoc+      noAssoc+        | GHC.L _ (GHC.OpApp _ _ o _) <- lhs+        , isSameAssoc o = leftAssoc+        | otherwise = rightAssoc+      prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.DoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Do]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.MDoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Mdo]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, r@(GHC.L _ GHC.HsLam {})] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty r]+      prettyOps [l, o, r@(GHC.L _ GHC.HsLamCase {})] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty r]+      prettyOps (l:xs) = do+        pretty l+        newline+        indentedBlock $ f xs+        where+          f (o:r:rems) = do+            (pretty (InfixExpr o) >> space) |=> pretty r+            unless (null rems) $ do+              newline+              f rems+          f _ =+            error+              "The number of the sum of operants and operators should be odd."+      prettyOps _ = error "Too short list."+      findFixity o =+        fromMaybe GHC.defaultFixity $ lookup (GHC.varToStr o) fixities+      allOperantsAndOperatorsLeftAssoc = reverse $ rhs : op : collect lhs+        where+          collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+          collect (GHC.L _ (GHC.OpApp _ l o r))+            | isSameAssoc o = r : o : collect l+          collect x = [x]+      allOperantsAndOperatorsRightAssoc = lhs : op : collect rhs+        where+          collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]+          collect (GHC.L _ (GHC.OpApp _ l o r))+            | isSameAssoc o = l : o : collect r+          collect x = [x]+      isSameAssoc (findFixity -> GHC.Fixity _ lv d) = lv == level && d == dir+      GHC.Fixity _ level dir = findFixity op+#endif+instance Pretty (GHC.FieldLabelStrings GHC.GhcPs) where+  pretty' (GHC.FieldLabelStrings xs) = hDotSep $ fmap pretty xs++instance Pretty (GHC.AmbiguousFieldOcc GHC.GhcPs) where+  pretty' (GHC.Unambiguous _ name) = pretty $ fmap mkPrefixName name+  pretty' (GHC.Ambiguous _ name) = pretty $ fmap mkPrefixName name++instance Pretty (GHC.DerivClauseTys GHC.GhcPs) where+  pretty' (GHC.DctSingle _ ty) = parens $ pretty ty+  pretty' (GHC.DctMulti _ ts) = hvTuple $ fmap pretty ts+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance Pretty GHC.StringLiteral where+  pretty' GHC.StringLiteral {sl_st = GHC.SourceText s} = string $ GHC.unpackFS s+  pretty' GHC.StringLiteral {..} = string $ GHC.unpackFS sl_fs+#else+instance Pretty GHC.StringLiteral where+  pretty' = output+#endif+instance Pretty (GHC.ArithSeqInfo GHC.GhcPs) where+  pretty' (GHC.From from) = brackets $ spaced [pretty from, string ".."]+  pretty' (GHC.FromThen from next) =+    brackets $ spaced [pretty from >> comma >> pretty next, string ".."]+  pretty' (GHC.FromTo from to) =+    brackets $ spaced [pretty from, string "..", pretty to]+  pretty' (GHC.FromThenTo from next to) =+    brackets+      $ spaced [pretty from >> comma >> pretty next, string "..", pretty to]++instance Pretty (GHC.HsForAllTelescope GHC.GhcPs) where+  pretty' GHC.HsForAllVis {..} = do+    string "forall "+    spaced $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) hsf_vis_bndrs+    dot+  pretty' GHC.HsForAllInvis {..} = do+    string "forall "+    spaced+      $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) hsf_invis_bndrs+    dot++instance Pretty Context where+  pretty' (Context xs) =+    pretty (HorizontalContext xs) <-|> pretty (VerticalContext xs)+#if MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty HorizontalContext where+  pretty' (HorizontalContext xs) =+    constraintsParens $ printCommentsAnd xs (hCommaSep . fmap pretty)+    where+      constraintsParens =+        case xs of+          (GHC.L _ []) -> parens+          (GHC.L _ [_]) -> id+          _ -> parens++instance Pretty VerticalContext where+  pretty' (VerticalContext full@(GHC.L _ [])) =+    printCommentsAnd full (const $ string "()")+  pretty' (VerticalContext full@(GHC.L _ [x])) =+    printCommentsAnd full (const $ pretty x)+  pretty' (VerticalContext xs) = printCommentsAnd xs (vTuple . fmap pretty)+#else+instance Pretty HorizontalContext where+  pretty' (HorizontalContext xs) =+    constraintsParens $ mapM_ (`printCommentsAnd` (hCommaSep . fmap pretty)) xs+    where+      constraintsParens =+        case xs of+          Nothing -> id+          Just (GHC.L _ []) -> parens+          Just (GHC.L _ [_]) -> id+          Just _ -> parens++instance Pretty VerticalContext where+  pretty' (VerticalContext Nothing) = pure ()+  pretty' (VerticalContext (Just (GHC.L _ []))) = string "()"+  pretty' (VerticalContext (Just full@(GHC.L _ [x]))) =+    printCommentsAnd full (const $ pretty x)+  pretty' (VerticalContext (Just xs)) =+    printCommentsAnd xs (vTuple . fmap pretty)+#endif+-- Wrap a value of this type with 'ModulenameWithPrefix' to print it with+-- the "module " prefix.+instance Pretty GHC.ModuleName where+  pretty' = output++instance Pretty ModuleNameWithPrefix where+  pretty' (ModuleNameWithPrefix name) = spaced [string "module", pretty name]+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance Pretty (GHC.IE GHC.GhcPs) where+  pretty' (GHC.IEVar _ name _) = pretty name+  pretty' (GHC.IEThingAbs _ name _) = pretty name+  pretty' (GHC.IEThingAll _ name _) = do+    pretty name+    string "(..)"+  -- FIXME: Currently, pretty-printing a 'IEThingWith' uses+  -- 'ghc-lib-parser''s pretty-printer. However, we should avoid it because+  -- 'ghc-lib-parser' may suddenly change how it prints, resulting in+  -- unexpected test failures.+  pretty' x@GHC.IEThingWith {} =+    case lines $ showOutputable x of+      [] -> pure ()+      [x'] -> string x'+      x':xs' -> do+        string x'+        indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> xs'+  pretty' (GHC.IEModuleContents _ name) =+    pretty $ fmap ModuleNameWithPrefix name+  pretty' GHC.IEGroup {} = docNode+  pretty' GHC.IEDoc {} = docNode+  pretty' GHC.IEDocNamed {} = docNode+#else+instance Pretty (GHC.IE GHC.GhcPs) where+  pretty' (GHC.IEVar _ name) = pretty name+  pretty' (GHC.IEThingAbs _ name) = pretty name+  pretty' (GHC.IEThingAll _ name) = do+    pretty name+    string "(..)"+  -- FIXME: Currently, pretty-printing a 'IEThingWith' uses+  -- 'ghc-lib-parser''s pretty-printer. However, we should avoid it because+  -- 'ghc-lib-parser' may suddenly change how it prints, resulting in+  -- unexpected test failures.+  pretty' x@GHC.IEThingWith {} =+    case lines $ showOutputable x of+      [] -> pure ()+      [x'] -> string x'+      x':xs' -> do+        string x'+        indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> xs'+  pretty' (GHC.IEModuleContents _ name) =+    pretty $ fmap ModuleNameWithPrefix name+  pretty' GHC.IEGroup {} = docNode+  pretty' GHC.IEDoc {} = docNode+  pretty' GHC.IEDocNamed {} = docNode+#endif+instance Pretty+           (GHC.FamEqn+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where+  pretty' GHC.FamEqn {..} = do+    pretty $ fmap mkPrefixName feqn_tycon+    spacePrefixed $ fmap pretty feqn_pats+    string " = "+    pretty feqn_rhs++-- | Pretty-print a data instance.+instance Pretty (GHC.FamEqn GHC.GhcPs (GHC.HsDataDefn GHC.GhcPs)) where+  pretty' = pretty' . FamEqnTopLevel+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance Pretty FamEqn' where+  pretty' FamEqn' {famEqn = GHC.FamEqn {..}, ..} = do+    spaced+      $ string prefix+          : pretty (fmap mkPrefixName feqn_tycon)+          : fmap pretty feqn_pats+    pretty (mkDataBody feqn_rhs)+    where+      prefix =+        case (famEqnFor, GHC.dd_cons feqn_rhs) of+          (DataFamInstDeclForTopLevel, GHC.NewTypeCon {}) -> "newtype instance"+          (DataFamInstDeclForTopLevel, GHC.DataTypeCons {}) -> "data instance"+          (DataFamInstDeclForInsideClassInst, GHC.NewTypeCon {}) -> "newtype"+          (DataFamInstDeclForInsideClassInst, GHC.DataTypeCons {}) -> "data"+#else+instance Pretty FamEqn' where+  pretty' FamEqn' {famEqn = GHC.FamEqn {..}, ..} = do+    spaced+      $ string prefix+          : pretty (fmap mkPrefixName feqn_tycon)+          : fmap pretty feqn_pats+    pretty (mkDataBody feqn_rhs)+    where+      prefix =+        case (famEqnFor, GHC.dd_ND feqn_rhs) of+          (DataFamInstDeclForTopLevel, GHC.NewType) -> "newtype instance"+          (DataFamInstDeclForTopLevel, GHC.DataType) -> "data instance"+          (DataFamInstDeclForInsideClassInst, GHC.NewType) -> "newtype"+          (DataFamInstDeclForInsideClassInst, GHC.DataType) -> "data"+#endif+-- | HsArg (LHsType GhcPs) (LHsType GhcPs)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance Pretty+           (GHC.HsArg+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where+  pretty' (GHC.HsValArg _ x) = pretty x+  pretty' (GHC.HsTypeArg _ x) = string "@" >> pretty x+  pretty' GHC.HsArgPar {} = notUsedInParsedStage+#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)+instance Pretty+           (GHC.HsArg+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where+  pretty' (GHC.HsValArg x) = pretty x+  pretty' (GHC.HsTypeArg _ x) = string "@" >> pretty x+  pretty' GHC.HsArgPar {} = notUsedInParsedStage+#else+instance Pretty+           (GHC.HsArg+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where+  pretty' (GHC.HsValArg x) = pretty x+  pretty' (GHC.HsTypeArg _ x) = string "@" >> pretty x+  pretty' GHC.HsArgPar {} = notUsedInParsedStage+#endif+#if MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs) where+  pretty' GHC.WithHsDocIdentifiers {..} = pretty hsDocString+#endif++#if MIN_VERSION_ghc_lib_parser(9,6,1)+-- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'+instance Pretty (GHC.IEWrappedName GHC.GhcPs) where+  pretty' (GHC.IEName _ name) = pretty $ fmap mkPrefixName name+  pretty' (GHC.IEPattern _ name) =+    spaced [string "pattern", pretty $ fmap mkPrefixName name]+  pretty' (GHC.IEType _ name) =+    string "type " >> pretty (fmap mkPrefixName name)+#else+-- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'+instance Pretty (GHC.IEWrappedName GHC.RdrName) where+  pretty' (GHC.IEName name) = pretty $ fmap mkPrefixName name+  pretty' (GHC.IEPattern _ name) =+    spaced [string "pattern", pretty $ fmap mkPrefixName name]+  pretty' (GHC.IEType _ name) =+    string "type " >> pretty (fmap mkPrefixName name)+#endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (GHC.DotFieldOcc GHC.GhcPs) where+  pretty' GHC.DotFieldOcc {..} = printCommentsAnd dfoLabel pretty+#elif MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty (GHC.DotFieldOcc GHC.GhcPs) where+  pretty' GHC.DotFieldOcc {..} =+    printCommentsAnd dfoLabel (string . GHC.unpackFS)+#else+instance Pretty (GHC.HsFieldLabel GHC.GhcPs) where+  pretty' GHC.HsFieldLabel {..} =+    printCommentsAnd hflLabel (string . GHC.unpackFS)+#endif+instance Pretty GHC.OccName where+  pretty' = output++-- | 'Pretty' for 'LHsWcType'+instance Pretty+           (GHC.HsWildCardBndrs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where+  pretty' GHC.HsWC {..} = pretty hswc_body++instance Pretty (GHC.TyFamInstDecl GHC.GhcPs) where+  pretty' GHC.TyFamInstDecl {..} = string "type " >> pretty tfid_eqn++instance Pretty TopLevelTyFamInstDecl where+  pretty' (TopLevelTyFamInstDecl GHC.TyFamInstDecl {..}) =+    string "type instance " >> pretty tfid_eqn++instance Pretty (GHC.DataFamInstDecl GHC.GhcPs) where+  pretty' = pretty' . DataFamInstDeclTopLevel++instance Pretty DataFamInstDecl' where+  pretty' DataFamInstDecl' {dataFamInstDecl = GHC.DataFamInstDecl {..}, ..} =+    pretty $ FamEqn' dataFamInstDeclFor dfid_eqn++-- | 'Pretty' for 'HsPatSynDetails'.+instance Pretty+           (GHC.HsConDetails+              Void+              (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)+              [GHC.RecordPatSynField GHC.GhcPs]) where+  pretty' (GHC.PrefixCon _ xs) = spaced $ fmap (pretty . fmap mkPrefixName) xs+  pretty' (GHC.RecCon rec) = hFields $ fmap pretty rec+  pretty' GHC.InfixCon {} =+    error+      "Cannot handle here because `InfixCon` does not have the information of the constructor."++instance Pretty (GHC.HsPatSynDir GHC.GhcPs) where+  pretty' GHC.Unidirectional = string "<-"+  pretty' GHC.ImplicitBidirectional = string "="+  pretty' GHC.ExplicitBidirectional {} = string "<-"++instance Pretty (GHC.HsOverLit GHC.GhcPs) where+  pretty' GHC.OverLit {..} = pretty ol_val++instance Pretty GHC.OverLitVal where+  pretty' (GHC.HsIntegral x) = pretty x+  pretty' (GHC.HsFractional x) = pretty x+  pretty' (GHC.HsIsString _ x) = string $ GHC.unpackFS x+#if MIN_VERSION_ghc_lib_parser(9,8,1)+instance Pretty GHC.IntegralLit where+  pretty' GHC.IL {il_text = GHC.SourceText s} = output s+  pretty' GHC.IL {..} = string $ show il_value+#else+instance Pretty GHC.IntegralLit where+  pretty' GHC.IL {il_text = GHC.SourceText s} = string s+  pretty' GHC.IL {..} = string $ show il_value+#endif+instance Pretty GHC.FractionalLit where+  pretty' = output++instance Pretty (GHC.HsLit GHC.GhcPs) where+  pretty' x@(GHC.HsChar _ _) = output x+  pretty' x@GHC.HsCharPrim {} = output x+  pretty' GHC.HsInt {} = notUsedInParsedStage+  pretty' (GHC.HsIntPrim _ x) = string $ show x ++ "#"+  pretty' GHC.HsWordPrim {} = notUsedInParsedStage+  pretty' GHC.HsInt64Prim {} = notUsedInParsedStage+  pretty' GHC.HsWord64Prim {} = notUsedInParsedStage+  pretty' GHC.HsInteger {} = notUsedInParsedStage+  pretty' GHC.HsRat {} = notUsedInParsedStage+  pretty' (GHC.HsFloatPrim _ x) = pretty x >> string "#"+  pretty' GHC.HsDoublePrim {} = notUsedInParsedStage+  pretty' x =+    case x of+      GHC.HsString {} -> prettyString+      GHC.HsStringPrim {} -> prettyString+    where+      prettyString =+        case lines $ showOutputable x of+          [] -> pure ()+          [l] -> string l+          (s:ss) ->+            string "" |=> do+              string s+              newline+              indentedWithSpace (-1)+                $ lined+                $ fmap (string . dropWhile (/= '\\')) ss+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (GHC.HsPragE GHC.GhcPs) where+  pretty' (GHC.HsPragSCC _ x) =+    spaced [string "{-# SCC", pretty x, string "#-}"]+#else+instance Pretty (GHC.HsPragE GHC.GhcPs) where+  pretty' (GHC.HsPragSCC _ _ x) =+    spaced [string "{-# SCC", pretty x, string "#-}"]+#endif+instance Pretty GHC.HsIPName where+  pretty' (GHC.HsIPName x) = string $ GHC.unpackFS x+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (GHC.HsTyLit GHC.GhcPs) where+  pretty' (GHC.HsNumTy _ x) = string $ show x+  pretty' (GHC.HsStrTy _ x) = string $ ushow x+  pretty' (GHC.HsCharTy _ x) = string $ show x+#else+instance Pretty GHC.HsTyLit where+  pretty' (GHC.HsNumTy _ x) = string $ show x+  pretty' (GHC.HsStrTy _ x) = string $ ushow x+  pretty' (GHC.HsCharTy _ x) = string $ show x+#endif+instance Pretty (GHC.HsPatSigType GHC.GhcPs) where+  pretty' GHC.HsPS {..} = pretty hsps_body++instance Pretty (GHC.HsIPBinds GHC.GhcPs) where+  pretty' (GHC.IPBinds _ xs) = lined $ fmap pretty xs++instance Pretty (GHC.IPBind GHC.GhcPs) where+  pretty' = prettyIPBind++prettyIPBind :: GHC.IPBind GHC.GhcPs -> Printer ()+#if MIN_VERSION_ghc_lib_parser(9,4,1)+prettyIPBind (GHC.IPBind _ l r) =+  spaced [string "?" >> pretty l, string "=", pretty r]+#else+prettyIPBind (GHC.IPBind _ (Right _) _) = notUsedInParsedStage+prettyIPBind (GHC.IPBind _ (Left l) r) =+  spaced [string "?" >> pretty l, string "=", pretty r]+#endif+instance Pretty (GHC.RecordPatSynField GHC.GhcPs) where+  pretty' GHC.RecordPatSynField {..} = pretty recordPatSynField++instance Pretty (GHC.HsCmdTop GHC.GhcPs) where+  pretty' (GHC.HsCmdTop _ cmd) = pretty cmd++instance Pretty (GHC.HsCmd GHC.GhcPs) where+  pretty' = prettyHsCmd++prettyHsCmd :: GHC.HsCmd GHC.GhcPs -> Printer ()+prettyHsCmd (GHC.HsCmdArrApp _ f arg GHC.HsHigherOrderApp True) =+  spaced [pretty f, string "-<<", pretty arg]+prettyHsCmd (GHC.HsCmdArrApp _ f arg GHC.HsHigherOrderApp False) =+  spaced [pretty arg, string ">>-", pretty f]+prettyHsCmd (GHC.HsCmdArrApp _ f arg GHC.HsFirstOrderApp True) =+  spaced [pretty f, string "-<", pretty arg]+prettyHsCmd (GHC.HsCmdArrApp _ f arg GHC.HsFirstOrderApp False) =+  spaced [pretty arg, string ">-", pretty f]+prettyHsCmd (GHC.HsCmdArrForm _ f _ _ args) =+  bananaBrackets $ spaced $ pretty f : fmap pretty args+prettyHsCmd (GHC.HsCmdApp _ f arg) = spaced [pretty f, pretty arg]+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsCmd (GHC.HsCmdLam _ GHC.LamSingle x) = pretty x+prettyHsCmd (GHC.HsCmdLam _ GHC.LamCase arms) = do+  string "\\case"+  newline+  indentedBlock $ pretty arms+prettyHsCmd (GHC.HsCmdLam _ GHC.LamCases arms) = do+  string "\\cases"+  newline+  indentedBlock $ pretty arms+#else+prettyHsCmd (GHC.HsCmdLam _ x) = pretty x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsCmd (GHC.HsCmdPar _ _ x _) = parens $ pretty x+#else+prettyHsCmd (GHC.HsCmdPar _ x) = parens $ pretty x+#endif+prettyHsCmd (GHC.HsCmdCase _ cond arms) = do+  spaced [string "case", pretty cond, string "of"]+  newline+  indentedBlock $ pretty arms+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- No `HsCmdLamCase` since 9.10.1+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)+prettyHsCmd (GHC.HsCmdLamCase _ _ arms) = do+  string "\\case"+  newline+  indentedBlock $ pretty arms+#else+prettyHsCmd (GHC.HsCmdLamCase _ arms) = do+  string "\\case"+  newline+  indentedBlock $ pretty arms+#endif+prettyHsCmd (GHC.HsCmdIf _ _ cond t f) = do+  string "if "+  pretty cond+  newline+  indentedBlock $ lined [string "then " >> pretty t, string "else " >> pretty f]+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+prettyHsCmd (GHC.HsCmdLet _ _ binds _ expr) =+  lined [string "let " |=> pretty binds, string " in " |=> pretty expr]+#else+prettyHsCmd (GHC.HsCmdLet _ binds expr) =+  lined [string "let " |=> pretty binds, string " in " |=> pretty expr]+#endif+prettyHsCmd (GHC.HsCmdDo _ stmts) = do+  string "do"+  newline+  indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)++instance Pretty ListComprehension where+  pretty' ListComprehension {..} = horizontal <-|> vertical+    where+      horizontal =+        brackets+          $ spaced+              [ pretty listCompLhs+              , string "|"+              , hCommaSep $ NE.toList $ NE.map pretty listCompRhs+              ]+      vertical = do+        string "[ "+        pretty $ fmap StmtLRInsideVerticalList listCompLhs+        newline+        forM_ (stmtsAndPrefixes listCompRhs) $ \(p, x) -> do+          string p |=> pretty (fmap StmtLRInsideVerticalList x)+          newline+        string "]"+      stmtsAndPrefixes (s :| ss) = ("| ", s) : fmap (", ", ) ss++instance Pretty DoExpression where+  pretty' DoExpression {..} = do+    pretty qualifiedDo+    newline+    indentedBlock $ lined $ fmap pretty doStmts++instance Pretty DoOrMdo where+  pretty' Do = string "do"+  pretty' Mdo = string "mdo"++instance Pretty QualifiedDo where+  pretty' (QualifiedDo (Just m) d) = do+    pretty m+    string "."+    pretty d+  pretty' (QualifiedDo Nothing d) = pretty d++instance Pretty LetIn where+  pretty' LetIn {..} =+    lined [string "let " |=> pretty letBinds, string " in " |=> pretty inExpr]++instance Pretty GHC.HsSrcBang where+  pretty' (GHC.HsSrcBang _ unpack strictness) = do+    pretty unpack+    unless (unpack == GHC.NoSrcUnpack) space+    pretty strictness++instance Pretty GHC.SrcUnpackedness where+  pretty' GHC.SrcUnpack = string "{-# UNPACK #-}"+  pretty' GHC.SrcNoUnpack = string "{-# NOUNPACK #-}"+  pretty' GHC.NoSrcUnpack = pure ()++instance Pretty GHC.SrcStrictness where+  pretty' GHC.SrcLazy = string "~"+  pretty' GHC.SrcStrict = string "!"+  pretty' GHC.NoSrcStrict = pure ()+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty GHC.FieldLabelString where+  pretty' = output+#endif+-- | Marks an AST node as never appearing in an AST.+--+-- Some AST node types are only defined in `ghc-lib-parser` and not+-- generated by it.+notGeneratedByParser :: HasCallStack => a+notGeneratedByParser = error "`ghc-lib-parser` never generates this AST node."++-- | Marks an AST node as related to Haddock comments.+--+-- The parser parses haddock comments as normal ones, meaning AST nodes+-- related to haddock never appear in an AST.+docNode :: HasCallStack => a+docNode =+  error+    "This AST node is related to Haddocks, but haddock comments are treated as normal ones, and this node should never appear in an AST."++-- | Marks an AST node as never appearing in the AST.+--+-- Some AST node types are only used in the renaming or type-checking phase.+notUsedInParsedStage :: HasCallStack => a+notUsedInParsedStage =+  error+    "This AST should never appears in an AST. It only appears in the renaming or type checked stages."+#if !MIN_VERSION_ghc_lib_parser(9,4,1)+-- | Marks an AST node as it is used only for Haskell Program Coverage.+forHpc :: HasCallStack => a+forHpc = error "This AST type is for the use of Haskell Program Coverage."+#endif++#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+getAnc (GHC.EpaSpan (GHC.RealSrcSpan x _)) = x+getAnc _ = undefined+#else+getAnc = GHC.anchor #endif
+ src/HIndent/Pretty.hs-boot view
@@ -0,0 +1,98 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}++module HIndent.Pretty+  ( Pretty(..)+  , pretty+  , printCommentsAnd+  ) where++import Data.Void+import qualified GHC.Types.Name as GHC+import qualified GHC.Types.Name.Reader as GHC+import qualified GHC.Types.SourceText as GHC+import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Unit as GHC+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHc+import HIndent.Pretty.NodeComments+import HIndent.Pretty.SigBindFamily+import HIndent.Pretty.Types+import HIndent.Printer++class CommentExtraction a =>+      Pretty a+  where+  pretty' :: a -> Printer ()++pretty :: Pretty a => a -> Printer ()+printCommentsAnd ::+     (CommentExtraction l)+  => GHC.GenLocated l e+  -> (e -> Printer ())+  -> Printer ()+instance (CommentExtraction l, Pretty e) => Pretty (GHC.GenLocated l e)++instance Pretty GHC.EpaComment++instance Pretty (GHC.HsType GHC.GhcPs)++instance Pretty+           (GHC.FamEqn+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs)))++instance Pretty SigBindFamily++instance Pretty HsSigType'++instance Pretty+           (GHC.MatchGroup+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs)))++instance Pretty (GHC.Pat GHC.GhcPs)++instance Pretty+           (GHc.GRHSs+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs)))++instance Pretty+           (GHC.HsConDetails+              Void+              (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)+              [GHC.RecordPatSynField GHC.GhcPs])++instance Pretty (GHC.HsPatSynDir GHC.GhcPs)++instance Pretty PatInsidePatDecl++instance Pretty GHC.StringLiteral++instance Pretty (GHC.HsSigType GHC.GhcPs)++instance Pretty Context++instance Pretty (GHC.DerivClauseTys GHC.GhcPs)++instance Pretty a => Pretty (GHC.HsScaled GHC.GhcPs a)+#if MIN_VERSION_ghc_lib_parser(9, 8, 1)+instance Pretty+           (GHC.HsArg+              GHC.GhcPs+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs)))+#else+instance Pretty+           (GHC.HsArg+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHc.GhcPs))+              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs)))+#endif+instance Pretty (GHC.HsExpr GHC.GhcPs)++instance Pretty (GHC.FieldOcc GHC.GhcPs)++instance Pretty GHC.OccName++instance Pretty GHC.ModuleName
src/HIndent/Pretty/Combinators/Indent.hs view
@@ -45,7 +45,6 @@   indentedWithFixedLevel col p  infixl 1 |=>- -- | This function runs the given printer with the passed indent level. indentedWithFixedLevel :: Int64 -> Printer a -> Printer a indentedWithFixedLevel i p = do
src/HIndent/Pretty/Combinators/Lineup.hs view
@@ -4,6 +4,7 @@     hvTuple   , hvTuple'   , hTuple+  , hFillingTuple   , vTuple   , vTuple'   , hPromotedTuple@@ -59,6 +60,15 @@ -- | Runs printers to construct a tuple in a line. hTuple :: [Printer ()] -> Printer () hTuple = parens . hCommaSep++-- | Runs printers to construct a tuple in a line, but inserts newlines if+-- the result doesn't fit in a line.+--+-- The difference between this function and 'vTuple' is that the number of elements+-- in a row in this function is not limited to 1 while the number of elements in+-- a row in 'vTuple' is limited to 1.+hFillingTuple :: [Printer ()] -> Printer ()+hFillingTuple = parens . inter (comma >> (space <-|> newline))  -- | Runs printers to construct a tuple where elements are aligned -- vertically.
− src/HIndent/Pretty/Import.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE CPP #-}---- | Helper functions for dealing with import declarations.-module HIndent.Pretty.Import-  ( importsExist-  , extractImports-  , extractImportsSorted-  , groupImports-  ) where--import GHC.Types.SrcLoc-import HIndent.GhcLibParserWrapper.GHC.Hs-import HIndent.Pretty.Import.Sort---- | Returns if the module has import declarations.-importsExist :: HsModule' -> Bool-importsExist = not . null . hsmodImports---- | Extracts import declarations from the given module. Adjacent import--- declarations are grouped as a single list.-extractImports :: HsModule' -> [[LImportDecl GhcPs]]-extractImports = groupImports . sortImportsByLocation . hsmodImports---- | Extracts import declarations from the given module and sorts them by--- their names. Adjacent import declarations are grouped as a single list.-extractImportsSorted :: HsModule' -> [[LImportDecl GhcPs]]-extractImportsSorted = fmap sortImportsByName . extractImports---- | Combines adjacent import declarations into a single list.-groupImports :: [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]-groupImports = groupImports' []-  where-    groupImports' ::-         [[LImportDecl GhcPs]] -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]-    groupImports' xs [] = xs-    groupImports' [] (x:xs) = groupImports' [[x]] xs-    groupImports' [[]] (x:xs) = groupImports' [[x]] xs-    groupImports' ([]:x:xs) (y:ys) = groupImports' ([y] : x : xs) ys-    groupImports' ((z:zs):xs) (y:ys)-      | z `isAdjacentTo` y = groupImports' ((y : z : zs) : xs) ys-      | otherwise = groupImports' ([y] : (z : zs) : xs) ys-    a `isAdjacentTo` b =-      srcSpanEndLine (sp a) + 1 == srcSpanStartLine (sp b)-        || srcSpanEndLine (sp b) + 1 == srcSpanStartLine (sp a)-    sp x =-      case locA $ getLoc x of-        RealSrcSpan x' _ -> x'-        _ -> error "Src span unavailable."
− src/HIndent/Pretty/Import/Sort.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE CPP #-}---- | Import declaration sorting for pretty-printing.-module HIndent.Pretty.Import.Sort-  ( sortImportsByName-  , sortImportsByLocation-  ) where--import Data.Char-import Data.Function-import Data.List-import Data.Maybe-import GHC.Hs-import GHC.Stack-import GHC.Types.SrcLoc-import HIndent.Pretty.Combinators.Outputable---- | The letter type of a 'Char'.------ The order of constructors is important. HIndent sorts explicit imports--- from ones starting from a capital letter (e.g., data constructors),--- symbol identifiers, and functions.-data LetterType-  = Capital-  | Symbol-  | Lower-  deriving (Eq, Ord)---- | This function sorts import declarations and explicit imports in them--- by their names.-sortImportsByName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-sortImportsByName = fmap sortExplicitImportsInDecl . sortByModuleName---- | This function sorts imports by their start line numbers.-sortImportsByLocation :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-sortImportsByLocation = sortBy (flip compare `on` lineIdx)-  where-    lineIdx = startLine . locA . getLoc---- | This function sorts import declarations by their module names.-sortByModuleName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-sortByModuleName = sortBy (compare `on` unLoc . ideclName . unLoc)---- | This function sorts explicit imports in the given import declaration--- by their names.-sortExplicitImportsInDecl :: LImportDecl GhcPs -> LImportDecl GhcPs-#if MIN_VERSION_ghc_lib_parser(9,6,1)-sortExplicitImportsInDecl (L l d@ImportDecl {ideclImportList = Just (x, imports)}) =-  L l d {ideclImportList = Just (x, sorted)}-  where-    sorted = fmap (fmap sortVariants . sortExplicitImports) imports-#else-sortExplicitImportsInDecl (L l d@ImportDecl {ideclHiding = Just (x, imports)}) =-  L l d {ideclHiding = Just (x, sorted)}-  where-    sorted = fmap (fmap sortVariants . sortExplicitImports) imports-#endif-sortExplicitImportsInDecl x = x---- | This function sorts the given explicit imports by their names.-sortExplicitImports :: [LIE GhcPs] -> [LIE GhcPs]-sortExplicitImports = sortBy compareImportEntities---- | This function sorts variants (e.g., data constructors and class--- methods) in the given explicit import by their names.-sortVariants :: LIE GhcPs -> LIE GhcPs-sortVariants (L l (IEThingWith x x' x'' xs)) =-  L l $ IEThingWith x x' x'' (sortWrappedNames xs)-  where-    sortWrappedNames = sortBy (compare `on` showOutputable)-sortVariants x = x---- | This function compares two import declarations by their module names.-compareImportEntities :: LIE GhcPs -> LIE GhcPs -> Ordering-compareImportEntities (L _ a) (L _ b) =-  fromMaybe LT $ compareIdentifier <$> moduleName a <*> moduleName b---- | This function returns a 'Just' value with the module name extracted--- from the import declaration. Otherwise, it returns a 'Nothing'.-moduleName :: IE GhcPs -> Maybe String-moduleName (IEVar _ wrapped) = Just $ showOutputable wrapped-moduleName (IEThingAbs _ wrapped) = Just $ showOutputable wrapped-moduleName (IEThingAll _ wrapped) = Just $ showOutputable wrapped-moduleName (IEThingWith _ wrapped _ _) = Just $ showOutputable wrapped-moduleName _ = Nothing---- | This function compares two identifiers in order of capitals, symbols,--- and lowers.-compareIdentifier :: String -> String -> Ordering-compareIdentifier as@(a:_) bs@(b:_) =-  case compareChar a b of-    EQ -> compareSameIdentifierType as bs-    x -> x-compareIdentifier _ _ = error "Either identifier is an empty string."---- | Almost similar to 'compare' but ignores parentheses for symbol--- identifiers as they are enclosed by parentheses.-compareSameIdentifierType :: String -> String -> Ordering-compareSameIdentifierType "" "" = EQ-compareSameIdentifierType "" _ = LT-compareSameIdentifierType _ "" = GT-compareSameIdentifierType ('(':as) bs = compareSameIdentifierType as bs-compareSameIdentifierType (')':as) bs = compareSameIdentifierType as bs-compareSameIdentifierType as ('(':bs) = compareSameIdentifierType as bs-compareSameIdentifierType as (')':bs) = compareSameIdentifierType as bs-compareSameIdentifierType (a:as) (b:bs) =-  case compare a b of-    EQ -> compareSameIdentifierType as bs-    x -> x---- | This function compares two characters by their types (capital, symbol,--- and lower). If both are the same type, then it compares them by the--- usual ordering.-compareChar :: Char -> Char -> Ordering-compareChar a b =-  case compare at bt of-    EQ -> compare a b-    x -> x-  where-    at = charToLetterType a-    bt = charToLetterType b---- | This function returns a 'LetterType' based on the given character.-charToLetterType :: Char -> LetterType-charToLetterType c-  | isLower c = Lower-  | isUpper c = Capital-  | otherwise = Symbol---- | This function returns the start line of the given 'SrcSpan'. If it is--- not available, it raises an error.-startLine :: HasCallStack => SrcSpan -> Int-startLine (RealSrcSpan x _) = srcSpanStartLine x-startLine (UnhelpfulSpan _) = error "The src span is unavailable."
src/HIndent/Pretty/NodeComments.hs view
@@ -8,6 +8,7 @@   , emptyNodeComments   ) where +import Data.Maybe import Data.Void import GHC.Core.Coercion import GHC.Data.BooleanFormula@@ -20,25 +21,40 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc-import HIndent.Pretty.Pragma+import HIndent.Ast.NodeComments+import HIndent.Pragma import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) import GHC.Core.DataCon-#endif-#if !MIN_VERSION_ghc_lib_parser(9,6,1)+#else import GHC.Unit #endif -- | An interface to extract comments from an AST node. class CommentExtraction a where   nodeComments :: a -> NodeComments-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (HsModule GhcPs) where   nodeComments =     nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn . hsmodExt     where       filterOutEofAndPragmasFromAnn EpAnn {..} =         EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}+      filterOutEofAndPragmasFromComments comments =+        EpaCommentsBalanced+          { priorComments = filterOutEofAndPragmas $ priorComments comments+          , followingComments =+              filterOutEofAndPragmas $ getFollowingComments comments+          }+      filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment+      isNeitherEofNorPragmaComment (L _ (EpaComment tok _)) = not $ isPragma tok+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance CommentExtraction (HsModule GhcPs) where+  nodeComments =+    nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn . hsmodExt+    where+      filterOutEofAndPragmasFromAnn EpAnn {..} =+        EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}       filterOutEofAndPragmasFromAnn EpAnnNotUsed = EpAnnNotUsed       filterOutEofAndPragmasFromComments comments =         EpaCommentsBalanced@@ -85,9 +101,15 @@   nodeComments DocD {} =     error "Document comments should be treated as normal ones."   nodeComments RoleAnnotD {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 0) instance CommentExtraction (TyClDecl GhcPs) where   nodeComments FamDecl {} = emptyNodeComments+  nodeComments SynDecl {..} = mconcat $ fmap nodeComments tcdSExt+  nodeComments DataDecl {..} = mconcat $ fmap nodeComments tcdDExt+  nodeComments ClassDecl {tcdCExt = (x, _, _)} = mconcat $ fmap nodeComments x+#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)+instance CommentExtraction (TyClDecl GhcPs) where+  nodeComments FamDecl {} = emptyNodeComments   nodeComments SynDecl {..} = nodeComments tcdSExt   nodeComments DataDecl {..} = nodeComments tcdDExt   nodeComments ClassDecl {tcdCExt = (x, _)} = nodeComments x@@ -115,17 +137,33 @@  nodeCommentsHsBind :: HsBind GhcPs -> NodeComments nodeCommentsHsBind FunBind {..} = nodeComments fun_id+#if MIN_VERSION_ghc_lib_parser(9, 10, 0)+nodeCommentsHsBind PatBind {} = emptyNodeComments+#else nodeCommentsHsBind PatBind {..} = nodeComments pat_ext+#endif nodeCommentsHsBind VarBind {} = emptyNodeComments-#if !MIN_VERSION_ghc_lib_parser(9,4,1)+#if !MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsBind AbsBinds {} = emptyNodeComments #endif nodeCommentsHsBind PatSynBind {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 0) instance CommentExtraction (Sig GhcPs) where   nodeComments (TypeSig x _ _) = nodeComments x   nodeComments (PatSynSig x _ _) = nodeComments x   nodeComments (ClassOpSig x _ _ _) = nodeComments x+  nodeComments (FixSig x _) = mconcat $ fmap nodeComments x+  nodeComments (InlineSig x _ _) = mconcat $ fmap nodeComments x+  nodeComments (SpecSig x _ _ _) = mconcat $ fmap nodeComments x+  nodeComments (SpecInstSig x _) = mconcat $ fmap nodeComments $ fst x+  nodeComments (MinimalSig x _) = mconcat $ fmap nodeComments $ fst x+  nodeComments (SCCFunSig x _ _) = mconcat $ fmap nodeComments $ fst x+  nodeComments (CompleteMatchSig x _ _) = mconcat $ fmap nodeComments $ fst x+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance CommentExtraction (Sig GhcPs) where+  nodeComments (TypeSig x _ _) = nodeComments x+  nodeComments (PatSynSig x _ _) = nodeComments x+  nodeComments (ClassOpSig x _ _ _) = nodeComments x   nodeComments (FixSig x _) = nodeComments x   nodeComments (InlineSig x _ _) = nodeComments x   nodeComments (SpecSig x _ _ _) = nodeComments x@@ -149,10 +187,14 @@ #endif instance CommentExtraction (HsDataDefn GhcPs) where   nodeComments HsDataDefn {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 0) instance CommentExtraction (ClsInstDecl GhcPs) where+  nodeComments ClsInstDecl {cid_ext = (x, _, _)} =+    fromMaybe mempty $ fmap nodeComments x+#else+instance CommentExtraction (ClsInstDecl GhcPs) where   nodeComments ClsInstDecl {cid_ext = (x, _)} = nodeComments x-+#endif instance CommentExtraction (MatchGroup GhcPs a) where   nodeComments MG {} = emptyNodeComments @@ -170,54 +212,126 @@  nodeCommentsHsExpr :: HsExpr GhcPs -> NodeComments nodeCommentsHsExpr HsVar {} = emptyNodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsUnboundVar x _) = fromMaybe mempty $ fmap nodeComments x+#else nodeCommentsHsExpr (HsUnboundVar x _) = nodeComments x-#if !MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if !MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr HsConLikeOut {} = emptyNodeComments nodeCommentsHsExpr HsRecFld {} = emptyNodeComments #endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsOverLabel {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1) nodeCommentsHsExpr (HsOverLabel x _ _) = nodeComments x #else nodeCommentsHsExpr (HsOverLabel x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsIPVar {} = emptyNodeComments+#else nodeCommentsHsExpr (HsIPVar x _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsOverLit {} = emptyNodeComments+#else nodeCommentsHsExpr (HsOverLit x _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsLit {} = emptyNodeComments+#else nodeCommentsHsExpr (HsLit x _) = nodeComments x+#endif nodeCommentsHsExpr HsLam {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- No `HsLamCase` since 9.10.1.+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr (HsLamCase x _ _) = nodeComments x #else nodeCommentsHsExpr (HsLamCase x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsApp {} = emptyNodeComments+#else nodeCommentsHsExpr (HsApp x _ _) = nodeComments x+#endif nodeCommentsHsExpr HsAppType {} = emptyNodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (OpApp x _ _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (OpApp x _ _ _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (NegApp x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (NegApp x _ _) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsPar {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr (HsPar x _ _ _) = nodeComments x #else nodeCommentsHsExpr (HsPar x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr SectionL {} = emptyNodeComments+#else nodeCommentsHsExpr (SectionL x _ _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr SectionR {} = emptyNodeComments+#else nodeCommentsHsExpr (SectionR x _ _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (ExplicitTuple x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (ExplicitTuple x _ _) = nodeComments x+#endif nodeCommentsHsExpr (ExplicitSum x _ _ _) = nodeComments x nodeCommentsHsExpr (HsCase x _ _) = nodeComments x nodeCommentsHsExpr (HsIf x _ _ _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsMultiIf x _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (HsMultiIf x _) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsLet {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr (HsLet x _ _ _ _) = nodeComments x #else nodeCommentsHsExpr (HsLet x _ _) = nodeComments x #endif nodeCommentsHsExpr (HsDo x _ _) = nodeComments x nodeCommentsHsExpr (ExplicitList x _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr RecordCon {..} = mconcat $ fmap nodeComments rcon_ext+#else nodeCommentsHsExpr RecordCon {..} = nodeComments rcon_ext+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr RecordUpd {..} = mconcat $ fmap nodeComments rupd_ext+#else nodeCommentsHsExpr RecordUpd {..} = nodeComments rupd_ext+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr HsGetField {} = emptyNodeComments+#else nodeCommentsHsExpr HsGetField {..} = nodeComments gf_ext+#endif nodeCommentsHsExpr HsProjection {..} = nodeComments proj_ext+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (ExprWithTySig x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (ExprWithTySig x _ _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (ArithSeq x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (ArithSeq x _ _) = nodeComments x+#endif #if !MIN_VERSION_ghc_lib_parser(9,4,1) nodeCommentsHsExpr (HsBracket x _) = nodeComments x nodeCommentsHsExpr HsRnBracketOut {} = notUsedInParsedStage@@ -226,19 +340,35 @@ #if !MIN_VERSION_ghc_lib_parser(9,6,1) nodeCommentsHsExpr (HsSpliceE x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsProc x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (HsProc x _ _) = nodeComments x+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsStatic x _) = mconcat $ fmap nodeComments x+#else nodeCommentsHsExpr (HsStatic x _) = nodeComments x-#if !MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if !MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr HsTick {} = emptyNodeComments nodeCommentsHsExpr HsBinTick {} = emptyNodeComments #endif nodeCommentsHsExpr HsPragE {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr HsRecSel {} = emptyNodeComments+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsTypedBracket x _) = mconcat $ fmap nodeComments x+nodeCommentsHsExpr (HsUntypedBracket x _) = mconcat $ fmap nodeComments x+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsExpr (HsTypedBracket x _) = nodeComments x nodeCommentsHsExpr (HsUntypedBracket x _) = nodeComments x #endif-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsExpr (HsTypedSplice x _) = mconcat $ fmap nodeComments x+nodeCommentsHsExpr HsUntypedSplice {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1) nodeCommentsHsExpr (HsTypedSplice (x, y) _) = nodeComments x <> nodeComments y nodeCommentsHsExpr (HsUntypedSplice x _) = nodeComments x #endif@@ -247,17 +377,37 @@  instance CommentExtraction HsSigType' where   nodeComments (HsSigType' _ _ HsSig {}) = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (ConDecl GhcPs) where+  nodeComments ConDeclGADT {..} = mconcat $ fmap nodeComments $ snd con_g_ext+  nodeComments ConDeclH98 {..} = mconcat $ fmap nodeComments con_ext+#else+instance CommentExtraction (ConDecl GhcPs) where   nodeComments ConDeclGADT {..} = nodeComments con_g_ext   nodeComments ConDeclH98 {..} = nodeComments con_ext-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (Match GhcPs a) where+  nodeComments Match {..} = mconcat $ fmap nodeComments m_ext+#else+instance CommentExtraction (Match GhcPs a) where   nodeComments Match {..} = nodeComments m_ext-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where   nodeComments LastStmt {} = emptyNodeComments+  nodeComments (BindStmt x _ _) = mconcat $ fmap nodeComments x+  nodeComments ApplicativeStmt {} = emptyNodeComments+  nodeComments BodyStmt {} = emptyNodeComments+  nodeComments (LetStmt x _) = mconcat $ fmap nodeComments x+  nodeComments ParStmt {} = emptyNodeComments+  nodeComments TransStmt {..} = mconcat $ fmap nodeComments trS_ext+  nodeComments RecStmt {..} = nodeComments recS_ext+#else+instance CommentExtraction+           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where+  nodeComments LastStmt {} = emptyNodeComments   nodeComments (BindStmt x _ _) = nodeComments x   nodeComments ApplicativeStmt {} = emptyNodeComments   nodeComments BodyStmt {} = emptyNodeComments@@ -265,10 +415,22 @@   nodeComments ParStmt {} = emptyNodeComments   nodeComments TransStmt {..} = nodeComments trS_ext   nodeComments RecStmt {..} = nodeComments recS_ext-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where   nodeComments LastStmt {} = emptyNodeComments+  nodeComments (BindStmt x _ _) = mconcat $ fmap nodeComments x+  nodeComments ApplicativeStmt {} = emptyNodeComments+  nodeComments BodyStmt {} = emptyNodeComments+  nodeComments (LetStmt x _) = mconcat $ fmap nodeComments x+  nodeComments ParStmt {} = emptyNodeComments+  nodeComments TransStmt {..} = mconcat $ fmap nodeComments trS_ext+  nodeComments RecStmt {..} = nodeComments recS_ext+#else+instance CommentExtraction+           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where+  nodeComments LastStmt {} = emptyNodeComments   nodeComments (BindStmt x _ _) = nodeComments x   nodeComments ApplicativeStmt {} = emptyNodeComments   nodeComments BodyStmt {} = emptyNodeComments@@ -276,7 +438,7 @@   nodeComments ParStmt {} = emptyNodeComments   nodeComments TransStmt {..} = nodeComments trS_ext   nodeComments RecStmt {..} = nodeComments recS_ext-+#endif instance CommentExtraction StmtLRInsideVerticalList where   nodeComments (StmtLRInsideVerticalList x) = nodeComments x @@ -292,10 +454,37 @@  instance CommentExtraction (HsType GhcPs) where   nodeComments = nodeComments . HsType' HsTypeForNormalDecl HsTypeNoDir-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction HsType' where   nodeComments (HsType' _ _ HsForAllTy {}) = emptyNodeComments   nodeComments (HsType' _ _ HsQualTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ (HsTyVar x _ _)) = mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ HsAppTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ HsAppKindTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ HsFunTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ (HsListTy x _)) = nodeComments x+  nodeComments (HsType' _ _ (HsTupleTy x _ _)) = nodeComments x+  nodeComments (HsType' _ _ (HsSumTy x _)) = nodeComments x+  nodeComments (HsType' _ _ HsOpTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ (HsParTy x _)) = nodeComments x+  nodeComments (HsType' _ _ (HsIParamTy x _ _)) = mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ HsStarTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ (HsKindSig x _ _)) = mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ HsSpliceTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ (HsDocTy x _ _)) = mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ (HsBangTy x _ _)) = mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ (HsRecTy x _)) = nodeComments x+  nodeComments (HsType' _ _ (HsExplicitListTy x _ _)) =+    mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ (HsExplicitTupleTy x _)) =+    mconcat $ fmap nodeComments x+  nodeComments (HsType' _ _ HsTyLit {}) = emptyNodeComments+  nodeComments (HsType' _ _ HsWildCardTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ XHsType {}) = emptyNodeComments+#else+instance CommentExtraction HsType' where+  nodeComments (HsType' _ _ HsForAllTy {}) = emptyNodeComments+  nodeComments (HsType' _ _ HsQualTy {}) = emptyNodeComments   nodeComments (HsType' _ _ (HsTyVar x _ _)) = nodeComments x   nodeComments (HsType' _ _ HsAppTy {}) = emptyNodeComments   nodeComments (HsType' _ _ HsAppKindTy {}) = emptyNodeComments@@ -317,7 +506,7 @@   nodeComments (HsType' _ _ HsTyLit {}) = emptyNodeComments   nodeComments (HsType' _ _ HsWildCardTy {}) = emptyNodeComments   nodeComments (HsType' _ _ XHsType {}) = emptyNodeComments-+#endif instance CommentExtraction (GRHSs GhcPs a) where   nodeComments GRHSs {..} = NodeComments {..}     where@@ -327,13 +516,38 @@  instance CommentExtraction GRHSsExpr where   nodeComments (GRHSsExpr {..}) = nodeComments grhssExpr+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance CommentExtraction (HsMatchContext (GenLocated SrcSpanAnnN RdrName)) where+  nodeComments = nodeCommentsMatchContext +nodeCommentsMatchContext ::+     HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> NodeComments+nodeCommentsMatchContext FunRhs {} = emptyNodeComments+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsMatchContext LambdaExpr {} = emptyNodeComments+#endif+nodeCommentsMatchContext CaseAlt {} = emptyNodeComments+nodeCommentsMatchContext IfAlt {} = emptyNodeComments+nodeCommentsMatchContext ArrowMatchCtxt {} = emptyNodeComments+nodeCommentsMatchContext PatBindRhs {} = emptyNodeComments+nodeCommentsMatchContext PatBindGuards {} = emptyNodeComments+nodeCommentsMatchContext RecUpd {} = emptyNodeComments+nodeCommentsMatchContext StmtCtxt {} = emptyNodeComments+nodeCommentsMatchContext ThPatSplice {} = emptyNodeComments+nodeCommentsMatchContext ThPatQuote {} = emptyNodeComments+nodeCommentsMatchContext PatSyn {} = emptyNodeComments+#if MIN_VERSION_ghc_lib_parser(9,4,1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsMatchContext LamCaseAlt {} = emptyNodeComments+#endif+#else instance CommentExtraction (HsMatchContext GhcPs) where   nodeComments = nodeCommentsMatchContext  nodeCommentsMatchContext :: HsMatchContext GhcPs -> NodeComments nodeCommentsMatchContext FunRhs {} = emptyNodeComments+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1) nodeCommentsMatchContext LambdaExpr {} = emptyNodeComments+#endif nodeCommentsMatchContext CaseAlt {} = emptyNodeComments nodeCommentsMatchContext IfAlt {} = emptyNodeComments nodeCommentsMatchContext ArrowMatchCtxt {} = emptyNodeComments@@ -344,9 +558,10 @@ nodeCommentsMatchContext ThPatSplice {} = emptyNodeComments nodeCommentsMatchContext ThPatQuote {} = emptyNodeComments nodeCommentsMatchContext PatSyn {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9,4,1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1) nodeCommentsMatchContext LamCaseAlt {} = emptyNodeComments #endif+#endif instance CommentExtraction (ParStmtBlock GhcPs GhcPs) where   nodeComments ParStmtBlock {} = emptyNodeComments @@ -389,32 +604,63 @@ nodeCommentsPat :: Pat GhcPs -> NodeComments nodeCommentsPat WildPat {} = emptyNodeComments nodeCommentsPat VarPat {} = emptyNodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (LazyPat x _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (LazyPat x _) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat AsPat {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1) nodeCommentsPat (AsPat x _ _ _) = nodeComments x #else nodeCommentsPat (AsPat x _ _) = nodeComments x #endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat ParPat {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsPat (ParPat x _ _ _) = nodeComments x #else nodeCommentsPat (ParPat x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (BangPat x _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (BangPat x _) = nodeComments x+#endif nodeCommentsPat (ListPat x _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (TuplePat x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (TuplePat x _ _) = nodeComments x+#endif nodeCommentsPat (SumPat x _ _ _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat ConPat {..} = mconcat $ fmap nodeComments pat_con_ext+#else nodeCommentsPat ConPat {..} = nodeComments pat_con_ext+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (ViewPat x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (ViewPat x _ _) = nodeComments x+#endif nodeCommentsPat SplicePat {} = emptyNodeComments nodeCommentsPat LitPat {} = emptyNodeComments+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (NPat x _ _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (NPat x _ _ _) = nodeComments x+#endif nodeCommentsPat (NPlusKPat x _ _ _ _ _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsPat (SigPat x _ _) = mconcat $ fmap nodeComments x+#else nodeCommentsPat (SigPat x _ _) = nodeComments x-+#endif instance CommentExtraction RecConPat where   nodeComments (RecConPat x) = nodeComments x-#if !MIN_VERSION_ghc_lib_parser(9,4,1)+#if !MIN_VERSION_ghc_lib_parser(9, 4, 1) instance CommentExtraction (HsBracket GhcPs) where   nodeComments ExpBr {} = emptyNodeComments   nodeComments PatBr {} = emptyNodeComments@@ -433,17 +679,17 @@  instance CommentExtraction EpaComment where   nodeComments EpaComment {} = emptyNodeComments-+#if !MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction Anchor where   nodeComments Anchor {} = emptyNodeComments  instance CommentExtraction (SrcAnn a) where   nodeComments (SrcSpanAnn ep _) = nodeComments ep-+#endif instance CommentExtraction SrcSpan where   nodeComments RealSrcSpan {} = emptyNodeComments   nodeComments UnhelpfulSpan {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (EpAnn a) where   nodeComments (EpAnn ann _ cs) = NodeComments {..}     where@@ -453,8 +699,18 @@         filter (not . isCommentOnSameLine) $ getFollowingComments cs       isCommentOnSameLine (L comAnn _) =         srcSpanEndLine (anchor ann) == srcSpanStartLine (anchor comAnn)+#else+instance CommentExtraction (EpAnn a) where+  nodeComments (EpAnn ann _ cs) = NodeComments {..}+    where+      commentsBefore = priorComments cs+      commentsOnSameLine = filter isCommentOnSameLine $ getFollowingComments cs+      commentsAfter =+        filter (not . isCommentOnSameLine) $ getFollowingComments cs+      isCommentOnSameLine (L comAnn _) =+        srcSpanEndLine (anchor ann) == srcSpanStartLine (anchor comAnn)   nodeComments EpAnnNotUsed = emptyNodeComments-+#endif instance CommentExtraction (HsLocalBindsLR GhcPs GhcPs) where   nodeComments (HsValBinds x _) = nodeComments x   nodeComments (HsIPBinds x _) = nodeComments x@@ -463,11 +719,16 @@ instance CommentExtraction (HsValBindsLR GhcPs GhcPs) where   nodeComments ValBinds {} = emptyNodeComments   nodeComments XValBindsLR {} = notUsedInParsedStage-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (HsTupArg GhcPs) where+  nodeComments Present {} = emptyNodeComments+  nodeComments (Missing x) = nodeComments x+#else+instance CommentExtraction (HsTupArg GhcPs) where   nodeComments (Present x _) = nodeComments x   nodeComments (Missing x) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 4, 1) instance CommentExtraction RecConField where   nodeComments (RecConField x) = nodeComments x #else@@ -481,7 +742,19 @@            (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where   nodeComments HsRecField {..} = nodeComments hsRecFieldAnn #endif-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance CommentExtraction+           (HsFieldBind+              (GenLocated SrcSpanAnnA (FieldOcc GhcPs))+              (GenLocated SrcSpanAnnA (Pat GhcPs))) where+  nodeComments HsFieldBind {..} = mconcat $ fmap nodeComments hfbAnn++instance CommentExtraction+           (HsFieldBind+              (GenLocated SrcSpanAnnA (FieldOcc GhcPs))+              (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where+  nodeComments HsFieldBind {..} = mconcat $ fmap nodeComments hfbAnn+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) -- | For pattern matchings against records. instance CommentExtraction            (HsFieldBind@@ -520,10 +793,13 @@  instance CommentExtraction (HsScaled GhcPs a) where   nodeComments HsScaled {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (ConDeclField GhcPs) where+  nodeComments ConDeclField {..} = mconcat $ fmap nodeComments cd_fld_ext+#else+instance CommentExtraction (ConDeclField GhcPs) where   nodeComments ConDeclField {..} = nodeComments cd_fld_ext-+#endif instance CommentExtraction InfixExpr where   nodeComments (InfixExpr x) = nodeComments x @@ -549,9 +825,14 @@ instance CommentExtraction XImportDeclPass where   nodeComments XImportDeclPass {..} = nodeComments ideclAnn #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (HsDerivingClause GhcPs) where+  nodeComments HsDerivingClause {..} =+    mconcat $ fmap nodeComments deriv_clause_ext+#else+instance CommentExtraction (HsDerivingClause GhcPs) where   nodeComments HsDerivingClause {..} = nodeComments deriv_clause_ext-+#endif instance CommentExtraction (DerivClauseTys GhcPs) where   nodeComments DctSingle {} = emptyNodeComments   nodeComments DctMulti {} = emptyNodeComments@@ -565,23 +846,35 @@  instance CommentExtraction StringLiteral where   nodeComments StringLiteral {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) -- | This instance is for type family declarations inside a class declaration. instance CommentExtraction (FamilyDecl GhcPs) where+  nodeComments FamilyDecl {..} = mconcat $ fmap nodeComments fdExt+#else+-- | This instance is for type family declarations inside a class declaration.+instance CommentExtraction (FamilyDecl GhcPs) where   nodeComments FamilyDecl {..} = nodeComments fdExt-+#endif instance CommentExtraction (FamilyResultSig GhcPs) where   nodeComments NoSig {} = emptyNodeComments   nodeComments KindSig {} = emptyNodeComments   nodeComments TyVarSig {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (HsTyVarBndr a GhcPs) where+  nodeComments (UserTyVar x _ _) = mconcat $ fmap nodeComments x+  nodeComments (KindedTyVar x _ _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (HsTyVarBndr a GhcPs) where   nodeComments (UserTyVar x _ _) = nodeComments x   nodeComments (KindedTyVar x _ _ _) = nodeComments x-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (InjectivityAnn GhcPs) where+  nodeComments (InjectivityAnn x _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (InjectivityAnn GhcPs) where   nodeComments (InjectivityAnn x _ _) = nodeComments x-+#endif instance CommentExtraction (ArithSeqInfo GhcPs) where   nodeComments From {} = emptyNodeComments   nodeComments FromThen {} = emptyNodeComments@@ -620,9 +913,20 @@  instance CommentExtraction ModuleNameWithPrefix where   nodeComments ModuleNameWithPrefix {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,8,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (IE GhcPs) where   nodeComments IEVar {} = emptyNodeComments+  nodeComments (IEThingAbs _ x _) = nodeComments x+  nodeComments (IEThingAll _ x _) = nodeComments x+  nodeComments (IEThingWith _ x _ _ _) = nodeComments x+  nodeComments (IEModuleContents (x, y) _) =+    mconcat $ maybeToList (fmap nodeComments x) <> fmap nodeComments y+  nodeComments IEGroup {} = emptyNodeComments+  nodeComments IEDoc {} = emptyNodeComments+  nodeComments IEDocNamed {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)+instance CommentExtraction (IE GhcPs) where+  nodeComments IEVar {} = emptyNodeComments   nodeComments (IEThingAbs (_, x) _) = nodeComments x   nodeComments (IEThingAll (_, x) _) = nodeComments x   nodeComments (IEThingWith (_, x) _ _ _) = nodeComments x@@ -641,16 +945,26 @@   nodeComments IEDoc {} = emptyNodeComments   nodeComments IEDocNamed {} = emptyNodeComments #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction            (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where+  nodeComments FamEqn {..} = mconcat $ fmap nodeComments feqn_ext+#else+instance CommentExtraction+           (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where   nodeComments FamEqn {..} = nodeComments feqn_ext-+#endif instance CommentExtraction FamEqn' where   nodeComments FamEqn' {..} = nodeComments famEqn-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) -- | Pretty-print a data instance. instance CommentExtraction (FamEqn GhcPs (HsDataDefn GhcPs)) where+  nodeComments FamEqn {..} = mconcat $ fmap nodeComments feqn_ext+#else+-- | Pretty-print a data instance.+instance CommentExtraction (FamEqn GhcPs (HsDataDefn GhcPs)) where   nodeComments FamEqn {..} = nodeComments feqn_ext+#endif -- | HsArg (LHsType GhcPs) (LHsType GhcPs) #if MIN_VERSION_ghc_lib_parser(9,8,1) instance CommentExtraction@@ -680,15 +994,23 @@   nodeComments VarBr {} = emptyNodeComments #endif -#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (WarnDecls GhcPs) where+  nodeComments Warnings {..} = mconcat $ fmap nodeComments $ fst wd_ext+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance CommentExtraction (WarnDecls GhcPs) where   nodeComments Warnings {..} = nodeComments $ fst wd_ext #else instance CommentExtraction (WarnDecls GhcPs) where   nodeComments Warnings {..} = nodeComments wd_ext #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (WarnDecl GhcPs) where+  nodeComments (Warning (_, x) _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (WarnDecl GhcPs) where   nodeComments (Warning x _ _) = nodeComments x+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance CommentExtraction (WithHsDocIdentifiers StringLiteral GhcPs) where   nodeComments WithHsDocIdentifiers {} = emptyNodeComments@@ -713,15 +1035,18 @@   nodeComments HsFieldLabel {..} = nodeComments hflExt #endif -#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (RuleDecls GhcPs) where+  nodeComments HsRules {..} = mconcat $ fmap nodeComments $ fst rds_ext+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance CommentExtraction (RuleDecls GhcPs) where   nodeComments HsRules {..} = nodeComments $ fst rds_ext #else instance CommentExtraction (RuleDecls GhcPs) where   nodeComments HsRules {..} = nodeComments rds_ext #endif -#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) instance CommentExtraction (RuleDecl GhcPs) where   nodeComments HsRule {..} = nodeComments $ fst rd_ext #else@@ -730,10 +1055,14 @@ #endif instance CommentExtraction OccName where   nodeComments = const emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (DerivDecl GhcPs) where+  nodeComments DerivDecl {deriv_ext = (x, xs)} =+    mconcat $ maybeToList (fmap nodeComments x) <> fmap nodeComments xs+#else+instance CommentExtraction (DerivDecl GhcPs) where   nodeComments DerivDecl {..} = nodeComments deriv_ext-+#endif -- | 'Pretty' for 'LHsSigWcType GhcPs'. instance CommentExtraction            (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))) where@@ -743,17 +1072,30 @@ instance CommentExtraction            (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where   nodeComments HsWC {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (StandaloneKindSig GhcPs) where+  nodeComments (StandaloneKindSig x _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (StandaloneKindSig GhcPs) where   nodeComments (StandaloneKindSig x _ _) = nodeComments x-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (DefaultDecl GhcPs) where+  nodeComments (DefaultDecl x _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (DefaultDecl GhcPs) where   nodeComments (DefaultDecl x _) = nodeComments x-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (ForeignDecl GhcPs) where+  nodeComments ForeignImport {..} = mconcat $ fmap nodeComments fd_i_ext+  nodeComments ForeignExport {..} = mconcat $ fmap nodeComments fd_e_ext+#else+instance CommentExtraction (ForeignDecl GhcPs) where   nodeComments ForeignImport {..} = nodeComments fd_i_ext   nodeComments ForeignExport {..} = nodeComments fd_e_ext-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) instance CommentExtraction (ForeignImport GhcPs) where   nodeComments CImport {} = emptyNodeComments #else@@ -782,17 +1124,24 @@ instance CommentExtraction (AnnDecl GhcPs) where   nodeComments (HsAnnotation x _ _ _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (RoleAnnotDecl GhcPs) where+  nodeComments (RoleAnnotDecl x _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (RoleAnnotDecl GhcPs) where   nodeComments (RoleAnnotDecl x _ _) = nodeComments x-+#endif instance CommentExtraction Role where   nodeComments Nominal = emptyNodeComments   nodeComments Representational = emptyNodeComments   nodeComments Phantom = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (TyFamInstDecl GhcPs) where+  nodeComments TyFamInstDecl {..} = mconcat $ fmap nodeComments tfid_xtn+#else+instance CommentExtraction (TyFamInstDecl GhcPs) where   nodeComments TyFamInstDecl {..} = nodeComments tfid_xtn-+#endif instance CommentExtraction TopLevelTyFamInstDecl where   nodeComments (TopLevelTyFamInstDecl x) = nodeComments x @@ -801,10 +1150,13 @@  instance CommentExtraction DataFamInstDecl' where   nodeComments DataFamInstDecl' {..} = nodeComments dataFamInstDecl-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (PatSynBind GhcPs GhcPs) where+  nodeComments PSB {..} = mconcat $ fmap nodeComments psb_ext+#else+instance CommentExtraction (PatSynBind GhcPs GhcPs) where   nodeComments PSB {..} = nodeComments psb_ext-+#endif -- | 'Pretty' for 'HsPatSynDetails'. instance CommentExtraction            (HsConDetails@@ -898,19 +1250,33 @@  instance CommentExtraction (HsIPBinds GhcPs) where   nodeComments IPBinds {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (IPBind GhcPs) where+  nodeComments (IPBind x _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (IPBind GhcPs) where   nodeComments (IPBind x _ _) = nodeComments x-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (DerivStrategy GhcPs) where+  nodeComments (StockStrategy x) = mconcat $ fmap nodeComments x+  nodeComments (AnyclassStrategy x) = mconcat $ fmap nodeComments x+  nodeComments (NewtypeStrategy x) = mconcat $ fmap nodeComments x+  nodeComments (ViaStrategy x) = nodeComments x+#else+instance CommentExtraction (DerivStrategy GhcPs) where   nodeComments (StockStrategy x) = nodeComments x   nodeComments (AnyclassStrategy x) = nodeComments x   nodeComments (NewtypeStrategy x) = nodeComments x   nodeComments (ViaStrategy x) = nodeComments x-+#endif+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction XViaStrategyPs where+  nodeComments (XViaStrategyPs x _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction XViaStrategyPs where   nodeComments (XViaStrategyPs x _) = nodeComments x-+#endif instance CommentExtraction (RecordPatSynField GhcPs) where   nodeComments RecordPatSynField {} = emptyNodeComments @@ -923,21 +1289,31 @@ nodeCommentsHsCmd :: HsCmd GhcPs -> NodeComments nodeCommentsHsCmd (HsCmdArrApp x _ _ _ _) = nodeComments x nodeCommentsHsCmd (HsCmdArrForm x _ _ _ _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsCmd HsCmdApp {} = emptyNodeComments+#else nodeCommentsHsCmd (HsCmdApp x _ _) = nodeComments x+#endif nodeCommentsHsCmd HsCmdLam {} = emptyNodeComments-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsCmd HsCmdPar {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsCmd (HsCmdPar x _ _ _) = nodeComments x #else nodeCommentsHsCmd (HsCmdPar x _) = nodeComments x #endif nodeCommentsHsCmd (HsCmdCase x _ _) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+-- No HsCmdLamCase since 9.10.1.+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsCmd (HsCmdLamCase x _ _) = nodeComments x #else nodeCommentsHsCmd (HsCmdLamCase x _) = nodeComments x #endif nodeCommentsHsCmd (HsCmdIf x _ _ _ _) = nodeComments x-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+nodeCommentsHsCmd HsCmdLet {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 4, 1) nodeCommentsHsCmd (HsCmdLet x _ _ _ _) = nodeComments x #else nodeCommentsHsCmd (HsCmdLet x _ _) = nodeComments x@@ -952,17 +1328,18 @@  instance CommentExtraction LetIn where   nodeComments LetIn {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (RuleBndr GhcPs) where+  nodeComments (RuleBndr x _) = mconcat $ fmap nodeComments x+  nodeComments (RuleBndrSig x _ _) = mconcat $ fmap nodeComments x+#else+instance CommentExtraction (RuleBndr GhcPs) where   nodeComments (RuleBndr x _) = nodeComments x   nodeComments (RuleBndrSig x _ _) = nodeComments x-+#endif instance CommentExtraction CCallConv where   nodeComments = const emptyNodeComments -instance CommentExtraction ModuleDeprecatedPragma where-  nodeComments ModuleDeprecatedPragma {} = emptyNodeComments- instance CommentExtraction HsSrcBang where   nodeComments HsSrcBang {} = emptyNodeComments @@ -979,11 +1356,17 @@ instance CommentExtraction (HsOuterSigTyVarBndrs GhcPs) where   nodeComments HsOuterImplicit {} = emptyNodeComments   nodeComments HsOuterExplicit {..} = nodeComments hso_xexplicit-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9, 6, 1) instance CommentExtraction FieldLabelString where   nodeComments = const emptyNodeComments+#endif +#if MIN_VERSION_ghc_lib_parser(9, 10, 1) instance CommentExtraction (HsUntypedSplice GhcPs) where+  nodeComments (HsUntypedSpliceExpr x _) = mconcat $ fmap nodeComments x+  nodeComments HsQuasiQuote {} = emptyNodeComments+#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)+instance CommentExtraction (HsUntypedSplice GhcPs) where   nodeComments (HsUntypedSpliceExpr x _) = nodeComments x   nodeComments HsQuasiQuote {} = emptyNodeComments #endif@@ -993,6 +1376,94 @@   nodeComments RegularRecUpdFields {} = emptyNodeComments   nodeComments OverloadedRecUpdFields {} = emptyNodeComments #endif+instance CommentExtraction AddEpAnn where+  nodeComments (AddEpAnn _ x) = nodeComments x++instance CommentExtraction EpaLocation where+  nodeComments EpaSpan {} = emptyNodeComments+  nodeComments (EpaDelta _ x) = mconcat $ fmap nodeComments x+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance CommentExtraction (EpaLocation' NoComments) where+  nodeComments EpaSpan {} = emptyNodeComments+  nodeComments EpaDelta {} = emptyNodeComments+#endif+instance CommentExtraction AnnPragma where+  nodeComments AnnPragma {..} =+    mconcat $ fmap nodeComments $ apr_open : apr_close : apr_rest++instance CommentExtraction HsRuleAnn where+  nodeComments HsRuleAnn {..} =+    mconcat $ f ra_tyanns : f ra_tmanns : fmap nodeComments ra_rest+    where+      f (Just (x, y)) = mconcat $ fmap nodeComments [x, y]+      f Nothing = emptyNodeComments++instance CommentExtraction AnnFieldLabel where+  nodeComments AnnFieldLabel {afDot = Just x} = nodeComments x+  nodeComments AnnFieldLabel {afDot = Nothing} = emptyNodeComments++instance CommentExtraction EpAnnSumPat where+  nodeComments EpAnnSumPat {..} =+    mconcat+      $ fmap nodeComments sumPatParens+          <> fmap nodeComments sumPatVbarsBefore+          <> fmap nodeComments sumPatVbarsAfter+#if MIN_VERSION_ghc_lib_parser(9, 10, 1)+instance CommentExtraction AnnList where+  nodeComments AnnList {..} = mconcat [a, b, c, d, e]+    where+      a = maybe mempty nodeComments al_anchor+      b = maybe mempty nodeComments al_open+      c = maybe mempty nodeComments al_close+      d = mconcat $ fmap nodeComments al_rest+      e = mconcat $ fmap nodeComments al_trailing++instance CommentExtraction TrailingAnn where+  nodeComments AddSemiAnn {..} = nodeComments ta_location+  nodeComments AddCommaAnn {..} = nodeComments ta_location+  nodeComments AddVbarAnn {..} = nodeComments ta_location+  nodeComments AddDarrowAnn {..} = nodeComments ta_location+  nodeComments AddDarrowUAnn {..} = nodeComments ta_location++instance CommentExtraction AnnParen where+  nodeComments AnnParen {..} = mconcat $ fmap nodeComments [ap_open, ap_close]+#endif+instance CommentExtraction AnnProjection where+  nodeComments AnnProjection {..} =+    mconcat $ fmap nodeComments [apOpen, apClose]++instance CommentExtraction AnnsIf where+  nodeComments AnnsIf {..} =+    mconcat+      $ fmap nodeComments+      $ aiIf+          : aiThen+          : aiElse+          : (maybeToList aiThenSemi <> maybeToList aiElseSemi)++instance CommentExtraction EpAnnHsCase where+  nodeComments EpAnnHsCase {..} =+    mconcat+      $ nodeComments hsCaseAnnCase+          : nodeComments hsCaseAnnOf+          : fmap nodeComments hsCaseAnnsRest++instance CommentExtraction AnnExplicitSum where+  nodeComments AnnExplicitSum {..} =+    mconcat+      $ fmap nodeComments+      $ aesOpen : aesBarsBefore <> aesBarsAfter <> [aesClose]++instance CommentExtraction EpAnnUnboundVar where+  nodeComments EpAnnUnboundVar {..} =+    mconcat+      $ fmap+          nodeComments+          [fst hsUnboundBackquotes, snd hsUnboundBackquotes, hsUnboundHole]++instance CommentExtraction AnnSig where+  nodeComments AnnSig {..} = mconcat $ fmap nodeComments $ asDcolon : asRest+ -- | Marks an AST node as never appearing in the AST. -- -- Some AST node types are only used in the renaming or type-checking phase.
− src/HIndent/Pretty/Pragma.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}---- | Pretty-printing pragmas-module HIndent.Pretty.Pragma-  ( prettyPragmas-  , pragmaExists-  , isPragma-  ) where--import Data.Bifunctor-import Data.Char-import Data.Generics.Schemes-import Data.List-import Data.List.Split-import Data.Maybe-import HIndent.GhcLibParserWrapper.GHC.Hs-import HIndent.Pragma-import HIndent.Pretty.Combinators.Lineup-import HIndent.Pretty.Combinators.String-import HIndent.Printer-import Text.Regex.TDFA---- | This function pretty-prints the module's pragmas-prettyPragmas :: HsModule' -> Printer ()-prettyPragmas = lined . fmap string . collectPragmas---- | This function returns a 'True' if the module has pragmas.--- Otherwise, it returns a 'False'.-pragmaExists :: HsModule' -> Bool-pragmaExists = not . null . collectPragmas--- | This function collects pragma comments from the--- given module and modifies them into 'String's.------ A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ ->--- @LANGUAGE@).-#if MIN_VERSION_ghc_lib_parser(9,6,1)-collectPragmas :: HsModule GhcPs -> [String]-collectPragmas =-  fmap (uncurry constructPragma)-    . mapMaybe extractPragma-    . listify isBlockComment-    . hsmodAnn-    . hsmodExt-#else-collectPragmas :: HsModule -> [String]-collectPragmas =-  fmap (uncurry constructPragma)-    . mapMaybe extractPragma-    . listify isBlockComment-    . hsmodAnn-#endif--- | This function returns a 'Just' value with the pragma--- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it--- returns a 'Nothing'.-extractPragma :: EpaCommentTok -> Maybe (String, [String])-extractPragma (EpaBlockComment c) =-  second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c-  where-    strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace-extractPragma _ = Nothing---- | This function returns a 'True' if the passed 'EpaCommentTok' is--- a pragma. Otherwise, it returns a 'False'.-isPragma :: EpaCommentTok -> Bool-isPragma (EpaBlockComment c) = match pragmaRegex c-isPragma _ = False---- | Construct a pragma.-constructPragma :: String -> [String] -> String-constructPragma optionOrPragma xs =-  "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"---- | Checks if the given comment is a block one.-isBlockComment :: EpaCommentTok -> Bool-isBlockComment EpaBlockComment {} = True-isBlockComment _ = False
src/HIndent/Pretty/Types.hs view
@@ -40,13 +40,11 @@   , ModuleNameWithPrefix(..)   , PatInsidePatDecl(..)   , LambdaCase(..)-  , ModuleDeprecatedPragma(..)   , ListComprehension(..)   , DoExpression(..)   , DoOrMdo(..)   , QualifiedDo(..)   , LetIn(..)-  , NodeComments(..)   , GRHSExprType(..)   , GRHSProcType(..)   , HsTypeFor(..)@@ -55,9 +53,9 @@   , DataFamInstDeclFor(..)   ) where +import Data.List.NonEmpty import GHC.Hs import GHC.Types.Name.Reader-import GHC.Unit.Module.Warnings #if !MIN_VERSION_ghc_lib_parser(9,6,1) import GHC.Unit #endif@@ -255,19 +253,11 @@   { lamCaseGroup :: MatchGroup GhcPs (LHsExpr GhcPs)   , caseOrCases :: CaseOrCases   }-#if MIN_VERSION_ghc_lib_parser(9,4,1)--- | A deprecation pragma for a module.-newtype ModuleDeprecatedPragma =-  ModuleDeprecatedPragma (WarningTxt GhcPs)-#else--- | A deprecation pragma for a module.-newtype ModuleDeprecatedPragma =-  ModuleDeprecatedPragma WarningTxt-#endif+ -- | Use this type to pretty-print a list comprehension. data ListComprehension = ListComprehension   { listCompLhs :: ExprLStmt GhcPs -- ^ @f x@ of @[f x| x <- xs]@.-  , listCompRhs :: [ExprLStmt GhcPs] -- ^ @x <- xs@ of @[f x| x <- xs]@.+  , listCompRhs :: NonEmpty (ExprLStmt GhcPs) -- ^ @x <- xs@ of @[f x| x <- xs]@.   }  -- | Use this type to pretty-print a do expression.@@ -281,21 +271,6 @@   { letBinds :: HsLocalBinds GhcPs   , inExpr :: LHsExpr GhcPs   }---- | Comments belonging to an AST node.-data NodeComments = NodeComments-  { commentsBefore :: [LEpaComment]-  , commentsOnSameLine :: [LEpaComment]-  , commentsAfter :: [LEpaComment]-  }--instance Semigroup NodeComments where-  x <> y =-    NodeComments-      { commentsBefore = commentsBefore x <> commentsBefore y-      , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y-      , commentsAfter = commentsAfter x <> commentsAfter y-      }  -- | Values indicating whether `do` or `mdo` is used. data DoOrMdo
tests/Main.hs view
@@ -34,7 +34,7 @@ reformat :: Config -> S.ByteString -> ByteString reformat cfg code =   either (("-- " <>) . L8.pack . HIndent.prettyParseError) L.fromStrict-    $ HIndent.reformat cfg [] Nothing code+    $ HIndent.reformat cfg HIndent.defaultExtensions Nothing code  -- | Convert the Markdone document to Spec benchmarks. toSpec :: [Markdone] -> Spec