{-# LANGUAGE CPP #-}
module Language.Haskell.Exts.Pretty (
Pretty,
prettyPrintStyleMode, prettyPrintWithMode, prettyPrint,
P.Style(..), P.style, P.Mode(..),
PPHsMode(..), Indent, PPLayout(..), defaultMode
, prettyPrim, prettyPrimWithMode
) where
import Language.Haskell.Exts.Syntax
import qualified Language.Haskell.Exts.ParseSyntax as P
import Language.Haskell.Exts.SrcLoc hiding (loc)
import Prelude hiding ( exp
#if MIN_VERSION_base(4,11,0)
, (<>)
#endif
)
import qualified Text.PrettyPrint as P
import Data.List (intersperse)
import Data.Maybe (isJust , fromMaybe)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..), (<$>))
#endif
import qualified Control.Monad as M (ap)
infixl 5 $$$
data PPLayout = PPOffsideRule
| PPSemiColon
| PPInLine
| PPNoLayout
deriving PPLayout -> PPLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPLayout -> PPLayout -> Bool
$c/= :: PPLayout -> PPLayout -> Bool
== :: PPLayout -> PPLayout -> Bool
$c== :: PPLayout -> PPLayout -> Bool
Eq
type Indent = Int
data PPHsMode = PPHsMode {
PPHsMode -> Indent
classIndent :: Indent,
PPHsMode -> Indent
doIndent :: Indent,
PPHsMode -> Indent
multiIfIndent :: Indent,
PPHsMode -> Indent
caseIndent :: Indent,
PPHsMode -> Indent
letIndent :: Indent,
PPHsMode -> Indent
whereIndent :: Indent,
PPHsMode -> Indent
onsideIndent :: Indent,
PPHsMode -> Bool
spacing :: Bool,
PPHsMode -> PPLayout
layout :: PPLayout,
PPHsMode -> Bool
linePragmas :: Bool
}
defaultMode :: PPHsMode
defaultMode :: PPHsMode
defaultMode = PPHsMode{
classIndent :: Indent
classIndent = Indent
8,
doIndent :: Indent
doIndent = Indent
3,
multiIfIndent :: Indent
multiIfIndent = Indent
3,
caseIndent :: Indent
caseIndent = Indent
4,
letIndent :: Indent
letIndent = Indent
4,
whereIndent :: Indent
whereIndent = Indent
6,
onsideIndent :: Indent
onsideIndent = Indent
2,
spacing :: Bool
spacing = Bool
True,
layout :: PPLayout
layout = PPLayout
PPOffsideRule,
linePragmas :: Bool
linePragmas = Bool
False
}
newtype DocM s a = DocM (s -> a)
instance Functor (DocM s) where
fmap :: forall a b. (a -> b) -> DocM s a -> DocM s b
fmap a -> b
f DocM s a
xs = do a
x <- DocM s a
xs; forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)
instance Applicative (DocM s) where
pure :: forall a. a -> DocM s a
pure = forall a s. a -> DocM s a
retDocM
<*> :: forall a b. DocM s (a -> b) -> DocM s a -> DocM s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
M.ap
instance Monad (DocM s) where
>>= :: forall a b. DocM s a -> (a -> DocM s b) -> DocM s b
(>>=) = forall s a b. DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM
>> :: forall a b. DocM s a -> DocM s b -> DocM s b
(>>) = forall s a b. DocM s a -> DocM s b -> DocM s b
then_DocM
return :: forall a. a -> DocM s a
return = forall a s. a -> DocM s a
retDocM
{-# INLINE thenDocM #-}
{-# INLINE then_DocM #-}
{-# INLINE retDocM #-}
{-# INLINE unDocM #-}
{-# INLINE getPPEnv #-}
thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM :: forall s a b. DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM DocM s a
m a -> DocM s b
k = forall s a. (s -> a) -> DocM s a
DocM forall a b. (a -> b) -> a -> b
$ \s
s -> case forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
a -> forall s a. DocM s a -> s -> a
unDocM (a -> DocM s b
k a
a) s
s
then_DocM :: DocM s a -> DocM s b -> DocM s b
then_DocM :: forall s a b. DocM s a -> DocM s b -> DocM s b
then_DocM DocM s a
m DocM s b
k = forall s a. (s -> a) -> DocM s a
DocM forall a b. (a -> b) -> a -> b
$ \s
s -> case forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
_ -> forall s a. DocM s a -> s -> a
unDocM DocM s b
k s
s
retDocM :: a -> DocM s a
retDocM :: forall a s. a -> DocM s a
retDocM a
a = forall s a. (s -> a) -> DocM s a
DocM forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a
a
unDocM :: DocM s a -> s -> a
unDocM :: forall s a. DocM s a -> s -> a
unDocM (DocM s -> a
f) = s -> a
f
getPPEnv :: DocM s s
getPPEnv :: forall s. DocM s s
getPPEnv = forall s a. (s -> a) -> DocM s a
DocM forall a. a -> a
id
type Doc = DocM PPHsMode P.Doc
class Pretty a where
pretty :: a -> Doc
prettyPrec :: Int -> a -> Doc
pretty = forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
0
prettyPrec Indent
_ = forall a. Pretty a => a -> Doc
pretty
empty :: Doc
empty :: Doc
empty = forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.empty
nest :: Int -> Doc -> Doc
nest :: Indent -> Doc -> Doc
nest Indent
i Doc
m = Doc
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc -> Doc
P.nest Indent
i
text :: String -> Doc
text :: String -> Doc
text = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text
char :: Char -> Doc
char :: Char -> Doc
char = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
P.char
int :: Int -> Doc
int :: Indent -> Doc
int = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc
P.int
integer :: Integer -> Doc
integer :: Integer -> Doc
integer = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc
P.integer
float :: Float -> Doc
float :: Float -> Doc
float = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Doc
P.float
double :: Double -> Doc
double :: Double -> Doc
double = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Doc
P.double
parens, brackets, braces, doubleQuotes :: Doc -> Doc
parens :: Doc -> Doc
parens Doc
d = Doc
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.parens
brackets :: Doc -> Doc
brackets Doc
d = Doc
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.brackets
braces :: Doc -> Doc
braces Doc
d = Doc
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.braces
doubleQuotes :: Doc -> Doc
doubleQuotes Doc
d = Doc
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.doubleQuotes
parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf Bool
True = Doc -> Doc
parens
parensIf Bool
False = forall a. a -> a
id
semi,comma,space,equals :: Doc
semi :: Doc
semi = forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.semi
comma :: Doc
comma = forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.comma
space :: Doc
space = forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.space
equals :: Doc
equals = forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.equals
(<>),(<+>),($$) :: Doc -> Doc -> Doc
Doc
aM <> :: Doc -> Doc -> Doc
<> Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.<> Doc
b)}
Doc
aM <+> :: Doc -> Doc -> Doc
<+> Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.<+> Doc
b)}
Doc
aM $$ :: Doc -> Doc -> Doc
$$ Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.$$ Doc
b)}
($+$) :: Doc -> Doc -> Doc
Doc
aM $+$ :: Doc -> Doc -> Doc
$+$ Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.$+$ Doc
b)}
hcat,hsep,vcat,fsep :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat [Doc]
dl = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hcat
hsep :: [Doc] -> Doc
hsep [Doc]
dl = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hsep
vcat :: [Doc] -> Doc
vcat [Doc]
dl = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.vcat
fsep :: [Doc] -> Doc
fsep [Doc]
dl = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.fsep
punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate Doc
_ [] = []
punctuate Doc
p (Doc
d1:[Doc]
ds) = Doc -> [Doc] -> [Doc]
go Doc
d1 [Doc]
ds
where
go :: Doc -> [Doc] -> [Doc]
go Doc
d [] = [Doc
d]
go Doc
d (Doc
e:[Doc]
es) = (Doc
d Doc -> Doc -> Doc
<> Doc
p) forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
go Doc
e [Doc]
es
renderStyleMode :: P.Style -> PPHsMode -> Doc -> String
renderStyleMode :: Style -> PPHsMode -> Doc -> String
renderStyleMode Style
ppStyle PPHsMode
ppMode Doc
d = Style -> Doc -> String
P.renderStyle Style
ppStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. DocM s a -> s -> a
unDocM Doc
d forall a b. (a -> b) -> a -> b
$ PPHsMode
ppMode
prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String
prettyPrintStyleMode :: forall a. Pretty a => Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
ppStyle PPHsMode
ppMode = Style -> PPHsMode -> Doc -> String
renderStyleMode Style
ppStyle PPHsMode
ppMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty
prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String
prettyPrintWithMode :: forall a. Pretty a => PPHsMode -> a -> String
prettyPrintWithMode = forall a. Pretty a => Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
P.style
prettyPrint :: Pretty a => a -> String
prettyPrint :: forall a. Pretty a => a -> String
prettyPrint = forall a. Pretty a => PPHsMode -> a -> String
prettyPrintWithMode PPHsMode
defaultMode
prettyPrim :: Pretty a => a -> P.Doc
prettyPrim :: forall a. Pretty a => a -> Doc
prettyPrim = forall a. Pretty a => PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
defaultMode
prettyPrimWithMode :: Pretty a => PPHsMode -> a -> P.Doc
prettyPrimWithMode :: forall a. Pretty a => PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
pphs a
doc = forall s a. DocM s a -> s -> a
unDocM (forall a. Pretty a => a -> Doc
pretty a
doc) PPHsMode
pphs
instance Pretty (ModuleHead l) where
pretty :: ModuleHead l -> Doc
pretty (ModuleHead l
_ ModuleName l
m Maybe (WarningText l)
mbWarn Maybe (ExportSpecList l)
mbExportList) =
[Doc] -> Doc
mySep [
String -> Doc
text String
"module",
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall l. WarningText l -> Doc
ppWarnTxt Maybe (WarningText l)
mbWarn,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ExportSpecList l)
mbExportList,
String -> Doc
text String
"where"]
instance Pretty (ExportSpecList l) where
pretty :: ExportSpecList l -> Doc
pretty (ExportSpecList l
_ [ExportSpec l]
especs) = [Doc] -> Doc
parenList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ExportSpec l]
especs
ppWarnTxt :: WarningText l -> Doc
ppWarnTxt :: forall l. WarningText l -> Doc
ppWarnTxt (DeprText l
_ String
s) = [Doc] -> Doc
mySep [String -> Doc
text String
"{-# DEPRECATED", String -> Doc
text (forall a. Show a => a -> String
show String
s), String -> Doc
text String
"#-}"]
ppWarnTxt (WarnText l
_ String
s) = [Doc] -> Doc
mySep [String -> Doc
text String
"{-# WARNING", String -> Doc
text (forall a. Show a => a -> String
show String
s), String -> Doc
text String
"#-}"]
instance Pretty (ModuleName l) where
pretty :: ModuleName l -> Doc
pretty (ModuleName l
_ String
modName) = String -> Doc
text String
modName
instance Pretty (Namespace l) where
pretty :: Namespace l -> Doc
pretty NoNamespace {} = Doc
empty
pretty TypeNamespace {} = String -> Doc
text String
"type"
pretty PatternNamespace {} = String -> Doc
text String
"pattern"
instance Pretty (ExportSpec l) where
pretty :: ExportSpec l -> Doc
pretty (EVar l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (EAbs l
_ Namespace l
ns QName l
name) = forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (EThingWith l
_ EWildcard l
wc QName l
name [CName l]
nameList) =
let prettyNames :: [Doc]
prettyNames = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [CName l]
nameList
names :: [Doc]
names = case EWildcard l
wc of
NoWildcard {} -> [Doc]
prettyNames
EWildcard l
_ Indent
n ->
let ([Doc]
before,[Doc]
after) = forall a. Indent -> [a] -> ([a], [a])
splitAt Indent
n [Doc]
prettyNames
in [Doc]
before forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
".."] forall a. [a] -> [a] -> [a]
++ [Doc]
after
in forall a. Pretty a => a -> Doc
pretty QName l
name Doc -> Doc -> Doc
<> ([Doc] -> Doc
parenList [Doc]
names)
pretty (EModuleContents l
_ ModuleName l
m) = String -> Doc
text String
"module" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ModuleName l
m
instance Pretty (ImportDecl l) where
pretty :: ImportDecl l -> Doc
pretty (ImportDecl l
_ ModuleName l
m Bool
qual Bool
src Bool
safe Maybe String
mbPkg Maybe (ModuleName l)
mbName Maybe (ImportSpecList l)
mbSpecs) =
[Doc] -> Doc
mySep [String -> Doc
text String
"import",
if Bool
src then String -> Doc
text String
"{-# SOURCE #-}" else Doc
empty,
if Bool
safe then String -> Doc
text String
"safe" else Doc
empty,
if Bool
qual then String -> Doc
text String
"qualified" else Doc
empty,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\String
s -> String -> Doc
text (forall a. Show a => a -> String
show String
s)) Maybe String
mbPkg,
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\ModuleName l
m' -> String -> Doc
text String
"as" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ModuleName l
m') Maybe (ModuleName l)
mbName,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ImportSpecList l)
mbSpecs]
instance Pretty (ImportSpecList l) where
pretty :: ImportSpecList l -> Doc
pretty (ImportSpecList l
_ Bool
b [ImportSpec l]
ispecs) =
(if Bool
b then String -> Doc
text String
"hiding" else Doc
empty)
Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ImportSpec l]
ispecs)
instance Pretty (ImportSpec l) where
pretty :: ImportSpec l -> Doc
pretty (IVar l
_ Name l
name ) = forall a. Pretty a => a -> Doc
pretty Name l
name
pretty (IAbs l
_ Namespace l
ns Name l
name) = forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Name l
name
pretty (IThingAll l
_ Name l
name) = forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> String -> Doc
text String
"(..)"
pretty (IThingWith l
_ Name l
name [CName l]
nameList) =
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> ([Doc] -> Doc
parenList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [CName l]
nameList)
instance Pretty (TypeEqn l) where
pretty :: TypeEqn l -> Doc
pretty (TypeEqn l
_ Type l
pat Type l
eqn) = [Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty Type l
pat, Doc
equals, forall a. Pretty a => a -> Doc
pretty Type l
eqn]
class Pretty a => PrettyDeclLike a where
wantsBlankline :: a -> Bool
instance PrettyDeclLike (Decl l) where
wantsBlankline :: Decl l -> Bool
wantsBlankline (FunBind {}) = Bool
False
wantsBlankline (PatBind {}) = Bool
False
wantsBlankline Decl l
_ = Bool
True
condBlankline :: PrettyDeclLike a => a -> Doc
condBlankline :: forall a. PrettyDeclLike a => a -> Doc
condBlankline a
d = (if forall a. PrettyDeclLike a => a -> Bool
wantsBlankline a
d then Doc -> Doc
blankline else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty a
d
ppDecls :: PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls :: forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
True [a]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall a. PrettyDeclLike a => a -> Doc
condBlankline [a]
ds
ppDecls Bool
False (a
d:[a]
ds) = forall a. Pretty a => a -> Doc
pretty a
d forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. PrettyDeclLike a => a -> Doc
condBlankline [a]
ds
ppDecls Bool
_ [a]
_ = []
instance Pretty (InjectivityInfo l) where
pretty :: InjectivityInfo l -> Doc
pretty (InjectivityInfo l
_ Name l
from [Name l]
to) =
Char -> Doc
char Char
'|' Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Name l
from Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
to)
instance Pretty (ResultSig l) where
pretty :: ResultSig l -> Doc
pretty (KindSig l
_ Kind l
kind) = String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Kind l
kind
pretty (TyVarSig l
_ TyVarBind l
tv) = Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv
instance Pretty (Decl l) where
pretty :: Decl l -> Doc
pretty (TypeDecl l
_ DeclHead l
dHead Type l
htype) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"type", forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, forall a. Pretty a => a -> Doc
pretty Type l
htype])
pretty (DataDecl l
_ DataOrNew l
don Maybe (Context l)
context DeclHead l
dHead [QualConDecl l]
constrList [Deriving l]
derives) =
[Doc] -> Doc
mySep ( [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead])
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))
pretty (GDataDecl l
_ DataOrNew l
don Maybe (Context l)
context DeclHead l
dHead Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
[Doc] -> Doc
mySep ( [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
forall a. [a] -> [a] -> [a]
++ forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)
pretty (TypeFamDecl l
_ DeclHead l
dHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj) =
[Doc] -> Doc
mySep ([String -> Doc
text String
"type", String -> Doc
text String
"family", forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj])
pretty (ClosedTypeFamDecl l
_ DeclHead l
dHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj [TypeEqn l]
eqns) =
[Doc] -> Doc
mySep ([String -> Doc
text String
"type", String -> Doc
text String
"family", forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind ,forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj
, String -> Doc
text String
"where"]) Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [TypeEqn l]
eqns)
pretty (DataFamDecl l
_ Maybe (Context l)
context DeclHead l
dHead Maybe (ResultSig l)
optkind) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"data", String -> Doc
text String
"family", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind])
pretty (TypeInsDecl l
_ Type l
ntype Type l
htype) =
[Doc] -> Doc
mySep [String -> Doc
text String
"type", String -> Doc
text String
"instance", forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, forall a. Pretty a => a -> Doc
pretty Type l
htype]
pretty (DataInsDecl l
_ DataOrNew l
don Type l
ntype [QualConDecl l]
constrList [Deriving l]
derives) =
[Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", forall a. Pretty a => a -> Doc
pretty Type l
ntype]
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))
pretty (GDataInsDecl l
_ DataOrNew l
don Type l
ntype Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
[Doc] -> Doc
mySep ( [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", forall a. Pretty a => a -> Doc
pretty Type l
ntype]
forall a. [a] -> [a] -> [a]
++ forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)
pretty (ClassDecl l
_ Maybe (Context l)
context DeclHead l
dHead [FunDep l]
fundeps Maybe [ClassDecl l]
Nothing) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"class", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, forall l. [FunDep l] -> Doc
ppFunDeps [FunDep l]
fundeps])
pretty (ClassDecl l
_ Maybe (Context l)
context DeclHead l
dHead [FunDep l]
fundeps Maybe [ClassDecl l]
declList) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"class", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, forall l. [FunDep l] -> Doc
ppFunDeps [FunDep l]
fundeps, String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a. a -> Maybe a -> a
fromMaybe [] ((forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ClassDecl l]
declList))
pretty (InstDecl l
_ Maybe (Overlap l)
moverlap InstRule l
iHead Maybe [InstDecl l]
Nothing) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"instance", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
moverlap, forall a. Pretty a => a -> Doc
pretty InstRule l
iHead])
pretty (InstDecl l
_ Maybe (Overlap l)
overlap InstRule l
iHead Maybe [InstDecl l]
declList) =
[Doc] -> Doc
mySep ( [ String -> Doc
text String
"instance", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
, forall a. Pretty a => a -> Doc
pretty InstRule l
iHead, String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a. a -> Maybe a -> a
fromMaybe [] ((forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InstDecl l]
declList))
pretty (DerivDecl l
_ Maybe (DerivStrategy l)
mds Maybe (Overlap l)
overlap InstRule l
irule) =
[Doc] -> Doc
mySep ( [ String -> Doc
text String
"deriving"
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (DerivStrategy l)
mds
, String -> Doc
text String
"instance"
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
, forall a. Pretty a => a -> Doc
pretty InstRule l
irule])
pretty (DefaultDecl l
_ [Type l]
htypes) =
String -> Doc
text String
"default" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
htypes)
pretty (SpliceDecl l
_ Exp l
splice) =
forall a. Pretty a => a -> Doc
pretty Exp l
splice
pretty (TSpliceDecl l
_ Exp l
splice) =
forall a. Pretty a => a -> Doc
pretty Exp l
splice
pretty (TypeSig l
_ [Name l]
nameList Type l
qualType) =
[Doc] -> Doc
mySep ((Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Name l]
nameList)
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
qualType])
pretty (PatSynSig l
_ [Name l]
ns Maybe [TyVarBind l]
mtvs Maybe (Context l)
prov Maybe [TyVarBind l]
mtvs2 Maybe (Context l)
req Type l
t) =
let contexts :: [Doc]
contexts = [forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
prov, forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs2, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
req]
in
[Doc] -> Doc
mySep ( [String -> Doc
text String
"pattern" ]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
ns)
forall a. [a] -> [a] -> [a]
++ [ String -> Doc
text String
"::", forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs] forall a. [a] -> [a] -> [a]
++
[Doc]
contexts forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty Type l
t] )
pretty (FunBind l
_ [Match l]
matches) = do
PPLayout
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout forall s. DocM s s
getPPEnv
case PPLayout
e of PPLayout
PPOffsideRule -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($$$) Doc
empty (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Match l]
matches)
PPLayout
_ -> [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Match l]
matches)
pretty (PatBind l
_ Pat l
pat Rhs l
rhs Maybe (Binds l)
whereBinds) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Pat l
pat, forall a. Pretty a => a -> Doc
pretty Rhs l
rhs] Doc -> Doc -> Doc
$$$ forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
whereBinds
pretty (InfixDecl l
_ Assoc l
assoc Maybe Indent
prec [Op l]
opList) =
[Doc] -> Doc
mySep ([forall a. Pretty a => a -> Doc
pretty Assoc l
assoc, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Indent -> Doc
int Maybe Indent
prec]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Op l]
opList))
pretty (PatSyn l
_ Pat l
pat Pat l
rhs PatternSynDirection l
dir) =
let sep :: String
sep = case PatternSynDirection l
dir of
ImplicitBidirectional {} -> String
"="
ExplicitBidirectional {} -> String
"<-"
Unidirectional {} -> String
"<-"
in
([Doc] -> Doc
mySep ([String -> Doc
text String
"pattern", forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
sep, forall a. Pretty a => a -> Doc
pretty Pat l
rhs])) Doc -> Doc -> Doc
$$$
(case PatternSynDirection l
dir of
ExplicitBidirectional l
_ [Decl l]
ds ->
Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [Decl l]
ds))
PatternSynDirection l
_ -> Doc
empty)
pretty (ForImp l
_ CallConv l
cconv Maybe (Safety l)
saf Maybe String
str Name l
name Type l
typ) =
[Doc] -> Doc
mySep [String -> Doc
text String
"foreign import", forall a. Pretty a => a -> Doc
pretty CallConv l
cconv, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Safety l)
saf,
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe String
str, forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
typ]
pretty (ForExp l
_ CallConv l
cconv Maybe String
str Name l
name Type l
typ) =
[Doc] -> Doc
mySep [String -> Doc
text String
"foreign export", forall a. Pretty a => a -> Doc
pretty CallConv l
cconv,
String -> Doc
text (forall a. Show a => a -> String
show Maybe String
str), forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
typ]
pretty (RulePragmaDecl l
_ [Rule l]
rules) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# RULES" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Rule l]
rules forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]
pretty (DeprPragmaDecl l
_ [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# DEPRECATED" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]
pretty (WarnPragmaDecl l
_ [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# WARNING" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]
pretty (InlineSig l
_ Bool
inl Maybe (Activation l)
activ QName l
name) =
[Doc] -> Doc
mySep [String -> Doc
text (if Bool
inl then String
"{-# INLINE" else String
"{-# NOINLINE")
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"#-}"]
pretty (InlineConlikeSig l
_ Maybe (Activation l)
activ QName l
name) =
[Doc] -> Doc
mySep [ String -> Doc
text String
"{-# INLINE CONLIKE", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
, forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"#-}"]
pretty (SpecSig l
_ Maybe (Activation l)
activ QName l
name [Type l]
types) =
[Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
, forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
types) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]
pretty (SpecInlineSig l
_ Bool
inl Maybe (Activation l)
activ QName l
name [Type l]
types) =
[Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text (if Bool
inl then String
"INLINE" else String
"NOINLINE"),
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
types) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]
pretty (InstSig l
_ InstRule l
irule) =
[Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text String
"instance", forall a. Pretty a => a -> Doc
pretty InstRule l
irule
, String -> Doc
text String
"#-}"]
pretty (AnnPragma l
_ Annotation l
annp) =
[Doc] -> Doc
mySep [String -> Doc
text String
"{-# ANN", forall a. Pretty a => a -> Doc
pretty Annotation l
annp, String -> Doc
text String
"#-}"]
pretty (MinimalPragma l
_ Maybe (BooleanFormula l)
b) =
let bs :: Doc
bs = case Maybe (BooleanFormula l)
b of { Just BooleanFormula l
b' -> forall a. Pretty a => a -> Doc
pretty BooleanFormula l
b'; Maybe (BooleanFormula l)
_ -> Doc
empty }
in [Doc] -> Doc
myFsep [String -> Doc
text String
"{-# MINIMAL", Doc
bs, String -> Doc
text String
"#-}"]
pretty (RoleAnnotDecl l
_ QName l
qn [Role l]
rs) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"type", String -> Doc
text String
"role", forall a. Pretty a => a -> Doc
pretty QName l
qn]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Role l]
rs )
pretty (CompletePragma l
_ [Name l]
cls Maybe (QName l)
opt_ts) =
let cls_p :: [Doc]
cls_p = Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
cls
ts_p :: Doc
ts_p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\QName l
tc -> String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty QName l
tc) Maybe (QName l)
opt_ts
in [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# COMPLETE"] forall a. [a] -> [a] -> [a]
++ [Doc]
cls_p forall a. [a] -> [a] -> [a]
++ [Doc
ts_p, String -> Doc
text String
"#-}"]
instance Pretty (InstRule l) where
pretty :: InstRule l -> Doc
pretty (IRule l
_ Maybe [TyVarBind l]
tvs Maybe (Context l)
mctxt InstHead l
qn) =
[Doc] -> Doc
mySep [forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
mctxt, forall a. Pretty a => a -> Doc
pretty InstHead l
qn]
pretty (IParen l
_ InstRule l
ih) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty InstRule l
ih)
instance Pretty (InstHead l) where
pretty :: InstHead l -> Doc
pretty (IHCon l
_ QName l
qn) = forall a. Pretty a => a -> Doc
pretty QName l
qn
pretty (IHInfix l
_ Type l
ta QName l
qn) = [Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty Type l
ta, forall a. Pretty a => a -> Doc
pretty QName l
qn]
pretty (IHParen l
_ InstHead l
ih) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty InstHead l
ih)
pretty (IHApp l
_ InstHead l
ih Type l
t) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty InstHead l
ih, forall a. Pretty a => a -> Doc
pretty Type l
t]
instance Pretty (Annotation l) where
pretty :: Annotation l -> Doc
pretty (Ann l
_ Name l
n Exp l
e) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
n, forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (TypeAnn l
_ Name l
n Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"type", forall a. Pretty a => a -> Doc
pretty Name l
n, forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (ModuleAnn l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"module", forall a. Pretty a => a -> Doc
pretty Exp l
e]
instance Pretty (BooleanFormula l) where
pretty :: BooleanFormula l -> Doc
pretty (VarFormula l
_ Name l
n) = forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (AndFormula l
_ [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" ,") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
pretty (OrFormula l
_ [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" |") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
pretty (ParenFormula l
_ BooleanFormula l
b) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty BooleanFormula l
b
instance Pretty (Role l) where
pretty :: Role l -> Doc
pretty RoleWildcard{} = Char -> Doc
char Char
'_'
pretty Nominal{} = String -> Doc
text String
"nominal"
pretty Representational{} = String -> Doc
text String
"representational"
pretty Phantom{} = String -> Doc
text String
"phantom"
instance Pretty (DataOrNew l) where
pretty :: DataOrNew l -> Doc
pretty DataType{} = String -> Doc
text String
"data"
pretty NewType{} = String -> Doc
text String
"newtype"
instance Pretty (Assoc l) where
pretty :: Assoc l -> Doc
pretty AssocNone{} = String -> Doc
text String
"infix"
pretty AssocLeft{} = String -> Doc
text String
"infixl"
pretty AssocRight{} = String -> Doc
text String
"infixr"
instance Pretty (Match l) where
pretty :: Match l -> Doc
pretty (InfixMatch l
_ Pat l
l Name l
op [Pat l]
rs Rhs l
rhs Maybe (Binds l)
wbinds) =
let
lhs :: [Doc]
lhs = case [Pat l]
rs of
[] -> []
(Pat l
r:[Pat l]
rs') ->
let hd :: [Doc]
hd = [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
l, forall l. Name l -> Doc
ppNameInfix Name l
op, forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
r]
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
rs'
then [Doc]
hd
else Doc -> Doc
parens ([Doc] -> Doc
myFsep [Doc]
hd) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
rs'
in [Doc] -> Doc
myFsep ([Doc]
lhs forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty Rhs l
rhs]) Doc -> Doc -> Doc
$$$ forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
wbinds
pretty (Match l
_ Name l
f [Pat l]
ps Rhs l
rhs Maybe (Binds l)
whereBinds) =
[Doc] -> Doc
myFsep (forall a. Pretty a => a -> Doc
pretty Name l
f forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
ps forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty Rhs l
rhs])
Doc -> Doc -> Doc
$$$ forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
whereBinds
ppWhere :: Maybe (Binds l) -> Doc
ppWhere :: forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
Nothing = Doc
empty
ppWhere (Just (BDecls l
_ [Decl l]
l)) = Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [Decl l]
l))
ppWhere (Just (IPBinds l
_ [IPBind l]
b)) = Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [IPBind l]
b))
instance PrettyDeclLike (ClassDecl l) where
wantsBlankline :: ClassDecl l -> Bool
wantsBlankline (ClsDecl l
_ Decl l
d) = forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
wantsBlankline (ClsDefSig {}) = Bool
True
wantsBlankline ClassDecl l
_ = Bool
False
instance Pretty (ClassDecl l) where
pretty :: ClassDecl l -> Doc
pretty (ClsDecl l
_ Decl l
decl) = forall a. Pretty a => a -> Doc
pretty Decl l
decl
pretty (ClsDataFam l
_ Maybe (Context l)
context DeclHead l
declHead Maybe (ResultSig l)
optkind) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"data", forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind])
pretty (ClsTyFam l
_ DeclHead l
declHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj) =
[Doc] -> Doc
mySep ( [String -> Doc
text String
"type", forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj])
pretty (ClsTyDef l
_ TypeEqn l
ntype) =
[Doc] -> Doc
mySep [String -> Doc
text String
"type", forall a. Pretty a => a -> Doc
pretty TypeEqn l
ntype]
pretty (ClsDefSig l
_ Name l
name Type l
typ) =
[Doc] -> Doc
mySep [
String -> Doc
text String
"default",
forall a. Pretty a => a -> Doc
pretty Name l
name,
String -> Doc
text String
"::",
forall a. Pretty a => a -> Doc
pretty Type l
typ]
instance Pretty (DeclHead l) where
pretty :: DeclHead l -> Doc
pretty (DHead l
_ Name l
n) = forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (DHInfix l
_ TyVarBind l
tv Name l
n) = forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv Doc -> Doc -> Doc
<+> forall l. Name l -> Doc
ppNameInfix Name l
n
pretty (DHParen l
_ DeclHead l
d) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty DeclHead l
d)
pretty (DHApp l
_ DeclHead l
dh TyVarBind l
tv) = forall a. Pretty a => a -> Doc
pretty DeclHead l
dh Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv
instance PrettyDeclLike (InstDecl l) where
wantsBlankline :: InstDecl l -> Bool
wantsBlankline (InsDecl l
_ Decl l
d) = forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
wantsBlankline InstDecl l
_ = Bool
False
instance Pretty (InstDecl l) where
pretty :: InstDecl l -> Doc
pretty (InsDecl l
_ Decl l
decl) = forall a. Pretty a => a -> Doc
pretty Decl l
decl
pretty (InsType l
_ Type l
ntype Type l
htype) =
[Doc] -> Doc
mySep [String -> Doc
text String
"type", forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, forall a. Pretty a => a -> Doc
pretty Type l
htype]
pretty (InsData l
_ DataOrNew l
don Type l
ntype [QualConDecl l]
constrList [Deriving l]
derives) =
[Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, forall a. Pretty a => a -> Doc
pretty Type l
ntype]
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))
pretty (InsGData l
_ DataOrNew l
don Type l
ntype Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
[Doc] -> Doc
mySep ( [forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, forall a. Pretty a => a -> Doc
pretty Type l
ntype]
forall a. [a] -> [a] -> [a]
++ forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)
instance Pretty (Safety l) where
pretty :: Safety l -> Doc
pretty PlayRisky {} = String -> Doc
text String
"unsafe"
pretty (PlaySafe l
_ Bool
b) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"threadsafe" else String
"safe"
pretty PlayInterruptible {} = String -> Doc
text String
"interruptible"
instance Pretty (CallConv l) where
pretty :: CallConv l -> Doc
pretty StdCall {} = String -> Doc
text String
"stdcall"
pretty CCall {} = String -> Doc
text String
"ccall"
pretty CPlusPlus {} = String -> Doc
text String
"cplusplus"
pretty DotNet {} = String -> Doc
text String
"dotnet"
pretty Jvm {} = String -> Doc
text String
"jvm"
pretty Js {} = String -> Doc
text String
"js"
pretty JavaScript {} = String -> Doc
text String
"javascript"
pretty CApi {} = String -> Doc
text String
"capi"
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr :: forall l. ([Name l], String) -> Doc
ppWarnDepr ([Name l]
names, String
txt) = [Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
names) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
txt]
instance Pretty (Rule l) where
pretty :: Rule l -> Doc
pretty (Rule l
_ String
tag Maybe (Activation l)
activ Maybe [RuleVar l]
rvs Exp l
rhs Exp l
lhs) =
[Doc] -> Doc
mySep [String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
tag, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ,
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall l. [RuleVar l] -> Doc
ppRuleVars Maybe [RuleVar l]
rvs,
forall a. Pretty a => a -> Doc
pretty Exp l
rhs, Char -> Doc
char Char
'=', forall a. Pretty a => a -> Doc
pretty Exp l
lhs]
ppRuleVars :: [RuleVar l] -> Doc
ppRuleVars :: forall l. [RuleVar l] -> Doc
ppRuleVars [] = Doc
empty
ppRuleVars [RuleVar l]
rvs = [Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"forall" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [RuleVar l]
rvs forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'.']
instance Pretty (Activation l) where
pretty :: Activation l -> Doc
pretty (ActiveFrom l
_ Indent
i) = Char -> Doc
char Char
'[' Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char Char
']'
pretty (ActiveUntil l
_ Indent
i) = String -> Doc
text String
"[~" Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char Char
']'
instance Pretty (Overlap l) where
pretty :: Overlap l -> Doc
pretty Overlap {} = String -> Doc
text String
"{-# OVERLAP #-}"
pretty Overlaps {} = String -> Doc
text String
"{-# OVERLAPS #-}"
pretty Overlapping {} = String -> Doc
text String
"{-# OVERLAPPING #-}"
pretty Overlappable {} = String -> Doc
text String
"{-# OVERLAPPABLE #-}"
pretty NoOverlap {} = String -> Doc
text String
"{-# NO_OVERLAP #-}"
pretty Incoherent {} = String -> Doc
text String
"{-# INCOHERENT #-}"
instance Pretty (RuleVar l) where
pretty :: RuleVar l -> Doc
pretty (RuleVar l
_ Name l
n) = forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (TypedRuleVar l
_ Name l
n Type l
t) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
t]
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma Doc
opt String
s =
case String
s of
(Char
'\n':String
_) -> Doc
opt Doc -> Doc -> Doc
<> String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text String
"#-}"
String
_ -> [Doc] -> Doc
myFsep [Doc
opt, String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text String
"#-}"]
instance Pretty (ModulePragma l) where
pretty :: ModulePragma l -> Doc
pretty (LanguagePragma l
_ [Name l]
ns) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# LANGUAGE" forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
',') (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
ns) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]
pretty (OptionsPragma l
_ (Just Tool
tool) String
s) =
Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text String
"{-# OPTIONS_" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Tool
tool) String
s
pretty (OptionsPragma l
_ Maybe Tool
_ String
s) =
Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text String
"{-# OPTIONS") String
s
pretty (AnnModulePragma l
_ Annotation l
mann) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"{-# ANN", forall a. Pretty a => a -> Doc
pretty Annotation l
mann, String -> Doc
text String
"#-}"]
instance Pretty Tool where
pretty :: Tool -> Doc
pretty (UnknownTool String
s) = String -> Doc
text String
s
pretty Tool
t = String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Tool
t
instance Pretty (QualConDecl l) where
pretty :: QualConDecl l -> Doc
pretty (QualConDecl l
_pos Maybe [TyVarBind l]
tvs Maybe (Context l)
ctxt ConDecl l
con) =
[Doc] -> Doc
myFsep [forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, forall a. Pretty a => a -> Doc
pretty ConDecl l
con]
instance Pretty (GadtDecl l) where
pretty :: GadtDecl l -> Doc
pretty (GadtDecl l
_pos Name l
name Maybe [TyVarBind l]
tvs Maybe (Context l)
ctxt Maybe [FieldDecl l]
names Type l
ty) =
case Maybe [FieldDecl l]
names of
Maybe [FieldDecl l]
Nothing ->
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
ty]
Just [FieldDecl l]
ts' ->
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::" , forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt,
[Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [FieldDecl l]
ts', String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Type l
ty]
instance Pretty (ConDecl l) where
pretty :: ConDecl l -> Doc
pretty (RecDecl l
_ Name l
name [FieldDecl l]
fieldList) =
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> [Doc] -> Doc
braceList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FieldDecl l]
fieldList)
pretty (ConDecl l
_ Name l
name [Type l]
typeList) =
[Doc] -> Doc
mySep forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Name l
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype) [Type l]
typeList
pretty (InfixConDecl l
_ Type l
l Name l
name Type l
r) =
[Doc] -> Doc
myFsep [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype Type l
l, forall l. Name l -> Doc
ppNameInfix Name l
name,
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype Type l
r]
instance Pretty (FieldDecl l) where
pretty :: FieldDecl l -> Doc
pretty (FieldDecl l
_ [Name l]
names Type l
ty) =
[Doc] -> Doc
myFsepSimple forall a b. (a -> b) -> a -> b
$ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Name l]
names) forall a. [a] -> [a] -> [a]
++
[String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
ty]
instance Pretty (BangType l) where
pretty :: BangType l -> Doc
pretty BangedTy {} = Char -> Doc
char Char
'!'
pretty LazyTy {} = Char -> Doc
char Char
'~'
pretty NoStrictAnnot {} = Doc
empty
instance Pretty (Unpackedness l) where
pretty :: Unpackedness l -> Doc
pretty Unpack {} = String -> Doc
text String
"{-# UNPACK #-} "
pretty NoUnpack {} = String -> Doc
text String
"{-# NOUNPACK #-} "
pretty NoUnpackPragma {} = Doc
empty
instance Pretty (Deriving l) where
pretty :: Deriving l -> Doc
pretty (Deriving l
_ Maybe (DerivStrategy l)
mds [InstRule l]
d) =
[Doc] -> Doc
hsep [ String -> Doc
text String
"deriving"
, Doc
pp_strat_before
, Doc
pp_dct
, Doc
pp_strat_after ]
where
pp_dct :: Doc
pp_dct =
case [InstRule l]
d of
[InstRule l
d'] -> forall a. Pretty a => a -> Doc
pretty InstRule l
d'
[InstRule l]
_ -> [Doc] -> Doc
parenList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [InstRule l]
d)
(Doc
pp_strat_before, Doc
pp_strat_after) =
case Maybe (DerivStrategy l)
mds of
Just (via :: DerivStrategy l
via@DerivVia{}) -> (Doc
empty, forall a. Pretty a => a -> Doc
pretty DerivStrategy l
via)
Maybe (DerivStrategy l)
_ -> (forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (DerivStrategy l)
mds, Doc
empty)
instance Pretty (DerivStrategy l) where
pretty :: DerivStrategy l -> Doc
pretty DerivStrategy l
ds =
case DerivStrategy l
ds of
DerivStock l
_ -> String -> Doc
text String
"stock"
DerivAnyclass l
_ -> String -> Doc
text String
"anyclass"
DerivNewtype l
_ -> String -> Doc
text String
"newtype"
DerivVia l
_ Type l
ty -> String -> Doc
text String
"via" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Type l
ty
ppBType :: Type l -> Doc
ppBType :: forall l. Type l -> Doc
ppBType = forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype
ppAType :: Type l -> Doc
ppAType :: forall l. Type l -> Doc
ppAType = forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype
prec_btype, prec_atype :: Int
prec_btype :: Indent
prec_btype = Indent
1
prec_atype :: Indent
prec_atype = Indent
2
instance Pretty (Type l) where
prettyPrec :: Indent -> Type l -> Doc
prettyPrec Indent
p (TyForall l
_ Maybe [TyVarBind l]
mtvs Maybe (Context l)
ctxt Type l
htype) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, forall a. Pretty a => a -> Doc
pretty Type l
htype]
prettyPrec Indent
_ (TyStar l
_) = String -> Doc
text String
"*"
prettyPrec Indent
p (TyFun l
_ Type l
a Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall l. Type l -> Doc
ppBType Type l
a, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Type l
b]
prettyPrec Indent
_ (TyTuple l
_ Boxed
bxd [Type l]
l) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
l
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec Indent
_ (TyUnboxedSum l
_ [Type l]
es) = [Doc] -> Doc
unboxedSumType (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
es)
prettyPrec Indent
_ (TyList l
_ Type l
t) = Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type l
t
prettyPrec Indent
_ (TyParArray l
_ Type l
t) = [Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty Type l
t]
prettyPrec Indent
p (TyApp l
_ Type l
a Type l
b) =
Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Type l
a, forall l. Type l -> Doc
ppAType Type l
b]
prettyPrec Indent
_ (TyVar l
_ Name l
name) = forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec Indent
_ (TyCon l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (TyParen l
_ Type l
t) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty Type l
t)
prettyPrec Indent
_ (TyInfix l
_ Type l
a MaybePromotedName l
op Type l
b) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Type l
a, forall a. Pretty a => a -> Doc
pretty MaybePromotedName l
op, forall a. Pretty a => a -> Doc
pretty Type l
b]
prettyPrec Indent
_ (TyKind l
_ Type l
t Type l
k) = Doc -> Doc
parens ([Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Type l
t, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
k])
prettyPrec Indent
_ (TyPromoted l
_ Promoted l
p) = forall a. Pretty a => a -> Doc
pretty Promoted l
p
prettyPrec Indent
p (TyEquals l
_ Type l
a Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) ([Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Type l
a, String -> Doc
text String
"~", forall a. Pretty a => a -> Doc
pretty Type l
b])
prettyPrec Indent
_ (TySplice l
_ Splice l
s) = forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (TyBang l
_ BangType l
b Unpackedness l
u Type l
t) = forall a. Pretty a => a -> Doc
pretty Unpackedness l
u Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty BangType l
b Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype Type l
t
prettyPrec Indent
_ (TyWildCard l
_ Maybe (Name l)
mn) = Char -> Doc
char Char
'_' Doc -> Doc -> Doc
<> forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Name l)
mn
prettyPrec Indent
_ (TyQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
qt forall a. [a] -> [a] -> [a]
++ String
"|]")
instance Pretty (MaybePromotedName l) where
pretty :: MaybePromotedName l -> Doc
pretty (PromotedName l
_ QName l
q) = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> forall l. QName l -> Doc
ppQNameInfix QName l
q
pretty (UnpromotedName l
_ QName l
q) = forall l. QName l -> Doc
ppQNameInfix QName l
q
instance Pretty (Promoted l) where
pretty :: Promoted l -> Doc
pretty Promoted l
p =
case Promoted l
p of
PromotedInteger l
_ Integer
n String
_ -> Integer -> Doc
integer Integer
n
PromotedString l
_ String
s String
_ -> Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
PromotedCon l
_ Bool
hasQuote QName l
qn ->
Bool -> Doc -> Doc
addQuote Bool
hasQuote (forall a. Pretty a => a -> Doc
pretty QName l
qn)
PromotedList l
_ Bool
hasQuote [Type l]
list ->
Bool -> Doc -> Doc
addQuote Bool
hasQuote forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
bracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Type l]
list
PromotedTuple l
_ [Type l]
list ->
Bool -> Doc -> Doc
addQuote Bool
True forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
parenList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Type l]
list
PromotedUnit {} -> Bool -> Doc -> Doc
addQuote Bool
True forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"()"
where
addQuote :: Bool -> Doc -> Doc
addQuote Bool
True Doc
doc = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> Doc
doc
addQuote Bool
False Doc
doc = Doc
doc
instance Pretty (TyVarBind l) where
pretty :: TyVarBind l -> Doc
pretty (KindedVar l
_ Name l
var Kind l
kind) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
var, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Kind l
kind]
pretty (UnkindedVar l
_ Name l
var) = forall a. Pretty a => a -> Doc
pretty Name l
var
ppForall :: Maybe [TyVarBind l] -> Doc
ppForall :: forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
Nothing = Doc
empty
ppForall (Just []) = Doc
empty
ppForall (Just [TyVarBind l]
vs) = [Doc] -> Doc
myFsep (String -> Doc
text String
"forall" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [TyVarBind l]
vs forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'.'])
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind :: forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Kind l)
Nothing = []
ppOptKind (Just Kind l
k) = [String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Kind l
k]
instance Pretty (FunDep l) where
pretty :: FunDep l -> Doc
pretty (FunDep l
_ [Name l]
from [Name l]
to) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
from forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->"] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name l]
to
ppFunDeps :: [FunDep l] -> Doc
ppFunDeps :: forall l. [FunDep l] -> Doc
ppFunDeps [] = Doc
empty
ppFunDeps [FunDep l]
fds = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'|'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [FunDep l]
fds
instance Pretty (Rhs l) where
pretty :: Rhs l -> Doc
pretty (UnGuardedRhs l
_ Exp l
e) = Doc
equals Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedRhss l
_ [GuardedRhs l]
guardList) = [Doc] -> Doc
myVcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [GuardedRhs l]
guardList
instance Pretty (GuardedRhs l) where
pretty :: GuardedRhs l -> Doc
pretty (GuardedRhs l
_pos [Stmt l]
guards Exp l
ppBody') =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) forall a. [a] -> [a] -> [a]
++ [Doc
equals, forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
newtype GuardedAlts l = GuardedAlts (Rhs l)
newtype GuardedAlt l = GuardedAlt (GuardedRhs l)
instance Pretty (GuardedAlts l) where
pretty :: GuardedAlts l -> Doc
pretty (GuardedAlts (UnGuardedRhs l
_ Exp l
e)) = String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedAlts (GuardedRhss l
_ [GuardedRhs l]
guardList)) = [Doc] -> Doc
myVcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) forall a b. (a -> b) -> a -> b
$ [GuardedRhs l]
guardList
instance Pretty (GuardedAlt l) where
pretty :: GuardedAlt l -> Doc
pretty (GuardedAlt (GuardedRhs l
_pos [Stmt l]
guards Exp l
ppBody')) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
instance Pretty (Literal l) where
pretty :: Literal l -> Doc
pretty (Int l
_ Integer
i String
_) = Integer -> Doc
integer Integer
i
pretty (Char l
_ Char
c String
_) = String -> Doc
text (forall a. Show a => a -> String
show Char
c)
pretty (String l
_ String
s String
_) = String -> Doc
text (forall a. Show a => a -> String
show String
s)
pretty (Frac l
_ Rational
r String
_) = Double -> Doc
double (forall a. Fractional a => Rational -> a
fromRational Rational
r)
pretty (PrimChar l
_ Char
c String
_) = String -> Doc
text (forall a. Show a => a -> String
show Char
c) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
pretty (PrimString l
_ String
s String
_) = String -> Doc
text (forall a. Show a => a -> String
show String
s) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
pretty (PrimInt l
_ Integer
i String
_) = Integer -> Doc
integer Integer
i Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
pretty (PrimWord l
_ Integer
w String
_) = Integer -> Doc
integer Integer
w Doc -> Doc -> Doc
<> String -> Doc
text String
"##"
pretty (PrimFloat l
_ Rational
r String
_) = Float -> Doc
float (forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
pretty (PrimDouble l
_ Rational
r String
_) = Double -> Doc
double (forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> String -> Doc
text String
"##"
instance Pretty (Exp l) where
prettyPrec :: Indent -> Exp l -> Doc
prettyPrec Indent
_ (Lit l
_ Literal l
l) = forall a. Pretty a => a -> Doc
pretty Literal l
l
prettyPrec Indent
p (InfixApp l
_ Exp l
a QOp l
op Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
2) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Exp l
a, forall a. Pretty a => a -> Doc
pretty QOp l
op, forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Exp l
b]
prettyPrec Indent
p (NegApp l
_ Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Exp l
e
prettyPrec Indent
p (App l
_ Exp l
a Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
3) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Exp l
a, forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
4 Exp l
b]
prettyPrec Indent
p (Lambda l
_loc [Pat l]
patList Exp l
ppBody') = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$
Char -> Doc
char Char
'\\' forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
patList forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
prettyPrec Indent
p (Let l
_ (BDecls l
_ [Decl l]
declList) Exp l
letBody) =
Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$ forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [Decl l]
declList Exp l
letBody
prettyPrec Indent
p (Let l
_ (IPBinds l
_ [IPBind l]
bindList) Exp l
letBody) =
Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$ forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [IPBind l]
bindList Exp l
letBody
prettyPrec Indent
p (If l
_ Exp l
cond Exp l
thenexp Exp l
elsexp) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [String -> Doc
text String
"if", forall a. Pretty a => a -> Doc
pretty Exp l
cond,
String -> Doc
text String
"then", forall a. Pretty a => a -> Doc
pretty Exp l
thenexp,
String -> Doc
text String
"else", forall a. Pretty a => a -> Doc
pretty Exp l
elsexp]
prettyPrec Indent
p (MultiIf l
_ [GuardedRhs l]
alts) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"if"
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
multiIfIndent (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) [GuardedRhs l]
alts)
prettyPrec Indent
p (Case l
_ Exp l
cond [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep ([String -> Doc
text String
"case", forall a. Pretty a => a -> Doc
pretty Exp l
cond, String -> Doc
text String
"of"] forall a. [a] -> [a] -> [a]
++
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt l]
altList then [String -> Doc
text String
"{", String -> Doc
text String
"}"] else [])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
prettyPrec Indent
p (Do l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
prettyPrec Indent
p (MDo l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"mdo" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
prettyPrec Indent
_ (Var l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (OverloadedLabel l
_ String
name) = String -> Doc
text (Char
'#'forall a. a -> [a] -> [a]
:String
name)
prettyPrec Indent
_ (IPVar l
_ IPName l
ipname) = forall a. Pretty a => a -> Doc
pretty IPName l
ipname
prettyPrec Indent
_ (Con l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (Tuple l
_ Boxed
bxd [Exp l]
expList) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Exp l]
expList
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec Indent
_ (UnboxedSum l
_ Indent
before Indent
after Exp l
exp) =
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after Exp l
exp
prettyPrec Indent
_ (TupleSection l
_ Boxed
bxd [Maybe (Exp l)]
mExpList) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty) [Maybe (Exp l)]
mExpList
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec Indent
_ (Paren l
_ Exp l
e) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ Exp l
e
prettyPrec Indent
_ (LeftSection l
_ Exp l
e QOp l
op) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty QOp l
op)
prettyPrec Indent
_ (RightSection l
_ QOp l
op Exp l
e) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty QOp l
op Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp l
e)
prettyPrec Indent
_ (RecConstr l
_ QName l
c [FieldUpdate l]
fieldList) =
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
prettyPrec Indent
_ (RecUpdate l
_ Exp l
e [FieldUpdate l]
fieldList) =
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
prettyPrec Indent
_ (List l
_ [Exp l]
list) =
[Doc] -> Doc
bracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Exp l]
list
prettyPrec Indent
_ (ParArray l
_ [Exp l]
arr) =
[Doc] -> Doc
bracketColonList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Exp l]
arr
prettyPrec Indent
_ (EnumFrom l
_ Exp l
e) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
".."]
prettyPrec Indent
_ (EnumFromTo l
_ Exp l
from Exp l
to) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (EnumFromThen l
_ Exp l
from Exp l
thenE) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty Exp l
thenE, String -> Doc
text String
".."]
prettyPrec Indent
_ (EnumFromThenTo l
_ Exp l
from Exp l
thenE Exp l
to) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (ParArrayFromTo l
_ Exp l
from Exp l
to) =
[Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (ParArrayFromThenTo l
_ Exp l
from Exp l
thenE Exp l
to) =
[Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (ListComp l
_ Exp l
e [QualStmt l]
qualList) =
[Doc] -> Doc
bracketList ([forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
'|']
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [QualStmt l]
qualList))
prettyPrec Indent
_ (ParComp l
_ Exp l
e [[QualStmt l]]
qualLists) =
[Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'|') forall a b. (a -> b) -> a -> b
$
forall a. Pretty a => a -> Doc
pretty Exp l
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty) [[QualStmt l]]
qualLists)
prettyPrec Indent
_ (ParArrayComp l
_ Exp l
e [[QualStmt l]]
qualArrs) =
[Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'|') forall a b. (a -> b) -> a -> b
$
forall a. Pretty a => a -> Doc
pretty Exp l
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty) [[QualStmt l]]
qualArrs)
prettyPrec Indent
p (ExpTypeSig l
_pos Exp l
e Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
ty]
prettyPrec Indent
_ (BracketExp l
_ Bracket l
b) = forall a. Pretty a => a -> Doc
pretty Bracket l
b
prettyPrec Indent
_ (SpliceExp l
_ Splice l
s) = forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (TypQuote l
_ QName l
t) = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty QName l
t
prettyPrec Indent
_ (VarQuote l
_ QName l
x) = String -> Doc
text String
"\'" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty QName l
x
prettyPrec Indent
_ (QuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
qt forall a. [a] -> [a] -> [a]
++ String
"|]")
prettyPrec Indent
_ (XTag l
_ XName l
n [XAttr l]
attrs Maybe (Exp l)
mattr [Exp l]
cs) =
let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
in [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Exp l]
cs forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'>']]
prettyPrec Indent
_ (XETag l
_ XName l
n [XAttr l]
attrs Maybe (Exp l)
mattr) =
let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
in [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
prettyPrec Indent
_ (XPcdata l
_ String
s) = String -> Doc
text String
s
prettyPrec Indent
_ (XExpTag l
_ Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"<%", forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"%>"]
prettyPrec Indent
_ (XChildTag l
_ [Exp l]
cs) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Exp l]
cs forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]
prettyPrec Indent
_ (CorePragma l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", forall a. Show a => a -> String
show String
s, String
"#-}"] forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec Indent
_ (SCCPragma l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC", forall a. Show a => a -> String
show String
s, String
"#-}"] forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec Indent
_ (GenPragma l
_ String
s (Indent
a,Indent
b) (Indent
c,Indent
d) Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"{-# GENERATED", String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s,
Indent -> Doc
int Indent
a, Char -> Doc
char Char
':', Indent -> Doc
int Indent
b, Char -> Doc
char Char
'-',
Indent -> Doc
int Indent
c, Char -> Doc
char Char
':', Indent -> Doc
int Indent
d, String -> Doc
text String
"#-}", forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec Indent
p (Proc l
_ Pat l
pat Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [String -> Doc
text String
"proc", forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec Indent
p (LeftArrApp l
_ Exp l
l Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<", forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec Indent
p (RightArrApp l
_ Exp l
l Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">-", forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec Indent
p (LeftArrHighApp l
_ Exp l
l Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<<", forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec Indent
p (RightArrHighApp l
_ Exp l
l Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">>-", forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec Indent
_ (ArrOp l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"|)"]
prettyPrec Indent
p (LCase l
_ [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep (String -> Doc
text String
"\\case"forall a. a -> [a] -> [a]
:
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt l]
altList then [String -> Doc
text String
"{", String -> Doc
text String
"}"] else [])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
prettyPrec Indent
_ (TypeApp l
_ Type l
ty) = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Type l
ty
printUnboxedSum :: Pretty e => Int -> Int -> e -> Doc
printUnboxedSum :: forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after e
exp =
Doc -> Doc
hashParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (forall a. Indent -> a -> [a]
replicate Indent
before (String -> Doc
text String
"|")
forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty e
exp]
forall a. [a] -> [a] -> [a]
++ (forall a. Indent -> a -> [a]
replicate Indent
after (String -> Doc
text String
"|")))
instance Pretty (XAttr l) where
pretty :: XAttr l -> Doc
pretty (XAttr l
_ XName l
n Exp l
v) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', forall a. Pretty a => a -> Doc
pretty Exp l
v]
instance Pretty (XName l) where
pretty :: XName l -> Doc
pretty (XName l
_ String
n) = String -> Doc
text String
n
pretty (XDomName l
_ String
d String
n) = String -> Doc
text String
d Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> String -> Doc
text String
n
ppLetExp :: (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp :: forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [a]
l b
b = [Doc] -> Doc
myFsep [String -> Doc
text String
"let" Doc -> Doc -> Doc
<+> (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent (forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [a]
l),
String -> Doc
text String
"in", forall a. Pretty a => a -> Doc
pretty b
b]
instance Pretty (Bracket l) where
pretty :: Bracket l -> Doc
pretty (ExpBracket l
_ Exp l
e) = forall a. Pretty a => String -> a -> Doc
ppBracket String
"[|" Exp l
e
pretty (TExpBracket l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"[||", forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"||]"]
pretty (PatBracket l
_ Pat l
p) = forall a. Pretty a => String -> a -> Doc
ppBracket String
"[p|" Pat l
p
pretty (TypeBracket l
_ Type l
t) = forall a. Pretty a => String -> a -> Doc
ppBracket String
"[t|" Type l
t
pretty (DeclBracket l
_ [Decl l]
d) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"[d|" forall a. a -> [a] -> [a]
: forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
True [Decl l]
d forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|]"]
ppBracket :: Pretty a => String -> a -> Doc
ppBracket :: forall a. Pretty a => String -> a -> Doc
ppBracket String
o a
x = [Doc] -> Doc
myFsep [String -> Doc
text String
o, forall a. Pretty a => a -> Doc
pretty a
x, String -> Doc
text String
"|]"]
instance Pretty (Splice l) where
pretty :: Splice l -> Doc
pretty (IdSplice l
_ String
s) = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (TIdSplice l
_ String
s) = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (TParenSplice l
_ Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"$$(", forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
')']
pretty (ParenSplice l
_ Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"$(", forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
')']
instance Pretty (Pat l) where
prettyPrec :: Indent -> Pat l -> Doc
prettyPrec Indent
_ (PVar l
_ Name l
name) = forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec Indent
_ (PLit l
_ (Signless {}) Literal l
lit) = forall a. Pretty a => a -> Doc
pretty Literal l
lit
prettyPrec Indent
p (PLit l
_ (Negative{}) Literal l
lit) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
1) forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Literal l
lit
prettyPrec Indent
p (PInfixApp l
l Pat l
a QName l
op Pat l
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Pat l
a, forall a. Pretty a => a -> Doc
pretty (forall l. l -> QName l -> QOp l
QConOp l
l QName l
op), forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Pat l
b]
prettyPrec Indent
p (PApp l
_ QName l
n [Pat l]
ps) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
2 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
ps)) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep (forall a. Pretty a => a -> Doc
pretty QName l
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
ps)
prettyPrec Indent
_ (PTuple l
_ Boxed
bxd [Pat l]
ps) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Pat l]
ps
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec Indent
_ (PUnboxedSum l
_ Indent
before Indent
after Pat l
exp) =
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after Pat l
exp
prettyPrec Indent
_ (PList l
_ [Pat l]
ps) =
[Doc] -> Doc
bracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Pat l]
ps
prettyPrec Indent
_ (PParen l
_ Pat l
pat) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ Pat l
pat
prettyPrec Indent
_ (PRec l
_ QName l
c [PatField l]
fields) =
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PatField l]
fields)
prettyPrec Indent
_ (PAsPat l
_ Name l
name (PIrrPat l
_ Pat l
pat)) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat]
prettyPrec Indent
_ (PAsPat l
_ Name l
name Pat l
pat) =
[Doc] -> Doc
hcat [forall a. Pretty a => a -> Doc
pretty Name l
name, Char -> Doc
char Char
'@', forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat]
prettyPrec Indent
_ PWildCard {} = Char -> Doc
char Char
'_'
prettyPrec Indent
_ (PIrrPat l
_ Pat l
pat) = Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat
prettyPrec Indent
p (PatTypeSig l
_pos Pat l
pat Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
ty]
prettyPrec Indent
p (PViewPat l
_ Exp l
e Pat l
pat) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Pat l
pat]
prettyPrec Indent
p (PNPlusK l
_ Name l
n Integer
k) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"+", String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
k]
prettyPrec Indent
_ (PRPat l
_ [RPat l]
rs) =
[Doc] -> Doc
bracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [RPat l]
rs
prettyPrec Indent
_ (PXTag l
_ XName l
n [PXAttr l]
attrs Maybe (Pat l)
mattr [Pat l]
cp) =
let ap :: [Doc]
ap = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
in [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ap forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Pat l]
cp forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'>']]
prettyPrec Indent
_ (PXETag l
_ XName l
n [PXAttr l]
attrs Maybe (Pat l)
mattr) =
let ap :: [Doc]
ap = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
in [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName l
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ap forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
prettyPrec Indent
_ (PXPcdata l
_ String
s) = String -> Doc
text String
s
prettyPrec Indent
_ (PXPatTag l
_ Pat l
p) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"<%", forall a. Pretty a => a -> Doc
pretty Pat l
p, String -> Doc
text String
"%>"]
prettyPrec Indent
_ (PXRPats l
_ [RPat l]
ps) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [RPat l]
ps forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
prettyPrec Indent
_ (PBangPat l
_ Pat l
pat) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat
prettyPrec Indent
_ (PSplice l
_ Splice l
s) = forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (PQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[$" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
qt forall a. [a] -> [a] -> [a]
++ String
"|]")
instance Pretty (PXAttr l) where
pretty :: PXAttr l -> Doc
pretty (PXAttr l
_ XName l
n Pat l
p) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', forall a. Pretty a => a -> Doc
pretty Pat l
p]
instance Pretty (PatField l) where
pretty :: PatField l -> Doc
pretty (PFieldPat l
_ QName l
name Pat l
pat) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, forall a. Pretty a => a -> Doc
pretty Pat l
pat]
pretty (PFieldPun l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (PFieldWildcard{}) = String -> Doc
text String
".."
instance Pretty (RPat l) where
pretty :: RPat l -> Doc
pretty (RPOp l
_ RPat l
r RPatOp l
op) = forall a. Pretty a => a -> Doc
pretty RPat l
r Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty RPatOp l
op
pretty (RPEither l
_ RPat l
r1 RPat l
r2) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$
[forall a. Pretty a => a -> Doc
pretty RPat l
r1, Char -> Doc
char Char
'|', forall a. Pretty a => a -> Doc
pretty RPat l
r2]
pretty (RPSeq l
_ [RPat l]
rs) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [RPat l]
rs)
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (RPGuard l
_ Pat l
r [Stmt l]
gs) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" forall a. a -> [a] -> [a]
: forall a. Pretty a => a -> Doc
pretty Pat l
r forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' forall a. a -> [a] -> [a]
:
(Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Stmt l]
gs) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (RPCAs l
_ Name l
n (RPPat l
_ (PIrrPat l
_ Pat l
p))) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPCAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"@:", forall a. Pretty a => a -> Doc
pretty RPat l
r]
pretty (RPAs l
_ Name l
n (RPPat l
_ (PIrrPat l
_ Pat l
p))) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [forall a. Pretty a => a -> Doc
pretty Name l
n, Char -> Doc
char Char
'@', forall a. Pretty a => a -> Doc
pretty RPat l
r]
pretty (RPPat l
_ Pat l
p) = forall a. Pretty a => a -> Doc
pretty Pat l
p
pretty (RPParen l
_ RPat l
rp) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ RPat l
rp
instance Pretty (RPatOp l) where
pretty :: RPatOp l -> Doc
pretty RPStar{} = Char -> Doc
char Char
'*'
pretty RPStarG{} = String -> Doc
text String
"*!"
pretty RPPlus{} = Char -> Doc
char Char
'+'
pretty RPPlusG{} = String -> Doc
text String
"+!"
pretty RPOpt{} = Char -> Doc
char Char
'?'
pretty RPOptG{} = String -> Doc
text String
"?!"
instance Pretty (Alt l) where
pretty :: Alt l -> Doc
pretty (Alt l
_pos Pat l
e Rhs l
gAlts Maybe (Binds l)
binds) =
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs l
gAlts) Doc -> Doc -> Doc
$$$ forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
binds
instance Pretty (Stmt l) where
pretty :: Stmt l -> Doc
pretty (Generator l
_loc Pat l
e Exp l
from) =
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"<-" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp l
from
pretty (Qualifier l
_ Exp l
e) = forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (LetStmt l
_ (BDecls l
_ [Decl l]
declList)) =
forall a. Pretty a => [a] -> Doc
ppLetStmt [Decl l]
declList
pretty (LetStmt l
_ (IPBinds l
_ [IPBind l]
bindList)) =
forall a. Pretty a => [a] -> Doc
ppLetStmt [IPBind l]
bindList
pretty (RecStmt l
_ [Stmt l]
stmtList) =
String -> Doc
text String
"rec" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
ppLetStmt :: Pretty a => [a] -> Doc
ppLetStmt :: forall a. Pretty a => [a] -> Doc
ppLetStmt [a]
l = String -> Doc
text String
"let" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [a]
l)
instance Pretty (QualStmt l) where
pretty :: QualStmt l -> Doc
pretty (QualStmt l
_ Stmt l
s) = forall a. Pretty a => a -> Doc
pretty Stmt l
s
pretty (ThenTrans l
_ Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", forall a. Pretty a => a -> Doc
pretty Exp l
f]
pretty (ThenBy l
_ Exp l
f Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", forall a. Pretty a => a -> Doc
pretty Exp l
f, String -> Doc
text String
"by", forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (GroupBy l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"by", forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (GroupUsing l
_ Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"using", forall a. Pretty a => a -> Doc
pretty Exp l
f]
pretty (GroupByUsing l
_ Exp l
e Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"by",
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"using", forall a. Pretty a => a -> Doc
pretty Exp l
f]
instance Pretty (FieldUpdate l) where
pretty :: FieldUpdate l -> Doc
pretty (FieldUpdate l
_ QName l
name Exp l
e) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (FieldPun l
_ QName l
name) = forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (FieldWildcard {}) = String -> Doc
text String
".."
instance Pretty (QOp l) where
pretty :: QOp l -> Doc
pretty (QVarOp l
_ QName l
n) = forall l. QName l -> Doc
ppQNameInfix QName l
n
pretty (QConOp l
_ QName l
n) = forall l. QName l -> Doc
ppQNameInfix QName l
n
ppQNameInfix :: QName l -> Doc
ppQNameInfix :: forall l. QName l -> Doc
ppQNameInfix QName l
name
| forall l. QName l -> Bool
isSymbolQName QName l
name = forall l. QName l -> Doc
ppQName QName l
name
| Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'`'
instance Pretty (QName l) where
pretty :: QName l -> Doc
pretty QName l
name = case QName l
name of
UnQual l
_ (Symbol l
_ (Char
'#':String
_)) -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<+> forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
QName l
_ -> Bool -> Doc -> Doc
parensIf (forall l. QName l -> Bool
isSymbolQName QName l
name) (forall l. QName l -> Doc
ppQName QName l
name)
ppQName :: QName l -> Doc
ppQName :: forall l. QName l -> Doc
ppQName (UnQual l
_ Name l
name) = forall l. Name l -> Doc
ppName Name l
name
ppQName (Qual l
_ ModuleName l
m Name l
name) = forall a. Pretty a => a -> Doc
pretty ModuleName l
m Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> forall l. Name l -> Doc
ppName Name l
name
ppQName (Special l
_ SpecialCon l
sym) = forall a. Pretty a => a -> Doc
pretty SpecialCon l
sym
instance Pretty (Op l) where
pretty :: Op l -> Doc
pretty (VarOp l
_ Name l
n) = forall l. Name l -> Doc
ppNameInfix Name l
n
pretty (ConOp l
_ Name l
n) = forall l. Name l -> Doc
ppNameInfix Name l
n
ppNameInfix :: Name l -> Doc
ppNameInfix :: forall l. Name l -> Doc
ppNameInfix Name l
name
| forall l. Name l -> Bool
isSymbolName Name l
name = forall l. Name l -> Doc
ppName Name l
name
| Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'`'
instance Pretty (Name l) where
pretty :: Name l -> Doc
pretty Name l
name = case Name l
name of
Symbol l
_ (Char
'#':String
_) -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<+> forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
Name l
_ -> Bool -> Doc -> Doc
parensIf (forall l. Name l -> Bool
isSymbolName Name l
name) (forall l. Name l -> Doc
ppName Name l
name)
ppName :: Name l -> Doc
ppName :: forall l. Name l -> Doc
ppName (Ident l
_ String
s) = String -> Doc
text String
s
ppName (Symbol l
_ String
s) = String -> Doc
text String
s
instance Pretty (IPName l) where
pretty :: IPName l -> Doc
pretty (IPDup l
_ String
s) = Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (IPLin l
_ String
s) = Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<> String -> Doc
text String
s
instance PrettyDeclLike (IPBind l) where
wantsBlankline :: IPBind l -> Bool
wantsBlankline IPBind l
_ = Bool
False
instance Pretty (IPBind l) where
pretty :: IPBind l -> Doc
pretty (IPBind l
_loc IPName l
ipname Exp l
exp) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty IPName l
ipname, Doc
equals, forall a. Pretty a => a -> Doc
pretty Exp l
exp]
instance Pretty (CName l) where
pretty :: CName l -> Doc
pretty (VarName l
_ Name l
n) = forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (ConName l
_ Name l
n) = forall a. Pretty a => a -> Doc
pretty Name l
n
instance Pretty (SpecialCon l) where
pretty :: SpecialCon l -> Doc
pretty (UnitCon {}) = String -> Doc
text String
"()"
pretty (ListCon {}) = String -> Doc
text String
"[]"
pretty (FunCon {}) = String -> Doc
text String
"->"
pretty (TupleCon l
_ Boxed
b Indent
n) = Doc -> Doc
listFun forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<>) Doc
empty (forall a. Indent -> a -> [a]
replicate (Indent
nforall a. Num a => a -> a -> a
-Indent
1) Doc
comma)
where listFun :: Doc -> Doc
listFun = if Boxed
b forall a. Eq a => a -> a -> Bool
== Boxed
Unboxed then Doc -> Doc
hashParens else Doc -> Doc
parens
pretty (Cons {}) = String -> Doc
text String
":"
pretty (UnboxedSingleCon {}) = String -> Doc
text String
"(# #)"
pretty (ExprHole {}) = String -> Doc
text String
"_"
isSymbolName :: Name l -> Bool
isSymbolName :: forall l. Name l -> Bool
isSymbolName (Symbol {}) = Bool
True
isSymbolName Name l
_ = Bool
False
isSymbolQName :: QName l -> Bool
isSymbolQName :: forall l. QName l -> Bool
isSymbolQName (UnQual l
_ Name l
n) = forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual l
_ ModuleName l
_ Name l
n) = forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Special l
_ (Cons {})) = Bool
True
isSymbolQName (Special l
_ (FunCon {})) = Bool
True
isSymbolQName QName l
_ = Bool
False
instance (Pretty (Context l)) where
pretty :: Context l -> Doc
pretty (CxEmpty l
_) = String -> Doc
text String
"()" Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
pretty (CxSingle l
_ Asst l
ctxt) = forall a. Pretty a => a -> Doc
pretty Asst l
ctxt Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
pretty (CxTuple l
_ [Asst l]
context) = [Doc] -> Doc
mySep [[Doc] -> Doc
parenList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Asst l]
context), String -> Doc
text String
"=>"]
instance Pretty (Asst l) where
pretty :: Asst l -> Doc
pretty (TypeA l
_ Type l
t) = forall a. Pretty a => a -> Doc
pretty Type l
t
pretty (IParam l
_ IPName l
i Type l
t) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty IPName l
i, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type l
t]
pretty (ParenA l
_ Asst l
a) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty Asst l
a)
instance Pretty SrcLoc where
pretty :: SrcLoc -> Doc
pretty SrcLoc
srcLoc =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hcat [ Doc -> Doc
colonFollow (String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcFilename SrcLoc
srcLoc)
, Doc -> Doc
colonFollow (Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcLoc -> Indent
srcLine SrcLoc
srcLoc)
, Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcLoc -> Indent
srcColumn SrcLoc
srcLoc
]
colonFollow :: P.Doc -> P.Doc
colonFollow :: Doc -> Doc
colonFollow Doc
p = [Doc] -> Doc
P.hcat [ Doc
p, Doc
P.colon ]
instance Pretty SrcSpan where
pretty :: SrcSpan -> Doc
pretty SrcSpan
srcSpan =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hsep [ Doc -> Doc
colonFollow (String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ SrcSpan -> String
srcSpanFilename SrcSpan
srcSpan)
, [Doc] -> Doc
P.hcat [ String -> Doc
P.text String
"("
, Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanStartLine SrcSpan
srcSpan
, Doc
P.colon
, Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanStartColumn SrcSpan
srcSpan
, String -> Doc
P.text String
")"
]
, String -> Doc
P.text String
"-"
, [Doc] -> Doc
P.hcat [ String -> Doc
P.text String
"("
, Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanEndLine SrcSpan
srcSpan
, Doc
P.colon
, Indent -> Doc
P.int forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanEndColumn SrcSpan
srcSpan
, String -> Doc
P.text String
")"
]
]
instance Pretty (Module pos) where
pretty :: Module pos -> Doc
pretty (Module pos
_ Maybe (ModuleHead pos)
mbHead [ModulePragma pos]
os [ImportDecl pos]
imp [Decl pos]
decls) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os forall a. [a] -> [a] -> [a]
++
(case Maybe (ModuleHead pos)
mbHead of
Maybe (ModuleHead pos)
Nothing -> forall a. a -> a
id
Just ModuleHead pos
h -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp forall a. [a] -> [a] -> [a]
++
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
||
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
||
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma pos]
os))
[Decl pos]
decls)
pretty (XmlPage pos
_ ModuleName pos
_mn [ModulePragma pos]
os XName pos
n [XAttr pos]
attrs Maybe (Exp pos)
mattr [Exp pos]
cs) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os forall a. [a] -> [a] -> [a]
++
[let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
in [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName pos
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char Char
'>']]]
pretty (XmlHybrid pos
_ Maybe (ModuleHead pos)
mbHead [ModulePragma pos]
os [ImportDecl pos]
imp [Decl pos]
decls XName pos
n [XAttr pos]
attrs Maybe (Exp pos)
mattr [Exp pos]
cs) =
[Doc] -> Doc
myVcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"<%"] forall a. [a] -> [a] -> [a]
++
(case Maybe (ModuleHead pos)
mbHead of
Maybe (ModuleHead pos)
Nothing -> forall a. a -> a
id
Just ModuleHead pos
h -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp forall a. [a] -> [a] -> [a]
++
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma pos]
os)) [Decl pos]
decls forall a. [a] -> [a] -> [a]
++
[let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
in [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName pos
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char Char
'>']]])
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: forall a. (a -> Doc) -> Maybe a -> Doc
maybePP a -> Doc
_ Maybe a
Nothing = Doc
empty
maybePP a -> Doc
pp (Just a
a) = a -> Doc
pp a
a
parenList :: [Doc] -> Doc
parenList :: [Doc] -> Doc
parenList = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
hashParenList :: [Doc] -> Doc
hashParenList :: [Doc] -> Doc
hashParenList = Doc -> Doc
hashParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
unboxedSumType :: [Doc] -> Doc
unboxedSumType :: [Doc] -> Doc
unboxedSumType = Doc -> Doc
hashParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" |")
hashParens :: Doc -> Doc
hashParens :: Doc -> Doc
hashParens = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
hashes
where
hashes :: Doc -> Doc
hashes Doc
doc = Char -> Doc
char Char
'#' Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'#'
braceList :: [Doc] -> Doc
braceList :: [Doc] -> Doc
braceList = Doc -> Doc
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
bracketList :: [Doc] -> Doc
bracketList :: [Doc] -> Doc
bracketList = Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple
bracketColonList :: [Doc] -> Doc
bracketColonList :: [Doc] -> Doc
bracketColonList = Doc -> Doc
bracketColons forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple
where bracketColons :: Doc -> Doc
bracketColons = Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
colons
colons :: Doc -> Doc
colons Doc
doc = Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Char -> Doc
char Char
':'
flatBlock :: [Doc] -> Doc
flatBlock :: [Doc] -> Doc
flatBlock = Doc -> Doc
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi
prettyBlock :: [Doc] -> Doc
prettyBlock :: [Doc] -> Doc
prettyBlock = Doc -> Doc
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi
blankline :: Doc -> Doc
blankline :: Doc -> Doc
blankline Doc
dl = do{PPHsMode
e<-forall s. DocM s s
getPPEnv;if PPHsMode -> Bool
spacing PPHsMode
e Bool -> Bool -> Bool
&& PPHsMode -> PPLayout
layout PPHsMode
e forall a. Eq a => a -> a -> Bool
/= PPLayout
PPNoLayout
then String -> Doc
text String
"" Doc -> Doc -> Doc
$+$ Doc
dl else Doc
dl}
topLevel :: Doc -> [Doc] -> Doc
topLevel :: Doc -> [Doc] -> Doc
topLevel Doc
header [Doc]
dl = do
PPLayout
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout forall s. DocM s s
getPPEnv
case PPLayout
e of
PPLayout
PPOffsideRule -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc]
dl
PPLayout
PPSemiColon -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
PPLayout
PPInLine -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
PPLayout
PPNoLayout -> Doc
header Doc -> Doc -> Doc
<+> [Doc] -> Doc
flatBlock [Doc]
dl
ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
ppBody :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
f [Doc]
dl = do
PPLayout
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout forall s. DocM s s
getPPEnv
case PPLayout
e of PPLayout
PPOffsideRule -> Doc
indent
PPLayout
PPSemiColon -> Doc
indentExplicit
PPLayout
_ -> [Doc] -> Doc
flatBlock [Doc]
dl
where
indent :: Doc
indent = do{Indent
i <-forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f forall s. DocM s s
getPPEnv;Indent -> Doc -> Doc
nest Indent
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ [Doc]
dl}
indentExplicit :: Doc
indentExplicit = do {Indent
i <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f forall s. DocM s s
getPPEnv;
Indent -> Doc -> Doc
nest Indent
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
prettyBlock forall a b. (a -> b) -> a -> b
$ [Doc]
dl}
ppIndent :: (PPHsMode -> Int) -> [Doc] -> Doc
ppIndent :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
f [Doc]
dl = do
Indent
i <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f forall s. DocM s s
getPPEnv
Indent -> Doc -> Doc
nest Indent
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ [Doc]
dl
($$$) :: Doc -> Doc -> Doc
Doc
a $$$ :: Doc -> Doc -> Doc
$$$ Doc
b = forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice (Doc
a Doc -> Doc -> Doc
$$) (Doc
a Doc -> Doc -> Doc
<+>) Doc
b
mySep :: [Doc] -> Doc
mySep :: [Doc] -> Doc
mySep = forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
mySep' [Doc] -> Doc
hsep
where
mySep' :: [Doc] -> Doc
mySep' [Doc
x] = Doc
x
mySep' (Doc
x:[Doc]
xs) = Doc
x Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
xs
mySep' [] = forall a. HasCallStack => String -> a
error String
"Internal error: mySep"
myVcat :: [Doc] -> Doc
myVcat :: [Doc] -> Doc
myVcat = forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
vcat [Doc] -> Doc
hsep
myFsepSimple :: [Doc] -> Doc
myFsepSimple :: [Doc] -> Doc
myFsepSimple = forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
fsep [Doc] -> Doc
hsep
myFsep :: [Doc] -> Doc
myFsep :: [Doc] -> Doc
myFsep = forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
fsep' [Doc] -> Doc
hsep
where fsep' :: [Doc] -> Doc
fsep' [] = Doc
empty
fsep' (Doc
d:[Doc]
ds) = do
PPHsMode
e <- forall s. DocM s s
getPPEnv
let n :: Indent
n = PPHsMode -> Indent
onsideIndent PPHsMode
e
Indent -> Doc -> Doc
nest Indent
n ([Doc] -> Doc
fsep (Indent -> Doc -> Doc
nest (-Indent
n) Doc
dforall a. a -> [a] -> [a]
:[Doc]
ds))
layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice :: forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice a -> Doc
a a -> Doc
b a
dl = do PPHsMode
e <- forall s. DocM s s
getPPEnv
if PPHsMode -> PPLayout
layout PPHsMode
e forall a. Eq a => a -> a -> Bool
== PPLayout
PPOffsideRule Bool -> Bool -> Bool
||
PPHsMode -> PPLayout
layout PPHsMode
e forall a. Eq a => a -> a -> Bool
== PPLayout
PPSemiColon
then a -> Doc
a a
dl else a -> Doc
b a
dl
instance SrcInfo loc => Pretty (P.PExp loc) where
pretty :: PExp loc -> Doc
pretty (P.Lit loc
_ Literal loc
l) = forall a. Pretty a => a -> Doc
pretty Literal loc
l
pretty (P.InfixApp loc
_ PExp loc
a QOp loc
op PExp loc
b) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
a, forall a. Pretty a => a -> Doc
pretty QOp loc
op, forall a. Pretty a => a -> Doc
pretty PExp loc
b]
pretty (P.NegApp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [Char -> Doc
char Char
'-', forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.App loc
_ PExp loc
a PExp loc
b) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
a, forall a. Pretty a => a -> Doc
pretty PExp loc
b]
pretty (P.Lambda loc
_loc [Pat loc]
expList PExp loc
ppBody') = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$
Char -> Doc
char Char
'\\' forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Pat loc]
expList forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty PExp loc
ppBody']
pretty (P.Let loc
_ (BDecls loc
_ [Decl loc]
declList) PExp loc
letBody) =
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [Decl loc]
declList PExp loc
letBody
pretty (P.Let loc
_ (IPBinds loc
_ [IPBind loc]
bindList) PExp loc
letBody) =
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [IPBind loc]
bindList PExp loc
letBody
pretty (P.If loc
_ PExp loc
cond PExp loc
thenexp PExp loc
elsexp) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"if", forall a. Pretty a => a -> Doc
pretty PExp loc
cond,
String -> Doc
text String
"then", forall a. Pretty a => a -> Doc
pretty PExp loc
thenexp,
String -> Doc
text String
"else", forall a. Pretty a => a -> Doc
pretty PExp loc
elsexp]
pretty (P.MultiIf loc
_ [GuardedRhs loc]
alts) =
String -> Doc
text String
"if"
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [GuardedRhs loc]
alts)
pretty (P.Case loc
_ PExp loc
cond [Alt loc]
altList) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"case", forall a. Pretty a => a -> Doc
pretty PExp loc
cond, String -> Doc
text String
"of"]
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Alt loc]
altList)
pretty (P.Do loc
_ [Stmt loc]
stmtList) =
String -> Doc
text String
"do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt loc]
stmtList)
pretty (P.MDo loc
_ [Stmt loc]
stmtList) =
String -> Doc
text String
"mdo" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt loc]
stmtList)
pretty (P.Var loc
_ QName loc
name) = forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.OverloadedLabel loc
_ String
name) = String -> Doc
text String
name
pretty (P.IPVar loc
_ IPName loc
ipname) = forall a. Pretty a => a -> Doc
pretty IPName loc
ipname
pretty (P.Con loc
_ QName loc
name) = forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.TupleSection loc
_ Boxed
bxd [Maybe (PExp loc)]
mExpList) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty) [Maybe (PExp loc)]
mExpList
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
pretty (P.UnboxedSum loc
_ Indent
before Indent
after PExp loc
exp) =
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after PExp loc
exp
pretty (P.Paren loc
_ PExp loc
e) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ PExp loc
e
pretty (P.RecConstr loc
_ QName loc
c [PFieldUpdate loc]
fieldList) =
forall a. Pretty a => a -> Doc
pretty QName loc
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
pretty (P.RecUpdate loc
_ PExp loc
e [PFieldUpdate loc]
fieldList) =
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
pretty (P.List loc
_ [PExp loc]
list) =
[Doc] -> Doc
bracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PExp loc]
list
pretty (P.ParArray loc
_ [PExp loc]
arr) =
[Doc] -> Doc
bracketColonList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PExp loc]
arr
pretty (P.EnumFrom loc
_ PExp loc
e) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
".."]
pretty (P.EnumFromTo loc
_ PExp loc
from PExp loc
to) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.EnumFromThen loc
_ PExp loc
from PExp loc
thenE) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty PExp loc
thenE, String -> Doc
text String
".."]
pretty (P.EnumFromThenTo loc
_ PExp loc
from PExp loc
thenE PExp loc
to) =
[Doc] -> Doc
bracketList [forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParArrayFromTo loc
_ PExp loc
from PExp loc
to) =
[Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParArrayFromThenTo loc
_ PExp loc
from PExp loc
thenE PExp loc
to) =
[Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
String -> Doc
text String
"..", forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParComp loc
_ PExp loc
e [[QualStmt loc]]
qualLists) =
[Doc] -> Doc
bracketList (forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') forall a b. (a -> b) -> a -> b
$
forall a. Pretty a => a -> Doc
pretty PExp loc
e forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty) forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualLists))
pretty (P.ParArrayComp loc
_ PExp loc
e [[QualStmt loc]]
qualArrs) =
[Doc] -> Doc
bracketColonList (forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') forall a b. (a -> b) -> a -> b
$
forall a. Pretty a => a -> Doc
pretty PExp loc
e forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty) forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualArrs))
pretty (P.ExpTypeSig loc
_pos PExp loc
e Type loc
ty) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Type loc
ty]
pretty (P.BracketExp loc
_ Bracket loc
b) = forall a. Pretty a => a -> Doc
pretty Bracket loc
b
pretty (P.SpliceExp loc
_ Splice loc
s) = forall a. Pretty a => a -> Doc
pretty Splice loc
s
pretty (P.TypQuote loc
_ QName loc
t) = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty QName loc
t
pretty (P.VarQuote loc
_ QName loc
x) = String -> Doc
text String
"\'" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty QName loc
x
pretty (P.QuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
qt forall a. [a] -> [a] -> [a]
++ String
"|]")
pretty (P.XTag loc
_ XName loc
n [ParseXAttr loc]
attrs Maybe (PExp loc)
mattr [PExp loc]
cs) =
let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
in [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName loc
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PExp loc]
cs forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char Char
'>']]
pretty (P.XETag loc
_ XName loc
n [ParseXAttr loc]
attrs Maybe (PExp loc)
mattr) =
let ax :: [Doc]
ax = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
in [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty XName loc
n)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs forall a. [a] -> [a] -> [a]
++ [Doc]
ax forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
pretty (P.XPcdata loc
_ String
s) = String -> Doc
text String
s
pretty (P.XExpTag loc
_ PExp loc
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"<%", forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"%>"]
pretty (P.XChildTag loc
_ [PExp loc]
es) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PExp loc]
es forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]
pretty (P.CorePragma loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", forall a. Show a => a -> String
show String
s, String
"#-}"] forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.SCCPragma loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC", forall a. Show a => a -> String
show String
s, String
"#-}"] forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.GenPragma loc
_ String
s (Indent
a,Indent
b) (Indent
c,Indent
d) PExp loc
e) =
[Doc] -> Doc
myFsep [String -> Doc
text String
"{-# GENERATED", String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s,
Indent -> Doc
int Indent
a, Char -> Doc
char Char
':', Indent -> Doc
int Indent
b, Char -> Doc
char Char
'-',
Indent -> Doc
int Indent
c, Char -> Doc
char Char
':', Indent -> Doc
int Indent
d, String -> Doc
text String
"#-}", forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.Proc loc
_ Pat loc
p PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"proc", forall a. Pretty a => a -> Doc
pretty Pat loc
p, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.LeftArrApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<", forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">-", forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.LeftArrHighApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<<", forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrHighApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">>-", forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.ArrOp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"|)"]
pretty (P.AsPat loc
_ Name loc
name (P.IrrPat loc
_ PExp loc
pat)) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name loc
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
pretty (P.AsPat loc
_ Name loc
name PExp loc
pat) =
[Doc] -> Doc
hcat [forall a. Pretty a => a -> Doc
pretty Name loc
name, Char -> Doc
char Char
'@', forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
pretty (P.WildCard loc
_) = Char -> Doc
char Char
'_'
pretty (P.IrrPat loc
_ PExp loc
pat) = Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty PExp loc
pat
pretty (P.PostOp loc
_ PExp loc
e QOp loc
op) = forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty QOp loc
op
pretty (P.PreOp loc
_ QOp loc
op PExp loc
e) = forall a. Pretty a => a -> Doc
pretty QOp loc
op Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PExp loc
e
pretty (P.ViewPat loc
_ PExp loc
e Pat loc
p) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty Pat loc
p]
pretty (P.SeqRP loc
_ [PExp loc]
rs) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [PExp loc]
rs) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (P.GuardRP loc
_ PExp loc
r [Stmt loc]
gs) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" forall a. a -> [a] -> [a]
: forall a. Pretty a => a -> Doc
pretty PExp loc
r forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' forall a. a -> [a] -> [a]
:
(Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall a b. (a -> b) -> a -> b
$ [Stmt loc]
gs) forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (P.EitherRP loc
_ PExp loc
r1 PExp loc
r2) = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ [forall a. Pretty a => a -> Doc
pretty PExp loc
r1, Char -> Doc
char Char
'|', forall a. Pretty a => a -> Doc
pretty PExp loc
r2]
pretty (P.CAsRP loc
_ Name loc
n (P.IrrPat loc
_ PExp loc
e)) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty Name loc
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.CAsRP loc
_ Name loc
n PExp loc
r) = [Doc] -> Doc
hcat [forall a. Pretty a => a -> Doc
pretty Name loc
n, String -> Doc
text String
"@:", forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.XRPats loc
_ [PExp loc]
ps) =
[Doc] -> Doc
myFsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PExp loc]
ps forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
pretty (P.BangPat loc
_ PExp loc
e) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty PExp loc
e
pretty (P.LCase loc
_ [Alt loc]
altList) = String -> Doc
text String
"\\case" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Alt loc]
altList)
pretty (P.TypeApp loc
_ Type loc
ty) = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> forall a. Pretty a => a -> Doc
pretty Type loc
ty
instance SrcInfo loc => Pretty (P.PFieldUpdate loc) where
pretty :: PFieldUpdate loc -> Doc
pretty (P.FieldUpdate loc
_ QName loc
name PExp loc
e) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty QName loc
name, Doc
equals, forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.FieldPun loc
_ QName loc
name) = forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.FieldWildcard loc
_) = String -> Doc
text String
".."
instance SrcInfo loc => Pretty (P.ParseXAttr loc) where
pretty :: ParseXAttr loc -> Doc
pretty (P.XAttr loc
_ XName loc
n PExp loc
v) =
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char Char
'=', forall a. Pretty a => a -> Doc
pretty PExp loc
v]
instance SrcInfo loc => Pretty (P.PContext loc) where
pretty :: PContext loc -> Doc
pretty (P.CxEmpty loc
_) = [Doc] -> Doc
mySep [String -> Doc
text String
"()", String -> Doc
text String
"=>"]
pretty (P.CxSingle loc
_ PAsst loc
asst) = [Doc] -> Doc
mySep [forall a. Pretty a => a -> Doc
pretty PAsst loc
asst, String -> Doc
text String
"=>"]
pretty (P.CxTuple loc
_ [PAsst loc]
assts) = [Doc] -> Doc
myFsep [[Doc] -> Doc
parenList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PAsst loc]
assts), String -> Doc
text String
"=>"]
instance SrcInfo loc => Pretty (P.PAsst loc) where
pretty :: PAsst loc -> Doc
pretty (P.TypeA loc
_ PType loc
t) = forall a. Pretty a => a -> Doc
pretty PType loc
t
pretty (P.IParam loc
_ IPName loc
i PType loc
t) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty IPName loc
i, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty PType loc
t]
pretty (P.ParenA loc
_ PAsst loc
a) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty PAsst loc
a)
instance SrcInfo loc => Pretty (P.PType loc) where
prettyPrec :: Indent -> PType loc -> Doc
prettyPrec Indent
p (P.TyForall loc
_ Maybe [TyVarBind loc]
mtvs Maybe (PContext loc)
ctxt PType loc
htype) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind loc]
mtvs, forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (PContext loc)
ctxt, forall a. Pretty a => a -> Doc
pretty PType loc
htype]
prettyPrec Indent
_ (P.TyStar loc
_) = String -> Doc
text String
"*"
prettyPrec Indent
p (P.TyFun loc
_ PType loc
a PType loc
b) = Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
0) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype PType loc
a, String -> Doc
text String
"->", forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec Indent
_ (P.TyTuple loc
_ Boxed
bxd [PType loc]
l) =
let ds :: [Doc]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PType loc]
l
in case Boxed
bxd of
Boxed
Boxed -> [Doc] -> Doc
parenList [Doc]
ds
Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec Indent
_ (P.TyUnboxedSum loc
_ [PType loc]
es) =
[Doc] -> Doc
unboxedSumType (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [PType loc]
es)
prettyPrec Indent
_ (P.TyList loc
_ PType loc
t) = Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty PType loc
t
prettyPrec Indent
_ (P.TyParArray loc
_ PType loc
t) = [Doc] -> Doc
bracketColonList [forall a. Pretty a => a -> Doc
pretty PType loc
t]
prettyPrec Indent
p (P.TyApp loc
_ PType loc
a PType loc
b) =
Bool -> Doc -> Doc
parensIf (Indent
p forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PType loc
a, forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype PType loc
b]
prettyPrec Indent
_ (P.TyVar loc
_ Name loc
name) = forall a. Pretty a => a -> Doc
pretty Name loc
name
prettyPrec Indent
_ (P.TyCon loc
_ QName loc
name) = forall a. Pretty a => a -> Doc
pretty QName loc
name
prettyPrec Indent
_ (P.TyParen loc
_ PType loc
t) = Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty PType loc
t)
prettyPrec Indent
_ (P.TyPred loc
_ PAsst loc
asst) = forall a. Pretty a => a -> Doc
pretty PAsst loc
asst
prettyPrec Indent
_ (P.TyInfix loc
_ PType loc
a MaybePromotedName loc
op PType loc
b) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PType loc
a, forall a. Pretty a => a -> Doc
pretty MaybePromotedName loc
op, forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec Indent
_ (P.TyKind loc
_ PType loc
t Kind loc
k) = Doc -> Doc
parens ([Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PType loc
t, String -> Doc
text String
"::", forall a. Pretty a => a -> Doc
pretty Kind loc
k])
prettyPrec Indent
_ (P.TyPromoted loc
_ Promoted loc
p) = forall a. Pretty a => a -> Doc
pretty Promoted loc
p
prettyPrec Indent
_ (P.TyEquals loc
_ PType loc
a PType loc
b) = [Doc] -> Doc
myFsep [forall a. Pretty a => a -> Doc
pretty PType loc
a, String -> Doc
text String
"~", forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec Indent
_ (P.TySplice loc
_ Splice loc
s) = forall a. Pretty a => a -> Doc
pretty Splice loc
s
prettyPrec Indent
_ (P.TyBang loc
_ BangType loc
b Unpackedness loc
u PType loc
t) = forall a. Pretty a => a -> Doc
pretty Unpackedness loc
u Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty BangType loc
b Doc -> Doc -> Doc
<> forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype PType loc
t
prettyPrec Indent
_ (P.TyWildCard loc
_ Maybe (Name loc)
mn) = Char -> Doc
char Char
'_' Doc -> Doc -> Doc
<> forall a. (a -> Doc) -> Maybe a -> Doc
maybePP forall a. Pretty a => a -> Doc
pretty Maybe (Name loc)
mn
prettyPrec Indent
_ (P.TyQuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"|" forall a. [a] -> [a] -> [a]
++ String
qt forall a. [a] -> [a] -> [a]
++ String
"|]")