{-# 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
(PPLayout -> PPLayout -> Bool)
-> (PPLayout -> PPLayout -> Bool) -> Eq PPLayout
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 :: Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Bool
-> PPLayout
-> Bool
-> PPHsMode
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 :: (a -> b) -> DocM s a -> DocM s b
fmap a -> b
f DocM s a
xs = do a
x <- DocM s a
xs; b -> DocM s b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)
instance Applicative (DocM s) where
pure :: a -> DocM s a
pure = a -> DocM s a
forall a s. a -> DocM s a
retDocM
<*> :: DocM s (a -> b) -> DocM s a -> DocM s 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
>>= :: DocM s a -> (a -> DocM s b) -> DocM s 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
>> :: DocM s a -> DocM s b -> DocM s 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 :: a -> DocM s a
return = a -> DocM s a
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 :: DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM DocM s a
m a -> DocM s b
k = (s -> b) -> DocM s b
forall s a. (s -> a) -> DocM s a
DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
forall a b. (a -> b) -> a -> b
$ \s
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
a -> DocM s b -> s -> b
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 :: DocM s a -> DocM s b -> DocM s b
then_DocM DocM s a
m DocM s b
k = (s -> b) -> DocM s b
forall s a. (s -> a) -> DocM s a
DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
forall a b. (a -> b) -> a -> b
$ \s
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
_ -> DocM s b -> s -> b
forall s a. DocM s a -> s -> a
unDocM DocM s b
k s
s
retDocM :: a -> DocM s a
retDocM :: a -> DocM s a
retDocM a
a = (s -> a) -> DocM s a
forall s a. (s -> a) -> DocM s a
DocM ((s -> a) -> DocM s a) -> (s -> a) -> DocM s a
forall a b. (a -> b) -> a -> b
$ a -> s -> a
forall a b. a -> b -> a
const a
a
unDocM :: DocM s a -> s -> a
unDocM :: DocM s a -> s -> a
unDocM (DocM s -> a
f) = s -> a
f
getPPEnv :: DocM s s
getPPEnv :: DocM s s
getPPEnv = (s -> s) -> DocM s s
forall s a. (s -> a) -> DocM s a
DocM s -> s
forall a. a -> a
id
type Doc = DocM PPHsMode P.Doc
class Pretty a where
pretty :: a -> Doc
prettyPrec :: Int -> a -> Doc
pretty = Indent -> a -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
0
prettyPrec Indent
_ = a -> Doc
forall a. Pretty a => a -> Doc
pretty
empty :: Doc
empty :: Doc
empty = Doc -> Doc
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 Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc -> Doc
P.nest Indent
i
text :: String -> Doc
text :: String -> Doc
text = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text
char :: Char -> Doc
char :: Char -> Doc
char = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
P.char
int :: Int -> Doc
int :: Indent -> Doc
int = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Indent -> Doc) -> Indent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc
P.int
integer :: Integer -> Doc
integer :: Integer -> Doc
integer = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Integer -> Doc) -> Integer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc
P.integer
float :: Float -> Doc
float :: Float -> Doc
float = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Float -> Doc) -> Float -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Doc
P.float
double :: Double -> Doc
double :: Double -> Doc
double = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Double -> Doc) -> Double -> Doc
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 Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.parens
brackets :: Doc -> Doc
brackets Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.brackets
braces :: Doc -> Doc
braces Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.braces
doubleQuotes :: Doc -> Doc
doubleQuotes Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
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 = Doc -> Doc
forall a. a -> a
id
semi,comma,space,equals :: Doc
semi :: Doc
semi = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.semi
comma :: Doc
comma = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.comma
space :: Doc
space = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.space
equals :: Doc
equals = Doc -> Doc
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;Doc -> Doc
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;Doc -> Doc
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;Doc -> Doc
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;Doc -> Doc
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 = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hcat
hsep :: [Doc] -> Doc
hsep [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hsep
vcat :: [Doc] -> Doc
vcat [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.vcat
fsep :: [Doc] -> Doc
fsep [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
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) Doc -> [Doc] -> [Doc]
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 (Doc -> String) -> (PPHsMode -> Doc) -> PPHsMode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> PPHsMode -> Doc
forall s a. DocM s a -> s -> a
unDocM Doc
d (PPHsMode -> String) -> PPHsMode -> String
forall a b. (a -> b) -> a -> b
$ PPHsMode
ppMode
prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String
prettyPrintStyleMode :: Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
ppStyle PPHsMode
ppMode = Style -> PPHsMode -> Doc -> String
renderStyleMode Style
ppStyle PPHsMode
ppMode (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty
prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String
prettyPrintWithMode :: PPHsMode -> a -> String
prettyPrintWithMode = Style -> PPHsMode -> a -> String
forall a. Pretty a => Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
P.style
prettyPrint :: Pretty a => a -> String
prettyPrint :: a -> String
prettyPrint = PPHsMode -> a -> String
forall a. Pretty a => PPHsMode -> a -> String
prettyPrintWithMode PPHsMode
defaultMode
prettyPrim :: Pretty a => a -> P.Doc
prettyPrim :: a -> Doc
prettyPrim = PPHsMode -> a -> Doc
forall a. Pretty a => PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
defaultMode
prettyPrimWithMode :: Pretty a => PPHsMode -> a -> P.Doc
prettyPrimWithMode :: PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
pphs a
doc = Doc -> PPHsMode -> Doc
forall s a. DocM s a -> s -> a
unDocM (a -> Doc
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",
ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
(WarningText l -> Doc) -> Maybe (WarningText l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP WarningText l -> Doc
forall l. WarningText l -> Doc
ppWarnTxt Maybe (WarningText l)
mbWarn,
(ExportSpecList l -> Doc) -> Maybe (ExportSpecList l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ExportSpecList l -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ExportSpec l -> Doc) -> [ExportSpec l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExportSpec l -> Doc
forall a. Pretty a => a -> Doc
pretty [ExportSpec l]
especs
ppWarnTxt :: WarningText l -> Doc
ppWarnTxt :: WarningText l -> Doc
ppWarnTxt (DeprText l
_ String
s) = [Doc] -> Doc
mySep [String -> Doc
text String
"{-# DEPRECATED", String -> Doc
text (String -> String
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 (String -> String
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) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (EAbs l
_ Namespace l
ns QName l
name) = Namespace l -> Doc
forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> QName l -> 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 = (CName l -> Doc) -> [CName l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CName l -> Doc
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) = Indent -> [Doc] -> ([Doc], [Doc])
forall a. Indent -> [a] -> ([a], [a])
splitAt Indent
n [Doc]
prettyNames
in [Doc]
before [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
".."] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
after
in QName l -> Doc
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
<+> ModuleName l -> 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,
(String -> Doc) -> Maybe String -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\String
s -> String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)) Maybe String
mbPkg,
ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
(ModuleName l -> Doc) -> Maybe (ModuleName l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\ModuleName l
m' -> String -> Doc
text String
"as" Doc -> Doc -> Doc
<+> ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m') Maybe (ModuleName l)
mbName,
(ImportSpecList l -> Doc) -> Maybe (ImportSpecList l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ImportSpecList l -> Doc
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 ((ImportSpec l -> Doc) -> [ImportSpec l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec l -> Doc
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 ) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
pretty (IAbs l
_ Namespace l
ns Name l
name) = Namespace l -> Doc
forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
pretty (IThingAll l
_ Name l
name) = Name l -> Doc
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) =
Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> ([Doc] -> Doc
parenList ([Doc] -> Doc) -> ([CName l] -> [Doc]) -> [CName l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CName l -> Doc) -> [CName l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CName l -> Doc
forall a. Pretty a => a -> Doc
pretty ([CName l] -> Doc) -> [CName l] -> Doc
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 [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
pat, Doc
equals, Type l -> Doc
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 :: a -> Doc
condBlankline a
d = (if a -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline a
d then Doc -> Doc
blankline else Doc -> Doc
forall a. a -> a
id) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty a
d
ppDecls :: PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls :: Bool -> [a] -> [Doc]
ppDecls Bool
True [a]
ds = (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PrettyDeclLike a => a -> Doc
condBlankline [a]
ds
ppDecls Bool
False (a
d:[a]
ds) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
d Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
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
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
from Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
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
<+> Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind
pretty (TyVarSig l
_ TyVarBind l
tv) = Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> TyVarBind l -> 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", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, Type l -> Doc
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 ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead])
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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 ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, (InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
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", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind ,(InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
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 ((TypeEqn l -> Doc) -> [TypeEqn l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeEqn l -> Doc
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", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
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", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, Type l -> Doc
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 [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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 ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, [FunDep l] -> Doc
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", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
, [FunDep l] -> Doc
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 ([Doc] -> Maybe [Doc] -> [Doc]
forall a. a -> Maybe a -> a
fromMaybe [] ((Bool -> [ClassDecl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) ([ClassDecl l] -> [Doc]) -> Maybe [ClassDecl l] -> Maybe [Doc]
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", (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
moverlap, InstRule l -> Doc
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", (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
, InstRule l -> Doc
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 ([Doc] -> Maybe [Doc] -> [Doc]
forall a. a -> Maybe a -> a
fromMaybe [] ((Bool -> [InstDecl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) ([InstDecl l] -> [Doc]) -> Maybe [InstDecl l] -> Maybe [Doc]
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"
, (DerivStrategy l -> Doc) -> Maybe (DerivStrategy l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP DerivStrategy l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (DerivStrategy l)
mds
, String -> Doc
text String
"instance"
, (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
, InstRule l -> Doc
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 ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
htypes)
pretty (SpliceDecl l
_ Exp l
splice) =
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice
pretty (TSpliceDecl l
_ Exp l
splice) =
Exp l -> Doc
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 ([Doc] -> [Doc]) -> ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Name l]
nameList)
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"::", Type l -> Doc
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 = [(Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
prov, Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs2, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
req]
in
[Doc] -> Doc
mySep ( [String -> Doc
text String
"pattern" ]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
ns)
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ String -> Doc
text String
"::", Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[Doc]
contexts [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t] )
pretty (FunBind l
_ [Match l]
matches) = do
PPLayout
e <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
case PPLayout
e of PPLayout
PPOffsideRule -> (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($$$) Doc
empty ((Match l -> Doc) -> [Match l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Match l -> Doc
forall a. Pretty a => a -> Doc
pretty [Match l]
matches)
PPLayout
_ -> [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi ((Match l -> Doc) -> [Match l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Match l -> Doc
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 [Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs] Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> 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 ([Assoc l -> Doc
forall a. Pretty a => a -> Doc
pretty Assoc l
assoc, (Indent -> Doc) -> Maybe Indent -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Indent -> Doc
int Maybe Indent
prec]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Op l] -> [Doc]) -> [Op l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op l -> Doc) -> [Op l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Op l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Op l] -> [Doc]) -> [Op l] -> [Doc]
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", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
sep, Pat l -> Doc
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 (Bool -> [Decl l] -> [Doc]
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", CallConv l -> Doc
forall a. Pretty a => a -> Doc
pretty CallConv l
cconv, (Safety l -> Doc) -> Maybe (Safety l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Safety l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Safety l)
saf,
Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) Maybe String
str, Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
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", CallConv l -> Doc
forall a. Pretty a => a -> Doc
pretty CallConv l
cconv,
String -> Doc
text (Maybe String -> String
forall a. Show a => a -> String
show Maybe String
str), Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]
pretty (RulePragmaDecl l
_ [Rule l]
rules) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# RULES" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Rule l -> Doc) -> [Rule l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Rule l -> Doc
forall a. Pretty a => a -> Doc
pretty [Rule l]
rules [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]
pretty (DeprPragmaDecl l
_ [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# DEPRECATED" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (([Name l], String) -> Doc) -> [([Name l], String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Name l], String) -> Doc
forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]
pretty (WarnPragmaDecl l
_ [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# WARNING" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (([Name l], String) -> Doc) -> [([Name l], String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Name l], String) -> Doc
forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs [Doc] -> [Doc] -> [Doc]
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")
, (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, QName l -> Doc
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", (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
, QName l -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
types) [Doc] -> [Doc] -> [Doc]
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text (if Bool
inl then String
"INLINE" else String
"NOINLINE"),
(Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
types) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]
pretty (InstSig l
_ InstRule l
irule) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text String
"instance", InstRule l -> Doc
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", Annotation l -> Doc
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' -> BooleanFormula l -> Doc
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", QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Role l -> Doc) -> [Role l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Role l -> Doc
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 ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
cls
ts_p :: Doc
ts_p = Doc -> (QName l -> Doc) -> Maybe (QName l) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\QName l
tc -> String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
tc) Maybe (QName l)
opt_ts
in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# COMPLETE"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
cls_p [Doc] -> [Doc] -> [Doc]
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 [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs
, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
mctxt, InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
qn]
pretty (IParen l
_ InstRule l
ih) = Doc -> Doc
parens (InstRule l -> Doc
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) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn
pretty (IHInfix l
_ Type l
ta QName l
qn) = [Doc] -> Doc
mySep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ta, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn]
pretty (IHParen l
_ InstHead l
ih) = Doc -> Doc
parens (InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih)
pretty (IHApp l
_ InstHead l
ih Type l
t) = [Doc] -> Doc
myFsep [InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih, Type l -> Doc
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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Exp l -> Doc
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", Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (ModuleAnn l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"module", Exp l -> Doc
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) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (AndFormula l
_ [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" ,") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (BooleanFormula l -> Doc) -> [BooleanFormula l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
pretty (OrFormula l
_ [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" |") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (BooleanFormula l -> Doc) -> [BooleanFormula l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
pretty (ParenFormula l
_ BooleanFormula l
b) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ BooleanFormula l -> Doc
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 = [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
l, Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
op, Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
r]
in if [Pat l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
rs'
then [Doc]
hd
else Doc -> Doc
parens ([Doc] -> Doc
myFsep [Doc]
hd) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
rs'
in [Doc] -> Doc
myFsep ([Doc]
lhs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs]) Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> 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 (Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
f Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs])
Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> Doc
forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
whereBinds
ppWhere :: Maybe (Binds l) -> Doc
ppWhere :: 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 (Bool -> [Decl l] -> [Doc]
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 (Bool -> [IPBind l] -> [Doc]
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) = Decl l -> Bool
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) = Decl l -> Doc
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", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
, (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
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", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
, (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, (InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
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", TypeEqn l -> Doc
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",
Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name,
String -> Doc
text String
"::",
Type l -> Doc
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) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (DHInfix l
_ TyVarBind l
tv Name l
n) = TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv Doc -> Doc -> Doc
<+> Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
pretty (DHParen l
_ DeclHead l
d) = Doc -> Doc
parens (DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
d)
pretty (DHApp l
_ DeclHead l
dh TyVarBind l
tv) = DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dh Doc -> Doc -> Doc
<+> TyVarBind l -> 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) = Decl l -> Bool
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) = Decl l -> Doc
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", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, Type l -> Doc
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 [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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 ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
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 (String -> Doc) -> String -> Doc
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 :: ([Name l], String) -> Doc
ppWarnDepr ([Name l]
names, String
txt) = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
tag, (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ,
([RuleVar l] -> Doc) -> Maybe [RuleVar l] -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP [RuleVar l] -> Doc
forall l. [RuleVar l] -> Doc
ppRuleVars Maybe [RuleVar l]
rvs,
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
rhs, Char -> Doc
char Char
'=', Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
lhs]
ppRuleVars :: [RuleVar l] -> Doc
ppRuleVars :: [RuleVar l] -> Doc
ppRuleVars [] = Doc
empty
ppRuleVars [RuleVar l]
rvs = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"forall" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (RuleVar l -> Doc) -> [RuleVar l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RuleVar l -> Doc
forall a. Pretty a => a -> Doc
pretty [RuleVar l]
rvs [Doc] -> [Doc] -> [Doc]
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) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (TypedRuleVar l
_ Name l
n Type l
t) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
mySep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"::", Type l -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# LANGUAGE" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
',') ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
ns) [Doc] -> [Doc] -> [Doc]
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
<> Tool -> 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", Annotation l -> Doc
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Tool -> String
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 [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, ConDecl l -> Doc
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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
Just [FieldDecl l]
ts' ->
[Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::" , Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt,
[Doc] -> Doc
braceList ([Doc] -> Doc) -> ([FieldDecl l] -> [Doc]) -> [FieldDecl l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDecl l -> Doc) -> [FieldDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldDecl l] -> Doc) -> [FieldDecl l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldDecl l]
ts', String -> Doc
text String
"->", Type l -> Doc
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) =
Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> [Doc] -> Doc
braceList ((FieldDecl l -> Doc) -> [FieldDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [FieldDecl l]
fieldList)
pretty (ConDecl l
_ Name l
name [Type l]
typeList) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Type l -> Doc
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 [Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype Type l
l, Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
name,
Indent -> Type l -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Name l]
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[String -> Doc
text String
"::", Type l -> Doc
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'] -> InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
d'
[InstRule l]
_ -> [Doc] -> Doc
parenList ((InstRule l -> Doc) -> [InstRule l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InstRule l -> Doc
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, DerivStrategy l -> Doc
forall a. Pretty a => a -> Doc
pretty DerivStrategy l
via)
Maybe (DerivStrategy l)
_ -> ((DerivStrategy l -> Doc) -> Maybe (DerivStrategy l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP DerivStrategy l -> Doc
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
<+> Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty
ppBType :: Type l -> Doc
ppBType :: Type l -> Doc
ppBType = Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype
ppAType :: Type l -> Doc
ppAType :: Type l -> Doc
ppAType = Indent -> Type l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, Type l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Type l -> Doc
forall l. Type l -> Doc
ppBType Type l
a, String -> Doc
text String
"->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b]
prettyPrec Indent
_ (TyTuple l
_ Boxed
bxd [Type l]
l) =
let ds :: [Doc]
ds = (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
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 ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
es)
prettyPrec Indent
_ (TyList l
_ Type l
t) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
prettyPrec Indent
_ (TyParArray l
_ Type l
t) = [Doc] -> Doc
bracketColonList [Type l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, Type l -> Doc
forall l. Type l -> Doc
ppAType Type l
b]
prettyPrec Indent
_ (TyVar l
_ Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec Indent
_ (TyCon l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (TyParen l
_ Type l
t) = Doc -> Doc
parens (Type l -> Doc
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 [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, MaybePromotedName l -> Doc
forall a. Pretty a => a -> Doc
pretty MaybePromotedName l
op, Type l -> Doc
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 [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
k])
prettyPrec Indent
_ (TyPromoted l
_ Promoted l
p) = Promoted l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) ([Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, String -> Doc
text String
"~", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b])
prettyPrec Indent
_ (TySplice l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (TyBang l
_ BangType l
b Unpackedness l
u Type l
t) = Unpackedness l -> Doc
forall a. Pretty a => a -> Doc
pretty Unpackedness l
u Doc -> Doc -> Doc
<> BangType l -> Doc
forall a. Pretty a => a -> Doc
pretty BangType l
b Doc -> Doc -> Doc
<> Indent -> Type l -> 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
<> (Name l -> Doc) -> Maybe (Name l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Name l)
mn
prettyPrec Indent
_ (TyQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
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
<> QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
q
pretty (UnpromotedName l
_ QName l
q) = QName l -> Doc
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 (Doc -> Doc) -> Doc -> Doc
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 (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn)
PromotedList l
_ Bool
hasQuote [Type l]
list ->
Bool -> Doc -> Doc
addQuote Bool
hasQuote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([Type l] -> [Doc]) -> [Type l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Type l] -> [Doc]) -> [Type l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Type l] -> Doc) -> [Type l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Type l]
list
PromotedTuple l
_ [Type l]
list ->
Bool -> Doc -> Doc
addQuote Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
parenList ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
list
PromotedUnit {} -> Bool -> Doc -> Doc
addQuote Bool
True (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
var, String -> Doc
text String
"::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind]
pretty (UnkindedVar l
_ Name l
var) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
var
ppForall :: Maybe [TyVarBind l] -> Doc
ppForall :: 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" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TyVarBind l -> Doc) -> [TyVarBind l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty [TyVarBind l]
vs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'.'])
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Kind l)
Nothing = []
ppOptKind (Just Kind l
k) = [String -> Doc
text String
"::", Kind l -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
from [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
to
ppFunDeps :: [FunDep l] -> Doc
ppFunDeps :: [FunDep l] -> Doc
ppFunDeps [] = Doc
empty
ppFunDeps [FunDep l]
fds = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'|'Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:) ([Doc] -> [Doc]) -> ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunDep l -> Doc) -> [FunDep l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FunDep l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
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
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedRhss l
_ [GuardedRhs l]
guardList) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([GuardedRhs l] -> [Doc]) -> [GuardedRhs l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs l -> Doc
forall a. Pretty a => a -> Doc
pretty ([GuardedRhs l] -> Doc) -> [GuardedRhs l] -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, Exp l -> Doc
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
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedAlts (GuardedRhss l
_ [GuardedRhs l]
guardList)) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([GuardedRhs l] -> [Doc]) -> [GuardedRhs l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (GuardedAlt l -> Doc
forall a. Pretty a => a -> Doc
pretty (GuardedAlt l -> Doc)
-> (GuardedRhs l -> GuardedAlt l) -> GuardedRhs l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs l -> GuardedAlt l
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) ([GuardedRhs l] -> Doc) -> [GuardedRhs l] -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", Exp l -> Doc
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 (Char -> String
forall a. Show a => a -> String
show Char
c)
pretty (String l
_ String
s String
_) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)
pretty (Frac l
_ Rational
r String
_) = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
pretty (PrimChar l
_ Char
c String
_) = String -> Doc
text (Char -> String
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 (String -> String
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 (Rational -> 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 (Rational -> 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) = Literal l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
2) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Exp l
a, QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op, Indent -> Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> Indent -> Exp l -> 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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
3) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Exp l
a, Indent -> Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
Char -> Doc
char Char
'\\' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
patList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Decl l] -> Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [IPBind l] -> Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [String -> Doc
text String
"if", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond,
String -> Doc
text String
"then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenexp,
String -> Doc
text String
"else", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
elsexp]
prettyPrec Indent
p (MultiIf l
_ [GuardedRhs l]
alts) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"if"
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
multiIfIndent ((GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (GuardedAlt l -> Doc
forall a. Pretty a => a -> Doc
pretty (GuardedAlt l -> Doc)
-> (GuardedRhs l -> GuardedAlt l) -> GuardedRhs l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs l -> GuardedAlt l
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep ([String -> Doc
text String
"case", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond, String -> Doc
text String
"of"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
if [Alt l] -> Bool
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 ((Alt l -> Doc) -> [Alt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
prettyPrec Indent
p (Do l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
prettyPrec Indent
p (MDo l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"mdo" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
prettyPrec Indent
_ (Var l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (OverloadedLabel l
_ String
name) = String -> Doc
text (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String
name)
prettyPrec Indent
_ (IPVar l
_ IPName l
ipname) = IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname
prettyPrec Indent
_ (Con l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec Indent
_ (Tuple l
_ Boxed
bxd [Exp l]
expList) =
let ds :: [Doc]
ds = (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
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) =
Indent -> Indent -> Exp l -> Doc
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 = (Maybe (Exp l) -> Doc) -> [Maybe (Exp l)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp l -> Doc) -> Maybe (Exp l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Exp l -> Doc
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 (Doc -> Doc) -> (Exp l -> Doc) -> Exp l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty (Exp l -> Doc) -> Exp l -> Doc
forall a b. (a -> b) -> a -> b
$ Exp l
e
prettyPrec Indent
_ (LeftSection l
_ Exp l
e QOp l
op) = Doc -> Doc
parens (Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<+> QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op)
prettyPrec Indent
_ (RightSection l
_ QOp l
op Exp l
e) = Doc -> Doc
parens (QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e)
prettyPrec Indent
_ (RecConstr l
_ QName l
c [FieldUpdate l]
fieldList) =
QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([FieldUpdate l] -> [Doc]) -> [FieldUpdate l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldUpdate l -> Doc) -> [FieldUpdate l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldUpdate l] -> Doc) -> [FieldUpdate l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
prettyPrec Indent
_ (RecUpdate l
_ Exp l
e [FieldUpdate l]
fieldList) =
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([FieldUpdate l] -> [Doc]) -> [FieldUpdate l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldUpdate l -> Doc) -> [FieldUpdate l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldUpdate l] -> Doc) -> [FieldUpdate l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
prettyPrec Indent
_ (List l
_ [Exp l]
list) =
[Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([Exp l] -> [Doc]) -> [Exp l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Exp l] -> [Doc]) -> [Exp l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Exp l] -> Doc) -> [Exp l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Exp l]
list
prettyPrec Indent
_ (ParArray l
_ [Exp l]
arr) =
[Doc] -> Doc
bracketColonList ([Doc] -> Doc) -> ([Exp l] -> [Doc]) -> [Exp l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Exp l] -> Doc) -> [Exp l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Exp l]
arr
prettyPrec Indent
_ (EnumFrom l
_ Exp l
e) =
[Doc] -> Doc
bracketList [Exp l -> Doc
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 [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (EnumFromThen l
_ Exp l
from Exp l
thenE) =
[Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
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 [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (ParArrayFromTo l
_ Exp l
from Exp l
to) =
[Doc] -> Doc
bracketColonList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", Exp l -> Doc
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 [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec Indent
_ (ListComp l
_ Exp l
e [QualStmt l]
qualList) =
[Doc] -> Doc
bracketList ([Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
'|']
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
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
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ([QualStmt l] -> Doc) -> [[QualStmt l]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
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
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ([QualStmt l] -> Doc) -> [[QualStmt l]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
prettyPrec Indent
_ (BracketExp l
_ Bracket l
b) = Bracket l -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket l
b
prettyPrec Indent
_ (SpliceExp l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (TypQuote l
_ QName l
t) = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> QName l -> 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
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
x
prettyPrec Indent
_ (QuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
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 = [Doc] -> (Exp l -> [Doc]) -> Maybe (Exp l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp l -> Doc) -> Exp l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr l -> Doc) -> [XAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp l]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName l -> 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 = [Doc] -> (Exp l -> [Doc]) -> Maybe (Exp l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp l -> Doc) -> Exp l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr l -> Doc) -> [XAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
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
"<%", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"%>"]
prettyPrec Indent
_ (XChildTag l
_ [Exp l]
cs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp l]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]
prettyPrec Indent
_ (CorePragma l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec Indent
_ (SCCPragma l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
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
"#-}", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [String -> Doc
text String
"proc", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"->", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">-", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<<", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">>-", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec Indent
_ (ArrOp l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", Exp l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep (String -> Doc
text String
"\\case"Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
if [Alt l] -> Bool
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 ((Alt l -> Doc) -> [Alt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
prettyPrec Indent
_ (TypeApp l
_ Type l
ty) = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty
printUnboxedSum :: Pretty e => Int -> Int -> e -> Doc
printUnboxedSum :: Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after e
exp =
Doc -> Doc
hashParens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Indent -> Doc -> [Doc]
forall a. Indent -> a -> [a]
replicate Indent
before (String -> Doc
text String
"|")
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [e -> Doc
forall a. Pretty a => a -> Doc
pretty e
exp]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Indent -> Doc -> [Doc]
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 [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', Exp l -> Doc
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 :: [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 (Bool -> [a] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [a]
l),
String -> Doc
text String
"in", b -> Doc
forall a. Pretty a => a -> Doc
pretty b
b]
instance Pretty (Bracket l) where
pretty :: Bracket l -> Doc
pretty (ExpBracket l
_ Exp l
e) = String -> Exp l -> Doc
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
"[||", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"||]"]
pretty (PatBracket l
_ Pat l
p) = String -> Pat l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket String
"[p|" Pat l
p
pretty (TypeBracket l
_ Type l
t) = String -> Type l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket String
"[t|" Type l
t
pretty (DeclBracket l
_ [Decl l]
d) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"[d|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [Decl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
True [Decl l]
d [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|]"]
ppBracket :: Pretty a => String -> a -> Doc
ppBracket :: String -> a -> Doc
ppBracket String
o a
x = [Doc] -> Doc
myFsep [String -> Doc
text String
o, a -> Doc
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
"$$(", Exp l -> Doc
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
"$(", Exp l -> Doc
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) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec Indent
_ (PLit l
_ (Signless {}) Literal l
lit) = Literal l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> Literal l -> 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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Pat l
a, QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty (l -> QName l -> QOp l
forall l. l -> QName l -> QOp l
QConOp l
l QName l
op), Indent -> Pat l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Pat l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
ps)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
n Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
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 = (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
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) =
Indent -> Indent -> Pat l -> Doc
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 ([Doc] -> Doc) -> ([Pat l] -> [Doc]) -> [Pat l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Pat l] -> [Doc]) -> [Pat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Pat l] -> Doc) -> [Pat l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Pat l]
ps
prettyPrec Indent
_ (PParen l
_ Pat l
pat) = Doc -> Doc
parens (Doc -> Doc) -> (Pat l -> Doc) -> Pat l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty (Pat l -> Doc) -> Pat l -> Doc
forall a b. (a -> b) -> a -> b
$ Pat l
pat
prettyPrec Indent
_ (PRec l
_ QName l
c [PatField l]
fields) =
QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc) -> ([PatField l] -> [Doc]) -> [PatField l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatField l -> Doc) -> [PatField l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatField l -> Doc
forall a. Pretty a => a -> Doc
pretty ([PatField l] -> Doc) -> [PatField l] -> Doc
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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Indent -> Pat l -> 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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, Char -> Doc
char Char
'@', Indent -> Pat l -> Doc
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
<> Indent -> Pat l -> 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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"::", Type l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"->", Pat l -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"+", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
k]
prettyPrec Indent
_ (PRPat l
_ [RPat l]
rs) =
[Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([RPat l] -> [Doc]) -> [RPat l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([RPat l] -> Doc) -> [RPat l] -> Doc
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 = [Doc] -> (Pat l -> [Doc]) -> Maybe (Pat l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Pat l -> Doc) -> Pat l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PXAttr l -> Doc) -> [PXAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PXAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ap [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty [Pat l]
cp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName l -> 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 = [Doc] -> (Pat l -> [Doc]) -> Maybe (Pat l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Pat l -> Doc) -> Pat l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PXAttr l -> Doc) -> [PXAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PXAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ap [Doc] -> [Doc] -> [Doc]
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
"<%", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p, String -> Doc
text String
"%>"]
prettyPrec Indent
_ (PXRPats l
_ [RPat l]
ps) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty [RPat l]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
prettyPrec Indent
_ (PBangPat l
_ Pat l
pat) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat
prettyPrec Indent
_ (PSplice l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec Indent
_ (PQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
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 [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', Pat l -> Doc
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 [QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat]
pretty (PFieldPun l
_ QName l
name) = QName l -> Doc
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) = RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r Doc -> Doc -> Doc
<> RPatOp l -> Doc
forall a. Pretty a => a -> Doc
pretty RPatOp l
op
pretty (RPEither l
_ RPat l
r1 RPat l
r2) = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
[RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r1, Char -> Doc
char Char
'|', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r2]
pretty (RPSeq l
_ [RPat l]
rs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [RPat l]
rs)
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (RPGuard l
_ Pat l
r [Stmt l]
gs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
r Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
gs) [Doc] -> [Doc] -> [Doc]
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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPCAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"@:", RPat l -> Doc
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 [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Char -> Doc
char Char
'@', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
pretty (RPPat l
_ Pat l
p) = Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p
pretty (RPParen l
_ RPat l
rp) = Doc -> Doc
parens (Doc -> Doc) -> (RPat l -> Doc) -> RPat l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty (RPat l -> Doc) -> RPat l -> Doc
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) =
Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> GuardedAlts l -> Doc
forall a. Pretty a => a -> Doc
pretty (Rhs l -> GuardedAlts l
forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs l
gAlts) Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> 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) =
Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"<-" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from
pretty (Qualifier l
_ Exp l
e) = Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (LetStmt l
_ (BDecls l
_ [Decl l]
declList)) =
[Decl l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [Decl l]
declList
pretty (LetStmt l
_ (IPBinds l
_ [IPBind l]
bindList)) =
[IPBind l] -> Doc
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 ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
ppLetStmt :: Pretty a => [a] -> Doc
ppLetStmt :: [a] -> Doc
ppLetStmt [a]
l = String -> Doc
text String
"let" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
l)
instance Pretty (QualStmt l) where
pretty :: QualStmt l -> Doc
pretty (QualStmt l
_ Stmt l
s) = Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt l
s
pretty (ThenTrans l
_ Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", Exp l -> Doc
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", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f, String -> Doc
text String
"by", Exp l -> Doc
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", Exp l -> Doc
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", Exp l -> Doc
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",
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"using", Exp l -> Doc
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 [QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (FieldPun l
_ QName l
name) = QName l -> Doc
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) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n
pretty (QConOp l
_ QName l
n) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n
ppQNameInfix :: QName l -> Doc
ppQNameInfix :: QName l -> Doc
ppQNameInfix QName l
name
| QName l -> Bool
forall l. QName l -> Bool
isSymbolQName QName l
name = QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name
| Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> QName l -> 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
<+> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
QName l
_ -> Bool -> Doc -> Doc
parensIf (QName l -> Bool
forall l. QName l -> Bool
isSymbolQName QName l
name) (QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name)
ppQName :: QName l -> Doc
ppQName :: QName l -> Doc
ppQName (UnQual l
_ Name l
name) = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Qual l
_ ModuleName l
m Name l
name) = ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Special l
_ SpecialCon l
sym) = SpecialCon l -> Doc
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) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
pretty (ConOp l
_ Name l
n) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
ppNameInfix :: Name l -> Doc
ppNameInfix :: Name l -> Doc
ppNameInfix Name l
name
| Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
name = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
| Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> Name l -> 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
<+> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
Name l
_ -> Bool -> Doc -> Doc
parensIf (Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
name) (Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name)
ppName :: Name l -> Doc
ppName :: 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 [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname, Doc
equals, Exp l -> Doc
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) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (ConName l
_ Name l
n) = Name l -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<>) Doc
empty (Indent -> Doc -> [Doc]
forall a. Indent -> a -> [a]
replicate (Indent
nIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
-Indent
1) Doc
comma)
where listFun :: Doc -> Doc
listFun = if Boxed
b Boxed -> Boxed -> Bool
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 :: Name l -> Bool
isSymbolName (Symbol {}) = Bool
True
isSymbolName Name l
_ = Bool
False
isSymbolQName :: QName l -> Bool
isSymbolQName :: QName l -> Bool
isSymbolQName (UnQual l
_ Name l
n) = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual l
_ ModuleName l
_ Name l
n) = Name l -> Bool
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) = Asst l -> Doc
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 ((Asst l -> Doc) -> [Asst l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Asst l -> Doc
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) = Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
pretty (IParam l
_ IPName l
i Type l
t) = [Doc] -> Doc
myFsep [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
i, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
pretty (ParenA l
_ Asst l
a) = Doc -> Doc
parens (Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty Asst l
a)
instance Pretty SrcLoc where
pretty :: SrcLoc -> Doc
pretty SrcLoc
srcLoc =
Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hcat [ Doc -> Doc
colonFollow (String -> Doc
P.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcFilename SrcLoc
srcLoc)
, Doc -> Doc
colonFollow (Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Indent
srcLine SrcLoc
srcLoc)
, Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
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 =
Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hsep [ Doc -> Doc
colonFollow (String -> Doc
P.text (String -> Doc) -> String -> Doc
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 (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanStartLine SrcSpan
srcSpan
, Doc
P.colon
, Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
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 (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanEndLine SrcSpan
srcSpan
, Doc
P.colon
, Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(case Maybe (ModuleHead pos)
mbHead of
Maybe (ModuleHead pos)
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
Just ModuleHead pos
h -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (ModuleHead pos -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
((ImportDecl pos -> Doc) -> [ImportDecl pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
Bool -> [Decl pos] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (Maybe (ModuleHead pos) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
||
Bool -> Bool
not ([ImportDecl pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
||
Bool -> Bool
not ([ModulePragma pos] -> Bool
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[let ax :: [Doc]
ax = [Doc] -> (Exp pos -> [Doc]) -> Maybe (Exp pos) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp pos -> Doc) -> Exp pos -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr pos -> Doc) -> [XAttr pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr pos -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Exp pos -> Doc) -> [Exp pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName pos -> 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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"<%"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(case Maybe (ModuleHead pos)
mbHead of
Maybe (ModuleHead pos)
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
Just ModuleHead pos
h -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (ModuleHead pos -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
((ImportDecl pos -> Doc) -> [ImportDecl pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
Bool -> [Decl pos] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (Maybe (ModuleHead pos) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
|| Bool -> Bool
not ([ImportDecl pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
|| Bool -> Bool
not ([ModulePragma pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma pos]
os)) [Decl pos]
decls [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[let ax :: [Doc]
ax = [Doc] -> (Exp pos -> [Doc]) -> Maybe (Exp pos) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp pos -> Doc) -> Exp pos -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr pos -> Doc) -> [XAttr pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr pos -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Exp pos -> Doc) -> [Exp pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char Char
'>']]])
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: (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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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 (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple
bracketColonList :: [Doc] -> Doc
bracketColonList :: [Doc] -> Doc
bracketColonList = Doc -> Doc
bracketColons (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple
where bracketColons :: Doc -> Doc
bracketColons = Doc -> Doc
brackets (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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<-DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;if PPHsMode -> Bool
spacing PPHsMode
e Bool -> Bool -> Bool
&& PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
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 <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
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 <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
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 <-(PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl}
indentExplicit :: Doc
indentExplicit = do {Indent
i <- (PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;
Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
prettyBlock ([Doc] -> Doc) -> [Doc] -> Doc
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 <- (PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl
($$$) :: Doc -> Doc -> Doc
Doc
a $$$ :: Doc -> Doc -> Doc
$$$ Doc
b = (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
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 = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
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' [] = String -> Doc
forall a. HasCallStack => String -> a
error String
"Internal error: mySep"
myVcat :: [Doc] -> Doc
myVcat :: [Doc] -> Doc
myVcat = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
vcat [Doc] -> Doc
hsep
myFsepSimple :: [Doc] -> Doc
myFsepSimple :: [Doc] -> Doc
myFsepSimple = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
fsep [Doc] -> Doc
hsep
myFsep :: [Doc] -> Doc
myFsep :: [Doc] -> Doc
myFsep = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
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 <- DocM PPHsMode PPHsMode
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
dDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds))
layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice a -> Doc
a a -> Doc
b a
dl = do PPHsMode
e <- DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
if PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
forall a. Eq a => a -> a -> Bool
== PPLayout
PPOffsideRule Bool -> Bool -> Bool
||
PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
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) = Literal loc -> Doc
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 [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
a, QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
b]
pretty (P.NegApp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [Char -> Doc
char Char
'-', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.App loc
_ PExp loc
a PExp loc
b) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
a, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
b]
pretty (P.Lambda loc
_loc [Pat loc]
expList PExp loc
ppBody') = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
Char -> Doc
char Char
'\\' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat loc -> Doc) -> [Pat loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Pat loc]
expList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
ppBody']
pretty (P.Let loc
_ (BDecls loc
_ [Decl loc]
declList) PExp loc
letBody) =
[Decl loc] -> PExp loc -> Doc
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) =
[IPBind loc] -> PExp loc -> Doc
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", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond,
String -> Doc
text String
"then", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenexp,
String -> Doc
text String
"else", PExp loc -> Doc
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 ((GuardedRhs loc -> Doc) -> [GuardedRhs loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs loc -> Doc
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", PExp loc -> Doc
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 ((Alt loc -> Doc) -> [Alt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt loc -> Doc
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 ((Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
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 ((Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt loc]
stmtList)
pretty (P.Var loc
_ QName loc
name) = QName loc -> Doc
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) = IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
ipname
pretty (P.Con loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.TupleSection loc
_ Boxed
bxd [Maybe (PExp loc)]
mExpList) =
let ds :: [Doc]
ds = (Maybe (PExp loc) -> Doc) -> [Maybe (PExp loc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((PExp loc -> Doc) -> Maybe (PExp loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP PExp loc -> Doc
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) =
Indent -> Indent -> PExp loc -> Doc
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 (Doc -> Doc) -> (PExp loc -> Doc) -> PExp loc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty (PExp loc -> Doc) -> PExp loc -> Doc
forall a b. (a -> b) -> a -> b
$ PExp loc
e
pretty (P.RecConstr loc
_ QName loc
c [PFieldUpdate loc]
fieldList) =
QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([PFieldUpdate loc] -> [Doc]) -> [PFieldUpdate loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PFieldUpdate loc -> Doc) -> [PFieldUpdate loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PFieldUpdate loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PFieldUpdate loc] -> Doc) -> [PFieldUpdate loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
pretty (P.RecUpdate loc
_ PExp loc
e [PFieldUpdate loc]
fieldList) =
PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([PFieldUpdate loc] -> [Doc]) -> [PFieldUpdate loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PFieldUpdate loc -> Doc) -> [PFieldUpdate loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PFieldUpdate loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PFieldUpdate loc] -> Doc) -> [PFieldUpdate loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
pretty (P.List loc
_ [PExp loc]
list) =
[Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> Doc) -> [PExp loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc]
list
pretty (P.ParArray loc
_ [PExp loc]
arr) =
[Doc] -> Doc
bracketColonList ([Doc] -> Doc) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> Doc) -> [PExp loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc]
arr
pretty (P.EnumFrom loc
_ PExp loc
e) =
[Doc] -> Doc
bracketList [PExp loc -> Doc
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 [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.EnumFromThen loc
_ PExp loc
from PExp loc
thenE) =
[Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
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 [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParArrayFromTo loc
_ PExp loc
from PExp loc
to) =
[Doc] -> Doc
bracketColonList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", PExp loc -> Doc
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 [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParComp loc
_ PExp loc
e [[QualStmt loc]]
qualLists) =
[Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QualStmt loc] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QualStmt loc -> Doc) -> [QualStmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty) ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualLists))
pretty (P.ParArrayComp loc
_ PExp loc
e [[QualStmt loc]]
qualArrs) =
[Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QualStmt loc] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QualStmt loc -> Doc) -> [QualStmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty) ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualArrs))
pretty (P.ExpTypeSig loc
_pos PExp loc
e Type loc
ty) =
[Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"::", Type loc -> Doc
forall a. Pretty a => a -> Doc
pretty Type loc
ty]
pretty (P.BracketExp loc
_ Bracket loc
b) = Bracket loc -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket loc
b
pretty (P.SpliceExp loc
_ Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
pretty (P.TypQuote loc
_ QName loc
t) = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> QName loc -> 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
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
x
pretty (P.QuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
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 = [Doc] -> (PExp loc -> [Doc]) -> Maybe (PExp loc) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (PExp loc -> Doc) -> PExp loc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (ParseXAttr loc -> Doc) -> [ParseXAttr loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ParseXAttr loc -> Doc
forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName loc -> 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 = [Doc] -> (PExp loc -> [Doc]) -> Maybe (PExp loc) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (PExp loc -> Doc) -> PExp loc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (ParseXAttr loc -> Doc) -> [ParseXAttr loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ParseXAttr loc -> Doc
forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
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
"<%", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"%>"]
pretty (P.XChildTag loc
_ [PExp loc]
es) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
es [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]
pretty (P.CorePragma loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.SCCPragma loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
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
"#-}", PExp loc -> Doc
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", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p, String -> Doc
text String
"->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.LeftArrApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.LeftArrHighApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrHighApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">>-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.ArrOp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", PExp loc -> Doc
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 [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
pretty (P.AsPat loc
_ Name loc
name PExp loc
pat) =
[Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name, Char -> Doc
char Char
'@', PExp loc -> Doc
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
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat
pretty (P.PostOp loc
_ PExp loc
e QOp loc
op) = PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<+> QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op
pretty (P.PreOp loc
_ QOp loc
op PExp loc
e) = QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op Doc -> Doc -> Doc
<+> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e
pretty (P.ViewPat loc
_ PExp loc
e Pat loc
p) =
[Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"->", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p]
pretty (P.SeqRP loc
_ [PExp loc]
rs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [PExp loc]
rs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (P.GuardRP loc
_ PExp loc
r [Stmt loc]
gs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
(Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt loc] -> [Doc]) -> [Stmt loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt loc] -> [Doc]) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt loc]
gs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
pretty (P.EitherRP loc
_ PExp loc
r1 PExp loc
r2) = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r1, Char -> Doc
char Char
'|', PExp loc -> Doc
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 [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.CAsRP loc
_ Name loc
n PExp loc
r) = [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n, String -> Doc
text String
"@:", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.XRPats loc
_ [PExp loc]
ps) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
pretty (P.BangPat loc
_ PExp loc
e) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> PExp loc -> 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 ((Alt loc -> Doc) -> [Alt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt loc]
altList)
pretty (P.TypeApp loc
_ Type loc
ty) = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> Type loc -> 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 [QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name, Doc
equals, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.FieldPun loc
_ QName loc
name) = QName loc -> Doc
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 [XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char Char
'=', PExp loc -> Doc
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 [PAsst loc -> Doc
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 ((PAsst loc -> Doc) -> [PAsst loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PAsst loc -> Doc
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) = PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
pretty (P.IParam loc
_ IPName loc
i PType loc
t) = [Doc] -> Doc
myFsep [IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
i, String -> Doc
text String
"::", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
pretty (P.ParenA loc
_ PAsst loc
a) = Doc -> Doc
parens (PAsst loc -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Maybe [TyVarBind loc] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind loc]
mtvs, (PContext loc -> Doc) -> Maybe (PContext loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP PContext loc -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (PContext loc)
ctxt, PType loc -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [Indent -> PType loc -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype PType loc
a, String -> Doc
text String
"->", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec Indent
_ (P.TyTuple loc
_ Boxed
bxd [PType loc]
l) =
let ds :: [Doc]
ds = (PType loc -> Doc) -> [PType loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PType loc -> Doc
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 ((PType loc -> Doc) -> [PType loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PType loc]
es)
prettyPrec Indent
_ (P.TyList loc
_ PType loc
t) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
prettyPrec Indent
_ (P.TyParArray loc
_ PType loc
t) = [Doc] -> Doc
bracketColonList [PType loc -> Doc
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 Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, Indent -> PType loc -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype PType loc
b]
prettyPrec Indent
_ (P.TyVar loc
_ Name loc
name) = Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name
prettyPrec Indent
_ (P.TyCon loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
prettyPrec Indent
_ (P.TyParen loc
_ PType loc
t) = Doc -> Doc
parens (PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t)
prettyPrec Indent
_ (P.TyPred loc
_ PAsst loc
asst) = PAsst loc -> Doc
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 [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, MaybePromotedName loc -> Doc
forall a. Pretty a => a -> Doc
pretty MaybePromotedName loc
op, PType loc -> Doc
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 [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t, String -> Doc
text String
"::", Kind loc -> Doc
forall a. Pretty a => a -> Doc
pretty Kind loc
k])
prettyPrec Indent
_ (P.TyPromoted loc
_ Promoted loc
p) = Promoted loc -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted loc
p
prettyPrec Indent
_ (P.TyEquals loc
_ PType loc
a PType loc
b) = [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, String -> Doc
text String
"~", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec Indent
_ (P.TySplice loc
_ Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
prettyPrec Indent
_ (P.TyBang loc
_ BangType loc
b Unpackedness loc
u PType loc
t) = Unpackedness loc -> Doc
forall a. Pretty a => a -> Doc
pretty Unpackedness loc
u Doc -> Doc -> Doc
<+> BangType loc -> Doc
forall a. Pretty a => a -> Doc
pretty BangType loc
b Doc -> Doc -> Doc
<> Indent -> PType loc -> 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
<> (Name loc -> Doc) -> Maybe (Name loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Name loc)
mn
prettyPrec Indent
_ (P.TyQuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")