{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
module GHC.Utils.Outputable (
Outputable(..), OutputableBndr(..), OutputableP(..),
IsOutput(..), IsLine(..), IsDoc(..),
HLine, HDoc,
SDoc, runSDoc, PDoc(..),
docToSDoc,
interppSP, interpp'SP, interpp'SP',
pprQuotedList, pprWithCommas,
quotedListWithOr, quotedListWithNor, quotedListWithAnd,
pprWithBars,
spaceIfSingleQuote,
isEmpty, nest,
ptext,
int, intWithCommas, integer, word, float, double, rational, doublePrec,
parens, cparen, brackets, braces, quotes, quote,
doubleQuotes, angleBrackets,
semi, comma, colon, dcolon, space, equals, dot, vbar,
arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
lambda,
lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
blankLine, forAllLit, bullet,
($+$),
cat, fcat,
hang, hangNotEmpty, punctuate, punctuateFinal,
ppWhen, ppUnless, ppWhenOption, ppUnlessOption,
speakNth, speakN, speakNOf, plural, singular,
isOrAre, doOrDoes, itsOrTheir, thisOrThese, hasOrHave,
itOrThey,
unicodeSyntax,
coloured, keyword,
printSDoc, printSDocLn,
bufLeftRenderSDoc,
pprCode,
showSDocOneLine,
showSDocUnsafe,
showPprUnsafe,
renderWithContext,
pprDebugAndThen,
pprInfixVar, pprPrefixVar,
pprHsChar, pprHsString, pprHsBytes,
primFloatSuffix, primCharSuffix, primDoubleSuffix,
primInt8Suffix, primWord8Suffix,
primInt16Suffix, primWord16Suffix,
primInt32Suffix, primWord32Suffix,
primInt64Suffix, primWord64Suffix,
primIntSuffix, primWordSuffix,
pprPrimChar, pprPrimInt, pprPrimWord,
pprPrimInt8, pprPrimWord8,
pprPrimInt16, pprPrimWord16,
pprPrimInt32, pprPrimWord32,
pprPrimInt64, pprPrimWord64,
pprFastFilePath, pprFilePathString,
pprModuleName,
BindingSite(..),
PprStyle(..), NamePprCtx(..),
QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, QueryPromotionTick,
PromotedItem(..), IsEmptyOrSingleton(..), isListEmptyOrSingleton,
PromotionTickContext(..),
reallyAlwaysQualify, reallyAlwaysQualifyNames,
alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
neverQualify, neverQualifyNames, neverQualifyModules,
alwaysQualifyPackages, neverQualifyPackages,
alwaysPrintPromTick,
QualifyName(..), queryQual,
sdocOption,
updSDocContext,
SDocContext (..), sdocWithContext,
defaultSDocContext, traceSDocContext,
getPprStyle, withPprStyle, setStyleColoured,
pprDeeper, pprDeeperList, pprSetDepth,
codeStyle, userStyle, dumpStyle,
qualName, qualModule, qualPackage, promTick,
mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
mkUserStyle, cmdlineParserStyle, Depth(..),
withUserStyle, withErrStyle,
ifPprDebug, whenPprDebug, getPprDebug,
bPutHDoc
) where
import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
import GHC.Prelude.Basic
import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName )
import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
import GHC.Utils.BufHandle (BufHandle, bPutChar, bPutStr, bPutFS, bPutFZS)
import GHC.Data.FastString
import qualified GHC.Utils.Ppr as Pretty
import qualified GHC.Utils.Ppr.Colour as Col
import GHC.Utils.Ppr ( Doc, Mode(..) )
import GHC.Utils.Panic.Plain (assert)
import GHC.Serialized
import GHC.LanguageExtensions (Extension)
import GHC.Utils.GlobalVars( unsafeHasPprDebug )
import GHC.Utils.Misc (lastMaybe)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Char
import qualified Data.Map as M
import Data.Int
import qualified Data.IntMap as IM
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.String
import Data.Word
import System.IO ( Handle )
import System.FilePath
import Text.Printf
import Numeric (showFFloat)
import Data.Graph (SCC(..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup (Arg(..))
import qualified Data.List.NonEmpty as NEL
import Data.Time ( UTCTime )
import Data.Time.Format.ISO8601
import Data.Void
import GHC.Fingerprint
import GHC.Show ( showMultiLineString )
import GHC.Utils.Exception
import GHC.Exts (oneShot)
data PprStyle
= PprUser NamePprCtx Depth Coloured
| PprDump NamePprCtx
| PprCode
data Depth
= AllTheWay
| PartWay Int
| DefaultDepth
data Coloured
= Uncoloured
| Coloured
data NamePprCtx = QueryQualify {
NamePprCtx -> QueryQualifyName
queryQualifyName :: QueryQualifyName,
NamePprCtx -> QueryQualifyModule
queryQualifyModule :: QueryQualifyModule,
NamePprCtx -> QueryQualifyPackage
queryQualifyPackage :: QueryQualifyPackage,
NamePprCtx -> QueryPromotionTick
queryPromotionTick :: QueryPromotionTick
}
type QueryQualifyName = Module -> OccName -> QualifyName
type QueryQualifyModule = Module -> Bool
type QueryQualifyPackage = Unit -> Bool
type QueryPromotionTick = PromotedItem -> Bool
data PromotionTickContext =
PromTickCtx {
PromotionTickContext -> Bool
ptcListTuplePuns :: !Bool,
PromotionTickContext -> Bool
ptcPrintRedundantPromTicks :: !Bool
}
data PromotedItem =
PromotedItemListSyntax IsEmptyOrSingleton
| PromotedItemTupleSyntax
| PromotedItemDataCon OccName
newtype IsEmptyOrSingleton = IsEmptyOrSingleton Bool
isListEmptyOrSingleton :: [a] -> IsEmptyOrSingleton
isListEmptyOrSingleton :: forall a. [a] -> IsEmptyOrSingleton
isListEmptyOrSingleton [a]
xs =
Bool -> IsEmptyOrSingleton
IsEmptyOrSingleton (Bool -> IsEmptyOrSingleton) -> Bool -> IsEmptyOrSingleton
forall a b. (a -> b) -> a -> b
$ case [a]
xs of
[] -> Bool
True
[a
_] -> Bool
True
[a]
_ -> Bool
False
data QualifyName
= NameUnqual
| NameQual ModuleName
| NameNotInScope1
| NameNotInScope2
instance Outputable QualifyName where
ppr :: QualifyName -> SDoc
ppr QualifyName
NameUnqual = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameUnqual"
ppr (NameQual ModuleName
_mod) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameQual"
ppr QualifyName
NameNotInScope1 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameNotInScope1"
ppr QualifyName
NameNotInScope2 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameNotInScope2"
reallyAlwaysQualifyNames :: QueryQualifyName
reallyAlwaysQualifyNames :: QueryQualifyName
reallyAlwaysQualifyNames Module
_ OccName
_ = QualifyName
NameNotInScope2
alwaysQualifyNames :: QueryQualifyName
alwaysQualifyNames :: QueryQualifyName
alwaysQualifyNames Module
m OccName
_ = ModuleName -> QualifyName
NameQual (Module -> ModuleName
forall a. GenModule a -> ModuleName
moduleName Module
m)
neverQualifyNames :: QueryQualifyName
neverQualifyNames :: QueryQualifyName
neverQualifyNames Module
_ OccName
_ = QualifyName
NameUnqual
alwaysQualifyModules :: QueryQualifyModule
alwaysQualifyModules :: QueryQualifyModule
alwaysQualifyModules Module
_ = Bool
True
neverQualifyModules :: QueryQualifyModule
neverQualifyModules :: QueryQualifyModule
neverQualifyModules Module
_ = Bool
False
alwaysQualifyPackages :: QueryQualifyPackage
alwaysQualifyPackages :: QueryQualifyPackage
alwaysQualifyPackages Unit
_ = Bool
True
neverQualifyPackages :: QueryQualifyPackage
neverQualifyPackages :: QueryQualifyPackage
neverQualifyPackages Unit
_ = Bool
False
alwaysPrintPromTick :: QueryPromotionTick
alwaysPrintPromTick :: QueryPromotionTick
alwaysPrintPromTick PromotedItem
_ = Bool
True
reallyAlwaysQualify, alwaysQualify, neverQualify :: NamePprCtx
reallyAlwaysQualify :: NamePprCtx
reallyAlwaysQualify
= QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify QueryQualifyName
reallyAlwaysQualifyNames
QueryQualifyModule
alwaysQualifyModules
QueryQualifyPackage
alwaysQualifyPackages
QueryPromotionTick
alwaysPrintPromTick
alwaysQualify :: NamePprCtx
alwaysQualify = QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify QueryQualifyName
alwaysQualifyNames
QueryQualifyModule
alwaysQualifyModules
QueryQualifyPackage
alwaysQualifyPackages
QueryPromotionTick
alwaysPrintPromTick
neverQualify :: NamePprCtx
neverQualify = QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify QueryQualifyName
neverQualifyNames
QueryQualifyModule
neverQualifyModules
QueryQualifyPackage
neverQualifyPackages
QueryPromotionTick
alwaysPrintPromTick
defaultUserStyle :: PprStyle
defaultUserStyle :: PprStyle
defaultUserStyle = NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
neverQualify Depth
AllTheWay
defaultDumpStyle :: PprStyle
defaultDumpStyle :: PprStyle
defaultDumpStyle = NamePprCtx -> PprStyle
PprDump NamePprCtx
neverQualify
mkDumpStyle :: NamePprCtx -> PprStyle
mkDumpStyle :: NamePprCtx -> PprStyle
mkDumpStyle NamePprCtx
name_ppr_ctx = NamePprCtx -> PprStyle
PprDump NamePprCtx
name_ppr_ctx
defaultErrStyle :: PprStyle
defaultErrStyle :: PprStyle
defaultErrStyle = NamePprCtx -> PprStyle
mkErrStyle NamePprCtx
neverQualify
mkErrStyle :: NamePprCtx -> PprStyle
mkErrStyle :: NamePprCtx -> PprStyle
mkErrStyle NamePprCtx
name_ppr_ctx = NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
name_ppr_ctx Depth
DefaultDepth
cmdlineParserStyle :: PprStyle
cmdlineParserStyle :: PprStyle
cmdlineParserStyle = NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
alwaysQualify Depth
AllTheWay
mkUserStyle :: NamePprCtx -> Depth -> PprStyle
mkUserStyle :: NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
name_ppr_ctx Depth
depth = NamePprCtx -> Depth -> Coloured -> PprStyle
PprUser NamePprCtx
name_ppr_ctx Depth
depth Coloured
Uncoloured
withUserStyle :: NamePprCtx -> Depth -> SDoc -> SDoc
withUserStyle :: NamePprCtx -> Depth -> SDoc -> SDoc
withUserStyle NamePprCtx
name_ppr_ctx Depth
depth SDoc
doc = PprStyle -> SDoc -> SDoc
withPprStyle (NamePprCtx -> Depth -> Coloured -> PprStyle
PprUser NamePprCtx
name_ppr_ctx Depth
depth Coloured
Uncoloured) SDoc
doc
withErrStyle :: NamePprCtx -> SDoc -> SDoc
withErrStyle :: NamePprCtx -> SDoc -> SDoc
withErrStyle NamePprCtx
name_ppr_ctx SDoc
doc =
PprStyle -> SDoc -> SDoc
withPprStyle (NamePprCtx -> PprStyle
mkErrStyle NamePprCtx
name_ppr_ctx) SDoc
doc
setStyleColoured :: Bool -> PprStyle -> PprStyle
setStyleColoured :: Bool -> PprStyle -> PprStyle
setStyleColoured Bool
col PprStyle
style =
case PprStyle
style of
PprUser NamePprCtx
q Depth
d Coloured
_ -> NamePprCtx -> Depth -> Coloured -> PprStyle
PprUser NamePprCtx
q Depth
d Coloured
c
PprStyle
_ -> PprStyle
style
where
c :: Coloured
c | Bool
col = Coloured
Coloured
| Bool
otherwise = Coloured
Uncoloured
instance Outputable PprStyle where
ppr :: PprStyle -> SDoc
ppr (PprUser {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"user-style"
ppr (PprCode {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"code-style"
ppr (PprDump {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dump-style"
newtype SDoc = SDoc' (SDocContext -> Doc)
{-# COMPLETE SDoc #-}
pattern SDoc :: (SDocContext -> Doc) -> SDoc
pattern $mSDoc :: forall {r}.
SDoc -> ((SDocContext -> Doc) -> r) -> ((# #) -> r) -> r
$bSDoc :: (SDocContext -> Doc) -> SDoc
SDoc m <- SDoc' m
where
SDoc SDocContext -> Doc
m = (SDocContext -> Doc) -> SDoc
SDoc' ((SDocContext -> Doc) -> SDocContext -> Doc
forall a b. (a -> b) -> a -> b
oneShot SDocContext -> Doc
m)
runSDoc :: SDoc -> (SDocContext -> Doc)
runSDoc :: SDoc -> SDocContext -> Doc
runSDoc (SDoc SDocContext -> Doc
m) = SDocContext -> Doc
m
data SDocContext = SDC
{ SDocContext -> PprStyle
sdocStyle :: !PprStyle
, SDocContext -> Scheme
sdocColScheme :: !Col.Scheme
, SDocContext -> PprColour
sdocLastColour :: !Col.PprColour
, SDocContext -> Bool
sdocShouldUseColor :: !Bool
, SDocContext -> Int
sdocDefaultDepth :: !Int
, SDocContext -> Int
sdocLineLength :: !Int
, SDocContext -> Bool
sdocCanUseUnicode :: !Bool
, SDocContext -> Bool
sdocHexWordLiterals :: !Bool
, SDocContext -> Bool
sdocPprDebug :: !Bool
, SDocContext -> Bool
sdocPrintUnicodeSyntax :: !Bool
, SDocContext -> Bool
sdocPrintCaseAsLet :: !Bool
, SDocContext -> Bool
sdocPrintTypecheckerElaboration :: !Bool
, SDocContext -> Bool
sdocPrintAxiomIncomps :: !Bool
, SDocContext -> Bool
sdocPrintExplicitKinds :: !Bool
, SDocContext -> Bool
sdocPrintExplicitCoercions :: !Bool
, SDocContext -> Bool
sdocPrintExplicitRuntimeReps :: !Bool
, SDocContext -> Bool
sdocPrintExplicitForalls :: !Bool
, SDocContext -> Bool
sdocPrintPotentialInstances :: !Bool
, SDocContext -> Bool
sdocPrintEqualityRelations :: !Bool
, SDocContext -> Bool
sdocSuppressTicks :: !Bool
, SDocContext -> Bool
sdocSuppressTypeSignatures :: !Bool
, SDocContext -> Bool
sdocSuppressTypeApplications :: !Bool
, SDocContext -> Bool
sdocSuppressIdInfo :: !Bool
, SDocContext -> Bool
sdocSuppressCoercions :: !Bool
, SDocContext -> Bool
sdocSuppressCoercionTypes :: !Bool
, SDocContext -> Bool
sdocSuppressUnfoldings :: !Bool
, SDocContext -> Bool
sdocSuppressVarKinds :: !Bool
, SDocContext -> Bool
sdocSuppressUniques :: !Bool
, SDocContext -> Bool
sdocSuppressModulePrefixes :: !Bool
, SDocContext -> Bool
sdocSuppressStgExts :: !Bool
, SDocContext -> Bool
sdocSuppressStgReps :: !Bool
, SDocContext -> Bool
sdocErrorSpans :: !Bool
, SDocContext -> Bool
sdocStarIsType :: !Bool
, SDocContext -> Bool
sdocLinearTypes :: !Bool
, SDocContext -> Bool
sdocListTuplePuns :: !Bool
, SDocContext -> Bool
sdocPrintTypeAbbreviations :: !Bool
, SDocContext -> FastString -> SDoc
sdocUnitIdForUser :: !(FastString -> SDoc)
}
instance IsString SDoc where
fromString :: String -> SDoc
fromString = String -> SDoc
forall doc. IsLine doc => String -> doc
text
instance Outputable SDoc where
ppr :: SDoc -> SDoc
ppr = SDoc -> SDoc
forall a. a -> a
id
defaultSDocContext :: SDocContext
defaultSDocContext :: SDocContext
defaultSDocContext = SDC
{ sdocStyle :: PprStyle
sdocStyle = PprStyle
defaultDumpStyle
, sdocColScheme :: Scheme
sdocColScheme = Scheme
Col.defaultScheme
, sdocLastColour :: PprColour
sdocLastColour = PprColour
Col.colReset
, sdocShouldUseColor :: Bool
sdocShouldUseColor = Bool
False
, sdocDefaultDepth :: Int
sdocDefaultDepth = Int
5
, sdocLineLength :: Int
sdocLineLength = Int
100
, sdocCanUseUnicode :: Bool
sdocCanUseUnicode = Bool
False
, sdocHexWordLiterals :: Bool
sdocHexWordLiterals = Bool
False
, sdocPprDebug :: Bool
sdocPprDebug = Bool
False
, sdocPrintUnicodeSyntax :: Bool
sdocPrintUnicodeSyntax = Bool
False
, sdocPrintCaseAsLet :: Bool
sdocPrintCaseAsLet = Bool
False
, sdocPrintTypecheckerElaboration :: Bool
sdocPrintTypecheckerElaboration = Bool
False
, sdocPrintAxiomIncomps :: Bool
sdocPrintAxiomIncomps = Bool
False
, sdocPrintExplicitKinds :: Bool
sdocPrintExplicitKinds = Bool
False
, sdocPrintExplicitCoercions :: Bool
sdocPrintExplicitCoercions = Bool
False
, sdocPrintExplicitRuntimeReps :: Bool
sdocPrintExplicitRuntimeReps = Bool
False
, sdocPrintExplicitForalls :: Bool
sdocPrintExplicitForalls = Bool
False
, sdocPrintPotentialInstances :: Bool
sdocPrintPotentialInstances = Bool
False
, sdocPrintEqualityRelations :: Bool
sdocPrintEqualityRelations = Bool
False
, sdocSuppressTicks :: Bool
sdocSuppressTicks = Bool
False
, sdocSuppressTypeSignatures :: Bool
sdocSuppressTypeSignatures = Bool
False
, sdocSuppressTypeApplications :: Bool
sdocSuppressTypeApplications = Bool
False
, sdocSuppressIdInfo :: Bool
sdocSuppressIdInfo = Bool
False
, sdocSuppressCoercions :: Bool
sdocSuppressCoercions = Bool
False
, sdocSuppressCoercionTypes :: Bool
sdocSuppressCoercionTypes = Bool
False
, sdocSuppressUnfoldings :: Bool
sdocSuppressUnfoldings = Bool
False
, sdocSuppressVarKinds :: Bool
sdocSuppressVarKinds = Bool
False
, sdocSuppressUniques :: Bool
sdocSuppressUniques = Bool
False
, sdocSuppressModulePrefixes :: Bool
sdocSuppressModulePrefixes = Bool
False
, sdocSuppressStgExts :: Bool
sdocSuppressStgExts = Bool
False
, sdocSuppressStgReps :: Bool
sdocSuppressStgReps = Bool
True
, sdocErrorSpans :: Bool
sdocErrorSpans = Bool
False
, sdocStarIsType :: Bool
sdocStarIsType = Bool
False
, sdocLinearTypes :: Bool
sdocLinearTypes = Bool
False
, sdocListTuplePuns :: Bool
sdocListTuplePuns = Bool
True
, sdocPrintTypeAbbreviations :: Bool
sdocPrintTypeAbbreviations = Bool
True
, sdocUnitIdForUser :: FastString -> SDoc
sdocUnitIdForUser = FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext
}
traceSDocContext :: SDocContext
traceSDocContext :: SDocContext
traceSDocContext = SDocContext
defaultSDocContext
{ sdocPprDebug = unsafeHasPprDebug
, sdocPrintTypecheckerElaboration = True
, sdocPrintExplicitKinds = True
, sdocPrintExplicitCoercions = True
, sdocPrintExplicitRuntimeReps = True
, sdocPrintExplicitForalls = True
, sdocPrintEqualityRelations = True
}
withPprStyle :: PprStyle -> SDoc -> SDoc
{-# INLINE CONLIKE withPprStyle #-}
withPprStyle :: PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
sty SDoc
d = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctxt -> SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctxt{sdocStyle=sty}
pprDeeper :: SDoc -> SDoc
pprDeeper :: SDoc -> SDoc
pprDeeper SDoc
d = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> case SDocContext -> PprStyle
sdocStyle SDocContext
ctx of
PprUser NamePprCtx
q Depth
depth Coloured
c ->
let deeper :: Int -> Doc
deeper Int
0 = String -> Doc
Pretty.text String
"..."
deeper Int
n = SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx{sdocStyle = PprUser q (PartWay (n-1)) c}
in case Depth
depth of
Depth
DefaultDepth -> Int -> Doc
deeper (SDocContext -> Int
sdocDefaultDepth SDocContext
ctx)
PartWay Int
n -> Int -> Doc
deeper Int
n
Depth
AllTheWay -> SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx
PprStyle
_ -> SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx
pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
pprDeeperList [SDoc] -> SDoc
f [SDoc]
ds
| [SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
ds = [SDoc] -> SDoc
f []
| Bool
otherwise = (SDocContext -> Doc) -> SDoc
SDoc SDocContext -> Doc
work
where
work :: SDocContext -> Doc
work ctx :: SDocContext
ctx@SDC{sdocStyle :: SDocContext -> PprStyle
sdocStyle=PprUser NamePprCtx
q Depth
depth Coloured
c}
| Depth
DefaultDepth <- Depth
depth
= SDocContext -> Doc
work (SDocContext
ctx { sdocStyle = PprUser q (PartWay (sdocDefaultDepth ctx)) c })
| PartWay Int
0 <- Depth
depth
= String -> Doc
Pretty.text String
"..."
| PartWay Int
n <- Depth
depth
= let
go :: Int -> [SDoc] -> [SDoc]
go Int
_ [] = []
go Int
i (SDoc
d:[SDoc]
ds) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...."]
| Bool
otherwise = SDoc
d SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: Int -> [SDoc] -> [SDoc]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [SDoc]
ds
in SDoc -> SDocContext -> Doc
runSDoc ([SDoc] -> SDoc
f (Int -> [SDoc] -> [SDoc]
go Int
0 [SDoc]
ds)) SDocContext
ctx{sdocStyle = PprUser q (PartWay (n-1)) c}
work SDocContext
other_ctx = SDoc -> SDocContext -> Doc
runSDoc ([SDoc] -> SDoc
f [SDoc]
ds) SDocContext
other_ctx
pprSetDepth :: Depth -> SDoc -> SDoc
pprSetDepth :: Depth -> SDoc -> SDoc
pprSetDepth Depth
depth SDoc
doc = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
case SDocContext
ctx of
SDC{sdocStyle :: SDocContext -> PprStyle
sdocStyle=PprUser NamePprCtx
q Depth
_ Coloured
c} ->
SDoc -> SDocContext -> Doc
runSDoc SDoc
doc SDocContext
ctx{sdocStyle = PprUser q depth c}
SDocContext
_ ->
SDoc -> SDocContext -> Doc
runSDoc SDoc
doc SDocContext
ctx
getPprStyle :: (PprStyle -> SDoc) -> SDoc
{-# INLINE CONLIKE getPprStyle #-}
getPprStyle :: (PprStyle -> SDoc) -> SDoc
getPprStyle PprStyle -> SDoc
df = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> SDoc -> SDocContext -> Doc
runSDoc (PprStyle -> SDoc
df (SDocContext -> PprStyle
sdocStyle SDocContext
ctx)) SDocContext
ctx
sdocWithContext :: (SDocContext -> SDoc) -> SDoc
{-# INLINE CONLIKE sdocWithContext #-}
sdocWithContext :: (SDocContext -> SDoc) -> SDoc
sdocWithContext SDocContext -> SDoc
f = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> SDoc -> SDocContext -> Doc
runSDoc (SDocContext -> SDoc
f SDocContext
ctx) SDocContext
ctx
sdocOption :: (SDocContext -> a) -> (a -> SDoc) -> SDoc
{-# INLINE CONLIKE sdocOption #-}
sdocOption :: forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> a
f a -> SDoc
g = (SDocContext -> SDoc) -> SDoc
sdocWithContext (a -> SDoc
g (a -> SDoc) -> (SDocContext -> a) -> SDocContext -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> a
f)
updSDocContext :: (SDocContext -> SDocContext) -> SDoc -> SDoc
{-# INLINE CONLIKE updSDocContext #-}
updSDocContext :: (SDocContext -> SDocContext) -> SDoc -> SDoc
updSDocContext SDocContext -> SDocContext
upd SDoc
doc
= (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> SDoc -> SDocContext -> Doc
runSDoc SDoc
doc (SDocContext -> SDocContext
upd SDocContext
ctx)
qualName :: PprStyle -> QueryQualifyName
qualName :: PprStyle -> QueryQualifyName
qualName (PprUser NamePprCtx
q Depth
_ Coloured
_) Module
mod OccName
occ = NamePprCtx -> QueryQualifyName
queryQualifyName NamePprCtx
q Module
mod OccName
occ
qualName (PprDump NamePprCtx
q) Module
mod OccName
occ = NamePprCtx -> QueryQualifyName
queryQualifyName NamePprCtx
q Module
mod OccName
occ
qualName PprStyle
_other Module
mod OccName
_ = ModuleName -> QualifyName
NameQual (Module -> ModuleName
forall a. GenModule a -> ModuleName
moduleName Module
mod)
qualModule :: PprStyle -> QueryQualifyModule
qualModule :: PprStyle -> QueryQualifyModule
qualModule (PprUser NamePprCtx
q Depth
_ Coloured
_) Module
m = NamePprCtx -> QueryQualifyModule
queryQualifyModule NamePprCtx
q Module
m
qualModule (PprDump NamePprCtx
q) Module
m = NamePprCtx -> QueryQualifyModule
queryQualifyModule NamePprCtx
q Module
m
qualModule PprStyle
_other Module
_m = Bool
True
qualPackage :: PprStyle -> QueryQualifyPackage
qualPackage :: PprStyle -> QueryQualifyPackage
qualPackage (PprUser NamePprCtx
q Depth
_ Coloured
_) Unit
m = NamePprCtx -> QueryQualifyPackage
queryQualifyPackage NamePprCtx
q Unit
m
qualPackage (PprDump NamePprCtx
q) Unit
m = NamePprCtx -> QueryQualifyPackage
queryQualifyPackage NamePprCtx
q Unit
m
qualPackage PprStyle
_other Unit
_m = Bool
True
promTick :: PprStyle -> QueryPromotionTick
promTick :: PprStyle -> QueryPromotionTick
promTick (PprUser NamePprCtx
q Depth
_ Coloured
_) PromotedItem
occ = NamePprCtx -> QueryPromotionTick
queryPromotionTick NamePprCtx
q PromotedItem
occ
promTick (PprDump NamePprCtx
q) PromotedItem
occ = NamePprCtx -> QueryPromotionTick
queryPromotionTick NamePprCtx
q PromotedItem
occ
promTick PprStyle
_ PromotedItem
_ = Bool
True
queryQual :: PprStyle -> NamePprCtx
queryQual :: PprStyle -> NamePprCtx
queryQual PprStyle
s = QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify (PprStyle -> QueryQualifyName
qualName PprStyle
s)
(PprStyle -> QueryQualifyModule
qualModule PprStyle
s)
(PprStyle -> QueryQualifyPackage
qualPackage PprStyle
s)
(PprStyle -> QueryPromotionTick
promTick PprStyle
s)
codeStyle :: PprStyle -> Bool
codeStyle :: PprStyle -> Bool
codeStyle PprStyle
PprCode = Bool
True
codeStyle PprStyle
_ = Bool
False
dumpStyle :: PprStyle -> Bool
dumpStyle :: PprStyle -> Bool
dumpStyle (PprDump {}) = Bool
True
dumpStyle PprStyle
_other = Bool
False
userStyle :: PprStyle -> Bool
userStyle :: PprStyle -> Bool
userStyle (PprUser {}) = Bool
True
userStyle PprStyle
_other = Bool
False
getPprDebug :: IsOutput doc => (Bool -> doc) -> doc
{-# INLINE CONLIKE getPprDebug #-}
getPprDebug :: forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug Bool -> doc
d = (SDocContext -> doc) -> doc
forall doc. IsOutput doc => (SDocContext -> doc) -> doc
docWithContext ((SDocContext -> doc) -> doc) -> (SDocContext -> doc) -> doc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Bool -> doc
d (SDocContext -> Bool
sdocPprDebug SDocContext
ctx)
ifPprDebug :: IsOutput doc => doc -> doc -> doc
{-# INLINE CONLIKE ifPprDebug #-}
ifPprDebug :: forall doc. IsOutput doc => doc -> doc -> doc
ifPprDebug doc
yes doc
no = (Bool -> doc) -> doc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> doc) -> doc) -> (Bool -> doc) -> doc
forall a b. (a -> b) -> a -> b
$ \Bool
dbg -> if Bool
dbg then doc
yes else doc
no
whenPprDebug :: IsOutput doc => doc -> doc
{-# INLINE CONLIKE whenPprDebug #-}
whenPprDebug :: forall doc. IsOutput doc => doc -> doc
whenPprDebug doc
d = doc -> doc -> doc
forall doc. IsOutput doc => doc -> doc -> doc
ifPprDebug doc
d doc
forall doc. IsOutput doc => doc
empty
printSDoc :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
printSDoc :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
printSDoc SDocContext
ctx Mode
mode Handle
handle SDoc
doc =
Mode -> Int -> Handle -> Doc -> IO ()
Pretty.printDoc_ Mode
mode Int
cols Handle
handle (SDoc -> SDocContext -> Doc
runSDoc SDoc
doc SDocContext
ctx)
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally`
Mode -> Int -> Handle -> Doc -> IO ()
Pretty.printDoc_ Mode
mode Int
cols Handle
handle
(SDoc -> SDocContext -> Doc
runSDoc (PprColour -> SDoc -> SDoc
coloured PprColour
Col.colReset SDoc
forall doc. IsOutput doc => doc
empty) SDocContext
ctx)
where
cols :: Int
cols = SDocContext -> Int
sdocLineLength SDocContext
ctx
printSDocLn :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
printSDocLn :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
printSDocLn SDocContext
ctx Mode
mode Handle
handle SDoc
doc =
SDocContext -> Mode -> Handle -> SDoc -> IO ()
printSDoc SDocContext
ctx Mode
mode Handle
handle (SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"")
bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO ()
bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO ()
bufLeftRenderSDoc SDocContext
ctx BufHandle
bufHandle SDoc
doc =
BufHandle -> Doc -> IO ()
Pretty.bufLeftRender BufHandle
bufHandle (SDoc -> SDocContext -> Doc
runSDoc SDoc
doc SDocContext
ctx)
pprCode :: SDoc -> SDoc
{-# INLINE CONLIKE pprCode #-}
pprCode :: SDoc -> SDoc
pprCode SDoc
d = PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
PprCode SDoc
d
renderWithContext :: SDocContext -> SDoc -> String
renderWithContext :: SDocContext -> SDoc -> String
renderWithContext SDocContext
ctx SDoc
sdoc
= let s :: Style
s = Style
Pretty.style{ Pretty.mode = PageMode False,
Pretty.lineLength = sdocLineLength ctx }
in Style -> Doc -> String
Pretty.renderStyle Style
s (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
ctx
showSDocOneLine :: SDocContext -> SDoc -> String
showSDocOneLine :: SDocContext -> SDoc -> String
showSDocOneLine SDocContext
ctx SDoc
d
= let s :: Style
s = Style
Pretty.style{ Pretty.mode = OneLineMode,
Pretty.lineLength = sdocLineLength ctx } in
Style -> Doc -> String
Pretty.renderStyle Style
s (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx
showSDocUnsafe :: SDoc -> String
showSDocUnsafe :: SDoc -> String
showSDocUnsafe SDoc
sdoc = SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext SDoc
sdoc
showPprUnsafe :: Outputable a => a -> String
showPprUnsafe :: forall a. Outputable a => a -> String
showPprUnsafe a
a = SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)
pprDebugAndThen :: SDocContext -> (String -> a) -> SDoc -> SDoc -> a
pprDebugAndThen :: forall a. SDocContext -> (String -> a) -> SDoc -> SDoc -> a
pprDebugAndThen SDocContext
ctx String -> a
cont SDoc
heading SDoc
pretty_msg
= String -> a
cont (SDocContext -> SDoc -> String
renderWithContext SDocContext
ctx SDoc
doc)
where
doc :: SDoc
doc = PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultDumpStyle ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
heading, Int -> SDoc -> SDoc
nest Int
2 SDoc
pretty_msg])
isEmpty :: SDocContext -> SDoc -> Bool
isEmpty :: SDocContext -> SDoc -> Bool
isEmpty SDocContext
ctx SDoc
sdoc = Doc -> Bool
Pretty.isEmpty (Doc -> Bool) -> Doc -> Bool
forall a b. (a -> b) -> a -> b
$ SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc (SDocContext
ctx {sdocPprDebug = True})
docToSDoc :: Doc -> SDoc
docToSDoc :: Doc -> SDoc
docToSDoc Doc
d = (SDocContext -> Doc) -> SDoc
SDoc (\SDocContext
_ -> Doc
d)
ptext :: PtrString -> SDoc
int :: IsLine doc => Int -> doc
integer :: IsLine doc => Integer -> doc
word :: Integer -> SDoc
float :: IsLine doc => Float -> doc
double :: IsLine doc => Double -> doc
rational :: Rational -> SDoc
{-# INLINE CONLIKE ptext #-}
ptext :: PtrString -> SDoc
ptext PtrString
s = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ PtrString -> Doc
Pretty.ptext PtrString
s
{-# INLINE CONLIKE int #-}
int :: forall doc. IsLine doc => Int -> doc
int Int
n = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n
{-# INLINE CONLIKE integer #-}
integer :: forall doc. IsLine doc => Integer -> doc
integer Integer
n = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n
{-# INLINE CONLIKE float #-}
float :: forall doc. IsLine doc => Float -> doc
float Float
n = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
n
{-# INLINE CONLIKE double #-}
double :: forall doc. IsLine doc => Double -> doc
double Double
n = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
n
{-# INLINE CONLIKE rational #-}
rational :: Rational -> SDoc
rational Rational
n = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ Rational -> String
forall a. Show a => a -> String
show Rational
n
{-# INLINE CONLIKE word #-}
word :: Integer -> SDoc
word Integer
n = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocHexWordLiterals ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ Integer -> Doc
Pretty.hex Integer
n
Bool
False -> Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ Integer -> Doc
Pretty.integer Integer
n
doublePrec :: Int -> Double -> SDoc
doublePrec :: Int -> Double -> SDoc
doublePrec Int
p Double
n = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p) Double
n String
"")
quotes, quote :: SDoc -> SDoc
parens, brackets, braces, doubleQuotes, angleBrackets :: IsLine doc => doc -> doc
{-# INLINE CONLIKE parens #-}
parens :: forall doc. IsLine doc => doc -> doc
parens doc
d = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'(' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')'
{-# INLINE CONLIKE braces #-}
braces :: forall doc. IsLine doc => doc -> doc
braces doc
d = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'{' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'}'
{-# INLINE CONLIKE brackets #-}
brackets :: forall doc. IsLine doc => doc -> doc
brackets doc
d = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'[' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
']'
{-# INLINE CONLIKE quote #-}
quote :: SDoc -> SDoc
quote SDoc
d = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
Pretty.quote (Doc -> Doc) -> (SDocContext -> Doc) -> SDocContext -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDocContext -> Doc
runSDoc SDoc
d
{-# INLINE CONLIKE doubleQuotes #-}
doubleQuotes :: forall doc. IsLine doc => doc -> doc
doubleQuotes doc
d = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'"' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'"'
{-# INLINE CONLIKE angleBrackets #-}
angleBrackets :: forall doc. IsLine doc => doc -> doc
angleBrackets doc
d = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'<' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'>'
cparen :: Bool -> SDoc -> SDoc
{-# INLINE CONLIKE cparen #-}
cparen :: Bool -> SDoc -> SDoc
cparen Bool
b SDoc
d = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> Doc -> Doc
Pretty.maybeParens Bool
b (Doc -> Doc) -> (SDocContext -> Doc) -> SDocContext -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDocContext -> Doc
runSDoc SDoc
d
quotes :: SDoc -> SDoc
quotes SDoc
d = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocCanUseUnicode ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'‘' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'’'
Bool
False -> (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
sty ->
let pp_d :: Doc
pp_d = SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
sty
str :: String
str = Doc -> String
forall a. Show a => a -> String
show Doc
pp_d
in case String
str of
[] -> Doc -> Doc
Pretty.quotes Doc
pp_d
Char
'\'' : String
_ -> Doc
pp_d
String
_ | Just Char
'\'' <- String -> Maybe Char
forall a. [a] -> Maybe a
lastMaybe String
str -> Doc
pp_d
| Bool
otherwise -> Doc -> Doc
Pretty.quotes Doc
pp_d
blankLine, dcolon, arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt,
larrowtt, lambda :: SDoc
blankLine :: SDoc
blankLine = Doc -> SDoc
docToSDoc Doc
Pretty.emptyText
dcolon :: SDoc
dcolon = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'∷') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"::")
arrow :: SDoc
arrow = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'→') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->")
lollipop :: SDoc
lollipop = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⊸') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%1 ->")
larrow :: SDoc
larrow = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'←') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<-")
darrow :: SDoc
darrow = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⇒') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"=>")
arrowt :: SDoc
arrowt = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⤚') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">-")
larrowt :: SDoc
larrowt = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⤙') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-<")
arrowtt :: SDoc
arrowtt = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⤜') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">>-")
larrowtt :: SDoc
larrowtt = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'⤛') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-<<")
lambda :: SDoc
lambda = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'λ') (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\\')
semi, comma, colon, equals, space, underscore, dot, vbar :: IsLine doc => doc
lparen, rparen, lbrack, rbrack, lbrace, rbrace :: IsLine doc => doc
semi :: forall doc. IsLine doc => doc
semi = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
';'
comma :: forall doc. IsLine doc => doc
comma = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
','
colon :: forall doc. IsLine doc => doc
colon = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
':'
equals :: forall doc. IsLine doc => doc
equals = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'='
space :: forall doc. IsLine doc => doc
space = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
' '
underscore :: forall doc. IsLine doc => doc
underscore = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_'
dot :: forall doc. IsLine doc => doc
dot = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'.'
vbar :: forall doc. IsLine doc => doc
vbar = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'|'
lparen :: forall doc. IsLine doc => doc
lparen = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'('
rparen :: forall doc. IsLine doc => doc
rparen = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')'
lbrack :: forall doc. IsLine doc => doc
lbrack = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'['
rbrack :: forall doc. IsLine doc => doc
rbrack = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
']'
lbrace :: forall doc. IsLine doc => doc
lbrace = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'{'
rbrace :: forall doc. IsLine doc => doc
rbrace = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'}'
forAllLit :: SDoc
forAllLit :: SDoc
forAllLit = SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'∀') (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall")
bullet :: SDoc
bullet :: SDoc
bullet = SDoc -> SDoc -> SDoc
unicode (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'•') (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'*')
unicodeSyntax :: SDoc -> SDoc -> SDoc
unicodeSyntax :: SDoc -> SDoc -> SDoc
unicodeSyntax SDoc
unicode SDoc
plain =
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocCanUseUnicode ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
can_use_unicode ->
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintUnicodeSyntax ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_unicode_syntax ->
if Bool
can_use_unicode Bool -> Bool -> Bool
&& Bool
print_unicode_syntax
then SDoc
unicode
else SDoc
plain
unicode :: SDoc -> SDoc -> SDoc
unicode :: SDoc -> SDoc -> SDoc
unicode SDoc
unicode SDoc
plain = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocCanUseUnicode ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc
unicode
Bool
False -> SDoc
plain
nest :: Int -> SDoc -> SDoc
($+$) :: SDoc -> SDoc -> SDoc
{-# INLINE CONLIKE nest #-}
nest :: Int -> SDoc -> SDoc
nest Int
n SDoc
d = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
Pretty.nest Int
n (Doc -> Doc) -> (SDocContext -> Doc) -> SDocContext -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDocContext -> Doc
runSDoc SDoc
d
{-# INLINE CONLIKE ($+$) #-}
$+$ :: SDoc -> SDoc -> SDoc
($+$) SDoc
d1 SDoc
d2 = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Doc -> Doc -> Doc
(Pretty.$+$) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
ctx) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
ctx)
cat :: [SDoc] -> SDoc
fcat :: [SDoc] -> SDoc
{-# INLINE CONLIKE cat #-}
cat :: [SDoc] -> SDoc
cat [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.cat [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE fcat #-}
fcat :: [SDoc] -> SDoc
fcat [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.fcat [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
hang :: SDoc
-> Int
-> SDoc
-> SDoc
{-# INLINE CONLIKE hang #-}
hang :: SDoc -> Int -> SDoc -> SDoc
hang SDoc
d1 Int
n SDoc
d2 = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
sty -> Doc -> Int -> Doc -> Doc
Pretty.hang (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
sty) Int
n (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
sty)
hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc
{-# INLINE CONLIKE hangNotEmpty #-}
hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc
hangNotEmpty SDoc
d1 Int
n SDoc
d2 =
(SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Doc -> Int -> Doc -> Doc
Pretty.hangNotEmpty (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
ctx) Int
n (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
ctx)
punctuate :: IsLine doc
=> doc
-> [doc]
-> [doc]
punctuate :: forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
_ [] = []
punctuate doc
p (doc
d:[doc]
ds) = doc -> [doc] -> [doc]
go doc
d [doc]
ds
where
go :: doc -> [doc] -> [doc]
go doc
d [] = [doc
d]
go doc
d (doc
e:[doc]
es) = (doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
p) doc -> [doc] -> [doc]
forall a. a -> [a] -> [a]
: doc -> [doc] -> [doc]
go doc
e [doc]
es
punctuateFinal :: IsLine doc
=> doc
-> doc
-> [doc]
-> [doc]
punctuateFinal :: forall doc. IsLine doc => doc -> doc -> [doc] -> [doc]
punctuateFinal doc
_ doc
_ [] = []
punctuateFinal doc
p doc
q (doc
d:[doc]
ds) = doc -> [doc] -> [doc]
go doc
d [doc]
ds
where
go :: doc -> [doc] -> [doc]
go doc
d [] = [doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
q]
go doc
d (doc
e:[doc]
es) = (doc
d doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
p) doc -> [doc] -> [doc]
forall a. a -> [a] -> [a]
: doc -> [doc] -> [doc]
go doc
e [doc]
es
ppWhen, ppUnless :: IsOutput doc => Bool -> doc -> doc
{-# INLINE CONLIKE ppWhen #-}
ppWhen :: forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
True doc
doc = doc
doc
ppWhen Bool
False doc
_ = doc
forall doc. IsOutput doc => doc
empty
{-# INLINE CONLIKE ppUnless #-}
ppUnless :: forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
True doc
_ = doc
forall doc. IsOutput doc => doc
empty
ppUnless Bool
False doc
doc = doc
doc
{-# INLINE CONLIKE ppWhenOption #-}
ppWhenOption :: (SDocContext -> Bool) -> SDoc -> SDoc
ppWhenOption :: (SDocContext -> Bool) -> SDoc -> SDoc
ppWhenOption SDocContext -> Bool
f SDoc
doc = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
f ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc
doc
Bool
False -> SDoc
forall doc. IsOutput doc => doc
empty
{-# INLINE CONLIKE ppUnlessOption #-}
ppUnlessOption :: (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption :: (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
f SDoc
doc = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
f ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc
forall doc. IsOutput doc => doc
empty
Bool
False -> SDoc
doc
coloured :: Col.PprColour -> SDoc -> SDoc
coloured :: PprColour -> SDoc -> SDoc
coloured PprColour
col SDoc
sdoc = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocShouldUseColor ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
ctx :: SDocContext
ctx@SDC{ sdocLastColour :: SDocContext -> PprColour
sdocLastColour = PprColour
lastCol, sdocStyle :: SDocContext -> PprStyle
sdocStyle = PprUser NamePprCtx
_ Depth
_ Coloured
Coloured } ->
let ctx' :: SDocContext
ctx' = SDocContext
ctx{ sdocLastColour = lastCol `mappend` col } in
String -> Doc
Pretty.zeroWidthText (PprColour -> String
Col.renderColour PprColour
col)
Doc -> Doc -> Doc
Pretty.<> SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
ctx'
Doc -> Doc -> Doc
Pretty.<> String -> Doc
Pretty.zeroWidthText (PprColour -> String
Col.renderColourAfresh PprColour
lastCol)
SDocContext
ctx -> SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
ctx
Bool
False -> SDoc
sdoc
keyword :: SDoc -> SDoc
keyword :: SDoc -> SDoc
keyword = PprColour -> SDoc -> SDoc
coloured PprColour
Col.colBold
class Outputable a where
ppr :: a -> SDoc
instance Outputable Void where
ppr :: Void -> SDoc
ppr Void
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<<Void>>"
instance Outputable Bool where
ppr :: Bool -> SDoc
ppr Bool
True = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"True"
ppr Bool
False = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"False"
instance Outputable Ordering where
ppr :: Ordering -> SDoc
ppr Ordering
LT = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LT"
ppr Ordering
EQ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"EQ"
ppr Ordering
GT = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GT"
instance Outputable Int8 where
ppr :: Int8 -> SDoc
ppr Int8
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
n
instance Outputable Int16 where
ppr :: Int16 -> SDoc
ppr Int16
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
n
instance Outputable Int32 where
ppr :: Int32 -> SDoc
ppr Int32
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n
instance Outputable Int64 where
ppr :: Int64 -> SDoc
ppr Int64
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
instance Outputable Int where
ppr :: Int -> SDoc
ppr Int
n = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n
instance Outputable Integer where
ppr :: Integer -> SDoc
ppr Integer
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
n
instance Outputable Word8 where
ppr :: Word8 -> SDoc
ppr Word8
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n
instance Outputable Word16 where
ppr :: Word16 -> SDoc
ppr Word16
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n
instance Outputable Word32 where
ppr :: Word32 -> SDoc
ppr Word32
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n
instance Outputable Word64 where
ppr :: Word64 -> SDoc
ppr Word64
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
instance Outputable Word where
ppr :: Word -> SDoc
ppr Word
n = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> SDoc) -> Integer -> SDoc
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n
instance Outputable Float where
ppr :: Float -> SDoc
ppr Float
f = Float -> SDoc
forall doc. IsLine doc => Float -> doc
float Float
f
instance Outputable Double where
ppr :: Double -> SDoc
ppr Double
f = Double -> SDoc
forall doc. IsLine doc => Double -> doc
double Double
f
instance Outputable () where
ppr :: () -> SDoc
ppr ()
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"()"
instance Outputable UTCTime where
ppr :: UTCTime -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (UTCTime -> String) -> UTCTime -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format UTCTime -> UTCTime -> String
forall t. Format t -> t -> String
formatShow Format UTCTime
forall t. ISO8601 t => Format t
iso8601Format
instance (Outputable a) => Outputable [a] where
ppr :: [a] -> SDoc
ppr [a]
xs = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ((a -> SDoc) -> [a] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
xs)
instance (Outputable a) => Outputable (NonEmpty a) where
ppr :: NonEmpty a -> SDoc
ppr = [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([a] -> SDoc) -> (NonEmpty a -> [a]) -> NonEmpty a -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.toList
instance (Outputable a, Outputable b) => Outputable (Arg a b) where
ppr :: Arg a b -> SDoc
ppr (Arg a
a b
b) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Arg" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b
instance (Outputable a) => Outputable (Set a) where
ppr :: Set a -> SDoc
ppr Set a
s = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ((a -> SDoc) -> [a] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s))
instance Outputable IntSet.IntSet where
ppr :: IntSet -> SDoc
ppr IntSet
s = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ((Int -> SDoc) -> [Int] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IntSet -> [Int]
IntSet.toList IntSet
s))
instance (Outputable a, Outputable b) => Outputable (a, b) where
ppr :: (a, b) -> SDoc
ppr (a
x,b
y) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma, b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
y])
instance Outputable a => Outputable (Maybe a) where
ppr :: Maybe a -> SDoc
ppr Maybe a
Nothing = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Nothing"
ppr (Just a
x) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Just" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x
instance (Outputable a, Outputable b) => Outputable (Either a b) where
ppr :: Either a b -> SDoc
ppr (Left a
x) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Left" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x
ppr (Right b
y) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Right" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
y
instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
ppr :: (a, b, c) -> SDoc
ppr (a
x,b
y,c
z) =
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
y SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
c -> SDoc
forall a. Outputable a => a -> SDoc
ppr c
z ])
instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
Outputable (a, b, c, d) where
ppr :: (a, b, c, d) -> SDoc
ppr (a
a,b
b,c
c,d
d) =
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
c -> SDoc
forall a. Outputable a => a -> SDoc
ppr c
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
d -> SDoc
forall a. Outputable a => a -> SDoc
ppr d
d])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
Outputable (a, b, c, d, e) where
ppr :: (a, b, c, d, e) -> SDoc
ppr (a
a,b
b,c
c,d
d,e
e) =
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
c -> SDoc
forall a. Outputable a => a -> SDoc
ppr c
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
d -> SDoc
forall a. Outputable a => a -> SDoc
ppr d
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
e -> SDoc
forall a. Outputable a => a -> SDoc
ppr e
e])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>
Outputable (a, b, c, d, e, f) where
ppr :: (a, b, c, d, e, f) -> SDoc
ppr (a
a,b
b,c
c,d
d,e
e,f
f) =
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
c -> SDoc
forall a. Outputable a => a -> SDoc
ppr c
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
d -> SDoc
forall a. Outputable a => a -> SDoc
ppr d
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
e -> SDoc
forall a. Outputable a => a -> SDoc
ppr e
e SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
f -> SDoc
forall a. Outputable a => a -> SDoc
ppr f
f])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>
Outputable (a, b, c, d, e, f, g) where
ppr :: (a, b, c, d, e, f, g) -> SDoc
ppr (a
a,b
b,c
c,d
d,e
e,f
f,g
g) =
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
c -> SDoc
forall a. Outputable a => a -> SDoc
ppr c
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
d -> SDoc
forall a. Outputable a => a -> SDoc
ppr d
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
e -> SDoc
forall a. Outputable a => a -> SDoc
ppr e
e SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
f -> SDoc
forall a. Outputable a => a -> SDoc
ppr f
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
g -> SDoc
forall a. Outputable a => a -> SDoc
ppr g
g])
instance Outputable FastString where
ppr :: FastString -> SDoc
ppr FastString
fs = FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
deriving newtype instance Outputable NonDetFastString
deriving newtype instance Outputable LexicalFastString
instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
ppr :: Map key elt -> SDoc
ppr Map key elt
m = [(key, elt)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Map key elt -> [(key, elt)]
forall k a. Map k a -> [(k, a)]
M.toList Map key elt
m)
instance (Outputable elt) => Outputable (IM.IntMap elt) where
ppr :: IntMap elt -> SDoc
ppr IntMap elt
m = [(Int, elt)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IntMap elt -> [(Int, elt)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap elt
m)
instance Outputable Fingerprint where
ppr :: Fingerprint -> SDoc
ppr (Fingerprint Word64
w1 Word64
w2) = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> Word64 -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%016x%016x" Word64
w1 Word64
w2)
instance Outputable a => Outputable (SCC a) where
ppr :: SCC a -> SDoc
ppr (AcyclicSCC a
v) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NONREC" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (Int -> SDoc -> SDoc
nest Int
3 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
v))
ppr (CyclicSCC [a]
vs) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"REC" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (Int -> SDoc -> SDoc
nest Int
3 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
vs)))
instance Outputable Serialized where
ppr :: Serialized -> SDoc
ppr (Serialized TypeRep
the_type [Word8]
bytes) = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
the_type)
instance Outputable Extension where
ppr :: Extension -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (Extension -> String) -> Extension -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Show a => a -> String
show
instance Outputable ModuleName where
ppr :: ModuleName -> SDoc
ppr = ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName
pprModuleName :: IsLine doc => ModuleName -> doc
pprModuleName :: forall doc. IsLine doc => ModuleName -> doc
pprModuleName (ModuleName FastString
nm) =
doc -> (PprStyle -> SDoc) -> doc
forall doc. IsOutput doc => doc -> (PprStyle -> SDoc) -> doc
docWithStyle (FastZString -> doc
forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS FastString
nm)) (\PprStyle
_ -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
nm)
{-# SPECIALIZE pprModuleName :: ModuleName -> SDoc #-}
{-# SPECIALIZE pprModuleName :: ModuleName -> HLine #-}
class OutputableP env a where
pdoc :: env -> a -> SDoc
newtype PDoc a = PDoc a
instance Outputable a => OutputableP env (PDoc a) where
pdoc :: env -> PDoc a -> SDoc
pdoc env
_ (PDoc a
a) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a
instance OutputableP env a => OutputableP env [a] where
pdoc :: env -> [a] -> SDoc
pdoc env
env [a]
xs = [SDoc] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) [a]
xs)
instance OutputableP env a => OutputableP env (Maybe a) where
pdoc :: env -> Maybe a -> SDoc
pdoc env
env Maybe a
xs = Maybe SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> SDoc) -> Maybe a -> Maybe SDoc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) Maybe a
xs)
instance (OutputableP env a, OutputableP env b) => OutputableP env (a, b) where
pdoc :: env -> (a, b) -> SDoc
pdoc env
env (a
a,b
b) = (SDoc, SDoc) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env a
a, env -> b -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env b
b)
instance (OutputableP env a, OutputableP env b, OutputableP env c) => OutputableP env (a, b, c) where
pdoc :: env -> (a, b, c) -> SDoc
pdoc env
env (a
a,b
b,c
c) = (SDoc, SDoc, SDoc) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env a
a, env -> b -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env b
b, env -> c -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env c
c)
instance (OutputableP env key, OutputableP env elt) => OutputableP env (M.Map key elt) where
pdoc :: env -> Map key elt -> SDoc
pdoc env
env Map key elt
m = [(SDoc, SDoc)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([(SDoc, SDoc)] -> SDoc) -> [(SDoc, SDoc)] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((key, elt) -> (SDoc, SDoc)) -> [(key, elt)] -> [(SDoc, SDoc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(key
x,elt
y) -> (env -> key -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env key
x, env -> elt -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env elt
y)) ([(key, elt)] -> [(SDoc, SDoc)]) -> [(key, elt)] -> [(SDoc, SDoc)]
forall a b. (a -> b) -> a -> b
$ Map key elt -> [(key, elt)]
forall k a. Map k a -> [(k, a)]
M.toList Map key elt
m
instance OutputableP env a => OutputableP env (SCC a) where
pdoc :: env -> SCC a -> SDoc
pdoc env
env SCC a
scc = SCC SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> SDoc) -> SCC a -> SCC SDoc
forall a b. (a -> b) -> SCC a -> SCC b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) SCC a
scc)
instance OutputableP env SDoc where
pdoc :: env -> SDoc -> SDoc
pdoc env
_ SDoc
x = SDoc
x
instance (OutputableP env a) => OutputableP env (Set a) where
pdoc :: env -> Set a -> SDoc
pdoc env
env Set a
s = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (env -> a -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s))))
instance OutputableP env Void where
pdoc :: env -> Void -> SDoc
pdoc env
_ = Void -> SDoc
\ case
data BindingSite
= LambdaBind
| CaseBind
| CasePatBind
| LetBind
deriving BindingSite -> BindingSite -> Bool
(BindingSite -> BindingSite -> Bool)
-> (BindingSite -> BindingSite -> Bool) -> Eq BindingSite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingSite -> BindingSite -> Bool
== :: BindingSite -> BindingSite -> Bool
$c/= :: BindingSite -> BindingSite -> Bool
/= :: BindingSite -> BindingSite -> Bool
Eq
class Outputable a => OutputableBndr a where
pprBndr :: BindingSite -> a -> SDoc
pprBndr BindingSite
_b a
x = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x
pprPrefixOcc, pprInfixOcc :: a -> SDoc
bndrIsJoin_maybe :: a -> Maybe Int
bndrIsJoin_maybe a
_ = Maybe Int
forall a. Maybe a
Nothing
pprHsChar :: Char -> SDoc
pprHsChar :: Char -> SDoc
pprHsChar Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\x10ffff' = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\\' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Word32 -> String
forall a. Show a => a -> String
show (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word32))
| Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
pprHsString :: FastString -> SDoc
pprHsString :: FastString -> SDoc
pprHsString FastString
fs = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> [String]
showMultiLineString (FastString -> String
unpackFS FastString
fs)))
pprHsBytes :: ByteString -> SDoc
pprHsBytes :: ByteString -> SDoc
pprHsBytes ByteString
bs = let escaped :: String
escaped = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
escape ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs
in [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> [String]
showMultiLineString String
escaped)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#'
where escape :: Word8 -> String
escape :: Word8 -> String
escape Word8
w = let c :: Char
c = Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)
in if Char -> Bool
isAscii Char
c
then [Char
c]
else Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Word8 -> String
forall a. Show a => a -> String
show Word8
w
primCharSuffix, primFloatSuffix, primDoubleSuffix,
primIntSuffix, primWordSuffix,
primInt8Suffix, primWord8Suffix,
primInt16Suffix, primWord16Suffix,
primInt32Suffix, primWord32Suffix,
primInt64Suffix, primWord64Suffix
:: SDoc
primCharSuffix :: SDoc
primCharSuffix = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#'
primFloatSuffix :: SDoc
primFloatSuffix = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#'
primIntSuffix :: SDoc
primIntSuffix = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#'
primDoubleSuffix :: SDoc
primDoubleSuffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"##"
primWordSuffix :: SDoc
primWordSuffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"##"
primInt8Suffix :: SDoc
primInt8Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Int8"
primWord8Suffix :: SDoc
primWord8Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Word8"
primInt16Suffix :: SDoc
primInt16Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Int16"
primWord16Suffix :: SDoc
primWord16Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Word16"
primInt32Suffix :: SDoc
primInt32Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Int32"
primWord32Suffix :: SDoc
primWord32Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Word32"
primInt64Suffix :: SDoc
primInt64Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Int64"
primWord64Suffix :: SDoc
primWord64Suffix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#Word64"
pprPrimChar :: Char -> SDoc
pprPrimInt, pprPrimWord,
pprPrimInt8, pprPrimWord8,
pprPrimInt16, pprPrimWord16,
pprPrimInt32, pprPrimWord32,
pprPrimInt64, pprPrimWord64
:: Integer -> SDoc
pprPrimChar :: Char -> SDoc
pprPrimChar Char
c = Char -> SDoc
pprHsChar Char
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primCharSuffix
pprPrimInt :: Integer -> SDoc
pprPrimInt Integer
i = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primIntSuffix
pprPrimWord :: Integer -> SDoc
pprPrimWord Integer
w = Integer -> SDoc
word Integer
w SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primWordSuffix
pprPrimInt8 :: Integer -> SDoc
pprPrimInt8 Integer
i = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primInt8Suffix
pprPrimInt16 :: Integer -> SDoc
pprPrimInt16 Integer
i = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primInt16Suffix
pprPrimInt32 :: Integer -> SDoc
pprPrimInt32 Integer
i = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primInt32Suffix
pprPrimInt64 :: Integer -> SDoc
pprPrimInt64 Integer
i = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primInt64Suffix
pprPrimWord8 :: Integer -> SDoc
pprPrimWord8 Integer
w = Integer -> SDoc
word Integer
w SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primWord8Suffix
pprPrimWord16 :: Integer -> SDoc
pprPrimWord16 Integer
w = Integer -> SDoc
word Integer
w SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primWord16Suffix
pprPrimWord32 :: Integer -> SDoc
pprPrimWord32 Integer
w = Integer -> SDoc
word Integer
w SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primWord32Suffix
pprPrimWord64 :: Integer -> SDoc
pprPrimWord64 Integer
w = Integer -> SDoc
word Integer
w SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primWord64Suffix
pprPrefixVar :: Bool -> SDoc -> SDoc
pprPrefixVar :: Bool -> SDoc -> SDoc
pprPrefixVar Bool
is_operator SDoc
pp_v
| Bool
is_operator = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
pp_v
| Bool
otherwise = SDoc
pp_v
pprInfixVar :: Bool -> SDoc -> SDoc
pprInfixVar :: Bool -> SDoc -> SDoc
pprInfixVar Bool
is_operator SDoc
pp_v
| Bool
is_operator = SDoc
pp_v
| Bool
otherwise = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'`' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_v SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'`'
pprFastFilePath :: FastString -> SDoc
pprFastFilePath :: FastString -> SDoc
pprFastFilePath FastString
path = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ ShowS
normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
path
pprFilePathString :: IsLine doc => FilePath -> doc
pprFilePathString :: forall doc. IsLine doc => String -> doc
pprFilePathString String
path = doc -> doc
forall doc. IsLine doc => doc -> doc
doubleQuotes (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text (ShowS
escape (ShowS
normalise String
path))
where
escape :: ShowS
escape [] = []
escape (Char
'\\':String
xs) = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
escape (Char
x:String
xs) = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
{-# SPECIALIZE pprFilePathString :: FilePath -> SDoc #-}
{-# SPECIALIZE pprFilePathString :: FilePath -> HLine #-}
pprWithCommas :: (a -> SDoc)
-> [a]
-> SDoc
pprWithCommas :: forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas a -> SDoc
pp [a]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
pp [a]
xs))
pprWithBars :: (a -> SDoc)
-> [a]
-> SDoc
pprWithBars :: forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars a -> SDoc
pp [a]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
forall doc. IsLine doc => doc
vbar ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
pp [a]
xs))
spaceIfSingleQuote :: SDoc -> SDoc
spaceIfSingleQuote :: SDoc -> SDoc
spaceIfSingleQuote (SDoc SDocContext -> Doc
m) =
(SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
let (Maybe Char
mHead, Doc
d) = Doc -> (Maybe Char, Doc)
Pretty.docHead (SDocContext -> Doc
m SDocContext
ctx)
in if Maybe Char
mHead Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\''
then Doc
Pretty.space Doc -> Doc -> Doc
Pretty.<> Doc
d
else Doc
d
interppSP :: Outputable a => [a] -> SDoc
interppSP :: forall a. Outputable a => [a] -> SDoc
interppSP [a]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
xs)
interpp'SP :: Outputable a => [a] -> SDoc
interpp'SP :: forall a. Outputable a => [a] -> SDoc
interpp'SP [a]
xs = (a -> SDoc) -> [a] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
interpp'SP' a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
xs
interpp'SP' :: (a -> SDoc) -> [a] -> SDoc
interpp'SP' :: forall a. (a -> SDoc) -> [a] -> SDoc
interpp'SP' a -> SDoc
f [a]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
f [a]
xs))
pprQuotedList :: Outputable a => [a] -> SDoc
pprQuotedList :: forall a. Outputable a => [a] -> SDoc
pprQuotedList = [SDoc] -> SDoc
quotedList ([SDoc] -> SDoc) -> ([a] -> [SDoc]) -> [a] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr
quotedList :: [SDoc] -> SDoc
quotedList :: [SDoc] -> SDoc
quotedList [SDoc]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SDoc -> SDoc
quotes [SDoc]
xs))
quotedListWithOr :: [SDoc] -> SDoc
quotedListWithOr :: [SDoc] -> SDoc
quotedListWithOr xs :: [SDoc]
xs@(SDoc
_:SDoc
_:[SDoc]
_) = [SDoc] -> SDoc
quotedList ([SDoc] -> [SDoc]
forall a. HasCallStack => [a] -> [a]
init [SDoc]
xs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([SDoc] -> SDoc
forall a. HasCallStack => [a] -> a
last [SDoc]
xs)
quotedListWithOr [SDoc]
xs = [SDoc] -> SDoc
quotedList [SDoc]
xs
quotedListWithNor :: [SDoc] -> SDoc
quotedListWithNor :: [SDoc] -> SDoc
quotedListWithNor xs :: [SDoc]
xs@(SDoc
_:SDoc
_:[SDoc]
_) = [SDoc] -> SDoc
quotedList ([SDoc] -> [SDoc]
forall a. HasCallStack => [a] -> [a]
init [SDoc]
xs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"nor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([SDoc] -> SDoc
forall a. HasCallStack => [a] -> a
last [SDoc]
xs)
quotedListWithNor [SDoc]
xs = [SDoc] -> SDoc
quotedList [SDoc]
xs
quotedListWithAnd :: [SDoc] -> SDoc
quotedListWithAnd :: [SDoc] -> SDoc
quotedListWithAnd xs :: [SDoc]
xs@(SDoc
_:SDoc
_:[SDoc]
_) = [SDoc] -> SDoc
quotedList ([SDoc] -> [SDoc]
forall a. HasCallStack => [a] -> [a]
init [SDoc]
xs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([SDoc] -> SDoc
forall a. HasCallStack => [a] -> a
last [SDoc]
xs)
quotedListWithAnd [SDoc]
xs = [SDoc] -> SDoc
quotedList [SDoc]
xs
intWithCommas :: Integral a => a -> SDoc
intWithCommas :: forall a. Integral a => a -> SDoc
intWithCommas a
n
| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'-' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> a -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas (-a
n)
| a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)
| Bool
otherwise = a -> SDoc
forall a. Integral a => a -> SDoc
intWithCommas a
q SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
zeroes SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)
where
(a
q,a
r) = a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
1000
zeroes :: SDoc
zeroes | a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100 = SDoc
forall doc. IsOutput doc => doc
empty
| a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'0'
| Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"00"
speakNth :: Int -> SDoc
speakNth :: Int -> SDoc
speakNth Int
1 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"first"
speakNth Int
2 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"second"
speakNth Int
3 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"third"
speakNth Int
4 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fourth"
speakNth Int
5 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fifth"
speakNth Int
6 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sixth"
speakNth Int
n = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
suffix ]
where
suffix :: String
suffix | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20 = String
"th"
| Int
last_dig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"st"
| Int
last_dig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"nd"
| Int
last_dig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = String
"rd"
| Bool
otherwise = String
"th"
last_dig :: Int
last_dig = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
10
speakN :: Int -> SDoc
speakN :: Int -> SDoc
speakN Int
0 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"none"
speakN Int
1 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one"
speakN Int
2 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"two"
speakN Int
3 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"three"
speakN Int
4 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"four"
speakN Int
5 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"five"
speakN Int
6 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"six"
speakN Int
n = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n
speakNOf :: Int -> SDoc -> SDoc
speakNOf :: Int -> SDoc -> SDoc
speakNOf Int
0 SDoc
d = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"no" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
's'
speakNOf Int
1 SDoc
d = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
d
speakNOf Int
n SDoc
d = Int -> SDoc
speakN Int
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
's'
plural :: [a] -> SDoc
plural :: forall a. [a] -> SDoc
plural [a
_] = SDoc
forall doc. IsOutput doc => doc
empty
plural [a]
_ = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
's'
singular :: [a] -> SDoc
singular :: forall a. [a] -> SDoc
singular [a
_] = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
's'
singular [a]
_ = SDoc
forall doc. IsOutput doc => doc
empty
isOrAre :: [a] -> SDoc
isOrAre :: forall a. [a] -> SDoc
isOrAre [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is"
isOrAre [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are"
doOrDoes :: [a] -> SDoc
doOrDoes :: forall a. [a] -> SDoc
doOrDoes [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does"
doOrDoes [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"do"
itsOrTheir :: [a] -> SDoc
itsOrTheir :: forall a. [a] -> SDoc
itsOrTheir [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"its"
itsOrTheir [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"their"
itOrThey :: [a] -> SDoc
itOrThey :: forall a. [a] -> SDoc
itOrThey [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it"
itOrThey [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"they"
thisOrThese :: [a] -> SDoc
thisOrThese :: forall a. [a] -> SDoc
thisOrThese [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This"
thisOrThese [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"These"
hasOrHave :: [a] -> SDoc
hasOrHave :: forall a. [a] -> SDoc
hasOrHave [a
_] = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has"
hasOrHave [a]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have"
newtype HLine = HLine' { HLine -> SDocContext -> BufHandle -> IO ()
runHLine :: SDocContext -> BufHandle -> IO () }
newtype HDoc = HDoc' { HDoc -> SDocContext -> BufHandle -> IO ()
runHDoc :: SDocContext -> BufHandle -> IO () }
pattern HLine :: (SDocContext -> BufHandle -> IO ()) -> HLine
pattern $mHLine :: forall {r}.
HLine
-> ((SDocContext -> BufHandle -> IO ()) -> r) -> ((# #) -> r) -> r
$bHLine :: (SDocContext -> BufHandle -> IO ()) -> HLine
HLine f <- HLine' f
where HLine SDocContext -> BufHandle -> IO ()
f = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine' ((SDocContext -> BufHandle -> IO ())
-> SDocContext -> BufHandle -> IO ()
forall a b. (a -> b) -> a -> b
oneShot (\SDocContext
ctx -> (BufHandle -> IO ()) -> BufHandle -> IO ()
forall a b. (a -> b) -> a -> b
oneShot (\BufHandle
h -> SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h)))
{-# COMPLETE HLine #-}
pattern HDoc :: (SDocContext -> BufHandle -> IO ()) -> HDoc
pattern $mHDoc :: forall {r}.
HDoc
-> ((SDocContext -> BufHandle -> IO ()) -> r) -> ((# #) -> r) -> r
$bHDoc :: (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc f <- HDoc' f
where HDoc SDocContext -> BufHandle -> IO ()
f = (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc' ((SDocContext -> BufHandle -> IO ())
-> SDocContext -> BufHandle -> IO ()
forall a b. (a -> b) -> a -> b
oneShot (\SDocContext
ctx -> (BufHandle -> IO ()) -> BufHandle -> IO ()
forall a b. (a -> b) -> a -> b
oneShot (\BufHandle
h -> SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h)))
{-# COMPLETE HDoc #-}
bPutHDoc :: BufHandle -> SDocContext -> HDoc -> IO ()
bPutHDoc :: BufHandle -> SDocContext -> HDoc -> IO ()
bPutHDoc BufHandle
h SDocContext
ctx (HDoc SDocContext -> BufHandle -> IO ()
f) = Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (PprStyle -> Bool
codeStyle (SDocContext -> PprStyle
sdocStyle SDocContext
ctx)) (SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h)
class IsOutput doc where
empty :: doc
docWithContext :: (SDocContext -> doc) -> doc
docWithStyle :: doc -> (PprStyle -> SDoc) -> doc
class IsOutput doc => IsLine doc where
char :: Char -> doc
text :: String -> doc
ftext :: FastString -> doc
ztext :: FastZString -> doc
(<>) :: doc -> doc -> doc
(<+>) :: doc -> doc -> doc
sep :: [doc] -> doc
fsep :: [doc] -> doc
hcat :: [doc] -> doc
hcat [doc]
docs = (doc -> doc -> doc) -> doc -> [doc] -> doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
(<>) doc
forall doc. IsOutput doc => doc
empty [doc]
docs
{-# INLINE CONLIKE hcat #-}
hsep :: [doc] -> doc
hsep [doc]
docs = (doc -> doc -> doc) -> doc -> [doc] -> doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
(<+>) doc
forall doc. IsOutput doc => doc
empty [doc]
docs
{-# INLINE CONLIKE hsep #-}
dualLine :: SDoc -> HLine -> doc
class (IsOutput doc, IsLine (Line doc)) => IsDoc doc where
type Line doc = r | r -> doc
line :: Line doc -> doc
($$) :: doc -> doc -> doc
lines_ :: [Line doc] -> doc
lines_ = [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ([doc] -> doc) -> ([Line doc] -> [doc]) -> [Line doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line doc -> doc) -> [Line doc] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line
{-# INLINE CONLIKE lines_ #-}
vcat :: [doc] -> doc
vcat [doc]
ls = (doc -> doc -> doc) -> doc -> [doc] -> doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
($$) doc
forall doc. IsOutput doc => doc
empty [doc]
ls
{-# INLINE CONLIKE vcat #-}
dualDoc :: SDoc -> HDoc -> doc
instance IsOutput SDoc where
empty :: SDoc
empty = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ Doc
Pretty.empty
{-# INLINE CONLIKE empty #-}
docWithContext :: (SDocContext -> SDoc) -> SDoc
docWithContext = (SDocContext -> SDoc) -> SDoc
sdocWithContext
{-# INLINE docWithContext #-}
docWithStyle :: SDoc -> (PprStyle -> SDoc) -> SDoc
docWithStyle SDoc
c PprStyle -> SDoc
f = (SDocContext -> SDoc) -> SDoc
sdocWithContext (\SDocContext
ctx -> let sty :: PprStyle
sty = SDocContext -> PprStyle
sdocStyle SDocContext
ctx
in if PprStyle -> Bool
codeStyle PprStyle
sty then SDoc
c
else PprStyle -> SDoc
f PprStyle
sty)
{-# INLINE CONLIKE docWithStyle #-}
instance IsLine SDoc where
char :: Char -> SDoc
char Char
c = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
Pretty.char Char
c
{-# INLINE CONLIKE char #-}
text :: String -> SDoc
text String
s = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
Pretty.text String
s
{-# INLINE CONLIKE text #-}
ftext :: FastString -> SDoc
ftext FastString
s = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> Doc
Pretty.ftext FastString
s
{-# INLINE CONLIKE ftext #-}
ztext :: FastZString -> SDoc
ztext FastZString
s = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> Doc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastZString -> Doc
Pretty.ztext FastZString
s
{-# INLINE CONLIKE ztext #-}
<> :: SDoc -> SDoc -> SDoc
(<>) SDoc
d1 SDoc
d2 = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Doc -> Doc -> Doc
(Pretty.<>) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
ctx) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
ctx)
{-# INLINE CONLIKE (<>) #-}
<+> :: SDoc -> SDoc -> SDoc
(<+>) SDoc
d1 SDoc
d2 = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Doc -> Doc -> Doc
(Pretty.<+>) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
ctx) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
ctx)
{-# INLINE CONLIKE (<+>) #-}
hcat :: [SDoc] -> SDoc
hcat [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.hcat [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE hcat #-}
hsep :: [SDoc] -> SDoc
hsep [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.hsep [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE hsep #-}
sep :: [SDoc] -> SDoc
sep [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.sep [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE sep #-}
fsep :: [SDoc] -> SDoc
fsep [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.fsep [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE fsep #-}
dualLine :: SDoc -> HLine -> SDoc
dualLine SDoc
s HLine
_ = SDoc
s
{-# INLINE CONLIKE dualLine #-}
instance IsDoc SDoc where
type Line SDoc = SDoc
line :: Line SDoc -> SDoc
line = Line SDoc -> SDoc
SDoc -> SDoc
forall a. a -> a
id
{-# INLINE line #-}
lines_ :: [Line SDoc] -> SDoc
lines_ = [Line SDoc] -> SDoc
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
{-# INLINE lines_ #-}
$$ :: SDoc -> SDoc -> SDoc
($$) SDoc
d1 SDoc
d2 = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> Doc -> Doc -> Doc
(Pretty.$$) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d1 SDocContext
ctx) (SDoc -> SDocContext -> Doc
runSDoc SDoc
d2 SDocContext
ctx)
{-# INLINE CONLIKE ($$) #-}
vcat :: [SDoc] -> SDoc
vcat [SDoc]
ds = (SDocContext -> Doc) -> SDoc
SDoc ((SDocContext -> Doc) -> SDoc) -> (SDocContext -> Doc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> [Doc] -> Doc
Pretty.vcat [SDoc -> SDocContext -> Doc
runSDoc SDoc
d SDocContext
ctx | SDoc
d <- [SDoc]
ds]
{-# INLINE CONLIKE vcat #-}
dualDoc :: SDoc -> HDoc -> SDoc
dualDoc SDoc
s HDoc
_ = SDoc
s
{-# INLINE CONLIKE dualDoc #-}
instance IsOutput HLine where
empty :: HLine
empty = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
_ BufHandle
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE empty #-}
docWithContext :: (SDocContext -> HLine) -> HLine
docWithContext SDocContext -> HLine
f = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine ((SDocContext -> BufHandle -> IO ()) -> HLine)
-> (SDocContext -> BufHandle -> IO ()) -> HLine
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx BufHandle
h -> HLine -> SDocContext -> BufHandle -> IO ()
runHLine (SDocContext -> HLine
f SDocContext
ctx) SDocContext
ctx BufHandle
h
{-# INLINE CONLIKE docWithContext #-}
docWithStyle :: HLine -> (PprStyle -> SDoc) -> HLine
docWithStyle HLine
c PprStyle -> SDoc
_ = HLine
c
{-# INLINE CONLIKE docWithStyle #-}
instance IsOutput HDoc where
empty :: HDoc
empty = (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc (\SDocContext
_ BufHandle
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE empty #-}
docWithContext :: (SDocContext -> HDoc) -> HDoc
docWithContext SDocContext -> HDoc
f = (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc ((SDocContext -> BufHandle -> IO ()) -> HDoc)
-> (SDocContext -> BufHandle -> IO ()) -> HDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx BufHandle
h -> HDoc -> SDocContext -> BufHandle -> IO ()
runHDoc (SDocContext -> HDoc
f SDocContext
ctx) SDocContext
ctx BufHandle
h
{-# INLINE CONLIKE docWithContext #-}
docWithStyle :: HDoc -> (PprStyle -> SDoc) -> HDoc
docWithStyle HDoc
c PprStyle -> SDoc
_ = HDoc
c
{-# INLINE CONLIKE docWithStyle #-}
instance IsLine HLine where
char :: Char -> HLine
char Char
c = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
_ BufHandle
h -> BufHandle -> Char -> IO ()
bPutChar BufHandle
h Char
c)
{-# INLINE CONLIKE char #-}
text :: String -> HLine
text String
str = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
_ BufHandle
h -> BufHandle -> String -> IO ()
bPutStr BufHandle
h String
str)
{-# INLINE CONLIKE text #-}
ftext :: FastString -> HLine
ftext FastString
fstr = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
_ BufHandle
h -> BufHandle -> FastString -> IO ()
bPutFS BufHandle
h FastString
fstr)
{-# INLINE CONLIKE ftext #-}
ztext :: FastZString -> HLine
ztext FastZString
fstr = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
_ BufHandle
h -> BufHandle -> FastZString -> IO ()
bPutFZS BufHandle
h FastZString
fstr)
{-# INLINE CONLIKE ztext #-}
HLine SDocContext -> BufHandle -> IO ()
f <> :: HLine -> HLine -> HLine
<> HLine SDocContext -> BufHandle -> IO ()
g = (SDocContext -> BufHandle -> IO ()) -> HLine
HLine (\SDocContext
ctx BufHandle
h -> SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SDocContext -> BufHandle -> IO ()
g SDocContext
ctx BufHandle
h)
{-# INLINE CONLIKE (<>) #-}
HLine
f <+> :: HLine -> HLine -> HLine
<+> HLine
g = HLine
f HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> HLine
forall doc. IsLine doc => Char -> doc
char Char
' ' HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> HLine
g
{-# INLINE CONLIKE (<+>) #-}
sep :: [HLine] -> HLine
sep = [HLine] -> HLine
forall doc. IsLine doc => [doc] -> doc
hsep
{-# INLINE sep #-}
fsep :: [HLine] -> HLine
fsep = [HLine] -> HLine
forall doc. IsLine doc => [doc] -> doc
hsep
{-# INLINE fsep #-}
dualLine :: SDoc -> HLine -> HLine
dualLine SDoc
_ HLine
h = HLine
h
{-# INLINE CONLIKE dualLine #-}
instance IsDoc HDoc where
type Line HDoc = HLine
line :: Line HDoc -> HDoc
line (HLine SDocContext -> BufHandle -> IO ()
f) = (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc (\SDocContext
ctx BufHandle
h -> SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufHandle -> Char -> IO ()
bPutChar BufHandle
h Char
'\n')
{-# INLINE CONLIKE line #-}
HDoc SDocContext -> BufHandle -> IO ()
f $$ :: HDoc -> HDoc -> HDoc
$$ HDoc SDocContext -> BufHandle -> IO ()
g = (SDocContext -> BufHandle -> IO ()) -> HDoc
HDoc (\SDocContext
ctx BufHandle
h -> SDocContext -> BufHandle -> IO ()
f SDocContext
ctx BufHandle
h IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SDocContext -> BufHandle -> IO ()
g SDocContext
ctx BufHandle
h)
{-# INLINE CONLIKE ($$) #-}
dualDoc :: SDoc -> HDoc -> HDoc
dualDoc SDoc
_ HDoc
h = HDoc
h
{-# INLINE CONLIKE dualDoc #-}