{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

-- | Pretty printing.
--
-- Some instances define top-level functions to handle CPP.
--
-- Some value constructors never appear in an AST. GHC has three stages for
-- 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 :: forall a. Pretty a => a -> Printer ()
pretty a
p = do
  a -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentsBefore a
p
  a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' a
p
  a -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentOnSameLine a
p
  a -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentsAfter a
p

-- | Prints comments included in the location information and then the
-- AST node body.
printCommentsAnd ::
     (CommentExtraction l) => GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd :: forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (L l
l e
e) e -> Printer ()
f = do
  l -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentsBefore l
l
  e -> Printer ()
f e
e
  l -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentOnSameLine l
l
  l -> Printer ()
forall a. CommentExtraction a => a -> Printer ()
printCommentsAfter l
l

-- | Prints comments that are before the given AST node.
printCommentsBefore :: CommentExtraction a => a -> Printer ()
printCommentsBefore :: forall a. CommentExtraction a => a -> Printer ()
printCommentsBefore a
p =
  [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NodeComments -> [LEpaComment]
commentsBefore (NodeComments -> [LEpaComment]) -> NodeComments -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ a -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments a
p) ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(L Anchor
loc EpaComment
c) -> do
    let col :: Int64
col = Arity -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Arity -> Int64) -> Arity -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Arity
srcSpanStartCol (Anchor -> RealSrcSpan
anchor Anchor
loc) Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1
    Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ EpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaComment
c
    Printer ()
newline

-- | Prints comments that are on the same line as the given AST node.
printCommentOnSameLine :: CommentExtraction a => a -> Printer ()
printCommentOnSameLine :: forall a. CommentExtraction a => a -> Printer ()
printCommentOnSameLine (NodeComments -> [LEpaComment]
commentsOnSameLine (NodeComments -> [LEpaComment])
-> (a -> NodeComments) -> a -> [LEpaComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments -> (LEpaComment
c:[LEpaComment]
cs)) = do
  Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
  if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
    then Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel
           (Arity -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Arity -> Int64) -> Arity -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Arity
srcSpanStartCol (RealSrcSpan -> Arity) -> RealSrcSpan -> Arity
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
forall l e. GenLocated l e -> l
getLoc LEpaComment
c)
           (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced
           ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> Printer ()) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LEpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
           ([LEpaComment] -> [Printer ()]) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ LEpaComment
c LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
: [LEpaComment]
cs
    else [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> Printer ()) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LEpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ([LEpaComment] -> [Printer ()]) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ LEpaComment
c LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
: [LEpaComment]
cs
  Printer ()
eolCommentsArePrinted
printCommentOnSameLine a
_ = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Prints comments that are after the given AST node.
printCommentsAfter :: CommentExtraction a => a -> Printer ()
printCommentsAfter :: forall a. CommentExtraction a => a -> Printer ()
printCommentsAfter a
p =
  case NodeComments -> [LEpaComment]
commentsAfter (NodeComments -> [LEpaComment]) -> NodeComments -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ a -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments a
p of
    [] -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [LEpaComment]
xs -> do
      Bool
isThereCommentsOnSameLine <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isThereCommentsOnSameLine Printer ()
newline
      [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
xs ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(L Anchor
loc EpaComment
c) -> do
        let col :: Int64
col = Arity -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Arity -> Int64) -> Arity -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Arity
srcSpanStartCol (Anchor -> RealSrcSpan
anchor Anchor
loc) Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ EpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaComment
c
        Printer ()
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 {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' :: HsModule -> Printer ()
pretty' m :: HsModule
m@HsModule {hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodName = Maybe (LocatedA ModuleName)
Nothing, hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports = [], hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls = []}
    | Bool -> Bool
not (HsModule -> Bool
pragmaExists HsModule
m) = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pretty' HsModule
m = [Printer ()] -> Printer ()
blanklined [Printer ()]
printers Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline
    where
      printers :: [Printer ()]
printers = (Bool, Printer ()) -> Printer ()
forall a b. (a, b) -> b
snd ((Bool, Printer ()) -> Printer ())
-> [(Bool, Printer ())] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Bool, Printer ()) -> Bool)
-> [(Bool, Printer ())] -> [(Bool, Printer ())]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Printer ()) -> Bool
forall a b. (a, b) -> a
fst [(Bool, Printer ())]
pairs
      pairs :: [(Bool, Printer ())]
pairs =
        [ (HsModule -> Bool
pragmaExists HsModule
m, HsModule -> Printer ()
prettyPragmas HsModule
m)
        , (HsModule -> Bool
moduleDeclExists HsModule
m, HsModule -> Printer ()
prettyModuleDecl HsModule
m)
        , (HsModule -> Bool
importsExist HsModule
m, Printer ()
prettyImports)
        , (HsModule -> Bool
declsExist HsModule
m, Printer ()
prettyDecls)
        ]
      prettyModuleDecl :: HsModule -> Printer ()
prettyModuleDecl HsModule {hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodName = Maybe (LocatedA ModuleName)
Nothing} =
        String -> Printer ()
forall a. HasCallStack => String -> a
error String
"The module declaration does not exist."
      prettyModuleDecl HsModule { hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodName = Just LocatedA ModuleName
name
                                , hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports = Maybe (LocatedL [LIE GhcPs])
Nothing
                                , [LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LocatedP (WarningTxt GhcPs))
LayoutInfo
EpAnn AnnsModule
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodAnn :: EpAnn AnnsModule
hsmodLayout :: LayoutInfo
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)
hsmodAnn :: HsModule -> EpAnn AnnsModule
hsmodLayout :: HsModule -> LayoutInfo
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: HsModule -> Maybe (LHsDoc GhcPs)
..
                                } = do
        GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ())
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ModuleName -> ModuleNameWithPrefix)
-> LocatedA ModuleName
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> ModuleNameWithPrefix
ModuleNameWithPrefix LocatedA ModuleName
name
        Maybe (LocatedP (WarningTxt GhcPs))
-> (LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (LocatedP (WarningTxt GhcPs))
hsmodDeprecMessage ((LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ())
-> (LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LocatedP (WarningTxt GhcPs)
x -> do
          Printer ()
space
          GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ())
-> GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WarningTxt GhcPs -> ModuleDeprecatedPragma)
-> LocatedP (WarningTxt GhcPs)
-> GenLocated SrcSpanAnnP ModuleDeprecatedPragma
forall a b.
(a -> b) -> GenLocated SrcSpanAnnP a -> GenLocated SrcSpanAnnP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningTxt GhcPs -> ModuleDeprecatedPragma
ModuleDeprecatedPragma LocatedP (WarningTxt GhcPs)
x
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
      prettyModuleDecl HsModule { hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodName = Just LocatedA ModuleName
name
                                , hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports = Just LocatedL [LIE GhcPs]
exports
                                , [LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LocatedP (WarningTxt GhcPs))
LayoutInfo
EpAnn AnnsModule
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
hsmodLayout :: HsModule -> LayoutInfo
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: HsModule -> Maybe (LHsDoc GhcPs)
hsmodAnn :: EpAnn AnnsModule
hsmodLayout :: LayoutInfo
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)
..
                                } = do
        GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ())
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ModuleName -> ModuleNameWithPrefix)
-> LocatedA ModuleName
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> ModuleNameWithPrefix
ModuleNameWithPrefix LocatedA ModuleName
name
        Maybe (LocatedP (WarningTxt GhcPs))
-> (LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (LocatedP (WarningTxt GhcPs))
hsmodDeprecMessage ((LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ())
-> (LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LocatedP (WarningTxt GhcPs)
x -> do
          Printer ()
space
          GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ())
-> GenLocated SrcSpanAnnP ModuleDeprecatedPragma -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WarningTxt GhcPs -> ModuleDeprecatedPragma)
-> LocatedP (WarningTxt GhcPs)
-> GenLocated SrcSpanAnnP ModuleDeprecatedPragma
forall a b.
(a -> b) -> GenLocated SrcSpanAnnP a -> GenLocated SrcSpanAnnP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningTxt GhcPs -> ModuleDeprecatedPragma
ModuleDeprecatedPragma LocatedP (WarningTxt GhcPs)
x
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
LocatedL [LIE GhcPs]
exports ([Printer ()] -> Printer ()
vTuple ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
      moduleDeclExists :: HsModule -> Bool
moduleDeclExists HsModule {hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodName = Maybe (LocatedA ModuleName)
Nothing} = Bool
False
      moduleDeclExists HsModule
_ = Bool
True
      prettyDecls :: Printer ()
prettyDecls =
        ((GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))
 -> Printer ())
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(GenLocated SrcSpanAnnA (HsDecl GhcPs)
x, Maybe (Printer ())
sp) -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsDecl GhcPs)
x Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Maybe (Printer ()) -> Printer ()
forall a. a -> Maybe a -> a
fromMaybe (() -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (Printer ())
sp)
          ([(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))]
 -> Printer ())
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))]
-> Printer ()
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))]
forall {l} {p}.
[GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), Maybe (Printer ()))]
addDeclSeparator
          ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe (Printer ()))]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LHsDecl GhcPs]
hsmodDecls HsModule
m
      addDeclSeparator :: [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), Maybe (Printer ()))]
addDeclSeparator [] = []
      addDeclSeparator [GenLocated l (HsDecl p)
x] = [(GenLocated l (HsDecl p)
x, Maybe (Printer ())
forall a. Maybe a
Nothing)]
      addDeclSeparator (GenLocated l (HsDecl p)
x:[GenLocated l (HsDecl p)]
xs) =
        (GenLocated l (HsDecl p)
x, Printer () -> Maybe (Printer ())
forall a. a -> Maybe a
Just (Printer () -> Maybe (Printer ()))
-> Printer () -> Maybe (Printer ())
forall a b. (a -> b) -> a -> b
$ HsDecl p -> Printer ()
forall {p}. HsDecl p -> Printer ()
declSeparator (HsDecl p -> Printer ()) -> HsDecl p -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated l (HsDecl p) -> HsDecl p
forall l e. GenLocated l e -> e
unLoc GenLocated l (HsDecl p)
x) (GenLocated l (HsDecl p), Maybe (Printer ()))
-> [(GenLocated l (HsDecl p), Maybe (Printer ()))]
-> [(GenLocated l (HsDecl p), Maybe (Printer ()))]
forall a. a -> [a] -> [a]
: [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), Maybe (Printer ()))]
addDeclSeparator [GenLocated l (HsDecl p)]
xs
      declSeparator :: HsDecl p -> Printer ()
declSeparator (SigD XSigD p
_ TypeSig {}) = Printer ()
newline
      declSeparator (SigD XSigD p
_ InlineSig {}) = Printer ()
newline
      declSeparator (SigD XSigD p
_ PatSynSig {}) = Printer ()
newline
      declSeparator HsDecl p
_ = Printer ()
blankline
      declsExist :: HsModule -> Bool
declsExist = Bool -> Bool
not (Bool -> Bool) -> (HsModule -> Bool) -> HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Bool)
-> (HsModule -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> HsModule
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
HsModule -> [LHsDecl GhcPs]
hsmodDecls
      prettyImports :: Printer ()
prettyImports = Printer [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
importDecls Printer [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> ([[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]] -> Printer ())
-> Printer ()
forall a b. Printer a -> (a -> Printer b) -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Printer ()] -> Printer ()
blanklined ([Printer ()] -> Printer ())
-> ([[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]] -> [Printer ()])
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Printer ())
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Printer ()
outputImportGroup
      outputImportGroup :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Printer ()
outputImportGroup = [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
      importDecls :: Printer [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
importDecls =
        (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> Bool
configSortImports (Config -> Bool) -> (PrintState -> Config) -> PrintState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig) Printer Bool
-> (Bool -> Printer [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]])
-> Printer [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
forall a b. Printer a -> (a -> Printer b) -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> [[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]])
-> [[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]]
forall a b. (a -> b) -> a -> b
$ HsModule -> [[LImportDecl GhcPs]]
extractImportsSorted HsModule
m
          Bool
False -> [[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]])
-> [[LImportDecl GhcPs]] -> Printer [[LImportDecl GhcPs]]
forall a b. (a -> b) -> a -> b
$ HsModule -> [[LImportDecl GhcPs]]
extractImports HsModule
m
#endif
instance (CommentExtraction l, Pretty e) => Pretty (GenLocated l e) where
  pretty' :: GenLocated l e -> Printer ()
pretty' (L l
_ e
e) = e -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty e
e

instance Pretty (HsDecl GhcPs) where
  pretty' :: HsDecl GhcPs -> Printer ()
pretty' (TyClD XTyClD GhcPs
_ TyClDecl GhcPs
d) = TyClDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TyClDecl GhcPs
d
  pretty' (InstD XInstD GhcPs
_ InstDecl GhcPs
inst) = InstDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty InstDecl GhcPs
inst
  pretty' (DerivD XDerivD GhcPs
_ DerivDecl GhcPs
x) = DerivDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DerivDecl GhcPs
x
  pretty' (ValD XValD GhcPs
_ HsBind GhcPs
bind) = HsBind GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsBind GhcPs
bind
  pretty' (SigD XSigD GhcPs
_ Sig GhcPs
s) = DeclSig -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (DeclSig -> Printer ()) -> DeclSig -> Printer ()
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> DeclSig
DeclSig Sig GhcPs
s
  pretty' (KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
x) = StandaloneKindSig GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StandaloneKindSig GhcPs
x
  pretty' (DefD XDefD GhcPs
_ DefaultDecl GhcPs
x) = DefaultDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DefaultDecl GhcPs
x
  pretty' (ForD XForD GhcPs
_ ForeignDecl GhcPs
x) = ForeignDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ForeignDecl GhcPs
x
  pretty' (WarningD XWarningD GhcPs
_ WarnDecls GhcPs
x) = WarnDecls GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WarnDecls GhcPs
x
  pretty' (AnnD XAnnD GhcPs
_ AnnDecl GhcPs
x) = AnnDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty AnnDecl GhcPs
x
  pretty' (RuleD XRuleD GhcPs
_ RuleDecls GhcPs
x) = RuleDecls GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty RuleDecls GhcPs
x
  pretty' (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
sp) = SpliceDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SpliceDecl GhcPs
sp
  pretty' DocD {} = Printer ()
forall a. HasCallStack => a
docNode
  pretty' (RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
x) = RoleAnnotDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty RoleAnnotDecl GhcPs
x

instance Pretty (TyClDecl GhcPs) where
  pretty' :: TyClDecl GhcPs -> Printer ()
pretty' = TyClDecl GhcPs -> Printer ()
prettyTyClDecl

prettyTyClDecl :: TyClDecl GhcPs -> Printer ()
prettyTyClDecl :: TyClDecl GhcPs -> Printer ()
prettyTyClDecl (FamDecl XFamDecl GhcPs
_ FamilyDecl GhcPs
x) = FamilyDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FamilyDecl GhcPs
x
prettyTyClDecl SynDecl {XSynDecl GhcPs
LIdP GhcPs
LHsType GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdSExt :: XSynDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdRhs :: LHsType GhcPs
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
..} = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type "
  case LexicalFixity
tcdFixity of
    LexicalFixity
Prefix -> [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tcdLName Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars)
    LexicalFixity
Infix ->
      case LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars of
        (LHsTyVarBndr () GhcPs
l:LHsTyVarBndr () GhcPs
r:[LHsTyVarBndr () GhcPs]
xs) -> do
          [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
LHsTyVarBndr () GhcPs
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tcdLName, GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
LHsTyVarBndr () GhcPs
r]
          [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
[LHsTyVarBndr () GhcPs]
xs ((GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
x -> do
            Printer ()
space
            GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
x
        [LHsTyVarBndr () GhcPs]
_ -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough parameters are given."
  Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
tcdRhs
    ver :: Printer ()
ver = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"= " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
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 {XDataDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
HsDataDefn GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdDExt :: XDataDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdDataDefn :: HsDataDefn GhcPs
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
..} = do
  Printer ()
printDataNewtype Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
    Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (HsDataDefn GhcPs -> Maybe (LHsContext GhcPs)
forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt HsDataDefn GhcPs
tcdDataDefn) ((GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
  -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
x -> do
      Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
x
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>"
      Printer ()
newline
    GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tcdLName
  [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars
  HsDataDefn GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsDataDefn GhcPs
tcdDataDefn
  where
    printDataNewtype :: Printer ()
printDataNewtype =
      case HsDataDefn GhcPs -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
dd_ND HsDataDefn GhcPs
tcdDataDefn of
        NewOrData
DataType -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"data "
        NewOrData
NewType -> HasCallStack => String -> Printer ()
String -> Printer ()
string 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 {[LSig GhcPs]
[LDocDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LFamilyDecl GhcPs]
[LHsFunDep GhcPs]
Maybe (LHsContext GhcPs)
XClassDecl GhcPs
LIdP GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdCExt :: XClassDecl GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdFDs :: [LHsFunDep GhcPs]
tcdSigs :: [LSig GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdATs :: [LFamilyDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
..} = do
  if Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Bool
forall a. Maybe a -> Bool
isJust Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
tcdCtxt
    then Printer ()
verHead
    else Printer ()
horHead Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
verHead
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LSigBindFamily -> Printer ()) -> [LSigBindFamily] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSigBindFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LSigBindFamily]
sigsMethodsFamilies
  where
    horHead :: Printer ()
horHead = do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
"class "
      Printer ()
printNameAndTypeVariables
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (FunDep GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (FunDep GhcPs)]
[LHsFunDep GhcPs]
tcdFDs) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" | "
        [GenLocated SrcSpanAnnA (FunDep GhcPs)]
-> (GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenLocated SrcSpanAnnA (FunDep GhcPs)]
[LHsFunDep GhcPs]
tcdFDs ((GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \x :: GenLocated SrcSpanAnnA (FunDep GhcPs)
x@(L SrcSpanAnnA
_ FunDep {}) ->
          GenLocated SrcSpanAnnA (FunDep GhcPs)
-> (FunDep GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (FunDep GhcPs)
x ((FunDep GhcPs -> Printer ()) -> Printer ())
-> (FunDep GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(FunDep XCFunDep GhcPs
_ [LIdP GhcPs]
from [LIdP GhcPs]
to) ->
            [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
from [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->"] [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
to
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsMethodsFamilies) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
    verHead :: Printer ()
verHead = do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
"class " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
        Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
tcdCtxt ((GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
  -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx -> do
          GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx (([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
 -> Printer ())
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
            [] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"()"
            [GenLocated SrcSpanAnnA (HsType GhcPs)
x] -> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x
            [GenLocated SrcSpanAnnA (HsType GhcPs)]
xs -> [Printer ()] -> Printer ()
hvTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>"
          Printer ()
newline
        Printer ()
printNameAndTypeVariables
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (FunDep GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (FunDep GhcPs)]
[LHsFunDep GhcPs]
tcdFDs) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"| "
              Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
vCommaSep
                    (((GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
 -> [GenLocated SrcSpanAnnA (FunDep GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (FunDep GhcPs)]
-> (GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
-> [Printer ()]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (FunDep GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GenLocated SrcSpanAnnA (FunDep GhcPs)]
[LHsFunDep GhcPs]
tcdFDs ((GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
 -> [Printer ()])
-> (GenLocated SrcSpanAnnA (FunDep GhcPs) -> Printer ())
-> [Printer ()]
forall a b. (a -> b) -> a -> b
$ \x :: GenLocated SrcSpanAnnA (FunDep GhcPs)
x@(L SrcSpanAnnA
_ FunDep {}) ->
                       GenLocated SrcSpanAnnA (FunDep GhcPs)
-> (FunDep GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (FunDep GhcPs)
x ((FunDep GhcPs -> Printer ()) -> Printer ())
-> (FunDep GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(FunDep XCFunDep GhcPs
_ [LIdP GhcPs]
from [LIdP GhcPs]
to) ->
                         [Printer ()] -> Printer ()
spaced
                           ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
from [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->"] [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
to)
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsMethodsFamilies) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where"
    printNameAndTypeVariables :: Printer ()
printNameAndTypeVariables =
      case LexicalFixity
tcdFixity of
        LexicalFixity
Prefix ->
          [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tcdLName Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars)
        LexicalFixity
Infix ->
          case LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars of
            (LHsTyVarBndr () GhcPs
l:LHsTyVarBndr () GhcPs
r:[LHsTyVarBndr () GhcPs]
xs) -> do
              Printer () -> Printer ()
forall a. Printer a -> Printer a
parens
                (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
LHsTyVarBndr () GhcPs
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
tcdLName, GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
LHsTyVarBndr () GhcPs
r]
              [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
[LHsTyVarBndr () GhcPs]
xs
            [LHsTyVarBndr () GhcPs]
_ -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough parameters are given."
    sigsMethodsFamilies :: [LSigBindFamily]
sigsMethodsFamilies =
      [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList [LSig GhcPs]
tcdSigs (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
LHsBinds GhcPs
tcdMeths) [LFamilyDecl GhcPs]
tcdATs [] []

instance Pretty (InstDecl GhcPs) where
  pretty' :: InstDecl GhcPs -> Printer ()
pretty' ClsInstD {XClsInstD GhcPs
ClsInstDecl GhcPs
cid_d_ext :: XClsInstD GhcPs
cid_inst :: ClsInstDecl GhcPs
cid_d_ext :: forall pass. InstDecl pass -> XClsInstD pass
cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
..} = ClsInstDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ClsInstDecl GhcPs
cid_inst
  pretty' DataFamInstD {XDataFamInstD GhcPs
DataFamInstDecl GhcPs
dfid_ext :: XDataFamInstD GhcPs
dfid_inst :: DataFamInstDecl GhcPs
dfid_ext :: forall pass. InstDecl pass -> XDataFamInstD pass
dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
..} = DataFamInstDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DataFamInstDecl GhcPs
dfid_inst
  pretty' TyFamInstD {XTyFamInstD GhcPs
TyFamInstDecl GhcPs
tfid_ext :: XTyFamInstD GhcPs
tfid_inst :: TyFamInstDecl GhcPs
tfid_ext :: forall pass. InstDecl pass -> XTyFamInstD pass
tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
..} = TopLevelTyFamInstDecl -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (TopLevelTyFamInstDecl -> Printer ())
-> TopLevelTyFamInstDecl -> Printer ()
forall a b. (a -> b) -> a -> b
$ TyFamInstDecl GhcPs -> TopLevelTyFamInstDecl
TopLevelTyFamInstDecl TyFamInstDecl GhcPs
tfid_inst

instance Pretty (HsBind GhcPs) where
  pretty' :: HsBind GhcPs -> Printer ()
pretty' = HsBind GhcPs -> Printer ()
prettyHsBind

prettyHsBind :: HsBind GhcPs -> Printer ()
prettyHsBind :: HsBind GhcPs -> Printer ()
prettyHsBind FunBind {[CoreTickish]
XFunBind GhcPs GhcPs
LIdP GhcPs
MatchGroup GhcPs (LHsExpr GhcPs)
fun_ext :: XFunBind GhcPs GhcPs
fun_id :: LIdP GhcPs
fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_tick :: [CoreTickish]
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
..} = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches
prettyHsBind PatBind {([CoreTickish], [[CoreTickish]])
XPatBind GhcPs GhcPs
LPat GhcPs
GRHSs GhcPs (LHsExpr GhcPs)
pat_ext :: XPatBind GhcPs GhcPs
pat_lhs :: LPat GhcPs
pat_rhs :: GRHSs GhcPs (LHsExpr GhcPs)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_ticks :: forall idL idR.
HsBindLR idL idR -> ([CoreTickish], [[CoreTickish]])
..} = GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat_lhs Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
pat_rhs
prettyHsBind VarBind {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
#if !MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsBind AbsBinds {} = notGeneratedByParser
#endif
prettyHsBind (PatSynBind XPatSynBind GhcPs GhcPs
_ PatSynBind GhcPs GhcPs
x) = PatSynBind GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty PatSynBind GhcPs GhcPs
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 = space >> pretty (hswc_body params)
      vertical = do
        headLen <- printerLength printFunName
        indentSpaces <- getIndentSpaces
        if headLen < indentSpaces
          then space
          else newline
        indentedBlock
          $ indentedWithSpace 3
          $ pretty
          $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params
      printFunName = pretty $ head 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 sig _) =
    spaced
      [ string "{-# SPECIALISE"
      , pretty name
      , string "::"
      , pretty $ head sig
      , 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' :: Sig GhcPs -> Printer ()
pretty' (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
funName LHsSigWcType GhcPs
params) = do
    Printer ()
printFunName
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ::"
    Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
params)
      vertical :: Printer ()
vertical = do
        Int64
headLen <- Printer () -> Printer Int64
forall a. Printer a -> Printer Int64
printerLength Printer ()
printFunName
        Int64
indentSpaces <- Printer Int64
getIndentSpaces
        if Int64
headLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
indentSpaces
          then Printer ()
space
          else Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
3
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
          (GenLocated SrcSpanAnnA HsSigType' -> Printer ())
-> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsSigType'
HsSigTypeInsideVerticalFuncSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
params
      printFunName :: Printer ()
printFunName = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnN RdrName] -> GenLocated SrcSpanAnnN RdrName
forall a. HasCallStack => [a] -> a
head [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
funName
  pretty' (PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
names LHsSigType GhcPs
sig) =
    [Printer ()] -> Printer ()
spaced
      [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"pattern", [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
names, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
sig]
  pretty' (ClassOpSig XClassOpSig GhcPs
_ Bool
True [LIdP GhcPs]
funNames LHsSigType GhcPs
params) =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"default"
      , [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
funNames
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
      , GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
params HsSigType GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
      ]
  pretty' (ClassOpSig XClassOpSig GhcPs
_ Bool
False [LIdP GhcPs]
funNames LHsSigType GhcPs
params) = do
    [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
funNames
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ::"
    Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
params (HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsSigType' -> Printer ())
-> (HsSigType GhcPs -> HsSigType') -> HsSigType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig)
      ver :: Printer ()
ver = do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
3
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
params (HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsSigType' -> Printer ())
-> (HsSigType GhcPs -> HsSigType') -> HsSigType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig)
  pretty' IdSig {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
  pretty' (FixSig XFixSig GhcPs
_ FixitySig GhcPs
x) = FixitySig GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FixitySig GhcPs
x
  pretty' (InlineSig XInlineSig GhcPs
_ LIdP GhcPs
name InlinePragma
detail) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-#", InlinePragma -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty InlinePragma
detail, GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (SpecSig XSpecSig GhcPs
_ LIdP GhcPs
name [LHsSigType GhcPs]
sig InlinePragma
_) =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SPECIALISE"
      , GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
      , GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ())
-> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall a. HasCallStack => [a] -> a
head [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
[LHsSigType GhcPs]
sig
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"
      ]
  pretty' (SpecInstSig XSpecInstSig GhcPs
_ SourceText
_ LHsSigType GhcPs
sig) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SPECIALISE instance", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
sig, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (MinimalSig XMinimalSig GhcPs
_ SourceText
_ LBooleanFormula (LIdP GhcPs)
xs) =
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# MINIMAL " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
      LBooleanFormula (GenLocated SrcSpanAnnN RdrName) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LBooleanFormula (GenLocated SrcSpanAnnN RdrName)
LBooleanFormula (LIdP GhcPs)
xs
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"
  pretty' (SCCFunSig XSCCFunSig GhcPs
_ SourceText
_ LIdP GhcPs
name Maybe (XRec GhcPs StringLiteral)
_) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SCC", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (CompleteMatchSig XCompleteMatchSig GhcPs
_ SourceText
_ XRec GhcPs [LIdP GhcPs]
names Maybe (LIdP GhcPs)
_) =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# COMPLETE"
      , GenLocated SrcSpan [GenLocated SrcSpanAnnN RdrName]
-> ([GenLocated SrcSpanAnnN RdrName] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpan [GenLocated SrcSpanAnnN RdrName]
XRec GhcPs [LIdP GhcPs]
names ([Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnN RdrName] -> [Printer ()])
-> [GenLocated SrcSpanAnnN RdrName]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"
      ]
#endif
instance Pretty DeclSig where
  pretty' :: DeclSig -> Printer ()
pretty' (DeclSig (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
funName LHsSigWcType GhcPs
params)) = do
    Printer ()
printFunName
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ::"
    Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal = do
        Printer ()
space
        GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsSigType' -> Printer ())
-> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
params
      vertical :: Printer ()
vertical = do
        Int64
headLen <- Printer () -> Printer Int64
forall a. Printer a -> Printer Int64
printerLength Printer ()
printFunName
        Int64
indentSpaces <- Printer Int64
getIndentSpaces
        if Int64
headLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
indentSpaces
          then Printer ()
space Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
params)
          else do
            Printer ()
newline
            Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
              (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
3
              (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
              (GenLocated SrcSpanAnnA HsSigType' -> Printer ())
-> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
params
      printFunName :: Printer ()
printFunName = [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
funName
  pretty' (DeclSig Sig GhcPs
x) = Sig GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Sig GhcPs
x
#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 GhcPs -> Printer ()
pretty' HsDataDefn {[LConDecl GhcPs]
HsDeriving GhcPs
Maybe (LHsContext GhcPs)
Maybe (XRec GhcPs CType)
Maybe (LHsType GhcPs)
XCHsDataDefn GhcPs
NewOrData
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ext :: XCHsDataDefn GhcPs
dd_ND :: NewOrData
dd_ctxt :: Maybe (LHsContext GhcPs)
dd_cType :: Maybe (XRec GhcPs CType)
dd_kindSig :: Maybe (LHsType GhcPs)
dd_cons :: [LConDecl GhcPs]
dd_derivs :: HsDeriving GhcPs
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
..} =
    if Bool
isGADT
      then do
        Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
Maybe (LHsType GhcPs)
dd_kindSig ((GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsType GhcPs)
x -> do
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
" :: "
          GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl GhcPs]
dd_cons
      else do
        case [LConDecl GhcPs]
dd_cons of
          [] -> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock Printer ()
derivingsAfterNewline
          [x :: LConDecl GhcPs
x@(L SrcSpanAnnA
_ ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = RecCon {}})] -> do
            HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = "
            GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (ConDecl GhcPs)
LConDecl GhcPs
x
            Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
HsDeriving GhcPs
dd_derivs) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
space Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> Printer ()
printDerivings
          [LConDecl GhcPs
x] -> do
            HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ="
            Printer ()
newline
            Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (ConDecl GhcPs)
LConDecl GhcPs
x
              Printer ()
derivingsAfterNewline
          [LConDecl GhcPs]
_ ->
            Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              Printer ()
newline
              HasCallStack => String -> Printer ()
String -> Printer ()
string String
"= " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
vBarSep ((GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
[LConDecl GhcPs]
dd_cons)
              Printer ()
derivingsAfterNewline
    where
      isGADT :: Bool
isGADT =
        case [LConDecl GhcPs]
dd_cons of
          (L SrcSpanAnnA
_ ConDeclGADT {}:[LConDecl GhcPs]
_) -> Bool
True
          [LConDecl GhcPs]
_ -> Bool
False
      derivingsAfterNewline :: Printer ()
derivingsAfterNewline =
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
HsDeriving GhcPs
dd_derivs) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printDerivings
      printDerivings :: Printer ()
printDerivings = [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)
 -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
HsDeriving GhcPs
dd_derivs
#endif
instance Pretty (ClsInstDecl GhcPs) where
  pretty' :: ClsInstDecl GhcPs -> Printer ()
pretty' ClsInstDecl {[LSig GhcPs]
[LDataFamInstDecl GhcPs]
[LTyFamDefltDecl GhcPs]
Maybe (XRec GhcPs OverlapMode)
XCClsInstDecl GhcPs
LHsSigType GhcPs
LHsBinds GhcPs
cid_ext :: XCClsInstDecl GhcPs
cid_poly_ty :: LHsSigType GhcPs
cid_binds :: LHsBinds GhcPs
cid_sigs :: [LSig GhcPs]
cid_tyfam_insts :: [LTyFamDefltDecl GhcPs]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"instance " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
      Maybe (GenLocated SrcSpanAnnP OverlapMode)
-> (GenLocated SrcSpanAnnP OverlapMode -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GenLocated SrcSpanAnnP OverlapMode)
Maybe (XRec GhcPs OverlapMode)
cid_overlap_mode ((GenLocated SrcSpanAnnP OverlapMode -> Printer ()) -> Printer ())
-> (GenLocated SrcSpanAnnP OverlapMode -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnP OverlapMode
x -> do
        GenLocated SrcSpanAnnP OverlapMode -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnP OverlapMode
x
        Printer ()
space
      GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsSigType GhcPs -> HsSigType'
HsSigTypeInsideInstDecl GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
cid_poly_ty)
        Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsAndMethods) (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where")
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsAndMethods) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LSigBindFamily -> Printer ()) -> [LSigBindFamily] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSigBindFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LSigBindFamily]
sigsAndMethods
    where
      sigsAndMethods :: [LSigBindFamily]
sigsAndMethods =
        [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList
          [LSig GhcPs]
cid_sigs
          (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
LHsBinds GhcPs
cid_binds)
          []
          [LTyFamDefltDecl GhcPs]
cid_tyfam_insts
          [LDataFamInstDecl GhcPs]
cid_datafam_insts

instance Pretty (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' MG {Origin
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
mg_ext :: XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg_alts :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
mg_origin :: Origin
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
..} = GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
mg_alts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)

instance Pretty (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  pretty' :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
pretty' MG {Origin
XMG GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_ext :: XMG GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg_alts :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
mg_origin :: Origin
..} = GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
mg_alts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)

instance Pretty (HsExpr GhcPs) where
  pretty' :: HsExpr GhcPs -> Printer ()
pretty' = HsExpr GhcPs -> Printer ()
prettyHsExpr

prettyHsExpr :: HsExpr GhcPs -> Printer ()
prettyHsExpr :: HsExpr GhcPs -> Printer ()
prettyHsExpr (HsVar XVar GhcPs
_ LIdP GhcPs
bind) = GenLocated SrcSpanAnnN PrefixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixOp -> Printer ())
-> GenLocated SrcSpanAnnN PrefixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixOp)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixOp
PrefixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
bind
prettyHsExpr (HsUnboundVar XUnboundVar GhcPs
_ OccName
x) = OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
x
#if MIN_VERSION_ghc_lib_parser(9,6,1)
prettyHsExpr (HsOverLabel _ _ l) = string "#" >> string (unpackFS l)
#else
prettyHsExpr (HsOverLabel XOverLabel GhcPs
_ FastString
l) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string (FastString -> String
unpackFS FastString
l)
#endif
prettyHsExpr (HsIPVar XIPVar GhcPs
_ HsIPName
var) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"?" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsIPName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsIPName
var
prettyHsExpr (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
x) = HsOverLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsOverLit GhcPs
x
prettyHsExpr (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = HsLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLit GhcPs
l
prettyHsExpr (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
body) = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
body
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr (HsLamCase XLamCase GhcPs
_ LamCaseVariant
LamCase MatchGroup GhcPs (LHsExpr GhcPs)
matches) = LambdaCase -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LambdaCase -> Printer ()) -> LambdaCase -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs) -> CaseOrCases -> LambdaCase
LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
matches CaseOrCases
Case
prettyHsExpr (HsLamCase XLamCase GhcPs
_ LamCaseVariant
LamCases MatchGroup GhcPs (LHsExpr GhcPs)
matches) = LambdaCase -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LambdaCase -> Printer ()) -> LambdaCase -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs) -> CaseOrCases -> LambdaCase
LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
matches CaseOrCases
Cases
#else
prettyHsExpr (HsLamCase _ matches) = pretty $ LambdaCase matches Case
#endif
prettyHsExpr (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
  where
    horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
l, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
r]
    vertical :: Printer ()
vertical = do
      let (GenLocated SrcSpanAnnA (HsExpr GhcPs)
f, [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
args) =
            case LHsExpr GhcPs -> [LHsExpr GhcPs]
flatten LHsExpr GhcPs
l [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
r] of
              [] -> String
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs),
    [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
forall a. HasCallStack => String -> a
error String
"Invalid function application."
              (GenLocated SrcSpanAnnA (HsExpr GhcPs)
f':[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
args') -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
f', [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
args')
      Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
      Int64
spaces <- Printer Int64
getIndentSpaces
      GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
f
      Int64
col' <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
      let diff :: Int64
diff =
            Int64
col'
              Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
col
              Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
                  then Int64
spaces
                  else Int64
0
      if Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
spaces
        then Printer ()
space
        else Printer ()
newline
      Int64
spaces' <- Printer Int64
getIndentSpaces
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
spaces' (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
args
    flatten :: LHsExpr GhcPs -> [LHsExpr GhcPs]
    flatten :: LHsExpr GhcPs -> [LHsExpr GhcPs]
flatten (L (SrcSpanAnn (EpAnn Anchor
_ AnnListItem
_ EpAnnComments
cs) SrcSpan
_) (HsApp XApp GhcPs
_ LHsExpr GhcPs
l' LHsExpr GhcPs
r')) =
      LHsExpr GhcPs -> [LHsExpr GhcPs]
flatten LHsExpr GhcPs
l' [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [a] -> [a] -> [a]
++ [EpAnnComments -> LHsExpr GhcPs -> LHsExpr GhcPs
insertComments EpAnnComments
cs LHsExpr GhcPs
r']
    flatten LHsExpr GhcPs
x = [LHsExpr GhcPs
x]
    insertComments :: EpAnnComments -> LHsExpr GhcPs -> LHsExpr GhcPs
    insertComments :: EpAnnComments -> LHsExpr GhcPs -> LHsExpr GhcPs
insertComments EpAnnComments
cs (L s :: SrcSpanAnnA
s@SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = e :: EpAnn AnnListItem
e@EpAnn {comments :: forall ann. EpAnn ann -> EpAnnComments
comments = EpAnnComments
cs'}} HsExpr GhcPs
r') =
      SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA
s {ann :: EpAnn AnnListItem
ann = EpAnn AnnListItem
e {comments :: EpAnnComments
comments = EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
<> EpAnnComments
cs'}}) HsExpr GhcPs
r'
    insertComments EpAnnComments
_ LHsExpr GhcPs
x = LHsExpr GhcPs
x
#if MIN_VERSION_ghc_lib_parser(9,6,1)
prettyHsExpr (HsAppType _ l _ r) = do
  pretty l
  string " @"
  pretty r
#else
prettyHsExpr (HsAppType XAppTypeE GhcPs
_ LHsExpr GhcPs
l LHsWcType (NoGhcTc GhcPs)
r) = do
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
l
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
" @"
  HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
r
#endif
prettyHsExpr (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r) = InfixApp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool -> InfixApp
InfixApp LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r Bool
False)
prettyHsExpr (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
x SyntaxExpr GhcPs
_) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
expr LHsToken ")" GhcPs
_) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr
#else
prettyHsExpr (HsPar _ expr) = parens $ pretty expr
#endif
prettyHsExpr (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> InfixExpr
InfixExpr LHsExpr GhcPs
o)]
prettyHsExpr (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
r) = (InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> InfixExpr
InfixExpr LHsExpr GhcPs
o) Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
r
prettyHsExpr (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
full Boxity
_) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
  where
    horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
hTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsTupArg GhcPs -> Printer ()) -> [HsTupArg GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTupArg GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsTupArg GhcPs]
full
    vertical :: Printer ()
vertical =
      Printer () -> Printer ()
forall a. Printer a -> Printer a
parens
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
","
        ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsTupArg GhcPs -> Printer ()) -> [HsTupArg GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HsTupArg GhcPs
e -> Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsTupArg GhcPs -> Bool
forall {id}. HsTupArg id -> Bool
isMissing HsTupArg GhcPs
e) (Printer ()
space Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsTupArg GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsTupArg GhcPs
e)) [HsTupArg GhcPs]
full
    isMissing :: HsTupArg id -> Bool
isMissing Missing {} = Bool
True
    isMissing HsTupArg id
_ = Bool
False
prettyHsExpr (ExplicitSum XExplicitSum GhcPs
_ Arity
position Arity
numElem LHsExpr GhcPs
expr) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(#"
  [Arity] -> (Arity -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Arity
1 .. Arity
numElem] ((Arity -> Printer ()) -> Printer ())
-> (Arity -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Arity
idx -> do
    if Arity
idx Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
position
      then HasCallStack => String -> Printer ()
String -> Printer ()
string String
" " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" "
      else HasCallStack => String -> Printer ()
String -> Printer ()
string String
" "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arity
idx Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
< Arity
numElem) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"|"
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#)"
prettyHsExpr (HsCase XCase GhcPs
_ LHsExpr GhcPs
cond MatchGroup GhcPs (LHsExpr GhcPs)
arms) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"case " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
cond
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" of"
  if [GenLocated
   (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated
    (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> Bool)
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated
  (Anno
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
  [GenLocated
     (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
     (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
         (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
   [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
           (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
arms
    then HasCallStack => String -> Printer ()
String -> Printer ()
string String
" {}"
    else do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
arms
prettyHsExpr (HsIf XIf GhcPs
_ LHsExpr GhcPs
cond LHsExpr GhcPs
t LHsExpr GhcPs
f) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"if " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
cond
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed [String -> LHsExpr GhcPs -> Printer ()
branch String
"then " LHsExpr GhcPs
t, String -> LHsExpr GhcPs -> Printer ()
branch String
"else " LHsExpr GhcPs
f]
  where
    branch :: String -> LHsExpr GhcPs -> Printer ()
    branch :: String -> LHsExpr GhcPs -> Printer ()
branch String
str LHsExpr GhcPs
e =
      case LHsExpr GhcPs
e of
        (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
xs)) -> QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doStmt (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
xs
        (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
xs)) -> QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doStmt (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
xs
        LHsExpr GhcPs
_ -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
str Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
      where
        doStmt :: a -> GenLocated l [a] -> Printer ()
doStmt a
qDo GenLocated l [a]
stmts = do
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
str
          a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
qDo
          Printer ()
newline
          Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated l [a] -> ([a] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated l [a]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([a] -> [Printer ()]) -> [a] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Printer ()) -> [a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
prettyHsExpr (HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
guards) =
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"if "
    Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
lined ((GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated (SrcAnn NoEpAnns) GRHSExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated (SrcAnn NoEpAnns) GRHSExpr -> Printer ())
-> (GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> GenLocated (SrcAnn NoEpAnns) GRHSExpr)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> GRHSExpr)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated (SrcAnn NoEpAnns) GRHSExpr
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
GRHSExprMultiWayIf)) [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LGRHS GhcPs (LHsExpr GhcPs)]
guards)
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr (HsLet XLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
_ LHsExpr GhcPs
exprs) = LetIn -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LetIn -> Printer ()) -> LetIn -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> LHsExpr GhcPs -> LetIn
LetIn HsLocalBinds GhcPs
binds LHsExpr GhcPs
exprs
#else
prettyHsExpr (HsLet _ binds exprs) = pretty $ LetIn binds exprs
#endif
prettyHsExpr (HsDo XDo GhcPs
_ ListComp {} (L SrcSpanAnnL
_ [])) =
  String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (HsDo XDo GhcPs
_ ListComp {} (L SrcSpanAnnL
l (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs:[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs))) =
  GenLocated SrcSpanAnnL ListComprehension -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnL ListComprehension -> Printer ())
-> GenLocated SrcSpanAnnL ListComprehension -> Printer ()
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnL
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (ListComprehension -> GenLocated SrcSpanAnnL ListComprehension)
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall a b. (a -> b) -> a -> b
$ ExprLStmt GhcPs -> [ExprLStmt GhcPs] -> ListComprehension
ListComprehension GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ExprLStmt GhcPs
lhs [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
rhs
-- While the name contains 'Monad', 'MonadComp' is for list comprehensions.
prettyHsExpr (HsDo XDo GhcPs
_ MonadComp {} (L SrcSpanAnnL
_ [])) =
  String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (HsDo XDo GhcPs
_ MonadComp {} (L SrcSpanAnnL
l (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs:[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs))) =
  GenLocated SrcSpanAnnL ListComprehension -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnL ListComprehension -> Printer ())
-> GenLocated SrcSpanAnnL ListComprehension -> Printer ()
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnL
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (ListComprehension -> GenLocated SrcSpanAnnL ListComprehension)
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall a b. (a -> b) -> a -> b
$ ExprLStmt GhcPs -> [ExprLStmt GhcPs] -> ListComprehension
ListComprehension GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ExprLStmt GhcPs
lhs [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
rhs
prettyHsExpr (HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs)) =
  GenLocated SrcSpanAnnL DoExpression -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnL DoExpression -> Printer ())
-> GenLocated SrcSpanAnnL DoExpression -> Printer ()
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnL -> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (DoExpression -> GenLocated SrcSpanAnnL DoExpression)
-> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall a b. (a -> b) -> a -> b
$ [ExprLStmt GhcPs] -> QualifiedDo -> DoExpression
DoExpression [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
xs (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do)
prettyHsExpr (HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) (L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs)) =
  GenLocated SrcSpanAnnL DoExpression -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnL DoExpression -> Printer ())
-> GenLocated SrcSpanAnnL DoExpression -> Printer ()
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnL -> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l (DoExpression -> GenLocated SrcSpanAnnL DoExpression)
-> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall a b. (a -> b) -> a -> b
$ [ExprLStmt GhcPs] -> QualifiedDo -> DoExpression
DoExpression [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
xs (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo)
prettyHsExpr (HsDo XDo GhcPs
_ GhciStmtCtxt {} XRec GhcPs [ExprLStmt GhcPs]
_) = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"We're not using GHCi, are we?"
prettyHsExpr (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
xs) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
  where
    horizontal :: Printer ()
horizontal = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
    vertical :: Printer ()
vertical = [Printer ()] -> Printer ()
vList ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
[LHsExpr GhcPs]
xs
prettyHsExpr (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
name HsRecordBinds GhcPs
fields) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
  where
    horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
name, HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
HsRecordBinds GhcPs
fields]
    vertical :: Printer ()
vertical = do
      GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
name
      (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
HsRecordBinds GhcPs
fields) Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
HsRecordBinds GhcPs
fields))
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
name Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fields) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
name, ([GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
       (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
          (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printHorFields [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printHorFields Either
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fields]
    ver :: Printer ()
ver = do
      GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
name
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ([GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
       (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
          (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printHorFields [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printHorFields Either
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fields
            Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> ([GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
       (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
          (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printVerFields [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printVerFields Either
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
  [GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fields
    printHorFields ::
         (Pretty a, Pretty b, CommentExtraction l)
      => [GenLocated l (HsFieldBind a b)]
      -> Printer ()
    printHorFields :: forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printHorFields = [Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ())
-> ([GenLocated l (HsFieldBind a b)] -> [Printer ()])
-> [GenLocated l (HsFieldBind a b)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l (HsFieldBind a b) -> Printer ())
-> [GenLocated l (HsFieldBind a b)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated l (HsFieldBind a b)
-> (HsFieldBind a b -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
`printCommentsAnd` HsFieldBind a b -> Printer ()
forall {a} {a}.
(Pretty a, Pretty a) =>
HsFieldBind a a -> Printer ()
horField)
    printVerFields ::
         (Pretty a, Pretty b, CommentExtraction l)
      => [GenLocated l (HsFieldBind a b)]
      -> Printer ()
    printVerFields :: forall a b l.
(Pretty a, Pretty b, CommentExtraction l) =>
[GenLocated l (HsFieldBind a b)] -> Printer ()
printVerFields = [Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ())
-> ([GenLocated l (HsFieldBind a b)] -> [Printer ()])
-> [GenLocated l (HsFieldBind a b)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l (HsFieldBind a b) -> Printer ())
-> [GenLocated l (HsFieldBind a b)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated l (HsFieldBind a b) -> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
GenLocated l (HsFieldBind a a) -> Printer ()
printField
    printField :: GenLocated l (HsFieldBind a a) -> Printer ()
printField GenLocated l (HsFieldBind a a)
x = GenLocated l (HsFieldBind a a)
-> (HsFieldBind a a -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated l (HsFieldBind a a)
x ((HsFieldBind a a -> Printer ()) -> Printer ())
-> (HsFieldBind a a -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
(<-|>) (Printer () -> Printer () -> Printer ())
-> (HsFieldBind a a -> Printer ())
-> HsFieldBind a a
-> Printer ()
-> Printer ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsFieldBind a a -> Printer ()
forall {a} {a}.
(Pretty a, Pretty a) =>
HsFieldBind a a -> Printer ()
horField (HsFieldBind a a -> Printer () -> Printer ())
-> (HsFieldBind a a -> Printer ()) -> HsFieldBind a a -> Printer ()
forall a b.
(HsFieldBind a a -> a -> b)
-> (HsFieldBind a a -> a) -> HsFieldBind a a -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HsFieldBind a a -> Printer ()
forall {a} {a}.
(Pretty a, Pretty a) =>
HsFieldBind a a -> Printer ()
verField
    horField :: HsFieldBind a a -> Printer ()
horField HsFieldBind {a
a
Bool
XHsFieldBind a
hfbAnn :: XHsFieldBind a
hfbLHS :: a
hfbRHS :: a
hfbPun :: Bool
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
..} = do
      a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
hfbLHS
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = "
      a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
hfbRHS
    verField :: HsFieldBind a a -> Printer ()
verField HsFieldBind {a
a
Bool
XHsFieldBind a
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbAnn :: XHsFieldBind a
hfbLHS :: a
hfbRHS :: a
hfbPun :: Bool
..} = do
      a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
hfbLHS
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ="
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
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 XGetField GhcPs
_ LHsExpr GhcPs
e XRec GhcPs (DotFieldOcc GhcPs)
f) = do
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
  Printer ()
dot
  GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
XRec GhcPs (DotFieldOcc GhcPs)
f
prettyHsExpr HsProjection {NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
XProjection GhcPs
proj_ext :: XProjection GhcPs
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
..} =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
parens
    (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds
    ((GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
x -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."
        GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
x
prettyHsExpr (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
e LHsSigWcType (NoGhcTc GhcPs)
sig) = do
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
" :: "
  GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ())
-> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
sig
prettyHsExpr (ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x) = ArithSeqInfo GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ArithSeqInfo GhcPs
x
#if !MIN_VERSION_ghc_lib_parser(9,6,1)
prettyHsExpr (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
x) = HsSplice GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsSplice GhcPs
x
#endif
prettyHsExpr (HsProc XProc GhcPs
_ LPat GhcPs
pat x :: LHsCmdTop GhcPs
x@(L SrcAnn NoEpAnns
_ (HsCmdTop XCmdTop GhcPs
_ (L SrcSpanAnnA
_ (HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
xs))))) = do
  [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"proc", GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-> do"]
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
    (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
LHsCmdTop GhcPs
x (Printer () -> HsCmdTop GhcPs -> Printer ()
forall a b. a -> b -> a
const (GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
XRec GhcPs [CmdLStmt GhcPs]
xs ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)))
prettyHsExpr (HsProc XProc GhcPs
_ LPat GhcPs
pat LHsCmdTop GhcPs
body) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"proc", GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
LHsCmdTop GhcPs
body]
    ver :: Printer ()
ver = do
      [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"proc", GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->"]
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
LHsCmdTop GhcPs
body)
prettyHsExpr (HsStatic XStatic GhcPs
_ LHsExpr GhcPs
x) = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"static", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
prettyHsExpr (HsPragE XPragE GhcPs
_ HsPragE GhcPs
p LHsExpr GhcPs
x) = [Printer ()] -> Printer ()
spaced [HsPragE GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsPragE GhcPs
p, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x]
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr HsRecSel {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsExpr (HsTypedBracket XTypedBracket GhcPs
_ LHsExpr GhcPs
inner) = Printer () -> Printer ()
forall a. Printer a -> Printer a
typedBrackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
inner
prettyHsExpr (HsUntypedBracket XUntypedBracket GhcPs
_ HsQuote GhcPs
inner) = HsQuote GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsQuote GhcPs
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 -> Printer ()
pretty' (LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
matches CaseOrCases
caseOrCases) = do
    case CaseOrCases
caseOrCases of
      CaseOrCases
Case -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\case"
      CaseOrCases
Cases -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\cases"
    if [GenLocated
   (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated
    (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> Bool)
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated
  (Anno
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
  [GenLocated
     (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
     (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
         (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
   [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
           (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches
      then HasCallStack => String -> Printer ()
String -> Printer ()
string String
" {}"
      else do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches

instance Pretty (HsSigType GhcPs) where
  pretty' :: HsSigType GhcPs -> Printer ()
pretty' = HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (HsSigType' -> Printer ())
-> (HsSigType GhcPs -> HsSigType') -> HsSigType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTypeFor -> HsTypeDir -> HsSigType GhcPs -> HsSigType'
HsSigType' HsTypeFor
HsTypeForNormalDecl HsTypeDir
HsTypeNoDir

instance Pretty HsSigType' where
  pretty' :: HsSigType' -> Printer ()
pretty' (HsSigTypeInsideDeclSig HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_body :: forall pass. HsSigType pass -> LHsType pass
..}) =
    case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
      HsOuterExplicit XHsOuterExplicit GhcPs Specificity
_ [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
        [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs
        Printer ()
dot
        case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body of
          HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_xqual :: XQualTy GhcPs
hst_ctxt :: LHsContext GhcPs
hst_body :: LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
..} ->
            GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body ((HsType GhcPs -> Printer ()) -> Printer ())
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \HsType GhcPs
_ ->
              let hor :: Printer ()
hor = do
                    Printer ()
space
                    HorizontalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HorizontalContext -> Printer ())
-> HorizontalContext -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> HorizontalContext
HorizontalContext LHsContext GhcPs
hst_ctxt
                  ver :: Printer ()
ver = do
                    Printer ()
newline
                    VerticalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (VerticalContext -> Printer ()) -> VerticalContext -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> VerticalContext
VerticalContext LHsContext GhcPs
hst_ctxt
               in do
                    Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
                    Printer ()
newline
                    String -> Printer () -> Printer ()
prefixed String
"=> "
                      (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"-> "
                      ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsType GhcPs -> [LHsType GhcPs]
flatten LHsType GhcPs
hst_body
          HsType GhcPs
_ ->
            let hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideDeclSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body)
                ver :: Printer ()
ver =
                  Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsType GhcPs -> [LHsType GhcPs]
flatten LHsType GhcPs
sig_body)
             in Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
      HsOuterSigTyVarBndrs GhcPs
_ -> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideDeclSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body
    where
      flatten :: LHsType GhcPs -> [LHsType GhcPs]
      flatten :: LHsType GhcPs -> [LHsType GhcPs]
flatten (L SrcSpanAnnA
_ (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
l LHsType GhcPs
r)) = LHsType GhcPs -> [LHsType GhcPs]
flatten LHsType GhcPs
l [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. [a] -> [a] -> [a]
++ LHsType GhcPs -> [LHsType GhcPs]
flatten LHsType GhcPs
r
      flatten LHsType GhcPs
x = [LHsType GhcPs
x]
  pretty' (HsSigTypeInsideVerticalFuncSig HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
..}) =
    case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
      HsOuterExplicit XHsOuterExplicit GhcPs Specificity
_ [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
        [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs
        Printer ()
dot
        GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body ((HsType GhcPs -> Printer ()) -> Printer ())
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
          HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: XQualTy GhcPs
hst_ctxt :: LHsContext GhcPs
hst_body :: LHsType GhcPs
..} -> do
            (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HorizontalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> HorizontalContext
HorizontalContext LHsContext GhcPs
hst_ctxt))
              Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VerticalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> VerticalContext
VerticalContext LHsContext GhcPs
hst_ctxt))
            Printer ()
newline
            String -> Printer () -> Printer ()
prefixed String
"=> " (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body
          HsType GhcPs
x -> HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsType' -> Printer ()) -> HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> HsType'
HsTypeInsideDeclSig HsType GhcPs
x
      HsOuterSigTyVarBndrs GhcPs
_ -> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideDeclSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body
  pretty' (HsSigType' HsTypeFor
for HsTypeDir
dir HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
..}) = do
    case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
      HsOuterExplicit XHsOuterExplicit GhcPs Specificity
_ [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
        [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
xs
        Printer ()
dot
        Printer ()
space
      HsOuterSigTyVarBndrs GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsTypeFor -> HsTypeDir -> HsType GhcPs -> HsType'
HsType' HsTypeFor
for HsTypeDir
dir (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
sig_body

instance Pretty (ConDecl GhcPs) where
  pretty' :: ConDecl GhcPs -> Printer ()
pretty' = ConDecl GhcPs -> Printer ()
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 :: ConDecl GhcPs -> Printer ()
prettyConDecl ConDeclGADT {[LIdP GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclGADT GhcPs
LHsType GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
HsConDeclGADTDetails GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_names :: [LIdP GhcPs]
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_res_ty :: LHsType GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
..} = do
  [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
con_names
  Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = HasCallStack => String -> Printer ()
String -> Printer ()
string String
" :: " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> Printer ()
body
    ver :: Printer ()
ver = do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (HasCallStack => String -> Printer ()
String -> Printer ()
string String
":: " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> Printer ()
body)
    body :: Printer ()
body =
      case (Bool
forallNeeded, Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
con_mb_cxt) of
        (Bool
True, Just GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx) -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
withForallCtx GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx
        (Bool
True, Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Nothing) -> Printer ()
withForallOnly
        (Bool
False, Just GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx) -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
withCtxOnly GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx
        (Bool
False, Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Nothing) -> Printer ()
noForallCtx
    withForallOnly :: Printer ()
withForallOnly = do
      GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs
      (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
horArgs) Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
verArgs)
    noForallCtx :: Printer ()
noForallCtx = Printer ()
horArgs Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
verArgs
#if MIN_VERSION_ghc_lib_parser(9,4,1)
    withForallCtx :: GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
withForallCtx GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx = do
      GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs
      (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctx)) Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctx))
      Printer ()
newline
      String -> Printer () -> Printer ()
prefixed String
"=> " Printer ()
verArgs
    
    withCtxOnly :: GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
withCtxOnly GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx =
      (Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctx) Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" => " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
horArgs)
        Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
ctx) Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer () -> Printer ()
prefixed String
"=> " Printer ()
verArgs)
    
    horArgs :: Printer ()
horArgs =
      case HsConDeclGADTDetails GhcPs
con_g_args of
        PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
xs ->
          Printer () -> [Printer ()] -> Printer ()
inter (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" -> ")
            ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HsScaled HsArrow GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
x) -> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x) [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsType GhcPs)]
xs [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
con_res_ty]
        RecConGADT XRec GhcPs [LConDeclField GhcPs]
xs LHsUniToken "->" "\8594" GhcPs
_ -> Printer () -> [Printer ()] -> Printer ()
inter (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" -> ") [GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Printer ()
forall {a} {l}.
(Pretty a, CommentExtraction l) =>
GenLocated l [a] -> Printer ()
recArg GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
xs, GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
con_res_ty]
    
    verArgs :: Printer ()
verArgs =
      case HsConDeclGADTDetails GhcPs
con_g_args of
        PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
xs ->
          String -> [Printer ()] -> Printer ()
prefixedLined String
"-> "
            ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HsScaled HsArrow GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
x) -> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x) [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
[HsScaled GhcPs (LHsType GhcPs)]
xs [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
con_res_ty]
        RecConGADT XRec GhcPs [LConDeclField GhcPs]
xs LHsUniToken "->" "\8594" GhcPs
_ -> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " [GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Printer ()
forall {a} {l}.
(Pretty a, CommentExtraction l) =>
GenLocated l [a] -> Printer ()
recArg GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
XRec GhcPs [LConDeclField GhcPs]
xs, GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
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 :: GenLocated l [a] -> Printer ()
recArg GenLocated l [a]
xs = GenLocated l [a] -> ([a] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated l [a]
xs (([a] -> Printer ()) -> Printer ())
-> ([a] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[a]
xs' -> [Printer ()] -> Printer ()
vFields' ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (a -> Printer ()) -> [a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [a]
xs'
    
    forallNeeded :: Bool
forallNeeded =
      case GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> HsOuterSigTyVarBndrs GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs of
        HsOuterImplicit {} -> Bool
False
        HsOuterExplicit {} -> Bool
True
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyConDecl ConDeclH98 {con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
True, [LHsTyVarBndr Specificity GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_doc :: Maybe (LHsDoc GhcPs)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
..} =
  (do
     HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
     [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity GhcPs]
con_ex_tvs
     HasCallStack => String -> Printer ()
String -> Printer ()
string String
". ")
    Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> (do
           Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
Maybe (LHsContext GhcPs)
con_mb_cxt ((GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
  -> Printer ())
 -> Printer ())
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
c -> do
             Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
c
             HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>"
             Printer ()
newline
           GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
con_name
           HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
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 :: forall pass. ConDecl pass -> Bool
con_forall = Bool
False, [LHsTyVarBndr Specificity GhcPs]
Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_doc :: Maybe (LHsDoc GhcPs)
..} =
  case HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_args of
    (InfixCon HsScaled GhcPs (LHsType GhcPs)
l HsScaled GhcPs (LHsType GhcPs)
r) ->
      [Printer ()] -> Printer ()
spaced [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
HsScaled GhcPs (LHsType GhcPs)
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
con_name, HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
HsScaled GhcPs (LHsType GhcPs)
r]
    HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
_ -> do
      GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
con_name
      HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
HsConDetails
  Void
  (HsScaled GhcPs (LHsType GhcPs))
  (XRec GhcPs [LConDeclField GhcPs])
con_args

instance Pretty (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
pretty' = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
Match GhcPs (LHsExpr GhcPs) -> Printer ()
prettyMatchExpr

prettyMatchExpr :: Match GhcPs (LHsExpr GhcPs) -> Printer ()
prettyMatchExpr :: Match GhcPs (LHsExpr GhcPs) -> Printer ()
prettyMatchExpr Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = HsMatchContext GhcPs
LambdaExpr, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
..} = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\"
  Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats)
    (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. HasCallStack => [a] -> a
head [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats of
        LazyPat {} -> Printer ()
space
        BangPat {} -> Printer ()
space
        Pat GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats
  GRHSsExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GRHSsExpr -> Printer ()) -> GRHSsExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ GRHSExprType -> GRHSs GhcPs (LHsExpr GhcPs) -> GRHSsExpr
GRHSsExpr GRHSExprType
GRHSExprLambda GRHSs GhcPs (LHsExpr GhcPs)
m_grhss
prettyMatchExpr Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = HsMatchContext GhcPs
CaseAlt, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
..} = do
  (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats
  GRHSsExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GRHSsExpr -> Printer ()) -> GRHSsExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ GRHSExprType -> GRHSs GhcPs (LHsExpr GhcPs) -> GRHSsExpr
GRHSsExpr GRHSExprType
GRHSExprCase GRHSs GhcPs (LHsExpr GhcPs)
m_grhss
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyMatchExpr Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = LamCaseAlt {}, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
..} = do
  [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats
  GRHSsExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GRHSsExpr -> Printer ()) -> GRHSsExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ GRHSExprType -> GRHSs GhcPs (LHsExpr GhcPs) -> GRHSsExpr
GRHSsExpr GRHSExprType
GRHSExprCase GRHSs GhcPs (LHsExpr GhcPs)
m_grhss
#endif
prettyMatchExpr Match {[LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
HsMatchContext GhcPs
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_ctxt :: HsMatchContext GhcPs
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
..} =
  case HsMatchContext GhcPs -> LexicalFixity
forall p. HsMatchContext p -> LexicalFixity
mc_fixity HsMatchContext GhcPs
m_ctxt of
    LexicalFixity
Prefix -> do
      HsMatchContext GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsMatchContext GhcPs
m_ctxt
      [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats
      GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
m_grhss
    LexicalFixity
Infix -> do
      case ([GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats, HsMatchContext GhcPs
m_ctxt) of
        (GenLocated SrcSpanAnnA (Pat GhcPs)
l:GenLocated SrcSpanAnnA (Pat GhcPs)
r:[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs, FunRhs {LIdP (NoGhcTc GhcPs)
LexicalFixity
SrcStrictness
mc_fixity :: forall p. HsMatchContext p -> LexicalFixity
mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fixity :: LexicalFixity
mc_strictness :: SrcStrictness
mc_fun :: forall p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
..}) -> do
          [Printer ()] -> Printer ()
spaced
            ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP (NoGhcTc GhcPs)
mc_fun, GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
r]
                [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
xs
          GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (LHsExpr GhcPs)
m_grhss
        ([GenLocated SrcSpanAnnA (Pat GhcPs)], HsMatchContext GhcPs)
_ -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough parameters are passed."

instance Pretty (Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  pretty' :: Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
pretty' = Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
Match GhcPs (LHsCmd GhcPs) -> Printer ()
prettyMatchProc

prettyMatchProc :: Match GhcPs (LHsCmd GhcPs) -> Printer ()
prettyMatchProc :: Match GhcPs (LHsCmd GhcPs) -> Printer ()
prettyMatchProc Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = HsMatchContext GhcPs
LambdaExpr, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsCmd GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsCmd GhcPs)
..} = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\"
  Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats)
    (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. HasCallStack => [a] -> a
head [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats of
        LazyPat {} -> Printer ()
space
        BangPat {} -> Printer ()
space
        Pat GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss]
prettyMatchProc Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = HsMatchContext GhcPs
CaseAlt, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsCmd GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsCmd GhcPs)
..} =
  [Printer ()] -> Printer ()
spaced [(GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss]
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyMatchProc Match {m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt = LamCaseAlt {}, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_ext :: forall p body. Match p body -> XCMatch p body
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (LHsCmd GhcPs)
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsCmd GhcPs)
..} = do
  [Printer ()] -> Printer ()
spaced [(GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
m_pats, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss]
#endif
prettyMatchProc Match GhcPs (LHsCmd GhcPs)
_ = Printer ()
forall a. HasCallStack => a
notGeneratedByParser

instance Pretty (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
x Maybe Bool
_ SyntaxExpr GhcPs
_) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
pat GenLocated SrcSpanAnnA (HsExpr GhcPs)
body) = do
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" <-"
    Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
body
      ver :: Printer ()
ver = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)
  pretty' ApplicativeStmt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
  pretty' (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (L SrcSpanAnnA
loc (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r)) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) =
    GenLocated SrcSpanAnnA InfixApp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (SrcSpanAnnA -> InfixApp -> GenLocated SrcSpanAnnA InfixApp
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool -> InfixApp
InfixApp LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r Bool
True))
  pretty' (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
body
  pretty' (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsLocalBinds GhcPs
l) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"let " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsLocalBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLocalBinds GhcPs
l
  pretty' (ParStmt XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
xs HsExpr GhcPs
_ SyntaxExpr GhcPs
_) = [Printer ()] -> Printer ()
hvBarSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ParStmtBlock GhcPs GhcPs -> Printer ())
-> [ParStmtBlock GhcPs GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParStmtBlock GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [ParStmtBlock GhcPs GhcPs]
xs
  pretty' TransStmt {[(IdP GhcPs, IdP GhcPs)]
[ExprLStmt GhcPs]
Maybe (LHsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
LHsExpr GhcPs
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_form :: TransForm
trS_stmts :: [ExprLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: LHsExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
..} =
    [Printer ()] -> Printer ()
vCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
trS_stmts [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"then " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
trS_using]
  pretty' RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
SyntaxExpr GhcPs
recS_ext :: XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
recS_stmts :: XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
recS_later_ids :: [IdP GhcPs]
recS_rec_ids :: [IdP GhcPs]
recS_bind_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: SyntaxExpr GhcPs
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
..} =
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"rec " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
recS_stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)

instance Pretty (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  pretty' :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
pretty' (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
x Maybe Bool
_ SyntaxExpr GhcPs
_) = GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
x
  pretty' (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
_ LPat GhcPs
pat GenLocated SrcSpanAnnA (HsCmd GhcPs)
body) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"<-", GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
body]
      ver :: Printer ()
ver = do
        GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" <-"
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
body
  pretty' ApplicativeStmt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
  pretty' (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
_ GenLocated SrcSpanAnnA (HsCmd GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
body
  pretty' (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
_ HsLocalBinds GhcPs
l) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"let " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsLocalBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLocalBinds GhcPs
l
  pretty' (ParStmt XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
xs HsExpr GhcPs
_ SyntaxExpr GhcPs
_) = [Printer ()] -> Printer ()
hvBarSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ParStmtBlock GhcPs GhcPs -> Printer ())
-> [ParStmtBlock GhcPs GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParStmtBlock GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [ParStmtBlock GhcPs GhcPs]
xs
  pretty' TransStmt {[(IdP GhcPs, IdP GhcPs)]
[ExprLStmt GhcPs]
Maybe (LHsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
LHsExpr GhcPs
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
trS_form :: TransForm
trS_stmts :: [ExprLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: LHsExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
..} =
    [Printer ()] -> Printer ()
vCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
trS_stmts [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"then " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
trS_using]
  pretty' RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
SyntaxExpr GhcPs
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ext :: XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
recS_stmts :: XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
recS_later_ids :: [IdP GhcPs]
recS_rec_ids :: [IdP GhcPs]
recS_bind_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: SyntaxExpr GhcPs
..} =
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"rec " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
XRec
  GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
recS_stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)

instance Pretty StmtLRInsideVerticalList where
  pretty' :: StmtLRInsideVerticalList -> Printer ()
pretty' (StmtLRInsideVerticalList (ParStmt XParStmt GhcPs GhcPs (LHsExpr GhcPs)
_ [ParStmtBlock GhcPs GhcPs]
xs HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) =
    [Printer ()] -> Printer ()
vBarSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ParStmtBlock GhcPs GhcPs -> Printer ())
-> [ParStmtBlock GhcPs GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParStmtBlockInsideVerticalList -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (ParStmtBlockInsideVerticalList -> Printer ())
-> (ParStmtBlock GhcPs GhcPs -> ParStmtBlockInsideVerticalList)
-> ParStmtBlock GhcPs GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> ParStmtBlockInsideVerticalList
ParStmtBlockInsideVerticalList) [ParStmtBlock GhcPs GhcPs]
xs
  pretty' (StmtLRInsideVerticalList StmtLR GhcPs GhcPs (LHsExpr GhcPs)
x) = StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
StmtLR GhcPs GhcPs (LHsExpr GhcPs)
x

-- | For pattern matching.
instance Pretty (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))) where
  pretty' :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Printer ()
pretty' HsRecFields {[LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
Maybe (Located Arity)
rec_flds :: [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
rec_dotdot :: Maybe (Located Arity)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Arity)
..} = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal =
        case Maybe (Located Arity)
rec_dotdot of
          Just Located Arity
_ -> Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
".."
          Maybe (Located Arity)
Nothing -> [Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
[LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
rec_flds
      vertical :: Printer ()
vertical = [Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
[LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
rec_flds

-- | For record updates
instance Pretty (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' HsRecFields {[LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Maybe (Located Arity)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Arity)
rec_flds :: [LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rec_dotdot :: Maybe (Located Arity)
..} = [Printer ()] -> Printer ()
hvFields [Printer ()]
fieldPrinters
    where
      fieldPrinters :: [Printer ()]
fieldPrinters =
        (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rec_flds
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((Located Arity -> Printer ())
-> Maybe (Located Arity) -> Maybe (Printer ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Printer () -> Located Arity -> Printer ()
forall a b. a -> b -> a
const (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..")) Maybe (Located Arity)
rec_dotdot)

instance Pretty (HsType GhcPs) where
  pretty' :: HsType GhcPs -> Printer ()
pretty' = HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (HsType' -> Printer ())
-> (HsType GhcPs -> HsType') -> HsType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTypeFor -> HsTypeDir -> HsType GhcPs -> HsType'
HsType' HsTypeFor
HsTypeForNormalDecl HsTypeDir
HsTypeNoDir

instance Pretty HsType' where
  pretty' :: HsType' -> Printer ()
pretty' (HsTypeInsideVerticalFuncSig (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
a LHsType GhcPs
b)) = do
    GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
a
    Printer ()
newline
    String -> Printer () -> Printer ()
prefixed String
"-> " (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
b
  pretty' (HsTypeInsideDeclSig HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: XQualTy GhcPs
hst_ctxt :: LHsContext GhcPs
hst_body :: LHsType GhcPs
..}) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"=>", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body]
      ver :: Printer ()
ver = do
        Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt
        Printer ()
newline
        String -> Printer () -> Printer ()
prefixed String
"=> " (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body
  pretty' (HsTypeInsideDeclSig (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
a LHsType GhcPs
b)) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
a, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
b]
      ver :: Printer ()
ver = do
        GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
a
        Printer ()
newline
        String -> Printer () -> Printer ()
prefixed String
"-> " (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
b
  pretty' (HsTypeInsideInstDecl HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: XQualTy GhcPs
hst_ctxt :: LHsContext GhcPs
hst_body :: LHsType GhcPs
..}) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt), HasCallStack => String -> Printer ()
String -> Printer ()
string String
"=>", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body]
      ver :: Printer ()
ver = do
        Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt)
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>"
        Printer ()
newline
        GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body
  pretty' (HsTypeWithVerticalAppTy (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
l LHsType GhcPs
r)) = do
    GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeWithVerticalAppTy GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
l
    Printer ()
newline
    Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsType' -> Printer ())
-> GenLocated SrcSpanAnnA HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsType GhcPs -> HsType')
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA HsType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsType GhcPs -> HsType'
HsTypeWithVerticalAppTy GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
r
  pretty' (HsType' HsTypeFor
_ HsTypeDir
_ HsType GhcPs
x) = HsType GhcPs -> Printer ()
prettyHsType HsType GhcPs
x

prettyHsType :: HsType GhcPs -> Printer ()
prettyHsType :: HsType GhcPs -> Printer ()
prettyHsType (HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
tele LHsType GhcPs
body) = (HsForAllTelescope GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsForAllTelescope GhcPs
tele Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
body
prettyHsType HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: XQualTy GhcPs
hst_ctxt :: LHsContext GhcPs
hst_body :: LHsType GhcPs
..} = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced [Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"=>", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body]
    ver :: Printer ()
ver = do
      Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Context -> Printer ()) -> Context -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Context
Context LHsContext GhcPs
hst_ctxt
      [Printer ()] -> Printer ()
lined [HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>", Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hst_body]
prettyHsType (HsTyVar XTyVar GhcPs
_ PromotionFlag
NotPromoted LIdP GhcPs
x) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x
prettyHsType (HsTyVar XTyVar GhcPs
_ PromotionFlag
IsPromoted LIdP GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"'" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x
prettyHsType x :: HsType GhcPs
x@(HsAppTy XAppTy GhcPs
_ LHsType GhcPs
l LHsType GhcPs
r) = Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
  where
    hor :: Printer ()
hor = [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
l, GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
r]
    ver :: Printer ()
ver = HsType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsType' -> Printer ()) -> HsType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> HsType'
HsTypeWithVerticalAppTy HsType GhcPs
x
prettyHsType (HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
l LHsType GhcPs
r) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
l Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" @" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
r
prettyHsType (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
a LHsType GhcPs
b) = (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
a Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" -> ") Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
b
prettyHsType (HsListTy XListTy GhcPs
_ LHsType GhcPs
xs) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
xs
prettyHsType (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsUnboxedTuple []) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(# #)"
prettyHsType (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple []) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"()"
prettyHsType (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsUnboxedTuple [LHsType GhcPs]
xs) = [Printer ()] -> Printer ()
hvUnboxedTuple' ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
xs
prettyHsType (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
xs) =
  [Printer ()] -> Printer ()
hvTuple' ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
xs
prettyHsType (HsSumTy XSumTy GhcPs
_ [LHsType GhcPs]
xs) = [Printer ()] -> Printer ()
hvUnboxedSum' ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
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 XOpTy GhcPs
_ PromotionFlag
_ LHsType GhcPs
l LIdP GhcPs
op LHsType GhcPs
r) = do
  [String]
lineBreak <- (PrintState -> [String]) -> Printer [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> [String]
configLineBreaks (Config -> [String])
-> (PrintState -> Config) -> PrintState -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig)
  if GenLocated SrcSpanAnnN RdrName -> String
forall a. Outputable a => a -> String
showOutputable GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lineBreak
    then do
      GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
l
      Printer ()
newline
      GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
op
      Printer ()
space
      GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
r
    else [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
op, GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
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 XParTy GhcPs
_ LHsType GhcPs
inside) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
inside
prettyHsType (HsIParamTy XIParamTy GhcPs
_ XRec GhcPs HsIPName
x LHsType GhcPs
ty) =
  [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"?" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated (SrcAnn NoEpAnns) HsIPName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) HsIPName
XRec GhcPs HsIPName
x, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty]
prettyHsType HsStarTy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"*"
prettyHsType (HsKindSig XKindSig GhcPs
_ LHsType GhcPs
t LHsType GhcPs
k) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
k]
prettyHsType (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
sp) = HsSplice GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsSplice GhcPs
sp
prettyHsType HsDocTy {} = Printer ()
forall a. HasCallStack => a
docNode
prettyHsType (HsBangTy XBangTy GhcPs
_ HsSrcBang
pack LHsType GhcPs
x) = HsSrcBang -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsSrcBang
pack Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
x
prettyHsType (HsRecTy XRecTy GhcPs
_ [LConDeclField GhcPs]
xs) = [Printer ()] -> Printer ()
hvFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
[LConDeclField GhcPs]
xs
prettyHsType (HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
_ [LHsType GhcPs]
xs) =
  case [LHsType GhcPs]
xs of
    [] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"'[]"
    [LHsType GhcPs]
_ -> [Printer ()] -> Printer ()
hvPromotedList ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
xs
prettyHsType (HsExplicitTupleTy XExplicitTupleTy GhcPs
_ [LHsType GhcPs]
xs) = [Printer ()] -> Printer ()
hPromotedTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
xs
prettyHsType (HsTyLit XTyLit GhcPs
_ HsTyLit
x) = HsTyLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsTyLit
x
prettyHsType HsWildCardTy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"_"
prettyHsType XHsType {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser

instance Pretty (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
pretty' = GRHSsExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (GRHSsExpr -> Printer ())
-> (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GRHSsExpr)
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHSExprType -> GRHSs GhcPs (LHsExpr GhcPs) -> GRHSsExpr
GRHSsExpr GRHSExprType
GRHSExprNormal

instance Pretty GRHSsExpr where
  pretty' :: GRHSsExpr -> Printer ()
pretty' (GRHSsExpr {grhssExpr :: GRHSsExpr -> GRHSs GhcPs (LHsExpr GhcPs)
grhssExpr = GRHSs {[LGRHS GhcPs (LHsExpr GhcPs)]
XCGRHSs GhcPs (LHsExpr GhcPs)
HsLocalBinds GhcPs
grhssExt :: XCGRHSs GhcPs (LHsExpr GhcPs)
grhssGRHSs :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhssLocalBinds :: HsLocalBinds GhcPs
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
..}, GRHSExprType
grhssExprType :: GRHSExprType
grhssExprType :: GRHSsExpr -> GRHSExprType
..}) = do
    (GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated (SrcAnn NoEpAnns) GRHSExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated (SrcAnn NoEpAnns) GRHSExpr -> Printer ())
-> (GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> GenLocated (SrcAnn NoEpAnns) GRHSExpr)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> GRHSExpr)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated (SrcAnn NoEpAnns) GRHSExpr
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
grhssExprType)) [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[LGRHS GhcPs (LHsExpr GhcPs)]
grhssGRHSs
    case (HsLocalBinds GhcPs
grhssLocalBinds, GRHSExprType
grhssExprType) of
      (HsValBinds {}, GRHSExprType
GRHSExprCase) ->
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          Printer ()
newline
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsLocalBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLocalBinds GhcPs
grhssLocalBinds
      (HsValBinds XHsValBinds GhcPs GhcPs
epa HsValBindsLR GhcPs GhcPs
lr, GRHSExprType
_) ->
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
2
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed
              [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where"
              , GenLocated (EpAnn AnnList) (HsValBindsLR GhcPs GhcPs)
-> (HsValBindsLR GhcPs GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (EpAnn AnnList
-> HsValBindsLR GhcPs GhcPs
-> GenLocated (EpAnn AnnList) (HsValBindsLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L XHsValBinds GhcPs GhcPs
EpAnn AnnList
epa HsValBindsLR GhcPs GhcPs
lr) (Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
2 (Printer () -> Printer ())
-> (HsValBindsLR GhcPs GhcPs -> Printer ())
-> HsValBindsLR GhcPs GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsValBindsLR GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
              ]
      (HsLocalBinds GhcPs, GRHSExprType)
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Pretty (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where
  pretty' :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
pretty' GRHSs {[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
HsLocalBinds GhcPs
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssExt :: XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
grhssGRHSs :: [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
grhssLocalBinds :: HsLocalBinds GhcPs
..} = do
    (GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
 -> Printer ())
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated (SrcAnn NoEpAnns) GRHSProc -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated (SrcAnn NoEpAnns) GRHSProc -> Printer ())
-> (GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
    -> GenLocated (SrcAnn NoEpAnns) GRHSProc)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> GRHSProc)
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated (SrcAnn NoEpAnns) GRHSProc
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> GRHSProc
GRHS GhcPs (LHsCmd GhcPs) -> GRHSProc
GRHSProc) [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
grhssGRHSs
    case HsLocalBinds GhcPs
grhssLocalBinds of
      (HsValBinds XHsValBinds GhcPs GhcPs
epa HsValBindsLR GhcPs GhcPs
lr) ->
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
2
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed
              [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where"
              , GenLocated (EpAnn AnnList) (HsValBindsLR GhcPs GhcPs)
-> (HsValBindsLR GhcPs GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (EpAnn AnnList
-> HsValBindsLR GhcPs GhcPs
-> GenLocated (EpAnn AnnList) (HsValBindsLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L XHsValBinds GhcPs GhcPs
EpAnn AnnList
epa HsValBindsLR GhcPs GhcPs
lr) (Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
2 (Printer () -> Printer ())
-> (HsValBindsLR GhcPs GhcPs -> Printer ())
-> HsValBindsLR GhcPs GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsValBindsLR GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
              ]
      HsLocalBinds GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Pretty (HsMatchContext GhcPs) where
  pretty' :: HsMatchContext GhcPs -> Printer ()
pretty' = HsMatchContext GhcPs -> Printer ()
prettyHsMatchContext

prettyHsMatchContext :: HsMatchContext GhcPs -> Printer ()
prettyHsMatchContext :: HsMatchContext GhcPs -> Printer ()
prettyHsMatchContext FunRhs {LIdP (NoGhcTc GhcPs)
LexicalFixity
SrcStrictness
mc_fixity :: forall p. HsMatchContext p -> LexicalFixity
mc_fun :: forall p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_fun :: LIdP (NoGhcTc GhcPs)
mc_fixity :: LexicalFixity
mc_strictness :: SrcStrictness
..} = SrcStrictness -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SrcStrictness
mc_strictness Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP (NoGhcTc GhcPs)
mc_fun
prettyHsMatchContext HsMatchContext GhcPs
LambdaExpr = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyHsMatchContext HsMatchContext GhcPs
CaseAlt = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyHsMatchContext IfAlt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext ArrowMatchCtxt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext PatBindRhs {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext PatBindGuards {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext RecUpd {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext StmtCtxt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext ThPatSplice {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext ThPatQuote {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext PatSyn {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsMatchContext LamCaseAlt {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
#endif
instance Pretty (ParStmtBlock GhcPs GhcPs) where
  pretty' :: ParStmtBlock GhcPs GhcPs -> Printer ()
pretty' (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [ExprLStmt GhcPs]
xs [IdP GhcPs]
_ SyntaxExpr GhcPs
_) = [Printer ()] -> Printer ()
hvCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
xs

instance Pretty ParStmtBlockInsideVerticalList where
  pretty' :: ParStmtBlockInsideVerticalList -> Printer ()
pretty' (ParStmtBlockInsideVerticalList (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [ExprLStmt GhcPs]
xs [IdP GhcPs]
_ SyntaxExpr GhcPs
_)) =
    [Printer ()] -> Printer ()
vCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
xs

instance Pretty RdrName where
  pretty' :: RdrName -> Printer ()
pretty' = PrefixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (PrefixOp -> Printer ())
-> (RdrName -> PrefixOp) -> RdrName -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> PrefixOp
PrefixOp

instance Pretty (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
pretty' = GRHSExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (GRHSExpr -> Printer ())
-> (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> GRHSExpr)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
GRHSExprNormal

instance Pretty GRHSExpr where
  pretty' :: GRHSExpr -> Printer ()
pretty' (GRHSExpr {grhsExpr :: GRHSExpr -> GRHS GhcPs (LHsExpr GhcPs)
grhsExpr = (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [] LHsExpr GhcPs
body), GRHSExprType
grhsExprType :: GRHSExprType
grhsExprType :: GRHSExpr -> GRHSExprType
..}) = do
    Printer ()
space
    GRHSExprType -> Printer ()
rhsSeparator GRHSExprType
grhsExprType
    case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body of
      HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
stmts ->
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body (Printer () -> HsExpr GhcPs -> Printer ()
forall a b. a -> b -> a
const (QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doExpr (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
stmts))
      HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
stmts ->
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body (Printer () -> HsExpr GhcPs -> Printer ()
forall a b. a -> b -> a
const (QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doExpr (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
stmts))
      OpApp XOpApp GhcPs
_ (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ DoExpr {} XRec GhcPs [ExprLStmt GhcPs]
_)) LHsExpr GhcPs
_ LHsExpr GhcPs
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body
      OpApp XOpApp GhcPs
_ (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ MDoExpr {} XRec GhcPs [ExprLStmt GhcPs]
_)) LHsExpr GhcPs
_ LHsExpr GhcPs
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body
      HsExpr GhcPs
_ ->
        let hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body
            ver :: Printer ()
ver = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body)
         in Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      doExpr :: a -> GenLocated l [a] -> Printer ()
doExpr a
qDo GenLocated l [a]
stmts = do
        Printer ()
space
        a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
qDo
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated l [a] -> ([a] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated l [a]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([a] -> [Printer ()]) -> [a] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Printer ()) -> [a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
  pretty' (GRHSExpr {grhsExpr :: GRHSExpr -> GRHS GhcPs (LHsExpr GhcPs)
grhsExpr = (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [ExprLStmt GhcPs]
guards LHsExpr GhcPs
body), GRHSExprType
grhsExprType :: GRHSExpr -> GRHSExprType
grhsExprType :: GRHSExprType
..}) = do
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GRHSExprType
grhsExprType GRHSExprType -> GRHSExprType -> Bool
forall a. Eq a => a -> a -> Bool
== GRHSExprType
GRHSExprMultiWayIf) Printer ()
newline
    (if GRHSExprType
grhsExprType GRHSExprType -> GRHSExprType -> Bool
forall a. Eq a => a -> a -> Bool
== GRHSExprType
GRHSExprMultiWayIf
       then Printer () -> Printer ()
forall a. a -> a
id
       else Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
"| " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
vCommaSep ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
guards)
      Printer ()
space
      GRHSExprType -> Printer ()
rhsSeparator GRHSExprType
grhsExprType
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body ((HsExpr GhcPs -> Printer ()) -> Printer ())
-> (HsExpr GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
        HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
stmts -> QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doExpr (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
stmts
        HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
stmts -> QualifiedDo
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
a -> GenLocated l [a] -> Printer ()
doExpr (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo) GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
stmts
        HsExpr GhcPs
x ->
          let hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsExpr GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsExpr GhcPs
x
              ver :: Printer ()
ver = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (HsExpr GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsExpr GhcPs
x)
           in Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      doExpr :: a -> GenLocated l [a] -> Printer ()
doExpr a
qDo GenLocated l [a]
stmts = do
        Printer ()
space
        a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
qDo
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated l [a] -> ([a] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated l [a]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([a] -> [Printer ()]) -> [a] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Printer ()) -> [a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty))

instance Pretty GRHSProc where
  pretty' :: GRHSProc -> Printer ()
pretty' (GRHSProc (GRHS XCGRHS GhcPs (LHsCmd GhcPs)
_ [ExprLStmt GhcPs]
guards LHsCmd GhcPs
body)) =
    if [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
guards
      then Printer ()
bodyPrinter
      else do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
"| " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
vCommaSep ((GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
guards)
          Printer ()
space
          Printer ()
bodyPrinter
    where
      bodyPrinter :: Printer ()
bodyPrinter = do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->"
        GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> (HsCmd GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
body ((HsCmd GhcPs -> Printer ()) -> Printer ())
-> (HsCmd GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
          HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
stmts ->
            let hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnL [CmdLStmt GhcPs]
-> ([CmdLStmt GhcPs] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnL [CmdLStmt GhcPs]
XRec GhcPs [CmdLStmt GhcPs]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([CmdLStmt GhcPs] -> [Printer ()])
-> [CmdLStmt GhcPs]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CmdLStmt GhcPs -> Printer ()) -> [CmdLStmt GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CmdLStmt GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
                ver :: Printer ()
ver = do
                  Printer ()
newline
                  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnL [CmdLStmt GhcPs]
-> ([CmdLStmt GhcPs] -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnL [CmdLStmt GhcPs]
XRec GhcPs [CmdLStmt GhcPs]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([CmdLStmt GhcPs] -> [Printer ()])
-> [CmdLStmt GhcPs]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CmdLStmt GhcPs -> Printer ()) -> [CmdLStmt GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CmdLStmt GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
             in Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
          HsCmd GhcPs
x ->
            let hor :: Printer ()
hor = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsCmd GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsCmd GhcPs
x
                ver :: Printer ()
ver = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (HsCmd GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsCmd GhcPs
x)
             in Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver

instance Pretty EpaCommentTok where
  pretty' :: EpaCommentTok -> Printer ()
pretty' (EpaLineComment String
c) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
c
  pretty' (EpaBlockComment String
c) =
    case String -> [String]
lines String
c of
      [] -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [String
x] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
x
      (String
x:[String]
xs) -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
x
        Printer ()
newline
        -- 'indentedWithFixedLevel 0' is used because an 'EpaBlockComment'
        -- contains indent spaces for all lines except the first one.
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
0 (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (String -> Printer ()) -> [String] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => String -> Printer ()
String -> Printer ()
string [String]
xs
  pretty' EpaCommentTok
_ = Printer ()
forall a. HasCallStack => a
docNode

instance Pretty (SpliceDecl GhcPs) where
  pretty' :: SpliceDecl GhcPs -> Printer ()
pretty' (SpliceDecl XSpliceDecl GhcPs
_ XRec GhcPs (HsSplice GhcPs)
sp SpliceExplicitFlag
_) = GenLocated SrcSpanAnnA (HsSplice GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSplice GhcPs)
XRec GhcPs (HsSplice GhcPs)
sp
#if !MIN_VERSION_ghc_lib_parser(9,6,1)
instance Pretty (HsSplice GhcPs) where
  pretty' :: HsSplice GhcPs -> Printer ()
pretty' (HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
_ IdP GhcPs
_ LHsExpr GhcPs
body) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"$$" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body
  pretty' (HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
DollarSplice IdP GhcPs
_ LHsExpr GhcPs
body) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"$" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
body
  pretty' (HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
BareSplice IdP GhcPs
_ LHsExpr GhcPs
body) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
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 XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
l SrcSpan
_ FastString
r) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty IdP GhcPs
RdrName
l
      Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
0
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> String -> String -> [Printer ()]
printers [] String
""
        (String -> [Printer ()]) -> String -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
r
    where
      printers :: [Printer ()] -> String -> String -> [Printer ()]
printers [Printer ()]
ps String
s [] = [Printer ()] -> [Printer ()]
forall a. [a] -> [a]
reverse (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> String
forall a. [a] -> [a]
reverse String
s) Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: [Printer ()]
ps)
      printers [Printer ()]
ps String
s (Char
'\n':String
xs) =
        [Printer ()] -> String -> String -> [Printer ()]
printers (Printer ()
newline Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> String
forall a. [a] -> [a]
reverse String
s) Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: [Printer ()]
ps) String
"" String
xs
      printers [Printer ()]
ps String
s (Char
x:String
xs) = [Printer ()] -> String -> String -> [Printer ()]
printers [Printer ()]
ps (Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
s) String
xs
  pretty' HsSpliced {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
#endif
instance Pretty (Pat GhcPs) where
  pretty' :: Pat GhcPs -> Printer ()
pretty' = Pat GhcPs -> Printer ()
prettyPat

instance Pretty PatInsidePatDecl where
  pretty' :: PatInsidePatDecl -> Printer ()
pretty' (PatInsidePatDecl (ConPat {pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = (InfixCon LPat GhcPs
l LPat GhcPs
r), XConPat GhcPs
XRec GhcPs (ConLikeP GhcPs)
pat_con_ext :: XConPat GhcPs
pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con_ext :: forall p. Pat p -> XConPat p
pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
..})) =
    [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con, GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
r]
  pretty' (PatInsidePatDecl Pat GhcPs
x) = Pat GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Pat GhcPs
x

prettyPat :: Pat GhcPs -> Printer ()
prettyPat :: Pat GhcPs -> Printer ()
prettyPat WildPat {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"_"
prettyPat (VarPat XVarPat GhcPs
_ LIdP GhcPs
x) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x
prettyPat (LazyPat XLazyPat GhcPs
_ LPat GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"~" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
x
#if MIN_VERSION_ghc_lib_parser(9,6,1)
prettyPat (AsPat _ a _ b) = pretty a >> string "@" >> pretty b
#else
prettyPat (AsPat XAsPat GhcPs
_ LIdP GhcPs
a LPat GhcPs
b) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
a Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"@" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
b
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyPat (ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
inner LHsToken ")" GhcPs
_) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
inner
#else
prettyPat (ParPat _ inner) = parens $ pretty inner
#endif
prettyPat (BangPat XBangPat GhcPs
_ LPat GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"!" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
x
prettyPat (ListPat XListPat GhcPs
_ [LPat GhcPs]
xs) = [Printer ()] -> Printer ()
hList ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
xs
prettyPat (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
Boxed) = [Printer ()] -> Printer ()
hTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
pats
prettyPat (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
Unboxed) = [Printer ()] -> Printer ()
hUnboxedTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
pats
prettyPat (SumPat XSumPat GhcPs
_ LPat GhcPs
x Arity
position Arity
numElem) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(#"
  [Arity] -> (Arity -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Arity
1 .. Arity
numElem] ((Arity -> Printer ()) -> Printer ())
-> (Arity -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Arity
idx -> do
    if Arity
idx Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
position
      then HasCallStack => String -> Printer ()
String -> Printer ()
string String
" " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
x Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" "
      else HasCallStack => String -> Printer ()
String -> Printer ()
string String
" "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arity
idx Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
< Arity
numElem) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"|"
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#)"
prettyPat ConPat {XConPat GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsConDetails
  (HsPatSigType (NoGhcTc GhcPs))
  (LPat GhcPs)
  (HsRecFields GhcPs (LPat GhcPs))
pat_args :: forall p. Pat p -> HsConPatDetails p
pat_con_ext :: forall p. Pat p -> XConPat p
pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con_ext :: XConPat GhcPs
pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_args :: HsConDetails
  (HsPatSigType (NoGhcTc GhcPs))
  (LPat GhcPs)
  (HsRecFields GhcPs (LPat GhcPs))
..} =
  case HsConDetails
  (HsPatSigType (NoGhcTc GhcPs))
  (LPat GhcPs)
  (HsRecFields GhcPs (LPat GhcPs))
pat_args of
    PrefixCon [HsPatSigType (NoGhcTc GhcPs)]
_ [LPat GhcPs]
as -> do
      GenLocated SrcSpanAnnN PrefixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixOp -> Printer ())
-> GenLocated SrcSpanAnnN PrefixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixOp)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixOp
PrefixOp GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con
      [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
as
    RecCon HsRecFields GhcPs (LPat GhcPs)
rec -> (GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> RecConPat -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsRecFields GhcPs (LPat GhcPs) -> RecConPat
RecConPat HsRecFields GhcPs (LPat GhcPs)
rec)
    InfixCon LPat GhcPs
a LPat GhcPs
b -> do
      GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
a
      RdrName -> Printer () -> Printer ()
unlessSpecialOp (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con) Printer ()
space
      GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con
      RdrName -> Printer () -> Printer ()
unlessSpecialOp (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
XRec GhcPs (ConLikeP GhcPs)
pat_con) Printer ()
space
      GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
b
prettyPat (ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
l LPat GhcPs
r) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
l, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
r]
prettyPat (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
x) = HsSplice GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsSplice GhcPs
x
prettyPat (LitPat XLitPat GhcPs
_ HsLit GhcPs
x) = HsLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLit GhcPs
x
prettyPat (NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
x Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_) = GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
XRec GhcPs (HsOverLit GhcPs)
x
prettyPat (NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
n Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"+" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
XRec GhcPs (HsOverLit GhcPs)
k
prettyPat (SigPat XSigPat GhcPs
_ LPat GhcPs
l HsPatSigType (NoGhcTc GhcPs)
r) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
l, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", HsPatSigType GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsPatSigType (NoGhcTc GhcPs)
HsPatSigType GhcPs
r]

instance Pretty RecConPat where
  pretty' :: RecConPat -> Printer ()
pretty' (RecConPat HsRecFields {[LHsRecField GhcPs (LPat GhcPs)]
Maybe (Located Arity)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Arity)
rec_flds :: [LHsRecField GhcPs (LPat GhcPs)]
rec_dotdot :: Maybe (Located Arity)
..}) =
    case [Printer ()]
fieldPrinters of
      [] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{}"
      [Printer ()
x] -> Printer () -> Printer ()
forall a. Printer a -> Printer a
braces Printer ()
x
      [Printer ()]
xs -> [Printer ()] -> Printer ()
hvFields [Printer ()]
xs
    where
      fieldPrinters :: [Printer ()]
fieldPrinters =
        (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnA RecConField -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA RecConField -> Printer ())
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))
    -> GenLocated SrcSpanAnnA RecConField)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
   (GenLocated SrcSpanAnnA (Pat GhcPs))
 -> RecConField)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> GenLocated SrcSpanAnnA RecConField
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
-> RecConField
HsFieldBind (LFieldOcc GhcPs) (LPat GhcPs) -> RecConField
RecConField) [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
[LHsRecField GhcPs (LPat GhcPs)]
rec_flds
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((Located Arity -> Printer ())
-> Maybe (Located Arity) -> Maybe (Printer ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Printer () -> Located Arity -> Printer ()
forall a b. a -> b -> a
const (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..")) Maybe (Located Arity)
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' :: SigBindFamily -> Printer ()
pretty' (Sig Sig GhcPs
x) = DeclSig -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (DeclSig -> Printer ()) -> DeclSig -> Printer ()
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> DeclSig
DeclSig Sig GhcPs
x
  pretty' (Bind HsBind GhcPs
x) = HsBind GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsBind GhcPs
x
  pretty' (TypeFamily FamilyDecl GhcPs
x) = FamilyDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FamilyDecl GhcPs
x
  pretty' (TyFamInst TyFamInstDecl GhcPs
x) = TyFamInstDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TyFamInstDecl GhcPs
x
  pretty' (DataFamInst DataFamInstDecl GhcPs
x) = DataFamInstDecl' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (DataFamInstDecl' -> Printer ()) -> DataFamInstDecl' -> Printer ()
forall a b. (a -> b) -> a -> b
$ DataFamInstDecl GhcPs -> DataFamInstDecl'
DataFamInstDeclInsideClassInst DataFamInstDecl GhcPs
x

instance Pretty EpaComment where
  pretty' :: EpaComment -> Printer ()
pretty' EpaComment {RealSrcSpan
EpaCommentTok
ac_tok :: EpaCommentTok
ac_prior_tok :: RealSrcSpan
ac_tok :: EpaComment -> EpaCommentTok
ac_prior_tok :: EpaComment -> RealSrcSpan
..} = EpaCommentTok -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaCommentTok
ac_tok

instance Pretty (HsLocalBindsLR GhcPs GhcPs) where
  pretty' :: HsLocalBinds GhcPs -> Printer ()
pretty' (HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
lr) = HsValBindsLR GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsValBindsLR GhcPs GhcPs
lr
  pretty' (HsIPBinds XHsIPBinds GhcPs GhcPs
_ HsIPBinds GhcPs
x) = HsIPBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsIPBinds GhcPs
x
  pretty' EmptyLocalBinds {} =
    String -> Printer ()
forall a. HasCallStack => String -> a
error
      String
"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' :: HsValBindsLR GhcPs GhcPs -> Printer ()
pretty' (ValBinds XValBinds GhcPs GhcPs
_ LHsBinds GhcPs
methods [LSig GhcPs]
sigs) = [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LSigBindFamily -> Printer ()) -> [LSigBindFamily] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSigBindFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LSigBindFamily]
sigsAndMethods
    where
      sigsAndMethods :: [LSigBindFamily]
sigsAndMethods =
        [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList [LSig GhcPs]
sigs (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
LHsBinds GhcPs
methods) [] [] []
  pretty' XValBindsLR {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage

instance Pretty (HsTupArg GhcPs) where
  pretty' :: HsTupArg GhcPs -> Printer ()
pretty' (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e
  pretty' Missing {} = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- This appears in a tuple section.
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty RecConField where
  pretty' :: RecConField -> Printer ()
pretty' (RecConField HsFieldBind {Bool
XHsFieldBind (LFieldOcc GhcPs)
LPat GhcPs
LFieldOcc GhcPs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbLHS :: LFieldOcc GhcPs
hfbRHS :: LPat GhcPs
hfbPun :: Bool
..}) = do
    GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
LFieldOcc GhcPs
hfbLHS
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = "
      GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
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
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Printer ()
pretty' HsFieldBind {Bool
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
GenLocated SrcSpanAnnA (Pat GhcPs)
XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbAnn :: XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (Pat GhcPs)
hfbPun :: Bool
..} = (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbLHS Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = ") Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
hfbRHS

-- | For record updates.
instance Pretty
           (HsFieldBind
              (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
              (GenLocated SrcSpanAnnA (HsExpr GhcPs))) where
  pretty' :: HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' HsFieldBind {Bool
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbAnn :: XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbPun :: Bool
..} = do
    GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbLHS
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ="
      Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal = Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS
      vertical :: Printer ()
vertical = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
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 GhcPs -> Printer ()
pretty' FieldOcc {XCFieldOcc GhcPs
XRec GhcPs RdrName
foExt :: XCFieldOcc GhcPs
foLabel :: XRec GhcPs RdrName
foExt :: forall pass. FieldOcc pass -> XCFieldOcc pass
foLabel :: forall pass. FieldOcc pass -> XRec pass RdrName
..} = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
XRec GhcPs RdrName
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' :: HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Printer ()
pretty' (PrefixCon [Void]
_ [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
      vertical :: Printer ()
vertical = Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
xs
  pretty' (RecCon GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
x) =
    GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
x (([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> Printer ())
 -> Printer ())
-> ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rec -> do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rec
  pretty' InfixCon {} =
    String -> Printer ()
forall a. HasCallStack => String -> a
error
      String
"Cannot handle here because 'InfixCon' does not have the information of its constructor."

instance Pretty a => Pretty (HsScaled GhcPs a) where
  pretty' :: HsScaled GhcPs a -> Printer ()
pretty' (HsScaled HsArrow GhcPs
_ a
x) = a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
x

instance Pretty (ConDeclField GhcPs) where
  pretty' :: ConDeclField GhcPs -> Printer ()
pretty' ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
XConDeclField GhcPs
LHsType GhcPs
cd_fld_ext :: XConDeclField GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_type :: LHsType GhcPs
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
..}
    -- Here, we *ignore* the 'cd_fld_doc' field because doc strings are
    -- also stored as comments, and printing both results in duplicated
    -- comments.
   = do
    [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
[LFieldOcc GhcPs]
cd_fld_names
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" :: "
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
cd_fld_type

instance Pretty InfixExpr where
  pretty' :: InfixExpr -> Printer ()
pretty' (InfixExpr (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ LIdP GhcPs
bind))) = GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
bind
  pretty' (InfixExpr LHsExpr GhcPs
x) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x

instance Pretty InfixApp where
  pretty' :: InfixApp -> Printer ()
pretty' InfixApp {Bool
LHsExpr GhcPs
lhs :: LHsExpr GhcPs
op :: LHsExpr GhcPs
rhs :: LHsExpr GhcPs
immediatelyAfterDo :: Bool
lhs :: InfixApp -> LHsExpr GhcPs
op :: InfixApp -> LHsExpr GhcPs
rhs :: InfixApp -> LHsExpr GhcPs
immediatelyAfterDo :: InfixApp -> Bool
..} = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> InfixExpr
InfixExpr LHsExpr GhcPs
op), GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rhs]
      vertical :: Printer ()
vertical =
        case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
op of
          Fixity SourceText
_ Arity
_ FixityDirection
InfixL -> Printer ()
leftAssoc
          Fixity SourceText
_ Arity
_ FixityDirection
InfixR -> Printer ()
rightAssoc
          Fixity SourceText
_ Arity
_ FixityDirection
InfixN -> Printer ()
noAssoc
      leftAssoc :: Printer ()
leftAssoc = [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
allOperantsAndOperatorsLeftAssoc
      rightAssoc :: Printer ()
rightAssoc = [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
allOperantsAndOperatorsRightAssoc
      noAssoc :: Printer ()
noAssoc
        | L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
_) <- LHsExpr GhcPs
lhs
        , GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o = Printer ()
leftAssoc
        | Bool
otherwise = Printer ()
rightAssoc
      prettyOps :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
xs)] = do
        [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (InfixExpr -> Printer ()) -> InfixExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> InfixExpr
InfixExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o, QualifiedDo -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (QualifiedDo -> Printer ()) -> QualifiedDo -> Printer ()
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do]
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
xs ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
      prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
m) XRec GhcPs [ExprLStmt GhcPs]
xs)] = do
        [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (InfixExpr -> Printer ()) -> InfixExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> InfixExpr
InfixExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o, QualifiedDo -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (QualifiedDo -> Printer ()) -> QualifiedDo -> Printer ()
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo]
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
XRec GhcPs [ExprLStmt GhcPs]
xs ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
      prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, r :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
r@(L SrcSpanAnnA
_ HsLam {})] = do
        [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (InfixExpr -> Printer ()) -> InfixExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> InfixExpr
InfixExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
r]
      prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
o, r :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
r@(L SrcSpanAnnA
_ HsLamCase {})] = do
        [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (InfixExpr -> Printer ()) -> InfixExpr -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> InfixExpr
InfixExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
r]
      prettyOps (GenLocated SrcSpanAnnA (HsExpr GhcPs)
l:[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs) = do
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
l
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
f [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs
        where
          f :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
f (GenLocated SrcSpanAnnA (HsExpr GhcPs)
o:GenLocated SrcSpanAnnA (HsExpr GhcPs)
r:[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
rems) = do
            (InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> InfixExpr
InfixExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o) Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
r
            Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
rems) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              Printer ()
newline
              [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Printer ()
f [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
rems
          f [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
_ =
            String -> Printer ()
forall a. HasCallStack => String -> a
error
              String
"The number of the sum of operants and operators should be odd."
      prettyOps [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
_ = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Too short list."
      findFixity :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity GenLocated SrcSpanAnnA (HsExpr GhcPs)
o = Fixity -> Maybe Fixity -> Fixity
forall a. a -> Maybe a -> a
fromMaybe Fixity
defaultFixity (Maybe Fixity -> Fixity) -> Maybe Fixity -> Fixity
forall a b. (a -> b) -> a -> b
$ String -> [(String, Fixity)] -> Maybe Fixity
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (LHsExpr GhcPs -> String
varToStr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o) [(String, Fixity)]
fixities
      allOperantsAndOperatorsLeftAssoc :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
allOperantsAndOperatorsLeftAssoc = [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. [a] -> [a]
reverse ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rhs GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect LHsExpr GhcPs
lhs
        where
          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r))
            | GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o = GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
r GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect LHsExpr GhcPs
l
          collect LHsExpr GhcPs
x = [LHsExpr GhcPs
x]
      allOperantsAndOperatorsRightAssoc :: [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
allOperantsAndOperatorsRightAssoc = GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect LHsExpr GhcPs
rhs
        where
          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r))
            | GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o = GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
o GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect LHsExpr GhcPs
r
          collect LHsExpr GhcPs
x = [LHsExpr GhcPs
x]
      isSameAssoc :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity -> Fixity SourceText
_ Arity
lv FixityDirection
d) = Arity
lv Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
level Bool -> Bool -> Bool
&& FixityDirection
d FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
dir
      Fixity SourceText
_ Arity
level FixityDirection
dir = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
op

instance Pretty a => Pretty (BooleanFormula a) where
  pretty' :: BooleanFormula a -> Printer ()
pretty' (Var a
x) = a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
x
  pretty' (And [LBooleanFormula a]
xs) = [Printer ()] -> Printer ()
hvCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LBooleanFormula a -> Printer ())
-> [LBooleanFormula a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LBooleanFormula a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LBooleanFormula a]
xs
  pretty' (Or [LBooleanFormula a]
xs) = [Printer ()] -> Printer ()
hvBarSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LBooleanFormula a -> Printer ())
-> [LBooleanFormula a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LBooleanFormula a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LBooleanFormula a]
xs
  pretty' (Parens LBooleanFormula a
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LBooleanFormula a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LBooleanFormula a
x

instance Pretty (FieldLabelStrings GhcPs) where
  pretty' :: FieldLabelStrings GhcPs -> Printer ()
pretty' (FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
xs) = [Printer ()] -> Printer ()
hDotSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)]
[XRec GhcPs (DotFieldOcc GhcPs)]
xs

instance Pretty (AmbiguousFieldOcc GhcPs) where
  pretty' :: AmbiguousFieldOcc GhcPs -> Printer ()
pretty' (Unambiguous XUnambiguous GhcPs
_ GenLocated SrcSpanAnnN RdrName
name) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
name
  pretty' (Ambiguous XAmbiguous GhcPs
_ GenLocated SrcSpanAnnN RdrName
name) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
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' :: ImportDecl GhcPs -> Printer ()
pretty' decl :: ImportDecl GhcPs
decl@ImportDecl {Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
IsBootInterface
SourceText
XCImportDecl GhcPs
XRec GhcPs ModuleName
ImportDeclPkgQual GhcPs
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"import "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsBootInterface
ideclSource IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SOURCE #-} "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSafe (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"safe "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ImportDeclQualifiedStyle
ideclQualified ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
NotQualified) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"qualified "
    Maybe StringLiteral -> (StringLiteral -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (ImportDecl GhcPs -> Maybe StringLiteral
packageName ImportDecl GhcPs
decl) ((StringLiteral -> Printer ()) -> Printer ())
-> (StringLiteral -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \StringLiteral
x -> do
      StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StringLiteral
x
      Printer ()
space
    LocatedA ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LocatedA ModuleName
XRec GhcPs ModuleName
ideclName
    Maybe (LocatedA ModuleName)
-> (LocatedA ModuleName -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (LocatedA ModuleName)
Maybe (XRec GhcPs ModuleName)
ideclAs ((LocatedA ModuleName -> Printer ()) -> Printer ())
-> (LocatedA ModuleName -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LocatedA ModuleName
x -> do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" as "
      LocatedA ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LocatedA ModuleName
x
    Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ((Bool,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding (((Bool,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
  -> Printer ())
 -> Printer ())
-> ((Bool,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Bool
x, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
ps) -> do
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" hiding")
      (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
ps ([Printer ()] -> Printer ()
hTuple ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty))
        Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (Printer ()
newline
                Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
ps ([Printer ()] -> Printer ()
vTuple ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)))
#endif
packageName :: ImportDecl GhcPs -> Maybe StringLiteral
#if MIN_VERSION_ghc_lib_parser(9,4,1)
packageName :: ImportDecl GhcPs -> Maybe StringLiteral
packageName (ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual -> RawPkgQual StringLiteral
name) = StringLiteral -> Maybe StringLiteral
forall a. a -> Maybe a
Just StringLiteral
name
packageName ImportDecl GhcPs
_ = Maybe StringLiteral
forall a. Maybe a
Nothing
#else
packageName = ideclPkgQual
#endif
instance Pretty (HsDerivingClause GhcPs) where
  pretty' :: HsDerivingClause GhcPs -> Printer ()
pretty' HsDerivingClause { deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Just strategy :: LDerivStrategy GhcPs
strategy@(L SrcAnn NoEpAnns
_ ViaStrategy {})
                           , XCHsDerivingClause GhcPs
LDerivClauseTys GhcPs
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
..
                           } =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"deriving", GenLocated SrcSpanAnnC (DerivClauseTys GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
LDerivClauseTys GhcPs
deriv_clause_tys, GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
LDerivStrategy GhcPs
strategy]
  pretty' HsDerivingClause {Maybe (LDerivStrategy GhcPs)
XCHsDerivingClause GhcPs
LDerivClauseTys GhcPs
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_tys :: LDerivClauseTys GhcPs
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"deriving "
    Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy ((GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
x -> do
      GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
x
      Printer ()
space
    GenLocated SrcSpanAnnC (DerivClauseTys GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
LDerivClauseTys GhcPs
deriv_clause_tys

instance Pretty (DerivClauseTys GhcPs) where
  pretty' :: DerivClauseTys GhcPs -> Printer ()
pretty' (DctSingle XDctSingle GhcPs
_ LHsSigType GhcPs
ty) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
ty
  pretty' (DctMulti XDctMulti GhcPs
_ [LHsSigType GhcPs]
ts) = [Printer ()] -> Printer ()
hvTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
[LHsSigType GhcPs]
ts

instance Pretty OverlapMode where
  pretty' :: OverlapMode -> Printer ()
pretty' NoOverlap {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' Overlappable {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# OVERLAPPABLE #-}"
  pretty' Overlapping {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# OVERLAPPING #-}"
  pretty' Overlaps {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# OVERLAPS #-}"
  pretty' Incoherent {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# INCOHERENT #-}"

instance Pretty StringLiteral where
  pretty' :: StringLiteral -> Printer ()
pretty' = StringLiteral -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output

-- | This instance is for type family declarations inside a class declaration.
instance Pretty (FamilyDecl GhcPs) where
  pretty' :: FamilyDecl GhcPs -> Printer ()
pretty' FamilyDecl {Maybe (LInjectivityAnn GhcPs)
TopLevelFlag
XCFamilyDecl GhcPs
LIdP GhcPs
LFamilyResultSig GhcPs
LexicalFixity
LHsQTyVars GhcPs
FamilyInfo GhcPs
fdExt :: XCFamilyDecl GhcPs
fdInfo :: FamilyInfo GhcPs
fdTopLevel :: TopLevelFlag
fdLName :: LIdP GhcPs
fdTyVars :: LHsQTyVars GhcPs
fdFixity :: LexicalFixity
fdResultSig :: LFamilyResultSig GhcPs
fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs)
fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity
fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string
      (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ case FamilyInfo GhcPs
fdInfo of
          FamilyInfo GhcPs
DataFamily -> String
"data"
          FamilyInfo GhcPs
OpenTypeFamily -> String
"type"
          ClosedTypeFamily {} -> String
"type"
    case TopLevelFlag
fdTopLevel of
      TopLevelFlag
TopLevel -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" family "
      TopLevelFlag
NotTopLevel -> Printer ()
space
    GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
fdLName
    [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
fdTyVars
    case GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
-> FamilyResultSig GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
LFamilyResultSig GhcPs
fdResultSig of
      NoSig {} -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      TyVarSig {} -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = "
        GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
LFamilyResultSig GhcPs
fdResultSig
      FamilyResultSig GhcPs
_ -> do
        Printer ()
space
        GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
LFamilyResultSig GhcPs
fdResultSig
    Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn ((GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)
  -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)
x -> do
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" | "
      GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)
x
    case FamilyInfo GhcPs
fdInfo of
      ClosedTypeFamily (Just [LTyFamInstEqn GhcPs]
xs) -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
[LTyFamInstEqn GhcPs]
xs
      FamilyInfo GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Pretty (FamilyResultSig GhcPs) where
  pretty' :: FamilyResultSig GhcPs -> Printer ()
pretty' NoSig {} = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pretty' (KindSig XCKindSig GhcPs
_ LHsType GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
":: " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
x
  pretty' (TyVarSig XTyVarSig GhcPs
_ LHsTyVarBndr () GhcPs
x) = GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
LHsTyVarBndr () GhcPs
x

instance Pretty (HsTyVarBndr a GhcPs) where
  pretty' :: HsTyVarBndr a GhcPs -> Printer ()
pretty' (UserTyVar XUserTyVar GhcPs
_ a
_ LIdP GhcPs
x) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x
  pretty' (KindedTyVar XKindedTyVar GhcPs
_ a
_ LIdP GhcPs
name LHsType GhcPs
ty) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty]

instance Pretty (InjectivityAnn GhcPs) where
  pretty' :: InjectivityAnn GhcPs -> Printer ()
pretty' (InjectivityAnn XCInjectivityAnn GhcPs
_ LIdP GhcPs
from [LIdP GhcPs]
to) =
    [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
from Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->" Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
to

instance Pretty (ArithSeqInfo GhcPs) where
  pretty' :: ArithSeqInfo GhcPs -> Printer ()
pretty' (From LHsExpr GhcPs
from) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
from, HasCallStack => String -> Printer ()
String -> Printer ()
string String
".."]
  pretty' (FromThen LHsExpr GhcPs
from LHsExpr GhcPs
next) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
from Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
comma Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
next, HasCallStack => String -> Printer ()
String -> Printer ()
string String
".."]
  pretty' (FromTo LHsExpr GhcPs
from LHsExpr GhcPs
to) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
from, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
to]
  pretty' (FromThenTo LHsExpr GhcPs
from LHsExpr GhcPs
next LHsExpr GhcPs
to) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
      (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
from Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
comma Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
next, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
to]

instance Pretty (HsForAllTelescope GhcPs) where
  pretty' :: HsForAllTelescope GhcPs -> Printer ()
pretty' HsForAllVis {[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_xvis :: XHsForAllVis GhcPs
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
    [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
[LHsTyVarBndr () GhcPs]
hsf_vis_bndrs
    Printer ()
dot
  pretty' HsForAllInvis {[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: XHsForAllInvis GhcPs
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
    [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs
    Printer ()
dot

instance Pretty InfixOp where
  pretty' :: InfixOp -> Printer ()
pretty' (InfixOp (Unqual OccName
name)) = OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
backticksIfNotSymbol OccName
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
name
  pretty' (InfixOp (Qual ModuleName
modName OccName
name)) =
    OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
backticksIfNotSymbol OccName
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ModuleName
modName
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."
      OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
name
  pretty' (InfixOp Orig {}) = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' (InfixOp (Exact Name
name)) = OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
backticksIfNotSymbol OccName
occ (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
occ
    where
      occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name

instance Pretty PrefixOp where
  pretty' :: PrefixOp -> Printer ()
pretty' (PrefixOp (Unqual OccName
name)) = OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
parensIfSymbol OccName
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
name
  pretty' (PrefixOp (Qual ModuleName
modName OccName
name)) =
    OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
parensIfSymbol OccName
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ModuleName
modName
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."
      OccName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OccName
name
  pretty' (PrefixOp Orig {}) = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' (PrefixOp (Exact Name
name)) = OccName -> Printer () -> Printer ()
forall a. OccName -> Printer a -> Printer a
parensIfSymbol OccName
occ (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Name -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output Name
name
    where
      occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name

instance Pretty Context where
  pretty' :: Context -> Printer ()
pretty' (Context LHsContext GhcPs
xs) =
    HorizontalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> HorizontalContext
HorizontalContext LHsContext GhcPs
xs) Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> VerticalContext -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsContext GhcPs -> VerticalContext
VerticalContext LHsContext GhcPs
xs)
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty HorizontalContext where
  pretty' :: HorizontalContext -> Printer ()
pretty' (HorizontalContext LHsContext GhcPs
xs) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
constraintsParens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
xs ([Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
    where
      constraintsParens :: Printer a -> Printer a
constraintsParens =
        case LHsContext GhcPs
xs of
          (L SrcSpanAnnC
_ []) -> Printer a -> Printer a
forall a. Printer a -> Printer a
parens
          (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType GhcPs)
_]) -> Printer a -> Printer a
forall a. a -> a
id
          LHsContext GhcPs
_ -> Printer a -> Printer a
forall a. Printer a -> Printer a
parens

instance Pretty VerticalContext where
  pretty' :: VerticalContext -> Printer ()
pretty' (VerticalContext full :: LHsContext GhcPs
full@(L SrcSpanAnnC
_ [])) =
    GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
full (Printer () -> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ()
forall a b. a -> b -> a
const (Printer ()
 -> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"()")
  pretty' (VerticalContext full :: LHsContext GhcPs
full@(L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType GhcPs)
x])) =
    GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
full (Printer () -> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ()
forall a b. a -> b -> a
const (Printer ()
 -> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x)
  pretty' (VerticalContext LHsContext GhcPs
xs) = GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
xs ([Printer ()] -> Printer ()
vTuple ([Printer ()] -> Printer ())
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()])
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
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' :: ModuleName -> Printer ()
pretty' = ModuleName -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output

instance Pretty ModuleNameWithPrefix where
  pretty' :: ModuleNameWithPrefix -> Printer ()
pretty' (ModuleNameWithPrefix ModuleName
name) = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"module", ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ModuleName
name]

instance Pretty (IE GhcPs) where
  pretty' :: IE GhcPs -> Printer ()
pretty' (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = LIEWrappedName RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
  pretty' (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = LIEWrappedName RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
  pretty' (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
    LIEWrappedName RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
    HasCallStack => String -> Printer ()
String -> Printer ()
string 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 :: IE GhcPs
x@IEThingWith {} =
    case String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> String
forall a. Outputable a => a -> String
showOutputable IE GhcPs
x of
      [] -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [String
x'] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
x'
      [String]
xs -> do
        HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
xs
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
0 (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> [String] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail [String]
xs
  pretty' (IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
name) = GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ())
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ModuleName -> ModuleNameWithPrefix)
-> LocatedA ModuleName
-> GenLocated SrcSpanAnnA ModuleNameWithPrefix
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> ModuleNameWithPrefix
ModuleNameWithPrefix LocatedA ModuleName
XRec GhcPs ModuleName
name
  pretty' IEGroup {} = Printer ()
forall a. HasCallStack => a
docNode
  pretty' IEDoc {} = Printer ()
forall a. HasCallStack => a
docNode
  pretty' IEDocNamed {} = Printer ()
forall a. HasCallStack => a
docNode

instance Pretty (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  pretty' :: FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Printer ()
pretty' FamEqn {HsTyPats GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
..} = do
    GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
feqn_tycon
    [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
HsTyPats GhcPs
feqn_pats
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = "
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs

-- | Pretty-print a data instance.
instance Pretty (FamEqn GhcPs (HsDataDefn GhcPs)) where
  pretty' :: FamEqn GhcPs (HsDataDefn GhcPs) -> Printer ()
pretty' = FamEqn' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (FamEqn' -> Printer ())
-> (FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn')
-> FamEqn GhcPs (HsDataDefn GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
FamEqnTopLevel

instance Pretty FamEqn' where
  pretty' :: FamEqn' -> Printer ()
pretty' FamEqn' {famEqn :: FamEqn' -> FamEqn GhcPs (HsDataDefn GhcPs)
famEqn = FamEqn {HsTyPats GhcPs
XCFamEqn GhcPs (HsDataDefn GhcPs)
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
HsDataDefn GhcPs
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: HsDataDefn GhcPs
..}, DataFamInstDeclFor
famEqnFor :: DataFamInstDeclFor
famEqnFor :: FamEqn' -> DataFamInstDeclFor
..} = do
    [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
prefix Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
feqn_tycon Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
HsTyPats GhcPs
feqn_pats
    HsDataDefn GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsDataDefn GhcPs
feqn_rhs
    where
      prefix :: String
prefix =
        case DataFamInstDeclFor
famEqnFor of
          DataFamInstDeclFor
DataFamInstDeclForTopLevel -> String
"data instance"
          DataFamInstDeclFor
DataFamInstDeclForInsideClassInst -> String
"data"

-- | HsArg (LHsType GhcPs) (LHsType GhcPs)
instance Pretty
           (HsArg
              (GenLocated SrcSpanAnnA (HsType GhcPs))
              (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  pretty' :: HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
pretty' (HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
x) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x
  pretty' (HsTypeArg SrcSpan
_ GenLocated SrcSpanAnnA (HsType GhcPs)
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"@" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x
  pretty' HsArgPar {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty (HsQuote GhcPs) where
  pretty' :: HsQuote GhcPs -> Printer ()
pretty' (ExpBr XExpBr GhcPs
_ LHsExpr GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
x
  pretty' (PatBr XPatBr GhcPs
_ LPat GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"p" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
x)
  pretty' (DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
decls) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"d| " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
lined ((GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
decls) Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" |"
  pretty' DecBrG {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' (TypBr XTypBr GhcPs
_ LHsType GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"t" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
x)
  pretty' (VarBr XVarBr GhcPs
_ Bool
True LIdP GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"'" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
x
  pretty' (VarBr XVarBr GhcPs
_ Bool
False LIdP GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"''" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
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' :: WarnDecls GhcPs -> Printer ()
pretty' (Warnings XWarnings GhcPs
_ SourceText
_ [LWarnDecl GhcPs]
x) = [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (WarnDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (WarnDecl GhcPs)]
[LWarnDecl GhcPs]
x
#endif
instance Pretty (WarnDecl GhcPs) where
  pretty' :: WarnDecl GhcPs -> Printer ()
pretty' (Warning XWarning GhcPs
_ [LIdP GhcPs]
names WarningTxt GhcPs
deprecatedOrWarning) =
    case WarningTxt GhcPs
deprecatedOrWarning of
      DeprecatedTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
reasons -> String
-> [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
-> Printer ()
forall {a}. Pretty a => String -> [a] -> Printer ()
prettyWithTitleReasons String
"DEPRECATED" [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
reasons
      WarningTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
reasons -> String
-> [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
-> Printer ()
forall {a}. Pretty a => String -> [a] -> Printer ()
prettyWithTitleReasons String
"WARNING" [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
reasons
    where
      prettyWithTitleReasons :: String -> [a] -> Printer ()
prettyWithTitleReasons String
title [a]
reasons =
        [Printer ()] -> Printer ()
lined
          [ HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String
"{-# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
title
          , [Printer ()] -> Printer ()
spaced
              [[Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
names, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (a -> Printer ()) -> [a] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [a]
reasons]
          , HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"
          ]
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty (WithHsDocIdentifiers StringLiteral GhcPs) where
  pretty' :: WithHsDocIdentifiers StringLiteral GhcPs -> Printer ()
pretty' WithHsDocIdentifiers {[Located (IdP GhcPs)]
StringLiteral
hsDocString :: StringLiteral
hsDocIdentifiers :: [Located (IdP GhcPs)]
hsDocString :: forall a pass. WithHsDocIdentifiers a pass -> a
hsDocIdentifiers :: forall a pass. WithHsDocIdentifiers a pass -> [Located (IdP pass)]
..} = StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StringLiteral
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' :: IEWrappedName RdrName -> Printer ()
pretty' (IEName GenLocated SrcSpanAnnN RdrName
name) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
name
  pretty' (IEPattern EpaLocation
_ GenLocated SrcSpanAnnN RdrName
name) = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"pattern", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
name]
  pretty' (IEType EpaLocation
_ GenLocated SrcSpanAnnN RdrName
name) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
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 GhcPs -> Printer ()
pretty' DotFieldOcc {XCDotFieldOcc GhcPs
XRec GhcPs FastString
dfoExt :: XCDotFieldOcc GhcPs
dfoLabel :: XRec GhcPs FastString
dfoExt :: forall p. DotFieldOcc p -> XCDotFieldOcc p
dfoLabel :: forall p. DotFieldOcc p -> XRec p FastString
..} = GenLocated SrcSpanAnnN FastString
-> (FastString -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated SrcSpanAnnN FastString
XRec GhcPs FastString
dfoLabel (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ())
-> (FastString -> String) -> FastString -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS)
#else
instance Pretty (HsFieldLabel GhcPs) where
  pretty' HsFieldLabel {..} = printCommentsAnd hflLabel (string . unpackFS)
#endif
instance Pretty (RuleDecls GhcPs) where
  pretty' :: RuleDecls GhcPs -> Printer ()
pretty' HsRules {[LRuleDecl GhcPs]
SourceText
XCRuleDecls GhcPs
rds_ext :: XCRuleDecls GhcPs
rds_src :: SourceText
rds_rules :: [LRuleDecl GhcPs]
rds_ext :: forall pass. RuleDecls pass -> XCRuleDecls pass
rds_src :: forall pass. RuleDecls pass -> SourceText
rds_rules :: forall pass. RuleDecls pass -> [LRuleDecl pass]
..} =
    [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# RULES" Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (RuleDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (RuleDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (RuleDecl GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
[LRuleDecl GhcPs]
rds_rules [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string 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' :: RuleDecl GhcPs -> Printer ()
pretty' HsRule {[LRuleBndr GhcPs]
Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Activation
XHsRule GhcPs
XRec GhcPs (SourceText, FastString)
LHsExpr GhcPs
rd_ext :: XHsRule GhcPs
rd_name :: XRec GhcPs (SourceText, FastString)
rd_act :: Activation
rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
rd_tmvs :: [LRuleBndr GhcPs]
rd_lhs :: LHsExpr GhcPs
rd_rhs :: LHsExpr GhcPs
rd_ext :: forall pass. RuleDecl pass -> XHsRule pass
rd_name :: forall pass. RuleDecl pass -> XRec pass (SourceText, FastString)
rd_act :: forall pass. RuleDecl pass -> Activation
rd_tyvs :: forall pass.
RuleDecl pass -> Maybe [LHsTyVarBndr () (NoGhcTc pass)]
rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
..} =
    [Printer ()] -> Printer ()
spaced
      [ GenLocated (SrcAnn NoEpAnns) (SourceText, FastString)
-> ((SourceText, FastString) -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated (SrcAnn NoEpAnns) (SourceText, FastString)
XRec GhcPs (SourceText, FastString)
rd_name (Printer () -> Printer ()
forall a. Printer a -> Printer a
doubleQuotes (Printer () -> Printer ())
-> ((SourceText, FastString) -> Printer ())
-> (SourceText, FastString)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ())
-> ((SourceText, FastString) -> String)
-> (SourceText, FastString)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS (FastString -> String)
-> ((SourceText, FastString) -> FastString)
-> (SourceText, FastString)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceText, FastString) -> FastString
forall a b. (a, b) -> b
snd)
      , Printer ()
lhs
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"="
      , GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rd_rhs
      ]
    where
      lhs :: Printer ()
lhs =
        if [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
[LRuleBndr GhcPs]
rd_tmvs
          then GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rd_lhs
          else do
            HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
            [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
[LRuleBndr GhcPs]
rd_tmvs
            Printer ()
dot
            Printer ()
space
            GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
rd_lhs
#endif
instance Pretty OccName where
  pretty' :: OccName -> Printer ()
pretty' = OccName -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output

instance Pretty (DerivDecl GhcPs) where
  pretty' :: DerivDecl GhcPs -> Printer ()
pretty' DerivDecl { deriv_strategy :: forall pass. DerivDecl pass -> Maybe (LDerivStrategy pass)
deriv_strategy = (Just deriv_strategy :: LDerivStrategy GhcPs
deriv_strategy@(L SrcAnn NoEpAnns
_ ViaStrategy {}))
                    , Maybe (XRec GhcPs OverlapMode)
XCDerivDecl GhcPs
LHsSigWcType GhcPs
deriv_ext :: XCDerivDecl GhcPs
deriv_type :: LHsSigWcType GhcPs
deriv_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
deriv_ext :: forall pass. DerivDecl pass -> XCDerivDecl pass
deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_overlap_mode :: forall pass. DerivDecl pass -> Maybe (XRec pass OverlapMode)
..
                    } =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"deriving"
      , GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
LDerivStrategy GhcPs
deriv_strategy
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"instance"
      , HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
deriv_type
      ]
  pretty' DerivDecl {Maybe (XRec GhcPs OverlapMode)
Maybe (LDerivStrategy GhcPs)
XCDerivDecl GhcPs
LHsSigWcType GhcPs
deriv_strategy :: forall pass. DerivDecl pass -> Maybe (LDerivStrategy pass)
deriv_ext :: forall pass. DerivDecl pass -> XCDerivDecl pass
deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_overlap_mode :: forall pass. DerivDecl pass -> Maybe (XRec pass OverlapMode)
deriv_ext :: XCDerivDecl GhcPs
deriv_type :: LHsSigWcType GhcPs
deriv_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"deriving "
    Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
Maybe (LDerivStrategy GhcPs)
deriv_strategy ((GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
x -> do
      GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
x
      Printer ()
space
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"instance "
    HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
deriv_type

-- | 'Pretty' for 'LHsSigWcType GhcPs'.
instance Pretty
           (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))) where
  pretty' :: HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Printer ()
pretty' HsWC {GenLocated SrcSpanAnnA (HsSigType GhcPs)
XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_ext :: XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
hswc_body :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
..} = GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
hswc_body

-- | 'Pretty' for 'LHsWcType'
instance Pretty (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
  pretty' :: HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
pretty' HsWC {GenLocated SrcSpanAnnA (HsType GhcPs)
XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
hswc_ext :: XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
hswc_body :: GenLocated SrcSpanAnnA (HsType GhcPs)
..} = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
hswc_body

instance Pretty (StandaloneKindSig GhcPs) where
  pretty' :: StandaloneKindSig GhcPs -> Printer ()
pretty' (StandaloneKindSig XStandaloneKindSig GhcPs
_ LIdP GhcPs
name LHsSigType GhcPs
kind) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
kind]

instance Pretty (DefaultDecl GhcPs) where
  pretty' :: DefaultDecl GhcPs -> Printer ()
pretty' (DefaultDecl XCDefaultDecl GhcPs
_ [LHsType GhcPs]
xs) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"default", [Printer ()] -> Printer ()
hTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsType GhcPs)]
[LHsType GhcPs]
xs]

instance Pretty (ForeignDecl GhcPs) where
  pretty' :: ForeignDecl GhcPs -> Printer ()
pretty' ForeignImport {XForeignImport GhcPs
LIdP GhcPs
LHsSigType GhcPs
ForeignImport
fd_i_ext :: XForeignImport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_fi :: ForeignImport
fd_i_ext :: forall pass. ForeignDecl pass -> XForeignImport pass
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_fi :: forall pass. ForeignDecl pass -> ForeignImport
..} =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"foreign import"
      , ForeignImport -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ForeignImport
fd_fi
      , GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
fd_name
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
      , GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
fd_sig_ty
      ]
  pretty' ForeignExport {XForeignExport GhcPs
LIdP GhcPs
LHsSigType GhcPs
ForeignExport
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_e_ext :: XForeignExport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_fe :: ForeignExport
fd_e_ext :: forall pass. ForeignDecl pass -> XForeignExport pass
fd_fe :: forall pass. ForeignDecl pass -> ForeignExport
..} =
    [Printer ()] -> Printer ()
spaced
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"foreign export"
      , ForeignExport -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ForeignExport
fd_fe
      , GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
fd_name
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
      , GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
fd_sig_ty
      ]
#if MIN_VERSION_ghc_lib_parser(9,6,1)
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' :: ForeignImport -> Printer ()
pretty' (CImport Located CCallConv
conv Located Safety
safety Maybe Header
_ CImportSpec
_ (L SrcSpan
_ (SourceText String
s))) =
    [Printer ()] -> Printer ()
spaced [Located CCallConv -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located CCallConv
conv, Located Safety -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located Safety
safety, HasCallStack => String -> Printer ()
String -> Printer ()
string String
s]
  pretty' (CImport Located CCallConv
conv Located Safety
safety Maybe Header
_ CImportSpec
_ Located SourceText
_) = [Printer ()] -> Printer ()
spaced [Located CCallConv -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located CCallConv
conv, Located Safety -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located Safety
safety]
#endif

#if MIN_VERSION_ghc_lib_parser(9,6,1)
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' :: ForeignExport -> Printer ()
pretty' (CExport Located CExportSpec
conv (L SrcSpan
_ (SourceText String
s))) = [Printer ()] -> Printer ()
spaced [Located CExportSpec -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located CExportSpec
conv, HasCallStack => String -> Printer ()
String -> Printer ()
string String
s]
  pretty' (CExport Located CExportSpec
conv Located SourceText
_) = Located CExportSpec -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Located CExportSpec
conv
#endif
instance Pretty CExportSpec where
  pretty' :: CExportSpec -> Printer ()
pretty' (CExportStatic SourceText
_ FastString
_ CCallConv
x) = CCallConv -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty CCallConv
x

instance Pretty Safety where
  pretty' :: Safety -> Printer ()
pretty' Safety
PlaySafe = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"safe"
  pretty' Safety
PlayInterruptible = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"interruptible"
  pretty' Safety
PlayRisky = HasCallStack => String -> Printer ()
String -> Printer ()
string 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' :: AnnDecl GhcPs -> Printer ()
pretty' (HsAnnotation XHsAnnotation GhcPs
_ SourceText
_ (ValueAnnProvenance LIdP GhcPs
name) LHsExpr GhcPs
expr) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# ANN", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (HsAnnotation XHsAnnotation GhcPs
_ SourceText
_ (TypeAnnProvenance LIdP GhcPs
name) LHsExpr GhcPs
expr) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# ANN type", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (HsAnnotation XHsAnnotation GhcPs
_ SourceText
_ AnnProvenance GhcPs
ModuleAnnProvenance LHsExpr GhcPs
expr) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# ANN module", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
expr, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
#endif
instance Pretty (RoleAnnotDecl GhcPs) where
  pretty' :: RoleAnnotDecl GhcPs -> Printer ()
pretty' (RoleAnnotDecl XCRoleAnnotDecl GhcPs
_ LIdP GhcPs
name [XRec GhcPs (Maybe Role)]
roles) =
    [Printer ()] -> Printer ()
spaced
      ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type role", GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name]
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ (GenLocated (SrcAnn NoEpAnns) (Maybe Role) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (Maybe Role)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Printer () -> (Role -> Printer ()) -> Maybe Role -> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"_") Role -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Maybe Role -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (Maybe Role) -> Maybe Role)
-> GenLocated (SrcAnn NoEpAnns) (Maybe Role)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (Maybe Role) -> Maybe Role
forall l e. GenLocated l e -> e
unLoc) [GenLocated (SrcAnn NoEpAnns) (Maybe Role)]
[XRec GhcPs (Maybe Role)]
roles

instance Pretty Role where
  pretty' :: Role -> Printer ()
pretty' Role
Nominal = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"nominal"
  pretty' Role
Representational = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"representational"
  pretty' Role
Phantom = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"phantom"

instance Pretty (TyFamInstDecl GhcPs) where
  pretty' :: TyFamInstDecl GhcPs -> Printer ()
pretty' TyFamInstDecl {XCTyFamInstDecl GhcPs
TyFamInstEqn GhcPs
tfid_xtn :: XCTyFamInstDecl GhcPs
tfid_eqn :: TyFamInstEqn GhcPs
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
..} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
TyFamInstEqn GhcPs
tfid_eqn

instance Pretty TopLevelTyFamInstDecl where
  pretty' :: TopLevelTyFamInstDecl -> Printer ()
pretty' (TopLevelTyFamInstDecl TyFamInstDecl {XCTyFamInstDecl GhcPs
TyFamInstEqn GhcPs
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_xtn :: XCTyFamInstDecl GhcPs
tfid_eqn :: TyFamInstEqn GhcPs
..}) =
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type instance " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
TyFamInstEqn GhcPs
tfid_eqn

instance Pretty (DataFamInstDecl GhcPs) where
  pretty' :: DataFamInstDecl GhcPs -> Printer ()
pretty' = DataFamInstDecl' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' (DataFamInstDecl' -> Printer ())
-> (DataFamInstDecl GhcPs -> DataFamInstDecl')
-> DataFamInstDecl GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataFamInstDecl GhcPs -> DataFamInstDecl'
DataFamInstDeclTopLevel

instance Pretty DataFamInstDecl' where
  pretty' :: DataFamInstDecl' -> Printer ()
pretty' DataFamInstDecl' {dataFamInstDecl :: DataFamInstDecl' -> DataFamInstDecl GhcPs
dataFamInstDecl = DataFamInstDecl {FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
..}, DataFamInstDeclFor
dataFamInstDeclFor :: DataFamInstDeclFor
dataFamInstDeclFor :: DataFamInstDecl' -> DataFamInstDeclFor
..} =
    FamEqn' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (FamEqn' -> Printer ()) -> FamEqn' -> Printer ()
forall a b. (a -> b) -> a -> b
$ DataFamInstDeclFor -> FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
FamEqn' DataFamInstDeclFor
dataFamInstDeclFor FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn

instance Pretty (PatSynBind GhcPs GhcPs) where
  pretty' :: PatSynBind GhcPs GhcPs -> Printer ()
pretty' PSB {XPSB GhcPs GhcPs
LIdP GhcPs
LPat GhcPs
HsPatSynDetails GhcPs
HsPatSynDir GhcPs
psb_ext :: XPSB GhcPs GhcPs
psb_id :: LIdP GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_def :: LPat GhcPs
psb_dir :: HsPatSynDir GhcPs
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"pattern "
    case HsPatSynDetails GhcPs
psb_args of
      InfixCon LIdP GhcPs
l LIdP GhcPs
r -> [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
l, GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
psb_id, GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
r]
      PrefixCon [Void]
_ [] -> GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
psb_id
      HsPatSynDetails GhcPs
_ -> [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
psb_id, HsConDetails
  Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField GhcPs]
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsConDetails
  Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField GhcPs]
HsPatSynDetails GhcPs
psb_args]
    [Printer ()] -> Printer ()
spacePrefixed [HsPatSynDir GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsPatSynDir GhcPs
psb_dir, GenLocated SrcSpanAnnA PatInsidePatDecl -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA PatInsidePatDecl -> Printer ())
-> GenLocated SrcSpanAnnA PatInsidePatDecl -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Pat GhcPs -> PatInsidePatDecl)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA PatInsidePatDecl
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat GhcPs -> PatInsidePatDecl
PatInsidePatDecl GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
psb_def]
    case HsPatSynDir GhcPs
psb_dir of
      ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
matches -> do
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches
      HsPatSynDir GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | 'Pretty' for 'HsPatSynDetails'.
instance Pretty
           (HsConDetails
              Void
              (GenLocated SrcSpanAnnN RdrName)
              [RecordPatSynField GhcPs]) where
  pretty' :: HsConDetails
  Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField GhcPs]
-> Printer ()
pretty' (PrefixCon [Void]
_ [GenLocated SrcSpanAnnN RdrName]
xs) = [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnN RdrName]
xs
  pretty' (RecCon [RecordPatSynField GhcPs]
rec) = [Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RecordPatSynField GhcPs -> Printer ())
-> [RecordPatSynField GhcPs] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RecordPatSynField GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [RecordPatSynField GhcPs]
rec
  pretty' InfixCon {} =
    String -> Printer ()
forall a. HasCallStack => String -> a
error
      String
"Cannot handle here because `InfixCon` does not have the information of the constructor."

instance Pretty (FixitySig GhcPs) where
  pretty' :: FixitySig GhcPs -> Printer ()
pretty' (FixitySig XFixitySig GhcPs
_ [LIdP GhcPs]
names Fixity
fixity) =
    [Printer ()] -> Printer ()
spaced [Fixity -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Fixity
fixity, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN InfixOp -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixOp -> Printer ())
-> (GenLocated SrcSpanAnnN RdrName
    -> GenLocated SrcSpanAnnN InfixOp)
-> GenLocated SrcSpanAnnN RdrName
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> InfixOp)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN InfixOp
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixOp
InfixOp) [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
names]

instance Pretty Fixity where
  pretty' :: Fixity -> Printer ()
pretty' (Fixity SourceText
_ Arity
level FixityDirection
dir) = [Printer ()] -> Printer ()
spaced [FixityDirection -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FixityDirection
dir, HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Arity -> String
forall a. Show a => a -> String
show Arity
level]

instance Pretty FixityDirection where
  pretty' :: FixityDirection -> Printer ()
pretty' FixityDirection
InfixL = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"infixl"
  pretty' FixityDirection
InfixR = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"infixr"
  pretty' FixityDirection
InfixN = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"infix"

instance Pretty InlinePragma where
  pretty' :: InlinePragma -> Printer ()
pretty' InlinePragma {Maybe Arity
SourceText
InlineSpec
RuleMatchInfo
Activation
inl_src :: SourceText
inl_inline :: InlineSpec
inl_sat :: Maybe Arity
inl_act :: Activation
inl_rule :: RuleMatchInfo
inl_src :: InlinePragma -> SourceText
inl_inline :: InlinePragma -> InlineSpec
inl_sat :: InlinePragma -> Maybe Arity
inl_act :: InlinePragma -> Activation
inl_rule :: InlinePragma -> RuleMatchInfo
..} = do
    InlineSpec -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty InlineSpec
inl_inline
    case Activation
inl_act of
      ActiveBefore SourceText
_ Arity
x -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String
"~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Arity -> String
forall a. Show a => a -> String
show Arity
x)
      ActiveAfter SourceText
_ Arity
x -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Arity -> String
forall a. Show a => a -> String
show Arity
x)
      Activation
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Pretty InlineSpec where
  pretty' :: InlineSpec -> Printer ()
pretty' = InlineSpec -> Printer ()
prettyInlineSpec

prettyInlineSpec :: InlineSpec -> Printer ()
prettyInlineSpec :: InlineSpec -> Printer ()
prettyInlineSpec Inline {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"INLINE"
prettyInlineSpec Inlinable {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"INLINABLE"
prettyInlineSpec NoInline {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"NOINLINE"
prettyInlineSpec InlineSpec
NoUserInlinePrag =
  String -> Printer ()
forall a. HasCallStack => String -> a
error
    String
"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 {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"OPAQUE"
#endif
instance Pretty (HsPatSynDir GhcPs) where
  pretty' :: HsPatSynDir GhcPs -> Printer ()
pretty' HsPatSynDir GhcPs
Unidirectional = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"<-"
  pretty' HsPatSynDir GhcPs
ImplicitBidirectional = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"="
  pretty' ExplicitBidirectional {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"<-"

instance Pretty (HsOverLit GhcPs) where
  pretty' :: HsOverLit GhcPs -> Printer ()
pretty' OverLit {XOverLit GhcPs
OverLitVal
ol_ext :: XOverLit GhcPs
ol_val :: OverLitVal
ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_val :: forall p. HsOverLit p -> OverLitVal
..} = OverLitVal -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OverLitVal
ol_val

instance Pretty OverLitVal where
  pretty' :: OverLitVal -> Printer ()
pretty' (HsIntegral IntegralLit
x) = IntegralLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty IntegralLit
x
  pretty' (HsFractional FractionalLit
x) = FractionalLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FractionalLit
x
  pretty' (HsIsString SourceText
_ FastString
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
x

instance Pretty IntegralLit where
  pretty' :: IntegralLit -> Printer ()
pretty' IL {il_text :: IntegralLit -> SourceText
il_text = SourceText String
s} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
s
  pretty' IL {Bool
Integer
SourceText
il_text :: IntegralLit -> SourceText
il_text :: SourceText
il_neg :: Bool
il_value :: Integer
il_neg :: IntegralLit -> Bool
il_value :: IntegralLit -> Integer
..} = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
il_value

instance Pretty FractionalLit where
  pretty' :: FractionalLit -> Printer ()
pretty' = FractionalLit -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output

instance Pretty (HsLit GhcPs) where
  pretty' :: HsLit GhcPs -> Printer ()
pretty' x :: HsLit GhcPs
x@(HsChar XHsChar GhcPs
_ Char
_) = HsLit GhcPs -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output HsLit GhcPs
x
  pretty' x :: HsLit GhcPs
x@HsCharPrim {} = HsLit GhcPs -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output HsLit GhcPs
x
  pretty' HsInt {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' (HsIntPrim XHsIntPrim GhcPs
_ Integer
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"#"
  pretty' HsWordPrim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' HsInt64Prim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' HsWord64Prim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' HsInteger {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' HsRat {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' (HsFloatPrim XHsFloatPrim GhcPs
_ FractionalLit
x) = FractionalLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FractionalLit
x Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#"
  pretty' HsDoublePrim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
  pretty' HsLit GhcPs
x =
    case HsLit GhcPs
x of
      HsString {} -> Printer ()
prettyString
      HsStringPrim {} -> Printer ()
prettyString
    where
      prettyString :: Printer ()
prettyString =
        case String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ HsLit GhcPs -> String
forall a. Outputable a => a -> String
showOutputable HsLit GhcPs
x of
          [] -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          [String
l] -> HasCallStack => String -> Printer ()
String -> Printer ()
string String
l
          (String
s:[String]
ss) ->
            HasCallStack => String -> Printer ()
String -> Printer ()
string String
"" Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
              HasCallStack => String -> Printer ()
String -> Printer ()
string String
s
              Printer ()
newline
              Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace (-Int64
1)
                (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined
                ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (String -> Printer ()) -> [String] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ())
-> (String -> String) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')) [String]
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' :: HsPragE GhcPs -> Printer ()
pretty' (HsPragSCC XSCC GhcPs
_ SourceText
_ StringLiteral
x) = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SCC", StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StringLiteral
x, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
#endif
instance Pretty HsIPName where
  pretty' :: HsIPName -> Printer ()
pretty' (HsIPName FastString
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
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' :: HsTyLit -> Printer ()
pretty' (HsNumTy SourceText
_ Integer
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x
  pretty' (HsStrTy SourceText
_ FastString
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
forall a. Show a => a -> String
ushow FastString
x
  pretty' (HsCharTy SourceText
_ Char
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x
#endif
instance Pretty (HsPatSigType GhcPs) where
  pretty' :: HsPatSigType GhcPs -> Printer ()
pretty' HsPS {XHsPS GhcPs
LHsType GhcPs
hsps_ext :: XHsPS GhcPs
hsps_body :: LHsType GhcPs
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
..} = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
hsps_body

instance Pretty (HsIPBinds GhcPs) where
  pretty' :: HsIPBinds GhcPs -> Printer ()
pretty' (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) = [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (IPBind GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IPBind GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (IPBind GhcPs)]
[LIPBind GhcPs]
xs

instance Pretty (IPBind GhcPs) where
  pretty' :: IPBind GhcPs -> Printer ()
pretty' = IPBind GhcPs -> Printer ()
prettyIPBind

prettyIPBind :: IPBind GhcPs -> Printer ()
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyIPBind :: IPBind GhcPs -> Printer ()
prettyIPBind (IPBind XCIPBind GhcPs
_ XRec GhcPs HsIPName
l LHsExpr GhcPs
r) =
  [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"?" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated (SrcAnn NoEpAnns) HsIPName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated (SrcAnn NoEpAnns) HsIPName
XRec GhcPs HsIPName
l, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"=", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
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' :: DerivStrategy GhcPs -> Printer ()
pretty' StockStrategy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"stock"
  pretty' AnyclassStrategy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"anyclass"
  pretty' NewtypeStrategy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"newtype"
  pretty' (ViaStrategy XViaStrategy GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"via " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XViaStrategyPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XViaStrategy GhcPs
XViaStrategyPs
x

instance Pretty XViaStrategyPs where
  pretty' :: XViaStrategyPs -> Printer ()
pretty' (XViaStrategyPs EpAnn [AddEpAnn]
_ LHsSigType GhcPs
ty) = GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
ty

instance Pretty (RecordPatSynField GhcPs) where
  pretty' :: RecordPatSynField GhcPs -> Printer ()
pretty' RecordPatSynField {LIdP GhcPs
FieldOcc GhcPs
recordPatSynField :: FieldOcc GhcPs
recordPatSynPatVar :: LIdP GhcPs
recordPatSynField :: forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynPatVar :: forall pass. RecordPatSynField pass -> LIdP pass
..} = FieldOcc GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FieldOcc GhcPs
recordPatSynField

instance Pretty (HsCmdTop GhcPs) where
  pretty' :: HsCmdTop GhcPs -> Printer ()
pretty' (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
cmd

instance Pretty (HsCmd GhcPs) where
  pretty' :: HsCmd GhcPs -> Printer ()
pretty' = HsCmd GhcPs -> Printer ()
prettyHsCmd

prettyHsCmd :: HsCmd GhcPs -> Printer ()
prettyHsCmd :: HsCmd GhcPs -> Printer ()
prettyHsCmd (HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
HsHigherOrderApp Bool
True) =
  [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-<<", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg]
prettyHsCmd (HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
HsHigherOrderApp Bool
False) =
  [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg, HasCallStack => String -> Printer ()
String -> Printer ()
string String
">>-", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f]
prettyHsCmd (HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
HsFirstOrderApp Bool
True) =
  [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-<", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg]
prettyHsCmd (HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
HsFirstOrderApp Bool
False) =
  [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg, HasCallStack => String -> Printer ()
String -> Printer ()
string String
">-", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f]
prettyHsCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
f LexicalFixity
_ Maybe Fixity
_ [LHsCmdTop GhcPs]
args) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
bananaBrackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
f Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)]
[LHsCmdTop GhcPs]
args
prettyHsCmd (HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
f LHsExpr GhcPs
arg) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
f, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
arg]
prettyHsCmd (HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
x) = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
x
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsCmd (HsCmdPar XCmdPar GhcPs
_ LHsToken "(" GhcPs
_ LHsCmd GhcPs
x LHsToken ")" GhcPs
_) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
x
#else
prettyHsCmd (HsCmdPar _ x) = parens $ pretty x
#endif
prettyHsCmd (HsCmdCase XCmdCase GhcPs
_ LHsExpr GhcPs
cond MatchGroup GhcPs (LHsCmd GhcPs)
arms) = do
  [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"case", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
cond, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"of"]
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
arms
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsCmd (HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
_ MatchGroup GhcPs (LHsCmd GhcPs)
arms) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\case"
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
arms
#else
prettyHsCmd (HsCmdLamCase _ arms) = do
  string "\\case"
  newline
  indentedBlock $ pretty arms
#endif
prettyHsCmd (HsCmdIf XCmdIf GhcPs
_ SyntaxExpr GhcPs
_ LHsExpr GhcPs
cond LHsCmd GhcPs
t LHsCmd GhcPs
f) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"if "
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
cond
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"then " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
t, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"else " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
f]
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsCmd (HsCmdLet XCmdLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
_ LHsCmd GhcPs
expr) =
  [Printer ()] -> Printer ()
lined [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"let " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsLocalBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLocalBinds GhcPs
binds, HasCallStack => String -> Printer ()
String -> Printer ()
string String
" in " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
expr]
#else
prettyHsCmd (HsCmdLet _ binds expr) =
  lined [string "let " |=> pretty binds, string " in " |=> pretty expr]
#endif
prettyHsCmd (HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
stmts) = do
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
"do"
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
XRec GhcPs [CmdLStmt GhcPs]
stmts ([Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ())
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
    -> [Printer ()])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)

instance Pretty ListComprehension where
  pretty' :: ListComprehension -> Printer ()
pretty' ListComprehension {[ExprLStmt GhcPs]
ExprLStmt GhcPs
listCompLhs :: ExprLStmt GhcPs
listCompRhs :: [ExprLStmt GhcPs]
listCompLhs :: ListComprehension -> ExprLStmt GhcPs
listCompRhs :: ListComprehension -> [ExprLStmt GhcPs]
..} = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
    where
      horizontal :: Printer ()
horizontal =
        Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced
              [ GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ExprLStmt GhcPs
listCompLhs
              , HasCallStack => String -> Printer ()
String -> Printer ()
string String
"|"
              , [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
listCompRhs
              ]
      vertical :: Printer ()
vertical = do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"[ "
        GenLocated SrcSpanAnnA StmtLRInsideVerticalList -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA StmtLRInsideVerticalList -> Printer ())
-> GenLocated SrcSpanAnnA StmtLRInsideVerticalList -> Printer ()
forall a b. (a -> b) -> a -> b
$ (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> StmtLRInsideVerticalList)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA StmtLRInsideVerticalList
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> StmtLRInsideVerticalList
StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> StmtLRInsideVerticalList
StmtLRInsideVerticalList GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ExprLStmt GhcPs
listCompLhs
        Printer ()
newline
        [(String,
  GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
-> ((String,
     GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [(String,
     GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
forall {b}. [b] -> [(String, b)]
stmtsAndPrefixes [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
listCompRhs) (((String,
   GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  -> Printer ())
 -> Printer ())
-> ((String,
     GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \(String
p, GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x) -> do
          HasCallStack => String -> Printer ()
String -> Printer ()
string String
p Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA StmtLRInsideVerticalList -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> StmtLRInsideVerticalList)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA StmtLRInsideVerticalList
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> StmtLRInsideVerticalList
StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> StmtLRInsideVerticalList
StmtLRInsideVerticalList GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x)
          Printer ()
newline
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"]"
      stmtsAndPrefixes :: [b] -> [(String, b)]
stmtsAndPrefixes [b]
l = (String
"| ", [b] -> b
forall a. HasCallStack => [a] -> a
head [b]
l) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: (b -> (String, b)) -> [b] -> [(String, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
", ", ) ([b] -> [b]
forall a. HasCallStack => [a] -> [a]
tail [b]
l)

instance Pretty DoExpression where
  pretty' :: DoExpression -> Printer ()
pretty' DoExpression {[ExprLStmt GhcPs]
QualifiedDo
doStmts :: [ExprLStmt GhcPs]
qualifiedDo :: QualifiedDo
doStmts :: DoExpression -> [ExprLStmt GhcPs]
qualifiedDo :: DoExpression -> QualifiedDo
..} = do
    QualifiedDo -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty QualifiedDo
qualifiedDo
    Printer ()
newline
    Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Printer ())
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
[ExprLStmt GhcPs]
doStmts

instance Pretty DoOrMdo where
  pretty' :: DoOrMdo -> Printer ()
pretty' DoOrMdo
Do = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"do"
  pretty' DoOrMdo
Mdo = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"mdo"

instance Pretty QualifiedDo where
  pretty' :: QualifiedDo -> Printer ()
pretty' (QualifiedDo (Just ModuleName
m) DoOrMdo
d) = do
    ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ModuleName
m
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."
    DoOrMdo -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DoOrMdo
d
  pretty' (QualifiedDo Maybe ModuleName
Nothing DoOrMdo
d) = DoOrMdo -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DoOrMdo
d

instance Pretty LetIn where
  pretty' :: LetIn -> Printer ()
pretty' LetIn {LHsExpr GhcPs
HsLocalBinds GhcPs
letBinds :: HsLocalBinds GhcPs
inExpr :: LHsExpr GhcPs
letBinds :: LetIn -> HsLocalBinds GhcPs
inExpr :: LetIn -> LHsExpr GhcPs
..} =
    [Printer ()] -> Printer ()
lined [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"let " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> HsLocalBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLocalBinds GhcPs
letBinds, HasCallStack => String -> Printer ()
String -> Printer ()
string String
" in " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
inExpr]

instance Pretty (RuleBndr GhcPs) where
  pretty' :: RuleBndr GhcPs -> Printer ()
pretty' (RuleBndr XCRuleBndr GhcPs
_ LIdP GhcPs
name) = GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name
  pretty' (RuleBndrSig XRuleBndrSig GhcPs
_ LIdP GhcPs
name HsPatSigType GhcPs
sig) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnN RdrName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnN RdrName
LIdP GhcPs
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", HsPatSigType GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsPatSigType GhcPs
sig]

instance Pretty CCallConv where
  pretty' :: CCallConv -> Printer ()
pretty' CCallConv
CCallConv = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"ccall"
  pretty' CCallConv
CApiConv = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"capi"
  pretty' CCallConv
StdCallConv = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"stdcall"
  pretty' CCallConv
PrimCallConv = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"prim"
  pretty' CCallConv
JavaScriptCallConv = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"javascript"

instance Pretty ModuleDeprecatedPragma where
  pretty' :: ModuleDeprecatedPragma -> Printer ()
pretty' (ModuleDeprecatedPragma (WarningTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
xs)) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# WARNING", [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ())
-> [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
xs, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
  pretty' (ModuleDeprecatedPragma (DeprecatedTxt Located SourceText
_ [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
xs)) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# DEPRECATED", [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ())
-> [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [Located (WithHsDocIdentifiers StringLiteral GhcPs)]
xs, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]

instance Pretty HsSrcBang where
  pretty' :: HsSrcBang -> Printer ()
pretty' (HsSrcBang SourceText
_ SrcUnpackedness
unpack SrcStrictness
strictness) = do
    SrcUnpackedness -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SrcUnpackedness
unpack
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcUnpackedness
unpack SrcUnpackedness -> SrcUnpackedness -> Bool
forall a. Eq a => a -> a -> Bool
== SrcUnpackedness
NoSrcUnpack) Printer ()
space
    SrcStrictness -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SrcStrictness
strictness

instance Pretty SrcUnpackedness where
  pretty' :: SrcUnpackedness -> Printer ()
pretty' SrcUnpackedness
SrcUnpack = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# UNPACK #-}"
  pretty' SrcUnpackedness
SrcNoUnpack = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# NOUNPACK #-}"
  pretty' SrcUnpackedness
NoSrcUnpack = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Pretty SrcStrictness where
  pretty' :: SrcStrictness -> Printer ()
pretty' SrcStrictness
SrcLazy = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"~"
  pretty' SrcStrictness
SrcStrict = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"!"
  pretty' SrcStrictness
NoSrcStrict = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Pretty (HsOuterSigTyVarBndrs GhcPs) where
  pretty' :: HsOuterSigTyVarBndrs GhcPs -> Printer ()
pretty' HsOuterImplicit {} = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pretty' HsOuterExplicit {[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
XHsOuterExplicit GhcPs Specificity
hso_xexplicit :: XHsOuterExplicit GhcPs Specificity
hso_bndrs :: [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
hso_xexplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterExplicit pass flag
hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall"
    [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
hso_bndrs
    Printer ()
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 :: forall a. HasCallStack => a
notGeneratedByParser = String -> a
forall a. HasCallStack => String -> a
error String
"`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 :: forall a. HasCallStack => a
docNode =
  String -> a
forall a. HasCallStack => String -> a
error
    String
"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 :: forall a. HasCallStack => a
notUsedInParsedStage =
  String -> a
forall a. HasCallStack => String -> a
error
    String
"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