{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module HIndent.Pretty
( Pretty(..)
, pretty
, printCommentsAnd
) where
import Control.Monad
import Control.Monad.RWS
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Void
import qualified GHC.Data.Bag as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Hs as GHC
import GHC.Stack
import qualified GHC.Types.Basic as GHC
import qualified GHC.Types.Fixity as GHC
import qualified GHC.Types.Name as GHC
import qualified GHC.Types.Name.Reader as GHC
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Ast.Declaration.Bind
import HIndent.Ast.Declaration.Data.Body
import HIndent.Ast.Declaration.Data.Record.Field
import HIndent.Ast.Declaration.Family.Type
import HIndent.Ast.Declaration.Signature
import HIndent.Ast.Expression.Bracket
import HIndent.Ast.Expression.Splice
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
import HIndent.Config
import HIndent.Fixity
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
import qualified HIndent.Pretty.SigBindFamily as SBF
import HIndent.Pretty.Types
import HIndent.Printer
import qualified Language.Haskell.GhclibParserEx.GHC.Hs.Expr as GHC
import Text.Show.Unicode
#if MIN_VERSION_ghc_lib_parser(9,6,1)
import qualified GHC.Core.DataCon as GHC
#endif
#if !MIN_VERSION_ghc_lib_parser(9,6,1)
import qualified GHC.Unit as GHC
#endif
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
printCommentsAnd ::
(CommentExtraction l)
=> GHC.GenLocated l e
-> (e -> Printer ())
-> Printer ()
printCommentsAnd :: forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (GHC.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
printCommentsBefore :: CommentExtraction a => a -> Printer ()
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
$ \(GHC.L NoCommentsLocation
loc EpaComment
c) -> do
let col :: Int64
col = SumWidth -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SumWidth -> Int64) -> SumWidth -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> SumWidth
GHC.srcSpanStartCol (NoCommentsLocation -> RealSrcSpan
forall {a}. EpaLocation' a -> RealSrcSpan
getAnc NoCommentsLocation
loc) SumWidth -> SumWidth -> SumWidth
forall a. Num a => a -> a -> a
- SumWidth
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
printCommentOnSameLine :: CommentExtraction a => a -> Printer ()
(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
(SumWidth -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SumWidth -> Int64) -> SumWidth -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> SumWidth
GHC.srcSpanStartCol (RealSrcSpan -> SumWidth) -> RealSrcSpan -> SumWidth
forall a b. (a -> b) -> a -> b
$ NoCommentsLocation -> RealSrcSpan
forall {a}. EpaLocation' a -> RealSrcSpan
getAnc (NoCommentsLocation -> RealSrcSpan)
-> NoCommentsLocation -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
GHC.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 ()
printCommentsAfter :: CommentExtraction a => a -> Printer ()
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
$ \(GHC.L NoCommentsLocation
loc EpaComment
c) -> do
let col :: Int64
col = SumWidth -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SumWidth -> Int64) -> SumWidth -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> SumWidth
GHC.srcSpanStartCol (NoCommentsLocation -> RealSrcSpan
forall {a}. EpaLocation' a -> RealSrcSpan
getAnc NoCommentsLocation
loc) SumWidth -> SumWidth -> SumWidth
forall a. Num a => a -> a -> a
- SumWidth
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
class CommentExtraction a =>
Pretty a
where
pretty' :: a -> Printer ()
instance (CommentExtraction l, Pretty e) => Pretty (GHC.GenLocated l e) where
pretty' :: GenLocated l e -> Printer ()
pretty' (GHC.L l
_ e
e) = e -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty e
e
instance Pretty
(GHC.MatchGroup
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' GHC.MG {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_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
..} = 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 XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match 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
(GHC.MatchGroup
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where
pretty' :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
pretty' GHC.MG {XMG GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext :: XMG GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mg_alts :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
..} = 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 XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (Match 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 (GHC.HsExpr GHC.GhcPs) where
pretty' :: HsExpr GhcPs -> Printer ()
pretty' = HsExpr GhcPs -> Printer ()
prettyHsExpr
prettyHsExpr :: GHC.HsExpr GHC.GhcPs -> Printer ()
prettyHsExpr :: HsExpr GhcPs -> Printer ()
prettyHsExpr (GHC.HsVar XVar GhcPs
_ LIdP GhcPs
bind) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
bind
#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
prettyHsExpr (GHC.HsUnboundVar XUnboundVar GhcPs
_ RdrName
x) = PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (PrefixName -> Printer ()) -> PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ RdrName -> PrefixName
mkPrefixName RdrName
x
#else
prettyHsExpr (GHC.HsUnboundVar _ x) = pretty x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
prettyHsExpr (GHC.HsOverLabel XOverLabel GhcPs
_ SourceText
_ 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
GHC.unpackFS FastString
l)
#else
prettyHsExpr (GHC.HsOverLabel _ l) = string "#" >> string (GHC.unpackFS l)
#endif
prettyHsExpr (GHC.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 (GHC.HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
x) = HsOverLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsOverLit GhcPs
x
prettyHsExpr (GHC.HsLit XLitE GhcPs
_ HsLit GhcPs
l) = HsLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLit GhcPs
l
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsExpr (GHC.HsLam XLam GhcPs
_ HsLamVariant
GHC.LamSingle MatchGroup GhcPs (LHsExpr GhcPs)
body) = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
body
prettyHsExpr (GHC.HsLam XLam GhcPs
_ HsLamVariant
GHC.LamCase MatchGroup GhcPs (LHsExpr GhcPs)
body) = 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)
body CaseOrCases
Case
prettyHsExpr (GHC.HsLam XLam GhcPs
_ HsLamVariant
GHC.LamCases MatchGroup GhcPs (LHsExpr GhcPs)
body) = 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)
body CaseOrCases
Cases
#else
prettyHsExpr (GHC.HsLam _ body) = pretty body
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
prettyHsExpr (GHC.HsLamCase _ GHC.LamCase matches) =
pretty $ LambdaCase matches Case
prettyHsExpr (GHC.HsLamCase _ GHC.LamCases matches) =
pretty $ LambdaCase matches Cases
#else
prettyHsExpr (GHC.HsLamCase _ matches) = pretty $ LambdaCase matches Case
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsExpr (GHC.HsApp 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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]
++ [LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
flatten :: LHsExpr GhcPs -> [LHsExpr GhcPs]
flatten (GHC.L (GHC.EpAnn Anchor
_ AnnListItem
_ EpAnnComments
cs) (GHC.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 ::
GHC.EpAnnComments -> GHC.LHsExpr GHC.GhcPs -> GHC.LHsExpr GHC.GhcPs
insertComments :: EpAnnComments -> LHsExpr GhcPs -> LHsExpr GhcPs
insertComments EpAnnComments
cs (GHC.L s :: SrcSpanAnnA
s@GHC.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
GHC.L (SrcSpanAnnA
s {GHC.comments = cs <> cs'}) HsExpr GhcPs
r'
insertComments EpAnnComments
_ LHsExpr GhcPs
x = LHsExpr GhcPs
x
#else
prettyHsExpr (GHC.HsApp _ l r) = horizontal <-|> vertical
where
horizontal = spaced [pretty l, pretty r]
vertical = do
let (f, args) =
case flatten l ++ [r] of
[] -> error "Invalid function application."
(f':args') -> (f', args')
col <- gets psColumn
spaces <- getIndentSpaces
pretty f
col' <- gets psColumn
let diff =
col'
- col
- if col == 0
then spaces
else 0
if diff + 1 <= spaces
then space
else newline
spaces' <- getIndentSpaces
indentedWithSpace spaces' $ lined $ fmap pretty args
flatten :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
flatten (GHC.L (GHC.SrcSpanAnn (GHC.EpAnn _ _ cs) _) (GHC.HsApp _ l' r')) =
flatten l' ++ [insertComments cs r']
flatten x = [x]
insertComments ::
GHC.EpAnnComments -> GHC.LHsExpr GHC.GhcPs -> GHC.LHsExpr GHC.GhcPs
insertComments cs (GHC.L s@GHC.SrcSpanAnn {GHC.ann = e@GHC.EpAnn {comments = cs'}} r') =
GHC.L (s {GHC.ann = e {GHC.comments = cs <> cs'}}) r'
insertComments _ x = x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 6, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsExpr (GHC.HsAppType _ l _ r) = do
pretty l
string " @"
pretty r
#else
prettyHsExpr (GHC.HsAppType XAppTypeE GhcPs
_ LHsExpr GhcPs
l LHsWcType (NoGhcTc GhcPs)
r) = do
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (GHC.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 -> InfixApp
InfixApp LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r)
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsExpr (GHC.HsPar _ _ expr _) = parens $ pretty expr
#else
prettyHsExpr (GHC.HsPar XPar GhcPs
_ LHsExpr GhcPs
expr) = 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
#endif
prettyHsExpr (GHC.SectionL XSectionL GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, InfixExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (LHsExpr GhcPs -> InfixExpr
InfixExpr LHsExpr GhcPs
o)]
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
r
prettyHsExpr (GHC.ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
full Boxity
boxity) = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
where
horizontal :: Printer ()
horizontal = [Printer ()] -> Printer ()
parH ([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
parV
(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 GHC.Missing {} = Bool
True
isMissing HsTupArg id
_ = Bool
False
parH :: [Printer ()] -> Printer ()
parH =
case Boxity
boxity of
Boxity
GHC.Boxed -> [Printer ()] -> Printer ()
hTuple
Boxity
GHC.Unboxed -> [Printer ()] -> Printer ()
hUnboxedTuple
parV :: Printer a -> Printer a
parV =
case Boxity
boxity of
Boxity
GHC.Boxed -> Printer a -> Printer a
forall a. Printer a -> Printer a
parens
Boxity
GHC.Unboxed -> Printer a -> Printer a
forall a. Printer a -> Printer a
unboxedParens
prettyHsExpr (GHC.ExplicitSum XExplicitSum GhcPs
_ SumWidth
position SumWidth
numElem LHsExpr GhcPs
expr) = do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(#"
[SumWidth] -> (SumWidth -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SumWidth
1 .. SumWidth
numElem] ((SumWidth -> Printer ()) -> Printer ())
-> (SumWidth -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \SumWidth
idx -> do
if SumWidth
idx SumWidth -> SumWidth -> Bool
forall a. Eq a => a -> a -> Bool
== SumWidth
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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (SumWidth
idx SumWidth -> SumWidth -> Bool
forall a. Ord a => a -> a -> Bool
< SumWidth
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 (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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
GHC.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]
GHC.mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
arms
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 -> GHC.LHsExpr GHC.GhcPs -> Printer ()
branch :: String -> LHsExpr GhcPs -> Printer ()
branch String
str LHsExpr GhcPs
e =
case LHsExpr GhcPs
e of
(GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ (GHC.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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
(GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ (GHC.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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (GHC.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
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ())
-> [GenLocated
EpAnnCO (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 EpAnnCO GRHSExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated EpAnnCO GRHSExpr -> Printer ())
-> (GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated EpAnnCO GRHSExpr)
-> GenLocated
EpAnnCO (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
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated EpAnnCO GRHSExpr
forall a b.
(a -> b) -> GenLocated EpAnnCO a -> GenLocated EpAnnCO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
GRHSExprMultiWayIf)) [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards)
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsExpr (GHC.HsLet _ _ binds _ exprs) = pretty $ LetIn binds exprs
#else
prettyHsExpr (GHC.HsLet XLet GhcPs
_ HsLocalBinds GhcPs
binds 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
#endif
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.ListComp {} (GHC.L SrcSpanAnnL
_ [])) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.ListComp {} (GHC.L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_])) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.ListComp {} (GHC.L SrcSpanAnnL
l (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs:GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
rhs:[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhss))) =
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
GHC.L SrcSpanAnnL
l (ListComprehension -> GenLocated SrcSpanAnnL ListComprehension)
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall a b. (a -> b) -> a -> b
$ ExprLStmt GhcPs -> NonEmpty (ExprLStmt GhcPs) -> ListComprehension
ListComprehension ExprLStmt GhcPs
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
rhs GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhss)
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.MonadComp {} (GHC.L SrcSpanAnnL
_ [])) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.MonadComp {} (GHC.L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_])) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough arguments are passed to pretty-print a list comprehension."
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.MonadComp {} (GHC.L SrcSpanAnnL
l (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs:GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
rhs:[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhss))) =
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
GHC.L SrcSpanAnnL
l (ListComprehension -> GenLocated SrcSpanAnnL ListComprehension)
-> ListComprehension -> GenLocated SrcSpanAnnL ListComprehension
forall a b. (a -> b) -> a -> b
$ ExprLStmt GhcPs -> NonEmpty (ExprLStmt GhcPs) -> ListComprehension
ListComprehension ExprLStmt GhcPs
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lhs (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
rhs GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhss)
prettyHsExpr (GHC.HsDo XDo GhcPs
_ (GHC.DoExpr Maybe ModuleName
m) (GHC.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
GHC.L SrcSpanAnnL
l (DoExpression -> GenLocated SrcSpanAnnL DoExpression)
-> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall a b. (a -> b) -> a -> b
$ [ExprLStmt GhcPs] -> QualifiedDo -> DoExpression
DoExpression [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Do)
prettyHsExpr (GHC.HsDo XDo GhcPs
_ (GHC.MDoExpr Maybe ModuleName
m) (GHC.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
GHC.L SrcSpanAnnL
l (DoExpression -> GenLocated SrcSpanAnnL DoExpression)
-> DoExpression -> GenLocated SrcSpanAnnL DoExpression
forall a b. (a -> b) -> a -> b
$ [ExprLStmt GhcPs] -> QualifiedDo -> DoExpression
DoExpression [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs (Maybe ModuleName -> DoOrMdo -> QualifiedDo
QualifiedDo Maybe ModuleName
m DoOrMdo
Mdo)
prettyHsExpr (GHC.HsDo XDo GhcPs
_ GHC.GhciStmtCtxt {} XRec GhcPs [ExprLStmt GhcPs]
_) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"We're not using GHCi, are we?"
prettyHsExpr (GHC.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 [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr 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 [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs
prettyHsExpr (GHC.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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
name, HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fields]
vertical :: Printer ()
vertical = do
GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
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 HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fields))
#if MIN_VERSION_ghc_lib_parser(9,8,1)
prettyHsExpr (GHC.RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
name LHsRecUpdFields 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
name, LHsRecUpdFields GhcPs -> Printer ()
forall {p} {l} {l}.
(XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p))),
XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p))),
Pretty (XRec p (AmbiguousFieldOcc p)), Pretty (XRec p (HsExpr p)),
Pretty (XRec p (FieldLabelStrings p)), CommentExtraction l,
CommentExtraction l) =>
LHsRecUpdFields p -> Printer ()
printHorFields LHsRecUpdFields GhcPs
fields]
ver :: Printer ()
ver = do
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
name
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsRecUpdFields GhcPs -> Printer ()
forall {p} {l} {l}.
(XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p))),
XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p))),
Pretty (XRec p (AmbiguousFieldOcc p)), Pretty (XRec p (HsExpr p)),
Pretty (XRec p (FieldLabelStrings p)), CommentExtraction l,
CommentExtraction l) =>
LHsRecUpdFields p -> Printer ()
printHorFields LHsRecUpdFields GhcPs
fields Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> LHsRecUpdFields GhcPs -> Printer ()
forall {p} {l} {l}.
(XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p))),
XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
~ GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p))),
Pretty (XRec p (AmbiguousFieldOcc p)), Pretty (XRec p (HsExpr p)),
Pretty (XRec p (FieldLabelStrings p)), CommentExtraction l,
CommentExtraction l) =>
LHsRecUpdFields p -> Printer ()
printVerFields LHsRecUpdFields GhcPs
fields
printHorFields :: LHsRecUpdFields p -> Printer ()
printHorFields GHC.RegularRecUpdFields {[XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
XLHsRecUpdLabels p
xRecUpdFields :: XLHsRecUpdLabels p
recUpdFields :: [XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
xRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsRecUpdLabels p
..} =
[Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
-> Printer ())
-> [GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
-> (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p))
-> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
`printCommentsAnd` HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p))
-> Printer ()
forall {a} {a}.
(Pretty a, Pretty a) =>
HsFieldBind a a -> Printer ()
horField) [XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
[GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
recUpdFields
printHorFields GHC.OverloadedRecUpdFields {[XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
XLHsOLRecUpdLabels p
xOLRecUpdFields :: XLHsOLRecUpdLabels p
olRecUpdFields :: [XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
olRecUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdProj p]
xOLRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsOLRecUpdLabels p
..} =
[Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
-> Printer ())
-> [GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
-> (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p))
-> Printer ())
-> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
`printCommentsAnd` HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p))
-> Printer ()
forall {a} {a}.
(Pretty a, Pretty a) =>
HsFieldBind a a -> Printer ()
horField) [XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
[GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
olRecUpdFields
printVerFields :: LHsRecUpdFields p -> Printer ()
printVerFields GHC.RegularRecUpdFields {[XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
XLHsRecUpdLabels p
recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
xRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsRecUpdLabels p
xRecUpdFields :: XLHsRecUpdLabels p
recUpdFields :: [XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
..} =
[Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
-> Printer ())
-> [GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
GenLocated l (HsFieldBind a a) -> Printer ()
printField [XRec
p (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
[GenLocated
l (HsFieldBind (XRec p (AmbiguousFieldOcc p)) (XRec p (HsExpr p)))]
recUpdFields
printVerFields GHC.OverloadedRecUpdFields {[XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
XLHsOLRecUpdLabels p
olRecUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdProj p]
xOLRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsOLRecUpdLabels p
xOLRecUpdFields :: XLHsOLRecUpdLabels p
olRecUpdFields :: [XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
..} =
[Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
-> Printer ())
-> [GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))
-> Printer ()
forall {a} {a} {l}.
(Pretty a, Pretty a, CommentExtraction l) =>
GenLocated l (HsFieldBind a a) -> Printer ()
printField [XRec
p (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
[GenLocated
l (HsFieldBind (XRec p (FieldLabelStrings p)) (XRec p (HsExpr p)))]
olRecUpdFields
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 GHC.HsFieldBind {a
a
Bool
XHsFieldBind a
hfbAnn :: XHsFieldBind a
hfbLHS :: a
hfbRHS :: a
hfbPun :: Bool
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
..} = 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 GHC.HsFieldBind {a
a
Bool
XHsFieldBind a
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
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
#elif MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr (GHC.RecordUpd _ name fields) = hor <-|> ver
where
hor = spaced [pretty name, either printHorFields printHorFields fields]
ver = do
pretty name
newline
indentedBlock
$ either printHorFields printHorFields fields
<-|> either printVerFields printVerFields fields
printHorFields ::
(Pretty a, Pretty b, CommentExtraction l)
=> [GHC.GenLocated l (GHC.HsFieldBind a b)]
-> Printer ()
printHorFields = hFields . fmap (`printCommentsAnd` horField)
printVerFields ::
(Pretty a, Pretty b, CommentExtraction l)
=> [GHC.GenLocated l (GHC.HsFieldBind a b)]
-> Printer ()
printVerFields = vFields . fmap printField
printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField
horField GHC.HsFieldBind {..} = do
pretty hfbLHS
string " = "
pretty hfbRHS
verField GHC.HsFieldBind {..} = do
pretty hfbLHS
string " ="
newline
indentedBlock $ pretty hfbRHS
#else
prettyHsExpr (GHC.RecordUpd _ name fields) = hor <-|> ver
where
hor = spaced [pretty name, either printHorFields printHorFields fields]
ver = do
pretty name
newline
indentedBlock
$ either printHorFields printHorFields fields
<-|> either printVerFields printVerFields fields
printHorFields ::
(Pretty a, Pretty b, CommentExtraction l)
=> [GHC.GenLocated l (GHC.HsRecField' a b)]
-> Printer ()
printHorFields = hFields . fmap (`printCommentsAnd` horField)
printVerFields ::
(Pretty a, Pretty b, CommentExtraction l)
=> [GHC.GenLocated l (GHC.HsRecField' a b)]
-> Printer ()
printVerFields = vFields . fmap printField
printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField
horField GHC.HsRecField {..} = do
pretty hsRecFieldLbl
string " = "
pretty hsRecFieldArg
verField GHC.HsRecField {..} = do
pretty hsRecFieldLbl
string " ="
newline
indentedBlock $ pretty hsRecFieldArg
#endif
prettyHsExpr (GHC.HsGetField XGetField GhcPs
_ LHsExpr GhcPs
e XRec GhcPs (DotFieldOcc GhcPs)
f) = do
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
Printer ()
dot
GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs (DotFieldOcc GhcPs)
GenLocated EpAnnCO (DotFieldOcc GhcPs)
f
prettyHsExpr GHC.HsProjection {NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
XProjection GhcPs
proj_ext :: XProjection GhcPs
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
proj_ext :: forall p. HsExpr p -> XProjection p
..} =
Printer () -> Printer ()
forall a. Printer a -> Printer a
parens
(Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated EpAnnCO (DotFieldOcc GhcPs))
-> (GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (GenLocated EpAnnCO (DotFieldOcc GhcPs))
proj_flds
((GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ())
-> Printer ())
-> (GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated EpAnnCO (DotFieldOcc GhcPs)
x -> do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."
GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated EpAnnCO (DotFieldOcc GhcPs)
x
prettyHsExpr (GHC.ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
e LHsSigWcType (NoGhcTc GhcPs)
sig) = do
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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
GHC.hswc_body LHsSigWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
sig
prettyHsExpr (GHC.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 (GHC.HsSpliceE _ x) = pretty $ mkSplice x
#endif
prettyHsExpr (GHC.HsProc XProc GhcPs
_ LPat GhcPs
pat x :: LHsCmdTop GhcPs
x@(GHC.L EpAnnCO
_ (GHC.HsCmdTop XCmdTop GhcPs
_ (GHC.L SrcSpanAnnA
_ (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 EpAnnCO (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsCmdTop GhcPs
GenLocated EpAnnCO (HsCmdTop 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 XRec GhcPs [CmdLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd 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 (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated EpAnnCO (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsCmdTop GhcPs
GenLocated EpAnnCO (HsCmdTop 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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->"]
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (GenLocated EpAnnCO (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsCmdTop GhcPs
GenLocated EpAnnCO (HsCmdTop GhcPs)
body)
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsExpr GHC.HsRecSel {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsExpr (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
inner
prettyHsExpr (GHC.HsUntypedBracket XUntypedBracket GhcPs
_ HsQuote GhcPs
inner) = Bracket -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Bracket -> Printer ()) -> Bracket -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsQuote GhcPs -> Bracket
mkBracket HsQuote GhcPs
inner
#else
prettyHsExpr GHC.HsConLikeOut {} = notGeneratedByParser
prettyHsExpr GHC.HsRecFld {} = notGeneratedByParser
prettyHsExpr (GHC.HsDo _ GHC.ArrowExpr {} _) = notGeneratedByParser
prettyHsExpr (GHC.HsDo _ GHC.PatGuard {} _) = notGeneratedByParser
prettyHsExpr (GHC.HsDo _ GHC.ParStmtCtxt {} _) = notGeneratedByParser
prettyHsExpr (GHC.HsDo _ GHC.TransStmtCtxt {} _) = notGeneratedByParser
prettyHsExpr GHC.HsTick {} = forHpc
prettyHsExpr GHC.HsBinTick {} = forHpc
prettyHsExpr (GHC.HsBracket _ inner) = pretty $ mkBracket inner
prettyHsExpr GHC.HsRnBracketOut {} = notGeneratedByParser
prettyHsExpr GHC.HsTcBracketOut {} = notGeneratedByParser
#endif
#if MIN_VERSION_ghc_lib_parser(9,6,1)
prettyHsExpr (GHC.HsTypedSplice XTypedSplice GhcPs
_ LHsExpr 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 (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
prettyHsExpr (GHC.HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSplice GhcPs
x) = Splice -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Splice -> Printer ()) -> Splice -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs -> Splice
mkSplice HsUntypedSplice GhcPs
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
GHC.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]
GHC.mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (LHsExpr GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
instance Pretty (GHC.HsSigType GHC.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 GHC.HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
..}) =
case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
GHC.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 (WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments TypeVariable -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr Specificity GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr Specificity GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
xs
Printer ()
dot
case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig_body of
GHC.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_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: forall pass. HsType pass -> XQualTy pass
..} ->
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig_body
where
flatten :: GHC.LHsType GHC.GhcPs -> [GHC.LHsType GHC.GhcPs]
flatten :: LHsType GhcPs -> [LHsType GhcPs]
flatten (GHC.L SrcSpanAnnA
_ (GHC.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 GHC.HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
..}) =
case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
GHC.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 (WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments TypeVariable -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr Specificity GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr Specificity GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
xs
Printer ()
dot
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig_body ((HsType GhcPs -> Printer ()) -> Printer ())
-> (HsType GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
GHC.HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: forall pass. HsType pass -> XQualTy 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig_body
pretty' (HsSigType' HsTypeFor
for HsTypeDir
dir GHC.HsSig {XHsSig GhcPs
LHsType GhcPs
HsOuterSigTyVarBndrs GhcPs
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: LHsType GhcPs
..}) = do
case HsOuterSigTyVarBndrs GhcPs
sig_bndrs of
GHC.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 (WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments TypeVariable -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr Specificity GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr Specificity GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity 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
<$> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
sig_body
instance Pretty
(GHC.Match
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
pretty' = Match GhcPs (LHsExpr GhcPs) -> Printer ()
Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
prettyMatchExpr
prettyMatchExpr :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> Printer ()
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyMatchExpr :: Match GhcPs (LHsExpr GhcPs) -> Printer ()
prettyMatchExpr GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamSingle, [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_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch p body
..} = do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\"
case [LPat GhcPs]
m_pats of
LPat GhcPs
p:[LPat GhcPs]
_ ->
case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p of
GHC.LazyPat {} -> Printer ()
space
GHC.BangPat {} -> Printer ()
space
Pat GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[LPat 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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 GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamCase, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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
prettyMatchExpr GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamCases, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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
#else
prettyMatchExpr GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
string "\\"
case m_pats of
p:_ ->
case GHC.unLoc p of
GHC.LazyPat {} -> space
GHC.BangPat {} -> space
_ -> return ()
_ -> return ()
spaced $ fmap pretty m_pats
pretty $ GRHSsExpr GRHSExprLambda m_grhss
#endif
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyMatchExpr GHC.Match {m_ctxt = GHC.LamCaseAlt {}, ..} = do
spaced $ fmap pretty m_pats
pretty $ GRHSsExpr GRHSExprCase m_grhss
#endif
prettyMatchExpr GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
GHC.CaseAlt, [LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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
prettyMatchExpr GHC.Match {[LPat GhcPs]
XCMatch GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LHsExpr GhcPs)
HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch p body
m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
..} =
case HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> LexicalFixity
forall fn. HsMatchContext fn -> LexicalFixity
GHC.mc_fixity HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
m_ctxt of
LexicalFixity
GHC.Prefix -> do
HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss
LexicalFixity
GHC.Infix -> do
case ([LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats, HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (GenLocated SrcSpanAnnN RdrName)
m_ctxt) of
(GenLocated SrcSpanAnnA (Pat GhcPs)
l:GenLocated SrcSpanAnnA (Pat GhcPs)
r:[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs, GHC.FunRhs {SrcStrictness
GenLocated SrcSpanAnnN RdrName
LexicalFixity
mc_fixity :: forall fn. HsMatchContext fn -> LexicalFixity
mc_fun :: GenLocated SrcSpanAnnN RdrName
mc_fixity :: LexicalFixity
mc_strictness :: SrcStrictness
mc_strictness :: forall fn. HsMatchContext fn -> SrcStrictness
mc_fun :: forall fn. HsMatchContext fn -> fn
..}) -> 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 InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName GenLocated SrcSpanAnnN RdrName
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 (LHsExpr GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss
([GenLocated SrcSpanAnnA (Pat GhcPs)],
HsMatchContext (GenLocated SrcSpanAnnN RdrName))
_ -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Not enough parameters are passed."
instance Pretty
(GHC.Match
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where
pretty' :: Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
pretty' = Match GhcPs (LHsCmd GhcPs) -> Printer ()
Match GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
prettyMatchProc
prettyMatchProc :: GHC.Match GHC.GhcPs (GHC.LHsCmd GHC.GhcPs) -> Printer ()
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyMatchProc :: Match GhcPs (LHsCmd GhcPs) -> Printer ()
prettyMatchProc GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamSingle, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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
"\\"
case [LPat GhcPs]
m_pats of
LPat GhcPs
p:[LPat GhcPs]
_ ->
case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p of
GHC.LazyPat {} -> Printer ()
space
GHC.BangPat {} -> Printer ()
space
Pat GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[LPat 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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 (LHsCmd GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m_grhss]
prettyMatchProc GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamCase, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m_grhss]
prettyMatchProc GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = GHC.LamAlt HsLamVariant
GHC.LamCases, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m_grhss]
#else
prettyMatchProc GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
string "\\"
case m_pats of
p:_ ->
case GHC.unLoc p of
GHC.LazyPat {} -> space
GHC.BangPat {} -> space
_ -> return ()
_ -> return ()
spaced $ fmap pretty m_pats ++ [pretty m_grhss]
#endif
prettyMatchProc GHC.Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcPs))
GHC.CaseAlt, [LPat GhcPs]
XCMatch GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (LHsCmd GhcPs)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch 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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GRHSs GhcPs (LHsCmd GhcPs)
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
m_grhss]
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyMatchProc GHC.Match {m_ctxt = GHC.LamCaseAlt {}, ..} = do
spaced [mapM_ pretty m_pats, pretty m_grhss]
#endif
prettyMatchProc Match GhcPs (LHsCmd GhcPs)
_ = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
instance Pretty
(GHC.StmtLR
GHC.GhcPs
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' (GHC.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' (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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' GHC.ApplicativeStmt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
pretty' (GHC.BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (GHC.L SrcSpanAnnA
loc (GHC.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
GHC.L SrcSpanAnnA
loc (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> InfixApp
InfixApp LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r))
pretty' (GHC.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' (GHC.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' (GHC.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' GHC.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_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
..} =
[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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
trS_using]
pretty' GHC.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_mfix_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_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
..} =
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 XRec
GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR 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
(GHC.StmtLR
GHC.GhcPs
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where
pretty' :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
pretty' (GHC.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' (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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' GHC.ApplicativeStmt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
pretty' (GHC.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' (GHC.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' (GHC.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' GHC.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_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
trS_using]
pretty' GHC.RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
XRec
GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
SyntaxExpr GhcPs
recS_mfix_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_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
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 XRec
GhcPs [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR 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 (GHC.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 (LHsExpr GhcPs)
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x
instance Pretty
(GHC.HsRecFields
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where
pretty' :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Printer ()
pretty' GHC.HsRecFields {[LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
..} = Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
where
horizontal :: Printer ()
horizontal =
case Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot of
Just XRec GhcPs RecFieldsDotDot
_ -> 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 (XRec GhcPs RecFieldsDotDot)
Nothing -> [Printer ()] -> Printer ()
hFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc 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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
rec_flds
instance Pretty
(GHC.HsRecFields
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' :: HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' GHC.HsRecFields {[LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds :: [LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
..} = [Printer ()] -> Printer ()
hvFields [Printer ()]
fieldPrinters
where
fieldPrinters :: [Printer ()]
fieldPrinters =
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rec_flds
[Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((GenLocated Anchor RecFieldsDotDot -> Printer ())
-> Maybe (GenLocated Anchor RecFieldsDotDot) -> 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 () -> GenLocated Anchor RecFieldsDotDot -> Printer ()
forall a b. a -> b -> a
const (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..")) Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated Anchor RecFieldsDotDot)
rec_dotdot)
instance Pretty (GHC.HsType GHC.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 (GHC.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
<$> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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
<$> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
b
pretty' (HsTypeInsideDeclSig GHC.HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: forall pass. HsType pass -> XQualTy 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body
pretty' (HsTypeInsideDeclSig (GHC.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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
a, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
b
pretty' (HsTypeInsideInstDecl GHC.HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: forall pass. HsType pass -> XQualTy 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body
pretty' (HsTypeWithVerticalAppTy (GHC.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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
r
pretty' (HsType' HsTypeFor
_ HsTypeDir
_ HsType GhcPs
x) = HsType GhcPs -> Printer ()
prettyHsType HsType GhcPs
x
prettyHsType :: GHC.HsType GHC.GhcPs -> Printer ()
prettyHsType :: HsType GhcPs -> Printer ()
prettyHsType (GHC.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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
body
prettyHsType GHC.HsQualTy {XQualTy GhcPs
LHsContext GhcPs
LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_xqual :: forall pass. HsType pass -> XQualTy 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body]
prettyHsType (GHC.HsTyVar XTyVar GhcPs
_ PromotionFlag
GHC.NotPromoted LIdP GhcPs
x) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
prettyHsType (GHC.HsTyVar XTyVar GhcPs
_ PromotionFlag
GHC.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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x)
prettyHsType x :: HsType GhcPs
x@(GHC.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 [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l, LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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
#if MIN_VERSION_ghc_lib_parser(9, 8, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsType (GHC.HsAppKindTy _ l _ r) = pretty l >> string " @" >> pretty r
#else
prettyHsType (GHC.HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
l LHsType GhcPs
r) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
r
#endif
prettyHsType (GHC.HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
a LHsType GhcPs
b) = (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
b
prettyHsType (GHC.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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
xs
prettyHsType (GHC.HsTupleTy XTupleTy GhcPs
_ HsTupleSort
GHC.HsUnboxedTuple []) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(# #)"
prettyHsType (GHC.HsTupleTy XTupleTy GhcPs
_ HsTupleSort
GHC.HsBoxedOrConstraintTuple []) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"()"
prettyHsType (GHC.HsTupleTy XTupleTy GhcPs
_ HsTupleSort
GHC.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 [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
prettyHsType (GHC.HsTupleTy XTupleTy GhcPs
_ HsTupleSort
GHC.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 [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
prettyHsType (GHC.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 [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyHsType (GHC.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 LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l
Printer ()
newline
GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
op
Printer ()
space
GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
r
else [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l, GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
op, GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
r]
#else
prettyHsType (GHC.HsOpTy _ l op r) = do
lineBreak <- gets (configLineBreaks . psConfig)
if showOutputable op `elem` lineBreak
then do
pretty l
newline
pretty $ fmap mkInfixName op
space
pretty r
else spaced [pretty l, pretty $ fmap mkInfixName op, pretty r]
#endif
prettyHsType (GHC.HsParTy 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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
inside
prettyHsType (GHC.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 EpAnnCO HsIPName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs HsIPName
GenLocated EpAnnCO HsIPName
x, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty]
prettyHsType GHC.HsStarTy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"*"
prettyHsType (GHC.HsKindSig XKindSig GhcPs
_ LHsType GhcPs
t LHsType GhcPs
k) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
k]
prettyHsType (GHC.HsSpliceTy XSpliceTy GhcPs
_ HsUntypedSplice GhcPs
sp) = Splice -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Splice -> Printer ()) -> Splice -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs -> Splice
mkSplice HsUntypedSplice GhcPs
sp
prettyHsType GHC.HsDocTy {} = Printer ()
forall a. HasCallStack => a
docNode
prettyHsType (GHC.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 LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x
prettyHsType (GHC.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 (WithComments RecordField -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments RecordField -> Printer ())
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments RecordField)
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConDeclField GhcPs -> RecordField)
-> WithComments (ConDeclField GhcPs) -> WithComments RecordField
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConDeclField GhcPs -> RecordField
mkRecordField (WithComments (ConDeclField GhcPs) -> WithComments RecordField)
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments (ConDeclField GhcPs))
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments RecordField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments (ConDeclField GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
xs
prettyHsType (GHC.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 [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
prettyHsType (GHC.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 [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
prettyHsType (GHC.HsTyLit XTyLit GhcPs
_ HsTyLit GhcPs
x) = HsTyLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsTyLit GhcPs
x
prettyHsType GHC.HsWildCardTy {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"_"
prettyHsType GHC.XHsType {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
instance Pretty
(GHC.GRHSs
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.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 = GHC.GRHSs {[LGRHS GhcPs (LHsExpr GhcPs)]
XCGRHSs GhcPs (LHsExpr GhcPs)
HsLocalBinds GhcPs
grhssExt :: XCGRHSs GhcPs (LHsExpr GhcPs)
grhssGRHSs :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhssLocalBinds :: HsLocalBinds GhcPs
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
..}, GRHSExprType
grhssExprType :: GRHSExprType
grhssExprType :: GRHSsExpr -> GRHSExprType
..}) = do
(GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ())
-> [GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated EpAnnCO GRHSExpr -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated EpAnnCO GRHSExpr -> Printer ())
-> (GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated EpAnnCO GRHSExpr)
-> GenLocated
EpAnnCO (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
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated EpAnnCO GRHSExpr
forall a b.
(a -> b) -> GenLocated EpAnnCO a -> GenLocated EpAnnCO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GRHSExprType -> GRHS GhcPs (LHsExpr GhcPs) -> GRHSExpr
GRHSExpr GRHSExprType
grhssExprType)) [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhssGRHSs
case (HsLocalBinds GhcPs
grhssLocalBinds, GRHSExprType
grhssExprType) of
(GHC.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
(GHC.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 SrcSpanAnnL (HsValBindsLR GhcPs GhcPs)
-> (HsValBindsLR GhcPs GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (SrcSpanAnnL
-> HsValBindsLR GhcPs GhcPs
-> GenLocated SrcSpanAnnL (HsValBindsLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L XHsValBinds GhcPs GhcPs
SrcSpanAnnL
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
(GHC.GRHSs
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsCmd GHC.GhcPs))) where
pretty' :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> Printer ()
pretty' GHC.GRHSs {[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
HsLocalBinds GhcPs
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssExt :: XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
grhssGRHSs :: [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
grhssLocalBinds :: HsLocalBinds GhcPs
..} = do
(GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> Printer ())
-> [GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GenLocated EpAnnCO GRHSProc -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated EpAnnCO GRHSProc -> Printer ())
-> (GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated EpAnnCO GRHSProc)
-> GenLocated
EpAnnCO (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
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))
-> GenLocated EpAnnCO GRHSProc
forall a b.
(a -> b) -> GenLocated EpAnnCO a -> GenLocated EpAnnCO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GRHS GhcPs (LHsCmd GhcPs) -> GRHSProc
GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)) -> GRHSProc
GRHSProc) [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))]
[GenLocated
EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
grhssGRHSs
case HsLocalBinds GhcPs
grhssLocalBinds of
(GHC.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 SrcSpanAnnL (HsValBindsLR GhcPs GhcPs)
-> (HsValBindsLR GhcPs GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd (SrcSpanAnnL
-> HsValBindsLR GhcPs GhcPs
-> GenLocated SrcSpanAnnL (HsValBindsLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L XHsValBinds GhcPs GhcPs
SrcSpanAnnL
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 ()
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty
(GHC.HsMatchContext (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)) where
pretty' :: HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> Printer ()
pretty' = HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> Printer ()
prettyHsMatchContext
prettyHsMatchContext ::
GHC.HsMatchContext (GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)
-> Printer ()
prettyHsMatchContext :: HsMatchContext (GenLocated SrcSpanAnnN RdrName) -> Printer ()
prettyHsMatchContext GHC.FunRhs {SrcStrictness
GenLocated SrcSpanAnnN RdrName
LexicalFixity
mc_fixity :: forall fn. HsMatchContext fn -> LexicalFixity
mc_strictness :: forall fn. HsMatchContext fn -> SrcStrictness
mc_fun :: forall fn. HsMatchContext fn -> fn
mc_fun :: GenLocated SrcSpanAnnN RdrName
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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName GenLocated SrcSpanAnnN RdrName
mc_fun)
prettyHsMatchContext HsMatchContext (GenLocated SrcSpanAnnN RdrName)
GHC.CaseAlt = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyHsMatchContext GHC.IfAlt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.ArrowMatchCtxt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.PatBindRhs {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.PatBindGuards {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.RecUpd {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.StmtCtxt {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.ThPatSplice {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.ThPatQuote {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
prettyHsMatchContext GHC.PatSyn {} = Printer ()
forall a. HasCallStack => a
notGeneratedByParser
#else
instance Pretty (GHC.HsMatchContext GHC.GhcPs) where
pretty' = prettyHsMatchContext
prettyHsMatchContext :: GHC.HsMatchContext GHC.GhcPs -> Printer ()
prettyHsMatchContext GHC.FunRhs {..} =
pretty mc_strictness >> pretty (fmap mkPrefixName mc_fun)
prettyHsMatchContext GHC.LambdaExpr = return ()
prettyHsMatchContext GHC.CaseAlt = return ()
prettyHsMatchContext GHC.IfAlt {} = notGeneratedByParser
prettyHsMatchContext GHC.ArrowMatchCtxt {} = notGeneratedByParser
prettyHsMatchContext GHC.PatBindRhs {} = notGeneratedByParser
prettyHsMatchContext GHC.PatBindGuards {} = notGeneratedByParser
prettyHsMatchContext GHC.RecUpd {} = notGeneratedByParser
prettyHsMatchContext GHC.StmtCtxt {} = notGeneratedByParser
prettyHsMatchContext GHC.ThPatSplice {} = notGeneratedByParser
prettyHsMatchContext GHC.ThPatQuote {} = notGeneratedByParser
prettyHsMatchContext GHC.PatSyn {} = notGeneratedByParser
#if MIN_VERSION_ghc_lib_parser(9, 4, 1)
prettyHsMatchContext GHC.LamCaseAlt {} = notUsedInParsedStage
#endif
#endif
instance Pretty (GHC.ParStmtBlock GHC.GhcPs GHC.GhcPs) where
pretty' :: ParStmtBlock GhcPs GhcPs -> Printer ()
pretty' (GHC.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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
instance Pretty ParStmtBlockInsideVerticalList where
pretty' :: ParStmtBlockInsideVerticalList -> Printer ()
pretty' (ParStmtBlockInsideVerticalList (GHC.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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
instance Pretty
(GHC.GRHS
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.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 = (GHC.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
GHC.unLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body of
GHC.HsDo XDo GhcPs
_ (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts))
GHC.HsDo XDo GhcPs
_ (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts))
GHC.OpApp XOpApp GhcPs
_ (GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body
GHC.OpApp XOpApp GhcPs
_ (GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = (GHC.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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body ((HsExpr GhcPs -> Printer ()) -> Printer ())
-> (HsExpr GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
GHC.HsDo XDo GhcPs
_ (GHC.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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
GHC.HsDo XDo GhcPs
_ (GHC.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) XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (GHC.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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
body ((HsCmd GhcPs -> Printer ()) -> Printer ())
-> (HsCmd GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \case
GHC.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 XRec GhcPs [CmdLStmt GhcPs]
GenLocated SrcSpanAnnL [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 XRec GhcPs [CmdLStmt GhcPs]
GenLocated SrcSpanAnnL [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 GHC.EpaCommentTok where
pretty' :: EpaCommentTok -> Printer ()
pretty' (GHC.EpaLineComment String
c) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
c
pretty' (GHC.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
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 (GHC.Pat GHC.GhcPs) where
pretty' :: Pat GhcPs -> Printer ()
pretty' = Pat GhcPs -> Printer ()
prettyPat
instance Pretty PatInsidePatDecl where
pretty' :: PatInsidePatDecl -> Printer ()
pretty' (PatInsidePatDecl (GHC.ConPat {pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = (GHC.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 :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con_ext :: forall p. Pat p -> XConPat p
..})) =
[Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
pat_con, GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r]
pretty' (PatInsidePatDecl Pat GhcPs
x) = Pat GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Pat GhcPs
x
prettyPat :: GHC.Pat GHC.GhcPs -> Printer ()
prettyPat :: Pat GhcPs -> Printer ()
prettyPat GHC.WildPat {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"_"
prettyPat (GHC.VarPat XVarPat GhcPs
_ LIdP GhcPs
x) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
prettyPat (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x
#if MIN_VERSION_ghc_lib_parser(9, 6, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyPat (GHC.AsPat _ a _ b) =
pretty (fmap mkPrefixName a) >> string "@" >> pretty b
#else
prettyPat (GHC.AsPat XAsPat GhcPs
_ LIdP GhcPs
a LPat GhcPs
b) =
GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
b
#endif
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyPat (GHC.ParPat _ _ inner _) = parens $ pretty inner
#else
prettyPat (GHC.ParPat XParPat GhcPs
_ LPat GhcPs
inner) = 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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
inner
#endif
prettyPat (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x
prettyPat (GHC.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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs
prettyPat (GHC.TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
GHC.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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
prettyPat (GHC.TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
GHC.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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
prettyPat (GHC.SumPat XSumPat GhcPs
_ LPat GhcPs
x SumWidth
position SumWidth
numElem) = do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(#"
[SumWidth] -> (SumWidth -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SumWidth
1 .. SumWidth
numElem] ((SumWidth -> Printer ()) -> Printer ())
-> (SumWidth -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \SumWidth
idx -> do
if SumWidth
idx SumWidth -> SumWidth -> Bool
forall a. Eq a => a -> a -> Bool
== SumWidth
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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 (SumWidth
idx SumWidth -> SumWidth -> Bool
forall a. Ord a => a -> a -> Bool
< SumWidth
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 GHC.ConPat {XConPat GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsConDetails
(HsConPatTyArg (NoGhcTc GhcPs))
(LPat GhcPs)
(HsRecFields GhcPs (LPat GhcPs))
pat_args :: forall p. Pat p -> HsConPatDetails p
pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext :: XConPat GhcPs
pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_args :: HsConDetails
(HsConPatTyArg (NoGhcTc GhcPs))
(LPat GhcPs)
(HsRecFields GhcPs (LPat GhcPs))
..} =
case HsConDetails
(HsConPatTyArg (NoGhcTc GhcPs))
(LPat GhcPs)
(HsRecFields GhcPs (LPat GhcPs))
pat_args of
GHC.PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
_ [LPat GhcPs]
as -> do
GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
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 [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
as
GHC.RecCon HsRecFields GhcPs (LPat GhcPs)
rec ->
(GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
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)
GHC.InfixCon LPat GhcPs
a LPat GhcPs
b -> do
GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
a
RdrName -> Printer () -> Printer ()
unlessSpecialOp (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
pat_con) Printer ()
space
GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
pat_con
RdrName -> Printer () -> Printer ()
unlessSpecialOp (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
pat_con) Printer ()
space
GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
b
prettyPat (GHC.ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
l LPat GhcPs
r) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"->", GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r]
prettyPat (GHC.SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
x) = Splice -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Splice -> Printer ()) -> Splice -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs -> Splice
mkSplice HsUntypedSplice GhcPs
x
prettyPat (GHC.LitPat XLitPat GhcPs
_ HsLit GhcPs
x) = HsLit GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsLit GhcPs
x
prettyPat (GHC.NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
x Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_) = GenLocated EpAnnCO (HsOverLit GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs (HsOverLit GhcPs)
GenLocated EpAnnCO (HsOverLit GhcPs)
x
prettyPat (GHC.NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) =
GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
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 EpAnnCO (HsOverLit GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs (HsOverLit GhcPs)
GenLocated EpAnnCO (HsOverLit GhcPs)
k
prettyPat (GHC.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 LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 GHC.HsRecFields {[LHsRecField GhcPs (LPat GhcPs)]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds :: [LHsRecField GhcPs (LPat GhcPs)]
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
..}) =
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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (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 SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> GenLocated SrcSpanAnnA RecConField)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> RecConField)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (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 (LFieldOcc GhcPs) (LPat GhcPs) -> RecConField
HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> RecConField
RecConField) [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
rec_flds
[Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((GenLocated Anchor RecFieldsDotDot -> Printer ())
-> Maybe (GenLocated Anchor RecFieldsDotDot) -> 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 () -> GenLocated Anchor RecFieldsDotDot -> Printer ()
forall a b. a -> b -> a
const (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..")) Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated Anchor RecFieldsDotDot)
rec_dotdot)
instance Pretty SBF.SigBindFamily where
pretty' :: SigBindFamily -> Printer ()
pretty' (SBF.Sig Sig GhcPs
x) = Signature -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Signature -> Printer ()) -> Signature -> Printer ()
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> Signature
mkSignature Sig GhcPs
x
pretty' (SBF.Bind HsBindLR GhcPs GhcPs
x) = Bind -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (Bind -> Printer ()) -> Bind -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsBindLR GhcPs GhcPs -> Bind
mkBind HsBindLR GhcPs GhcPs
x
pretty' (SBF.TypeFamily FamilyDecl GhcPs
x)
| Just TypeFamily
fam <- FamilyDecl GhcPs -> Maybe TypeFamily
mkTypeFamily FamilyDecl GhcPs
x = TypeFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TypeFamily
fam
| Bool
otherwise = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Unreachable"
pretty' (SBF.TyFamInst TyFamInstDecl GhcPs
x) = TyFamInstDecl GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TyFamInstDecl GhcPs
x
pretty' (SBF.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 GHC.EpaComment where
pretty' :: EpaComment -> Printer ()
pretty' GHC.EpaComment {RealSrcSpan
EpaCommentTok
ac_tok :: EpaCommentTok
ac_prior_tok :: RealSrcSpan
ac_prior_tok :: EpaComment -> RealSrcSpan
ac_tok :: EpaComment -> EpaCommentTok
..} = EpaCommentTok -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaCommentTok
ac_tok
instance Pretty (GHC.HsLocalBindsLR GHC.GhcPs GHC.GhcPs) where
pretty' :: HsLocalBinds GhcPs -> Printer ()
pretty' (GHC.HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
lr) = HsValBindsLR GhcPs GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsValBindsLR GhcPs GhcPs
lr
pretty' (GHC.HsIPBinds XHsIPBinds GhcPs GhcPs
_ HsIPBinds GhcPs
x) = HsIPBinds GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsIPBinds GhcPs
x
pretty' GHC.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 (GHC.HsValBindsLR GHC.GhcPs GHC.GhcPs) where
pretty' :: HsValBindsLR GhcPs GhcPs -> Printer ()
pretty' (GHC.ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs 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]
-> [LTyFamInstDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
SBF.mkSortedLSigBindFamilyList [LSig GhcPs]
sigs (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
GHC.bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
methods) [] [] []
pretty' GHC.XValBindsLR {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
instance Pretty (GHC.HsTupArg GHC.GhcPs) where
pretty' :: HsTupArg GhcPs -> Printer ()
pretty' (GHC.Present XPresent GhcPs
_ LHsExpr GhcPs
e) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
pretty' GHC.Missing {} = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty RecConField where
pretty' :: RecConField -> Printer ()
pretty' (RecConField GHC.HsFieldBind {Bool
XHsFieldBind (LFieldOcc GhcPs)
LPat GhcPs
LFieldOcc GhcPs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbLHS :: LFieldOcc GhcPs
hfbRHS :: LPat GhcPs
hfbPun :: Bool
..}) = do
GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LFieldOcc GhcPs
GenLocated SrcSpanAnnA (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
" = "
GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
hfbRHS
#else
instance Pretty
(GHC.HsRecField'
(GHC.FieldOcc GHC.GhcPs)
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where
pretty' GHC.HsRecField {..} =
(pretty hsRecFieldLbl >> string " = ") |=> pretty hsRecFieldArg
instance Pretty
(GHC.HsRecField'
(GHC.FieldOcc GHC.GhcPs)
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' GHC.HsRecField {..} = do
pretty hsRecFieldLbl
unless hsRecPun $ do
string " ="
horizontal <-|> vertical
where
horizontal = space >> pretty hsRecFieldArg
vertical = newline >> indentedBlock (pretty hsRecFieldArg)
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty
(GHC.HsFieldBind
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.FieldOcc GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where
pretty' :: HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> Printer ()
pretty' GHC.HsFieldBind {Bool
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
GenLocated SrcSpanAnnA (Pat GhcPs)
GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbLHS :: GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (Pat GhcPs)
hfbPun :: Bool
..} =
(GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (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
instance Pretty
(GHC.HsFieldBind
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.FieldOcc GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' :: HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Printer ()
pretty' GHC.HsFieldBind {Bool
XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
GenLocated SrcSpanAnnA (HsExpr GhcPs)
GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
hfbLHS :: GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbPun :: Bool
..} = do
GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (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)
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
instance Pretty
(GHC.HsFieldBind
(GHC.GenLocated (GHC.SrcAnn GHC.NoEpAnns) (GHC.FieldOcc GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.Pat GHC.GhcPs))) where
pretty' GHC.HsFieldBind {..} =
(pretty hfbLHS >> string " = ") |=> pretty hfbRHS
instance Pretty
(GHC.HsFieldBind
(GHC.GenLocated (GHC.SrcAnn GHC.NoEpAnns) (GHC.FieldOcc GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsExpr GHC.GhcPs))) where
pretty' GHC.HsFieldBind {..} = do
pretty hfbLHS
unless hfbPun $ do
string " ="
horizontal <-|> vertical
where
horizontal = space >> pretty hfbRHS
vertical = newline >> indentedBlock (pretty hfbRHS)
#else
instance Pretty RecConField where
pretty' (RecConField GHC.HsRecField {..}) = do
pretty hsRecFieldLbl
unless hsRecPun $ do
string " = "
pretty hsRecFieldArg
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty (GHC.FieldOcc GHC.GhcPs) where
pretty' :: FieldOcc GhcPs -> Printer ()
pretty' GHC.FieldOcc {XCFieldOcc GhcPs
XRec GhcPs RdrName
foExt :: XCFieldOcc GhcPs
foLabel :: XRec GhcPs RdrName
foLabel :: forall pass. FieldOcc pass -> XRec pass RdrName
foExt :: forall pass. FieldOcc pass -> XCFieldOcc pass
..} = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
foLabel
#else
instance Pretty (GHC.FieldOcc GHC.GhcPs) where
pretty' GHC.FieldOcc {..} = pretty $ fmap mkPrefixName rdrNameFieldOcc
#endif
instance Pretty a => Pretty (GHC.HsScaled GHC.GhcPs a) where
pretty' :: HsScaled GhcPs a -> Printer ()
pretty' (GHC.HsScaled HsArrow GhcPs
_ a
x) = a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty a
x
instance Pretty InfixExpr where
pretty' :: InfixExpr -> Printer ()
pretty' (InfixExpr (GHC.L SrcSpanAnnA
_ (GHC.HsVar XVar GhcPs
_ LIdP GhcPs
bind))) =
GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN InfixName -> Printer ())
-> GenLocated SrcSpanAnnN InfixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
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 -> InfixName
mkInfixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
bind
pretty' (InfixExpr LHsExpr GhcPs
x) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty InfixApp where
pretty' :: InfixApp -> Printer ()
pretty' InfixApp {LHsExpr GhcPs
lhs :: LHsExpr GhcPs
op :: LHsExpr GhcPs
rhs :: LHsExpr GhcPs
rhs :: InfixApp -> LHsExpr GhcPs
op :: InfixApp -> LHsExpr GhcPs
lhs :: InfixApp -> LHsExpr GhcPs
..} = 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs]
vertical :: Printer ()
vertical =
case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op of
GHC.Fixity SourceText
_ SumWidth
_ FixityDirection
GHC.InfixL -> Printer ()
leftAssoc
GHC.Fixity SourceText
_ SumWidth
_ FixityDirection
GHC.InfixR -> Printer ()
rightAssoc
GHC.Fixity SourceText
_ SumWidth
_ FixityDirection
GHC.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
| GHC.L SrcSpanAnnA
_ (GHC.OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
_) <- LHsExpr GhcPs
lhs
, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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, GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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, GHC.L SrcSpanAnnA
_ (GHC.HsDo XDo GhcPs
_ (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 XRec GhcPs [ExprLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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@(GHC.L SrcSpanAnnA
_ GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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
GHC.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
GHC.varToStr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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
$ LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect (GHC.L SrcSpanAnnA
_ (GHC.OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r))
| GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
r GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]
collect (GHC.L SrcSpanAnnA
_ (GHC.OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r))
| GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSameAssoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
l GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 -> GHC.Fixity SourceText
_ SumWidth
lv FixityDirection
d) = SumWidth
lv SumWidth -> SumWidth -> Bool
forall a. Eq a => a -> a -> Bool
== SumWidth
level Bool -> Bool -> Bool
&& FixityDirection
d FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
dir
GHC.Fixity SourceText
_ SumWidth
level FixityDirection
dir = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Fixity
findFixity LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op
#else
instance Pretty InfixApp where
pretty' InfixApp {..} = horizontal <-|> vertical
where
horizontal = spaced [pretty lhs, pretty (InfixExpr op), pretty rhs]
vertical =
case findFixity op of
GHC.Fixity _ _ GHC.InfixL -> leftAssoc
GHC.Fixity _ _ GHC.InfixR -> rightAssoc
GHC.Fixity _ _ GHC.InfixN -> noAssoc
leftAssoc = prettyOps allOperantsAndOperatorsLeftAssoc
rightAssoc = prettyOps allOperantsAndOperatorsRightAssoc
noAssoc
| GHC.L _ (GHC.OpApp _ _ o _) <- lhs
, isSameAssoc o = leftAssoc
| otherwise = rightAssoc
prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.DoExpr m) xs)] = do
spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Do]
newline
indentedBlock $ printCommentsAnd xs (lined . fmap pretty)
prettyOps [l, o, GHC.L _ (GHC.HsDo _ (GHC.MDoExpr m) xs)] = do
spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Mdo]
newline
indentedBlock $ printCommentsAnd xs (lined . fmap pretty)
prettyOps [l, o, r@(GHC.L _ GHC.HsLam {})] = do
spaced [pretty l, pretty $ InfixExpr o, pretty r]
prettyOps [l, o, r@(GHC.L _ GHC.HsLamCase {})] = do
spaced [pretty l, pretty $ InfixExpr o, pretty r]
prettyOps (l:xs) = do
pretty l
newline
indentedBlock $ f xs
where
f (o:r:rems) = do
(pretty (InfixExpr o) >> space) |=> pretty r
unless (null rems) $ do
newline
f rems
f _ =
error
"The number of the sum of operants and operators should be odd."
prettyOps _ = error "Too short list."
findFixity o =
fromMaybe GHC.defaultFixity $ lookup (GHC.varToStr o) fixities
allOperantsAndOperatorsLeftAssoc = reverse $ rhs : op : collect lhs
where
collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
collect (GHC.L _ (GHC.OpApp _ l o r))
| isSameAssoc o = r : o : collect l
collect x = [x]
allOperantsAndOperatorsRightAssoc = lhs : op : collect rhs
where
collect :: GHC.LHsExpr GHC.GhcPs -> [GHC.LHsExpr GHC.GhcPs]
collect (GHC.L _ (GHC.OpApp _ l o r))
| isSameAssoc o = l : o : collect r
collect x = [x]
isSameAssoc (findFixity -> GHC.Fixity _ lv d) = lv == level && d == dir
GHC.Fixity _ level dir = findFixity op
#endif
instance Pretty (GHC.FieldLabelStrings GHC.GhcPs) where
pretty' :: FieldLabelStrings GhcPs -> Printer ()
pretty' (GHC.FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
xs) = [Printer ()] -> Printer ()
hDotSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ())
-> [GenLocated EpAnnCO (DotFieldOcc GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated EpAnnCO (DotFieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [XRec GhcPs (DotFieldOcc GhcPs)]
[GenLocated EpAnnCO (DotFieldOcc GhcPs)]
xs
instance Pretty (GHC.AmbiguousFieldOcc GHC.GhcPs) where
pretty' :: AmbiguousFieldOcc GhcPs -> Printer ()
pretty' (GHC.Unambiguous XUnambiguous GhcPs
_ XRec GhcPs RdrName
name) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
name
pretty' (GHC.Ambiguous XAmbiguous GhcPs
_ XRec GhcPs RdrName
name) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
name
instance Pretty (GHC.DerivClauseTys GHC.GhcPs) where
pretty' :: DerivClauseTys GhcPs -> Printer ()
pretty' (GHC.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 LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
pretty' (GHC.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 [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
ts
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty GHC.StringLiteral where
pretty' :: StringLiteral -> Printer ()
pretty' GHC.StringLiteral {sl_st :: StringLiteral -> SourceText
sl_st = GHC.SourceText FastString
s} = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
s
pretty' GHC.StringLiteral {Maybe NoCommentsLocation
FastString
SourceText
sl_st :: StringLiteral -> SourceText
sl_st :: SourceText
sl_fs :: FastString
sl_tc :: Maybe NoCommentsLocation
sl_tc :: StringLiteral -> Maybe NoCommentsLocation
sl_fs :: StringLiteral -> FastString
..} = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
sl_fs
#else
instance Pretty GHC.StringLiteral where
pretty' = output
#endif
instance Pretty (GHC.ArithSeqInfo GHC.GhcPs) where
pretty' :: ArithSeqInfo GhcPs -> Printer ()
pretty' (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from, HasCallStack => String -> Printer ()
String -> Printer ()
string String
".."]
pretty' (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
next, HasCallStack => String -> Printer ()
String -> Printer ()
string String
".."]
pretty' (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to]
pretty' (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
next, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"..", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to]
instance Pretty (GHC.HsForAllTelescope GHC.GhcPs) where
pretty' :: HsForAllTelescope GhcPs -> Printer ()
pretty' GHC.HsForAllVis {[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_xvis :: XHsForAllVis GhcPs
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis 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 (WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments TypeVariable -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> WithComments TypeVariable)
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr () GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr () GhcPs) -> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr () GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr () GhcPs) -> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> WithComments (HsTyVarBndr () GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> WithComments (HsTyVarBndr () GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
hsf_vis_bndrs
Printer ()
dot
pretty' GHC.HsForAllInvis {[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: XHsForAllInvis GhcPs
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis 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 (WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (WithComments TypeVariable -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTyVarBndr Specificity GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr Specificity GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
hsf_invis_bndrs
Printer ()
dot
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 LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType 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
(GHC.L SrcSpanAnnC
_ []) -> Printer a -> Printer a
forall a. Printer a -> Printer a
parens
(GHC.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@(GHC.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 LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType 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@(GHC.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 LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType 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 LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType 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 (GHC.L _ []) -> parens
Just (GHC.L _ [_]) -> id
Just _ -> parens
instance Pretty VerticalContext where
pretty' (VerticalContext Nothing) = pure ()
pretty' (VerticalContext (Just (GHC.L _ []))) = string "()"
pretty' (VerticalContext (Just full@(GHC.L _ [x]))) =
printCommentsAnd full (const $ pretty x)
pretty' (VerticalContext (Just xs)) =
printCommentsAnd xs (vTuple . fmap pretty)
#endif
instance Pretty GHC.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]
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty (GHC.IE GHC.GhcPs) where
pretty' :: IE GhcPs -> Printer ()
pretty' (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
pretty' (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
pretty' (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = do
GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(..)"
pretty' x :: IE GhcPs
x@GHC.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
x':[String]
xs' -> do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
x'
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]
xs'
pretty' (GHC.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)
-> GenLocated SrcSpanAnnA 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 XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
name
pretty' GHC.IEGroup {} = Printer ()
forall a. HasCallStack => a
docNode
pretty' GHC.IEDoc {} = Printer ()
forall a. HasCallStack => a
docNode
pretty' GHC.IEDocNamed {} = Printer ()
forall a. HasCallStack => a
docNode
#else
instance Pretty (GHC.IE GHC.GhcPs) where
pretty' (GHC.IEVar _ name) = pretty name
pretty' (GHC.IEThingAbs _ name) = pretty name
pretty' (GHC.IEThingAll _ name) = do
pretty name
string "(..)"
pretty' x@GHC.IEThingWith {} =
case lines $ showOutputable x of
[] -> pure ()
[x'] -> string x'
x':xs' -> do
string x'
indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> xs'
pretty' (GHC.IEModuleContents _ name) =
pretty $ fmap ModuleNameWithPrefix name
pretty' GHC.IEGroup {} = docNode
pretty' GHC.IEDoc {} = docNode
pretty' GHC.IEDocNamed {} = docNode
#endif
instance Pretty
(GHC.FamEqn
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
pretty' :: FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> Printer ()
pretty' GHC.FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LIdP GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
..} = do
GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
feqn_tycon
[Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ())
-> [HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsFamEqnPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType 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
instance Pretty (GHC.FamEqn GHC.GhcPs (GHC.HsDataDefn GHC.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
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
instance Pretty FamEqn' where
pretty' :: FamEqn' -> Printer ()
pretty' FamEqn' {famEqn :: FamEqn' -> FamEqn GhcPs (HsDataDefn GhcPs)
famEqn = GHC.FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (HsDataDefn GhcPs)
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
HsDataDefn GhcPs
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats 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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
feqn_tycon)
Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ())
-> [HsArg
GhcPs
(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
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsFamEqnPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
feqn_pats
DataBody -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsDataDefn GhcPs -> DataBody
mkDataBody HsDataDefn GhcPs
feqn_rhs)
where
prefix :: String
prefix =
case (DataFamInstDeclFor
famEqnFor, HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons HsDataDefn GhcPs
feqn_rhs) of
(DataFamInstDeclFor
DataFamInstDeclForTopLevel, GHC.NewTypeCon {}) -> String
"newtype instance"
(DataFamInstDeclFor
DataFamInstDeclForTopLevel, GHC.DataTypeCons {}) -> String
"data instance"
(DataFamInstDeclFor
DataFamInstDeclForInsideClassInst, GHC.NewTypeCon {}) -> String
"newtype"
(DataFamInstDeclFor
DataFamInstDeclForInsideClassInst, GHC.DataTypeCons {}) -> String
"data"
#else
instance Pretty FamEqn' where
pretty' FamEqn' {famEqn = GHC.FamEqn {..}, ..} = do
spaced
$ string prefix
: pretty (fmap mkPrefixName feqn_tycon)
: fmap pretty feqn_pats
pretty (mkDataBody feqn_rhs)
where
prefix =
case (famEqnFor, GHC.dd_ND feqn_rhs) of
(DataFamInstDeclForTopLevel, GHC.NewType) -> "newtype instance"
(DataFamInstDeclForTopLevel, GHC.DataType) -> "data instance"
(DataFamInstDeclForInsideClassInst, GHC.NewType) -> "newtype"
(DataFamInstDeclForInsideClassInst, GHC.DataType) -> "data"
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
instance Pretty
(GHC.HsArg
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
pretty' :: HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
pretty' (GHC.HsValArg XValArg GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
x) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
x
pretty' (GHC.HsTypeArg XTypeArg GhcPs
_ 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' GHC.HsArgPar {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)
instance Pretty
(GHC.HsArg
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
pretty' (GHC.HsValArg x) = pretty x
pretty' (GHC.HsTypeArg _ x) = string "@" >> pretty x
pretty' GHC.HsArgPar {} = notUsedInParsedStage
#else
instance Pretty
(GHC.HsArg
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
pretty' (GHC.HsValArg x) = pretty x
pretty' (GHC.HsTypeArg _ x) = string "@" >> pretty x
pretty' GHC.HsArgPar {} = notUsedInParsedStage
#endif
#if MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs) where
pretty' :: WithHsDocIdentifiers StringLiteral GhcPs -> Printer ()
pretty' GHC.WithHsDocIdentifiers {[Located (IdP GhcPs)]
StringLiteral
hsDocString :: StringLiteral
hsDocIdentifiers :: [Located (IdP GhcPs)]
hsDocIdentifiers :: forall a pass. WithHsDocIdentifiers a pass -> [Located (IdP pass)]
hsDocString :: forall a pass. WithHsDocIdentifiers a pass -> a
..} = StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StringLiteral
hsDocString
#endif
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance Pretty (GHC.IEWrappedName GHC.GhcPs) where
pretty' :: IEWrappedName GhcPs -> Printer ()
pretty' (GHC.IEName XIEName GhcPs
_ LIdP GhcPs
name) = GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
name
pretty' (GHC.IEPattern XIEPattern GhcPs
_ LIdP GhcPs
name) =
[Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"pattern", GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> GenLocated SrcSpanAnnN PrefixName -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
name]
pretty' (GHC.IEType XIEType GhcPs
_ LIdP GhcPs
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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
name)
#else
instance Pretty (GHC.IEWrappedName GHC.RdrName) where
pretty' (GHC.IEName name) = pretty $ fmap mkPrefixName name
pretty' (GHC.IEPattern _ name) =
spaced [string "pattern", pretty $ fmap mkPrefixName name]
pretty' (GHC.IEType _ name) =
string "type " >> pretty (fmap mkPrefixName name)
#endif
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance Pretty (GHC.DotFieldOcc GHC.GhcPs) where
pretty' :: DotFieldOcc GhcPs -> Printer ()
pretty' GHC.DotFieldOcc {XCDotFieldOcc GhcPs
XRec GhcPs FieldLabelString
dfoExt :: XCDotFieldOcc GhcPs
dfoLabel :: XRec GhcPs FieldLabelString
dfoLabel :: forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoExt :: forall p. DotFieldOcc p -> XCDotFieldOcc p
..} = GenLocated SrcSpanAnnN FieldLabelString
-> (FieldLabelString -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd XRec GhcPs FieldLabelString
GenLocated SrcSpanAnnN FieldLabelString
dfoLabel FieldLabelString -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
#elif MIN_VERSION_ghc_lib_parser(9,4,1)
instance Pretty (GHC.DotFieldOcc GHC.GhcPs) where
pretty' GHC.DotFieldOcc {..} =
printCommentsAnd dfoLabel (string . GHC.unpackFS)
#else
instance Pretty (GHC.HsFieldLabel GHC.GhcPs) where
pretty' GHC.HsFieldLabel {..} =
printCommentsAnd hflLabel (string . GHC.unpackFS)
#endif
instance Pretty GHC.OccName where
pretty' :: OccName -> Printer ()
pretty' = OccName -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output
instance Pretty
(GHC.HsWildCardBndrs
GHC.GhcPs
(GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
pretty' :: HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
pretty' GHC.HsWC {XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
GenLocated SrcSpanAnnA (HsType GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_ext :: XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
hswc_body :: GenLocated SrcSpanAnnA (HsType GhcPs)
hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
..} = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty GenLocated SrcSpanAnnA (HsType GhcPs)
hswc_body
instance Pretty (GHC.TyFamInstDecl GHC.GhcPs) where
pretty' :: TyFamInstDecl GhcPs -> Printer ()
pretty' GHC.TyFamInstDecl {XCTyFamInstDecl GhcPs
TyFamInstEqn GhcPs
tfid_xtn :: XCTyFamInstDecl GhcPs
tfid_eqn :: TyFamInstEqn GhcPs
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl 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 TyFamInstEqn GhcPs
FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
tfid_eqn
instance Pretty TopLevelTyFamInstDecl where
pretty' :: TopLevelTyFamInstDecl -> Printer ()
pretty' (TopLevelTyFamInstDecl GHC.TyFamInstDecl {XCTyFamInstDecl GhcPs
TyFamInstEqn GhcPs
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl 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 TyFamInstEqn GhcPs
FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
tfid_eqn
instance Pretty (GHC.DataFamInstDecl GHC.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 = GHC.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
(GHC.HsConDetails
Void
(GHC.GenLocated GHC.SrcSpanAnnN GHC.RdrName)
[GHC.RecordPatSynField GHC.GhcPs]) where
pretty' :: HsConDetails
Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField GhcPs]
-> Printer ()
pretty' (GHC.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 PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnN PrefixName -> Printer ())
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
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 -> PrefixName
mkPrefixName) [GenLocated SrcSpanAnnN RdrName]
xs
pretty' (GHC.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' GHC.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 (GHC.HsPatSynDir GHC.GhcPs) where
pretty' :: HsPatSynDir GhcPs -> Printer ()
pretty' HsPatSynDir GhcPs
GHC.Unidirectional = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"<-"
pretty' HsPatSynDir GhcPs
GHC.ImplicitBidirectional = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"="
pretty' GHC.ExplicitBidirectional {} = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"<-"
instance Pretty (GHC.HsOverLit GHC.GhcPs) where
pretty' :: HsOverLit GhcPs -> Printer ()
pretty' GHC.OverLit {XOverLit GhcPs
OverLitVal
ol_ext :: XOverLit GhcPs
ol_val :: OverLitVal
ol_val :: forall p. HsOverLit p -> OverLitVal
ol_ext :: forall p. HsOverLit p -> XOverLit p
..} = OverLitVal -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty OverLitVal
ol_val
instance Pretty GHC.OverLitVal where
pretty' :: OverLitVal -> Printer ()
pretty' (GHC.HsIntegral IntegralLit
x) = IntegralLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty IntegralLit
x
pretty' (GHC.HsFractional FractionalLit
x) = FractionalLit -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FractionalLit
x
pretty' (GHC.HsIsString SourceText
_ FastString
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
x
#if MIN_VERSION_ghc_lib_parser(9,8,1)
instance Pretty GHC.IntegralLit where
pretty' :: IntegralLit -> Printer ()
pretty' GHC.IL {il_text :: IntegralLit -> SourceText
il_text = GHC.SourceText FastString
s} = FastString -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output FastString
s
pretty' GHC.IL {Bool
Integer
SourceText
il_text :: IntegralLit -> SourceText
il_text :: SourceText
il_neg :: Bool
il_value :: Integer
il_value :: IntegralLit -> Integer
il_neg :: IntegralLit -> Bool
..} = 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
#else
instance Pretty GHC.IntegralLit where
pretty' GHC.IL {il_text = GHC.SourceText s} = string s
pretty' GHC.IL {..} = string $ show il_value
#endif
instance Pretty GHC.FractionalLit where
pretty' :: FractionalLit -> Printer ()
pretty' = FractionalLit -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output
instance Pretty (GHC.HsLit GHC.GhcPs) where
pretty' :: HsLit GhcPs -> Printer ()
pretty' x :: HsLit GhcPs
x@(GHC.HsChar XHsChar GhcPs
_ Char
_) = HsLit GhcPs -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output HsLit GhcPs
x
pretty' x :: HsLit GhcPs
x@GHC.HsCharPrim {} = HsLit GhcPs -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output HsLit GhcPs
x
pretty' GHC.HsInt {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' (GHC.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' GHC.HsWordPrim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' GHC.HsInt64Prim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' GHC.HsWord64Prim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' GHC.HsInteger {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' GHC.HsRat {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' (GHC.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' GHC.HsDoublePrim {} = Printer ()
forall a. HasCallStack => a
notUsedInParsedStage
pretty' HsLit GhcPs
x =
case HsLit GhcPs
x of
GHC.HsString {} -> Printer ()
prettyString
GHC.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 (GHC.HsPragE GHC.GhcPs) where
pretty' :: HsPragE GhcPs -> Printer ()
pretty' (GHC.HsPragSCC XSCC GhcPs
_ 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
"#-}"]
#else
instance Pretty (GHC.HsPragE GHC.GhcPs) where
pretty' (GHC.HsPragSCC _ _ x) =
spaced [string "{-# SCC", pretty x, string "#-}"]
#endif
instance Pretty GHC.HsIPName where
pretty' :: HsIPName -> Printer ()
pretty' (GHC.HsIPName FastString
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
x
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance Pretty (GHC.HsTyLit GHC.GhcPs) where
pretty' :: HsTyLit GhcPs -> Printer ()
pretty' (GHC.HsNumTy XNumTy 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
pretty' (GHC.HsStrTy XStrTy GhcPs
_ 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' (GHC.HsCharTy XCharTy GhcPs
_ 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
#else
instance Pretty GHC.HsTyLit where
pretty' (GHC.HsNumTy _ x) = string $ show x
pretty' (GHC.HsStrTy _ x) = string $ ushow x
pretty' (GHC.HsCharTy _ x) = string $ show x
#endif
instance Pretty (GHC.HsPatSigType GHC.GhcPs) where
pretty' :: HsPatSigType GhcPs -> Printer ()
pretty' GHC.HsPS {XHsPS GhcPs
LHsType GhcPs
hsps_ext :: XHsPS GhcPs
hsps_body :: LHsType GhcPs
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
..} = GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hsps_body
instance Pretty (GHC.HsIPBinds GHC.GhcPs) where
pretty' :: HsIPBinds GhcPs -> Printer ()
pretty' (GHC.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 [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
xs
instance Pretty (GHC.IPBind GHC.GhcPs) where
pretty' :: IPBind GhcPs -> Printer ()
pretty' = IPBind GhcPs -> Printer ()
prettyIPBind
prettyIPBind :: GHC.IPBind GHC.GhcPs -> Printer ()
#if MIN_VERSION_ghc_lib_parser(9,4,1)
prettyIPBind :: IPBind GhcPs -> Printer ()
prettyIPBind (GHC.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 EpAnnCO HsIPName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs HsIPName
GenLocated EpAnnCO HsIPName
l, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"=", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
r]
#else
prettyIPBind (GHC.IPBind _ (Right _) _) = notUsedInParsedStage
prettyIPBind (GHC.IPBind _ (Left l) r) =
spaced [string "?" >> pretty l, string "=", pretty r]
#endif
instance Pretty (GHC.RecordPatSynField GHC.GhcPs) where
pretty' :: RecordPatSynField GhcPs -> Printer ()
pretty' GHC.RecordPatSynField {LIdP GhcPs
FieldOcc GhcPs
recordPatSynField :: FieldOcc GhcPs
recordPatSynPatVar :: LIdP GhcPs
recordPatSynPatVar :: forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynField :: forall pass. RecordPatSynField pass -> FieldOcc pass
..} = FieldOcc GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty FieldOcc GhcPs
recordPatSynField
instance Pretty (GHC.HsCmdTop GHC.GhcPs) where
pretty' :: HsCmdTop GhcPs -> Printer ()
pretty' (GHC.HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd
instance Pretty (GHC.HsCmd GHC.GhcPs) where
pretty' :: HsCmd GhcPs -> Printer ()
pretty' = HsCmd GhcPs -> Printer ()
prettyHsCmd
prettyHsCmd :: GHC.HsCmd GHC.GhcPs -> Printer ()
prettyHsCmd :: HsCmd GhcPs -> Printer ()
prettyHsCmd (GHC.HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
GHC.HsHigherOrderApp Bool
True) =
[Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-<<", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg]
prettyHsCmd (GHC.HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
GHC.HsHigherOrderApp Bool
False) =
[Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg, HasCallStack => String -> Printer ()
String -> Printer ()
string String
">>-", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f]
prettyHsCmd (GHC.HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
GHC.HsFirstOrderApp Bool
True) =
[Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"-<", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg]
prettyHsCmd (GHC.HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
arg HsArrAppType
GHC.HsFirstOrderApp Bool
False) =
[Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg, HasCallStack => String -> Printer ()
String -> Printer ()
string String
">-", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f]
prettyHsCmd (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (GenLocated EpAnnCO (HsCmdTop GhcPs) -> Printer ())
-> [GenLocated EpAnnCO (HsCmdTop GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated EpAnnCO (HsCmdTop GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsCmdTop GhcPs]
[GenLocated EpAnnCO (HsCmdTop GhcPs)]
args
prettyHsCmd (GHC.HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
f LHsExpr GhcPs
arg) = [Printer ()] -> Printer ()
spaced [GenLocated SrcSpanAnnA (HsCmd GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
f, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg]
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsCmd (GHC.HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
GHC.LamSingle MatchGroup GhcPs (LHsCmd GhcPs)
x) = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
x
prettyHsCmd (GHC.HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
GHC.LamCase 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 (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
arms
prettyHsCmd (GHC.HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
GHC.LamCases MatchGroup GhcPs (LHsCmd GhcPs)
arms) = do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"\\cases"
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 (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
arms
#else
prettyHsCmd (GHC.HsCmdLam _ x) = pretty x
#endif
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsCmd (GHC.HsCmdPar _ _ x _) = parens $ pretty x
#else
prettyHsCmd (GHC.HsCmdPar XCmdPar GhcPs
_ LHsCmd GhcPs
x) = 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 LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
x
#endif
prettyHsCmd (GHC.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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
arms
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
prettyHsCmd (GHC.HsCmdLamCase _ _ arms) = do
string "\\case"
newline
indentedBlock $ pretty arms
#else
prettyHsCmd (GHC.HsCmdLamCase _ arms) = do
string "\\case"
newline
indentedBlock $ pretty arms
#endif
prettyHsCmd (GHC.HsCmdIf 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd 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 LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
f]
#if MIN_VERSION_ghc_lib_parser(9, 4, 1) && !MIN_VERSION_ghc_lib_parser(9, 10, 1)
prettyHsCmd (GHC.HsCmdLet _ _ binds _ expr) =
lined [string "let " |=> pretty binds, string " in " |=> pretty expr]
#else
prettyHsCmd (GHC.HsCmdLet XCmdLet GhcPs
_ HsLocalBinds GhcPs
binds 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 LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
expr]
#endif
prettyHsCmd (GHC.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 XRec GhcPs [CmdLStmt GhcPs]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsCmd 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 {NonEmpty (ExprLStmt GhcPs)
ExprLStmt GhcPs
listCompLhs :: ExprLStmt GhcPs
listCompRhs :: NonEmpty (ExprLStmt GhcPs)
listCompRhs :: ListComprehension -> NonEmpty (ExprLStmt GhcPs)
listCompLhs :: 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 ExprLStmt GhcPs
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
listCompLhs
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"|"
, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (Printer ()) -> [Printer ()]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Printer ()) -> [Printer ()])
-> NonEmpty (Printer ()) -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ())
-> NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> NonEmpty (Printer ())
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty NonEmpty (ExprLStmt GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (LHsExpr GhcPs) -> StmtLRInsideVerticalList
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> StmtLRInsideVerticalList
StmtLRInsideVerticalList ExprLStmt GhcPs
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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_ (NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [(String,
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))]
forall {b}. NonEmpty b -> [(String, b)]
stmtsAndPrefixes NonEmpty (ExprLStmt GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 (LHsExpr GhcPs) -> StmtLRInsideVerticalList
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> StmtLRInsideVerticalList
StmtLRInsideVerticalList GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x)
Printer ()
newline
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"]"
stmtsAndPrefixes :: NonEmpty b -> [(String, b)]
stmtsAndPrefixes (b
s :| [b]
ss) = (String
"| ", b
s) (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]
ss
instance Pretty DoExpression where
pretty' :: DoExpression -> Printer ()
pretty' DoExpression {[ExprLStmt GhcPs]
QualifiedDo
doStmts :: [ExprLStmt GhcPs]
qualifiedDo :: QualifiedDo
qualifiedDo :: DoExpression -> QualifiedDo
doStmts :: DoExpression -> [ExprLStmt GhcPs]
..} = 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 [ExprLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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
inExpr :: LetIn -> LHsExpr GhcPs
letBinds :: LetIn -> HsLocalBinds 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 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
inExpr]
instance Pretty GHC.HsSrcBang where
pretty' :: HsSrcBang -> Printer ()
pretty' (GHC.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
GHC.NoSrcUnpack) Printer ()
space
SrcStrictness -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SrcStrictness
strictness
instance Pretty GHC.SrcUnpackedness where
pretty' :: SrcUnpackedness -> Printer ()
pretty' SrcUnpackedness
GHC.SrcUnpack = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# UNPACK #-}"
pretty' SrcUnpackedness
GHC.SrcNoUnpack = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# NOUNPACK #-}"
pretty' SrcUnpackedness
GHC.NoSrcUnpack = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance Pretty GHC.SrcStrictness where
pretty' :: SrcStrictness -> Printer ()
pretty' SrcStrictness
GHC.SrcLazy = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"~"
pretty' SrcStrictness
GHC.SrcStrict = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"!"
pretty' SrcStrictness
GHC.NoSrcStrict = () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#if MIN_VERSION_ghc_lib_parser(9,6,1)
instance Pretty GHC.FieldLabelString where
pretty' :: FieldLabelString -> Printer ()
pretty' = FieldLabelString -> Printer ()
forall a. (HasCallStack, Outputable a) => a -> Printer ()
output
#endif
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."
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."
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)
forHpc :: HasCallStack => a
forHpc = error "This AST type is for the use of Haskell Program Coverage."
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
getAnc :: EpaLocation' a -> RealSrcSpan
getAnc (GHC.EpaSpan (GHC.RealSrcSpan RealSrcSpan
x Maybe BufSpan
_)) = RealSrcSpan
x
getAnc EpaLocation' a
_ = RealSrcSpan
forall a. HasCallStack => a
undefined
#else
getAnc = GHC.anchor
#endif