{-# 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 = 8,
doIndent :: Indent
doIndent = 3,
multiIfIndent :: Indent
multiIfIndent = 3,
caseIndent :: Indent
caseIndent = 4,
letIndent :: Indent
letIndent = 4,
whereIndent :: Indent
whereIndent = 6,
onsideIndent :: Indent
onsideIndent = 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 f :: a -> b
f xs :: 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 m :: DocM s a
m k :: 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
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
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 m :: DocM s a
m k :: 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
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of _ -> 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
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 f :: 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 0
prettyPrec _ = 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 i :: Indent
i m :: 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 d :: 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 d :: 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 d :: 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 d :: 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 True = Doc -> Doc
parens
parensIf 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
aM :: Doc
aM <> :: Doc -> Doc -> Doc
<> bM :: 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)}
aM :: Doc
aM <+> :: Doc -> Doc -> Doc
<+> bM :: 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)}
aM :: Doc
aM $$ :: Doc -> Doc -> Doc
$$ bM :: 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
aM :: Doc
aM $+$ :: Doc -> Doc -> Doc
$+$ bM :: 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 dl :: [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 dl :: [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 dl :: [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 dl :: [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 _ [] = []
punctuate p :: Doc
p (d1 :: Doc
d1:ds :: [Doc]
ds) = Doc -> [Doc] -> [Doc]
go Doc
d1 [Doc]
ds
where
go :: Doc -> [Doc] -> [Doc]
go d :: Doc
d [] = [Doc
d]
go d :: Doc
d (e :: Doc
e:es :: [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 ppStyle :: Style
ppStyle ppMode :: PPHsMode
ppMode d :: 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 ppStyle :: Style
ppStyle ppMode :: 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 pphs :: PPHsMode
pphs doc :: 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 _ m :: ModuleName l
m mbWarn :: Maybe (WarningText l)
mbWarn mbExportList :: Maybe (ExportSpecList l)
mbExportList) =
[Doc] -> Doc
mySep [
String -> Doc
text "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 "where"]
instance Pretty (ExportSpecList l) where
pretty :: ExportSpecList l -> Doc
pretty (ExportSpecList _ especs :: [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 _ s :: String
s) = [Doc] -> Doc
mySep [String -> Doc
text "{-# DEPRECATED", String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text "#-}"]
ppWarnTxt (WarnText _ s :: String
s) = [Doc] -> Doc
mySep [String -> Doc
text "{-# WARNING", String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text "#-}"]
instance Pretty (ModuleName l) where
pretty :: ModuleName l -> Doc
pretty (ModuleName _ modName :: 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 "type"
pretty PatternNamespace {} = String -> Doc
text "pattern"
instance Pretty (ExportSpec l) where
pretty :: ExportSpec l -> Doc
pretty (EVar _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (EAbs _ ns :: Namespace l
ns name :: 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 _ wc :: EWildcard l
wc name :: QName l
name nameList :: [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 _ n :: Indent
n ->
let (before :: [Doc]
before,after :: [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 ".."] [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 _ m :: ModuleName l
m) = String -> Doc
text "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 _ m :: ModuleName l
m qual :: Bool
qual src :: Bool
src safe :: Bool
safe mbPkg :: Maybe String
mbPkg mbName :: Maybe (ModuleName l)
mbName mbSpecs :: Maybe (ImportSpecList l)
mbSpecs) =
[Doc] -> Doc
mySep [String -> Doc
text "import",
if Bool
src then String -> Doc
text "{-# SOURCE #-}" else Doc
empty,
if Bool
safe then String -> Doc
text "safe" else Doc
empty,
if Bool
qual then String -> Doc
text "qualified" else Doc
empty,
(String -> Doc) -> Maybe String -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\s :: 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 (\m' :: ModuleName l
m' -> String -> Doc
text "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 _ b :: Bool
b ispecs :: [ImportSpec l]
ispecs) =
(if Bool
b then String -> Doc
text "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 _ name :: Name l
name ) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
pretty (IAbs _ ns :: Namespace l
ns name :: 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 _ name :: Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> String -> Doc
text "(..)"
pretty (IThingWith _ name :: Name l
name nameList :: [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 _ pat :: Type l
pat eqn :: 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 _ = Bool
True
condBlankline :: PrettyDeclLike a => a -> Doc
condBlankline :: a -> Doc
condBlankline d :: 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 True ds :: [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 False (d :: a
d:ds :: [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 _ _ = []
instance Pretty (InjectivityInfo l) where
pretty :: InjectivityInfo l -> Doc
pretty (InjectivityInfo _ from :: Name l
from to :: [Name l]
to) =
Char -> Doc
char '|' Doc -> Doc -> Doc
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
from Doc -> Doc -> Doc
<+> String -> Doc
text "->" 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 _ kind :: Kind l
kind) = String -> Doc
text "::" Doc -> Doc -> Doc
<+> Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind
pretty (TyVarSig _ tv :: TyVarBind l
tv) = Char -> Doc
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 _ dHead :: DeclHead l
dHead htype :: Type l
htype) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 _ don :: DataOrNew l
don context :: Maybe (Context l)
context dHead :: DeclHead l
dHead constrList :: [QualConDecl l]
constrList derives :: [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 '|'))
((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 _ don :: DataOrNew l
don context :: Maybe (Context l)
context dHead :: DeclHead l
dHead optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [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 "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 _ dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj) =
[Doc] -> Doc
mySep ([String -> Doc
text "type", String -> Doc
text "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 _ dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj eqns :: [TypeEqn l]
eqns) =
[Doc] -> Doc
mySep ([String -> Doc
text "type", String -> Doc
text "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 "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind) =
[Doc] -> Doc
mySep ( [String -> Doc
text "data", String -> Doc
text "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 _ ntype :: Type l
ntype htype :: Type l
htype) =
[Doc] -> Doc
mySep [String -> Doc
text "type", String -> Doc
text "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 _ don :: DataOrNew l
don ntype :: Type l
ntype constrList :: [QualConDecl l]
constrList derives :: [Deriving l]
derives) =
[Doc] -> Doc
mySep [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text "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 '|'))
((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 _ don :: DataOrNew l
don ntype :: Type l
ntype optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [Deriving l]
derives) =
[Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text "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 "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead fundeps :: [FunDep l]
fundeps Nothing) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead fundeps :: [FunDep l]
fundeps declList :: Maybe [ClassDecl l]
declList) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 "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 _ moverlap :: Maybe (Overlap l)
moverlap iHead :: InstRule l
iHead Nothing) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 _ overlap :: Maybe (Overlap l)
overlap iHead :: InstRule l
iHead declList :: Maybe [InstDecl l]
declList) =
[Doc] -> Doc
mySep ( [ String -> Doc
text "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 "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 _ mds :: Maybe (DerivStrategy l)
mds overlap :: Maybe (Overlap l)
overlap irule :: InstRule l
irule) =
[Doc] -> Doc
mySep ( [ String -> Doc
text "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 "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 _ htypes :: [Type l]
htypes) =
String -> Doc
text "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 _ splice :: Exp l
splice) =
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice
pretty (TSpliceDecl _ splice :: Exp l
splice) =
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice
pretty (TypeSig _ nameList :: [Name l]
nameList qualType :: 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
qualType])
pretty (PatSynSig _ ns :: [Name l]
ns mtvs :: Maybe [TyVarBind l]
mtvs prov :: Maybe (Context l)
prov mtvs2 :: Maybe [TyVarBind l]
mtvs2 req :: Maybe (Context l)
req t :: 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 "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 "::", 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 _ matches :: [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 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)
_ -> [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 _ pat :: Pat l
pat rhs :: Rhs l
rhs whereBinds :: 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 _ assoc :: Assoc l
assoc prec :: Maybe Indent
prec opList :: [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 _ pat :: Pat l
pat rhs :: Pat l
rhs dir :: PatternSynDirection l
dir) =
let sep :: String
sep = case PatternSynDirection l
dir of
ImplicitBidirectional {} -> "="
ExplicitBidirectional {} -> "<-"
Unidirectional {} -> "<-"
in
([Doc] -> Doc
mySep ([String -> Doc
text "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 _ ds :: [Decl l]
ds ->
Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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))
_ -> Doc
empty)
pretty (ForImp _ cconv :: CallConv l
cconv saf :: Maybe (Safety l)
saf str :: Maybe String
str name :: Name l
name typ :: Type l
typ) =
[Doc] -> Doc
mySep [String -> Doc
text "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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]
pretty (ForExp _ cconv :: CallConv l
cconv str :: Maybe String
str name :: Name l
name typ :: Type l
typ) =
[Doc] -> Doc
mySep [String -> Doc
text "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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]
pretty (RulePragmaDecl _ rules :: [Rule l]
rules) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]
pretty (DeprPragmaDecl _ deprs :: [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]
pretty (WarnPragmaDecl _ deprs :: [([Name l], String)]
deprs) =
[Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]
pretty (InlineSig _ inl :: Bool
inl activ :: Maybe (Activation l)
activ name :: QName l
name) =
[Doc] -> Doc
mySep [String -> Doc
text (if Bool
inl then "{-# INLINE" else "{-# 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 "#-}"]
pretty (InlineConlikeSig _ activ :: Maybe (Activation l)
activ name :: QName l
name) =
[Doc] -> Doc
mySep [ String -> Doc
text "{-# 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 "#-}"]
pretty (SpecSig _ activ :: Maybe (Activation l)
activ name :: QName l
name types :: [Type l]
types) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "{-# 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 "::"]
[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 "#-}"]
pretty (SpecInlineSig _ inl :: Bool
inl activ :: Maybe (Activation l)
activ name :: QName l
name types :: [Type l]
types) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "{-# SPECIALISE", String -> Doc
text (if Bool
inl then "INLINE" else "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 "::"]
[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 "#-}"]
pretty (InstSig _ irule :: InstRule l
irule) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text "{-# SPECIALISE", String -> Doc
text "instance", InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
irule
, String -> Doc
text "#-}"]
pretty (AnnPragma _ annp :: Annotation l
annp) =
[Doc] -> Doc
mySep [String -> Doc
text "{-# ANN", Annotation l -> Doc
forall a. Pretty a => a -> Doc
pretty Annotation l
annp, String -> Doc
text "#-}"]
pretty (MinimalPragma _ b :: Maybe (BooleanFormula l)
b) =
let bs :: Doc
bs = case Maybe (BooleanFormula l)
b of { Just b' :: BooleanFormula l
b' -> BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty BooleanFormula l
b'; _ -> Doc
empty }
in [Doc] -> Doc
myFsep [String -> Doc
text "{-# MINIMAL", Doc
bs, String -> Doc
text "#-}"]
pretty (RoleAnnotDecl _ qn :: QName l
qn rs :: [Role l]
rs) =
[Doc] -> Doc
mySep ( [String -> Doc
text "type", String -> Doc
text "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 _ cls :: [Name l]
cls opt_ts :: 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 (\tc :: QName l
tc -> String -> Doc
text "::" 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 "{-# 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 "#-}"]
instance Pretty (InstRule l) where
pretty :: InstRule l -> Doc
pretty (IRule _ tvs :: Maybe [TyVarBind l]
tvs mctxt :: Maybe (Context l)
mctxt qn :: 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 _ ih :: 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 _ qn :: QName l
qn) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn
pretty (IHInfix _ ta :: Type l
ta qn :: 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 _ ih :: InstHead l
ih) = Doc -> Doc
parens (InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih)
pretty (IHApp _ ih :: InstHead l
ih t :: 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 _ n :: Name l
n e :: 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 _ n :: Name l
n e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "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 _ e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "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 _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (AndFormula _ bs :: [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text " ,") ([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 _ bs :: [BooleanFormula l]
bs) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text " |") ([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 _ b :: 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 '_'
pretty Nominal{} = String -> Doc
text "nominal"
pretty Representational{} = String -> Doc
text "representational"
pretty Phantom{} = String -> Doc
text "phantom"
instance Pretty (DataOrNew l) where
pretty :: DataOrNew l -> Doc
pretty DataType{} = String -> Doc
text "data"
pretty NewType{} = String -> Doc
text "newtype"
instance Pretty (Assoc l) where
pretty :: Assoc l -> Doc
pretty AssocNone{} = String -> Doc
text "infix"
pretty AssocLeft{} = String -> Doc
text "infixl"
pretty AssocRight{} = String -> Doc
text "infixr"
instance Pretty (Match l) where
pretty :: Match l -> Doc
pretty (InfixMatch _ l :: Pat l
l op :: Name l
op rs :: [Pat l]
rs rhs :: Rhs l
rhs wbinds :: Maybe (Binds l)
wbinds) =
let
lhs :: [Doc]
lhs = case [Pat l]
rs of
[] -> []
(r :: Pat l
r:rs' :: [Pat l]
rs') ->
let hd :: [Doc]
hd = [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 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 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 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 _ f :: Name l
f ps :: [Pat l]
ps rhs :: Rhs l
rhs whereBinds :: 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 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 Nothing = Doc
empty
ppWhere (Just (BDecls _ l :: [Decl l]
l)) = Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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 _ b :: [IPBind l]
b)) = Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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 _ d :: Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
wantsBlankline (ClsDefSig {}) = Bool
True
wantsBlankline _ = Bool
False
instance Pretty (ClassDecl l) where
pretty :: ClassDecl l -> Doc
pretty (ClsDecl _ decl :: Decl l
decl) = Decl l -> Doc
forall a. Pretty a => a -> Doc
pretty Decl l
decl
pretty (ClsDataFam _ context :: Maybe (Context l)
context declHead :: DeclHead l
declHead optkind :: Maybe (ResultSig l)
optkind) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 _ declHead :: DeclHead l
declHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj) =
[Doc] -> Doc
mySep ( [String -> Doc
text "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 _ ntype :: TypeEqn l
ntype) =
[Doc] -> Doc
mySep [String -> Doc
text "type", TypeEqn l -> Doc
forall a. Pretty a => a -> Doc
pretty TypeEqn l
ntype]
pretty (ClsDefSig _ name :: Name l
name typ :: Type l
typ) =
[Doc] -> Doc
mySep [
String -> Doc
text "default",
Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name,
String -> Doc
text "::",
Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]
instance Pretty (DeclHead l) where
pretty :: DeclHead l -> Doc
pretty (DHead _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (DHInfix _ tv :: TyVarBind l
tv n :: 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 _ d :: DeclHead l
d) = Doc -> Doc
parens (DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
d)
pretty (DHApp _ dh :: DeclHead l
dh tv :: 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 _ d :: Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
wantsBlankline _ = Bool
False
instance Pretty (InstDecl l) where
pretty :: InstDecl l -> Doc
pretty (InsDecl _ decl :: Decl l
decl) = Decl l -> Doc
forall a. Pretty a => a -> Doc
pretty Decl l
decl
pretty (InsType _ ntype :: Type l
ntype htype :: Type l
htype) =
[Doc] -> Doc
mySep [String -> Doc
text "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 _ don :: DataOrNew l
don ntype :: Type l
ntype constrList :: [QualConDecl l]
constrList derives :: [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 '|'))
((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 _ don :: DataOrNew l
don ntype :: Type l
ntype optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [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 "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 "unsafe"
pretty (PlaySafe _ b :: Bool
b) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
b then "threadsafe" else "safe"
pretty PlayInterruptible {} = String -> Doc
text "interruptible"
instance Pretty (CallConv l) where
pretty :: CallConv l -> Doc
pretty StdCall {} = String -> Doc
text "stdcall"
pretty CCall {} = String -> Doc
text "ccall"
pretty CPlusPlus {} = String -> Doc
text "cplusplus"
pretty DotNet {} = String -> Doc
text "dotnet"
pretty Jvm {} = String -> Doc
text "jvm"
pretty Js {} = String -> Doc
text "js"
pretty JavaScript {} = String -> Doc
text "javascript"
pretty CApi {} = String -> Doc
text "capi"
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr (names :: [Name l]
names, txt :: 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 _ tag :: String
tag activ :: Maybe (Activation l)
activ rvs :: Maybe [RuleVar l]
rvs rhs :: Exp l
rhs lhs :: 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 '=', 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 rvs :: [RuleVar l]
rvs = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "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 '.']
instance Pretty (Activation l) where
pretty :: Activation l -> Doc
pretty (ActiveFrom _ i :: Indent
i) = Char -> Doc
char '[' Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char ']'
pretty (ActiveUntil _ i :: Indent
i) = String -> Doc
text "[~" Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char ']'
instance Pretty (Overlap l) where
pretty :: Overlap l -> Doc
pretty Overlap {} = String -> Doc
text "{-# OVERLAP #-}"
pretty Overlaps {} = String -> Doc
text "{-# OVERLAPS #-}"
pretty Overlapping {} = String -> Doc
text "{-# OVERLAPPING #-}"
pretty Overlappable {} = String -> Doc
text "{-# OVERLAPPABLE #-}"
pretty NoOverlap {} = String -> Doc
text "{-# NO_OVERLAP #-}"
pretty Incoherent {} = String -> Doc
text "{-# INCOHERENT #-}"
instance Pretty (RuleVar l) where
pretty :: RuleVar l -> Doc
pretty (RuleVar _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (TypedRuleVar _ n :: Name l
n t :: 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma opt :: Doc
opt s :: String
s =
case String
s of
('\n':_) -> Doc
opt Doc -> Doc -> Doc
<> String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text "#-}"
_ -> [Doc] -> Doc
myFsep [Doc
opt, String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text "#-}"]
instance Pretty (ModulePragma l) where
pretty :: ModulePragma l -> Doc
pretty (LanguagePragma _ ns :: [Name l]
ns) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# LANGUAGE" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 "#-}"]
pretty (OptionsPragma _ (Just tool :: Tool
tool) s :: String
s) =
Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text "{-# OPTIONS_" Doc -> Doc -> Doc
<> Tool -> Doc
forall a. Pretty a => a -> Doc
pretty Tool
tool) String
s
pretty (OptionsPragma _ _ s :: String
s) =
Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text "{-# OPTIONS") String
s
pretty (AnnModulePragma _ mann :: Annotation l
mann) =
[Doc] -> Doc
myFsep [String -> Doc
text "{-# ANN", Annotation l -> Doc
forall a. Pretty a => a -> Doc
pretty Annotation l
mann, String -> Doc
text "#-}"]
instance Pretty Tool where
pretty :: Tool -> Doc
pretty (UnknownTool s :: String
s) = String -> Doc
text String
s
pretty t :: 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 _pos :: l
_pos tvs :: Maybe [TyVarBind l]
tvs ctxt :: Maybe (Context l)
ctxt con :: 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 _pos :: l
_pos name :: Name l
name tvs :: Maybe [TyVarBind l]
tvs ctxt :: Maybe (Context l)
ctxt names :: Maybe [FieldDecl l]
names ty :: Type l
ty) =
case Maybe [FieldDecl l]
names of
Nothing ->
[Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
Just ts' :: [FieldDecl l]
ts' ->
[Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text "::" , 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 "->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
instance Pretty (ConDecl l) where
pretty :: ConDecl l -> Doc
pretty (RecDecl _ name :: Name l
name fieldList :: [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 _ name :: Name l
name typeList :: [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 :: Name l
name r :: 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 _ names :: [Name l]
names ty :: 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 "::", 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 '!'
pretty LazyTy {} = Char -> Doc
char '~'
pretty NoStrictAnnot {} = Doc
empty
instance Pretty (Unpackedness l) where
pretty :: Unpackedness l -> Doc
pretty Unpack {} = String -> Doc
text "{-# UNPACK #-} "
pretty NoUnpack {} = String -> Doc
text "{-# NOUNPACK #-} "
pretty NoUnpackPragma {} = Doc
empty
instance Pretty (Deriving l) where
pretty :: Deriving l -> Doc
pretty (Deriving _ mds :: Maybe (DerivStrategy l)
mds d :: [InstRule l]
d) =
[Doc] -> Doc
hsep [ String -> Doc
text "deriving"
, Doc
pp_strat_before
, Doc
pp_dct
, Doc
pp_strat_after ]
where
pp_dct :: Doc
pp_dct =
case [InstRule l]
d of
[d' :: InstRule l
d'] -> InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
d'
_ -> [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)
(pp_strat_before :: Doc
pp_strat_before, pp_strat_after :: 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)
_ -> ((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 ds :: DerivStrategy l
ds =
case DerivStrategy l
ds of
DerivStock _ -> String -> Doc
text "stock"
DerivAnyclass _ -> String -> Doc
text "anyclass"
DerivNewtype _ -> String -> Doc
text "newtype"
DerivVia _ ty :: Type l
ty -> String -> Doc
text "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 = 1
prec_atype :: Indent
prec_atype = 2
instance Pretty (Type l) where
prettyPrec :: Indent -> Type l -> Doc
prettyPrec p :: Indent
p (TyForall _ mtvs :: Maybe [TyVarBind l]
mtvs ctxt :: Maybe (Context l)
ctxt htype :: Type l
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ (TyStar _) = String -> Doc
text "*"
prettyPrec p :: Indent
p (TyFun _ a :: Type l
a b :: Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b]
prettyPrec _ (TyTuple _ bxd :: Boxed
bxd l :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec _ (TyUnboxedSum _ es :: [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 _ (TyList _ t :: 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 _ (TyParArray _ t :: Type l
t) = [Doc] -> Doc
bracketColonList [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
prettyPrec p :: Indent
p (TyApp _ a :: Type l
a b :: 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 _ (TyVar _ name :: Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec _ (TyCon _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec _ (TyParen _ t :: Type l
t) = Doc -> Doc
parens (Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t)
prettyPrec _ (TyInfix _ a :: Type l
a op :: MaybePromotedName l
op b :: 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 _ (TyKind _ t :: Type l
t k :: 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
k])
prettyPrec _ (TyPromoted _ p :: Promoted l
p) = Promoted l -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted l
p
prettyPrec p :: Indent
p (TyEquals _ a :: Type l
a b :: Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, String -> Doc
text "~", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b])
prettyPrec _ (TySplice _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec _ (TyBang _ b :: BangType l
b u :: Unpackedness l
u t :: 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 _ (TyWildCard _ mn :: Maybe (Name l)
mn) = Char -> Doc
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 _ (TyQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
instance Pretty (MaybePromotedName l) where
pretty :: MaybePromotedName l -> Doc
pretty (PromotedName _ q :: QName l
q) = Char -> Doc
char '\'' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
q
pretty (UnpromotedName _ q :: 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 p :: Promoted l
p =
case Promoted l
p of
PromotedInteger _ n :: Integer
n _ -> Integer -> Doc
integer Integer
n
PromotedString _ s :: String
s _ -> Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
PromotedCon _ hasQuote :: Bool
hasQuote qn :: QName l
qn ->
Bool -> Doc -> Doc
addQuote Bool
hasQuote (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn)
PromotedList _ hasQuote :: Bool
hasQuote list :: [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 _ list :: [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 "()"
where
addQuote :: Bool -> Doc -> Doc
addQuote True doc :: Doc
doc = Char -> Doc
char '\'' Doc -> Doc -> Doc
<> Doc
doc
addQuote False doc :: Doc
doc = Doc
doc
instance Pretty (TyVarBind l) where
pretty :: TyVarBind l -> Doc
pretty (KindedVar _ var :: Name l
var kind :: 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 "::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind]
pretty (UnkindedVar _ var :: 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 Nothing = Doc
empty
ppForall (Just []) = Doc
empty
ppForall (Just vs :: [TyVarBind l]
vs) = [Doc] -> Doc
myFsep (String -> Doc
text "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 '.'])
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind Nothing = []
ppOptKind (Just k :: Kind l
k) = [String -> Doc
text "::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
k]
instance Pretty (FunDep l) where
pretty :: FunDep l -> Doc
pretty (FunDep _ from :: [Name l]
from to :: [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 "->"] [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 fds :: [FunDep l]
fds = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
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 _ e :: Exp l
e) = Doc
equals Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedRhss _ guardList :: [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 _pos :: l
_pos guards :: [Stmt l]
guards ppBody' :: Exp l
ppBody') =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
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 _ e :: Exp l
e)) = String -> Doc
text "->" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (GuardedAlts (GuardedRhss _ guardList :: [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 _pos :: l
_pos guards :: [Stmt l]
guards ppBody' :: Exp l
ppBody')) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
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 "->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
instance Pretty (Literal l) where
pretty :: Literal l -> Doc
pretty (Int _ i :: Integer
i _) = Integer -> Doc
integer Integer
i
pretty (Char _ c :: Char
c _) = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
pretty (String _ s :: String
s _) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)
pretty (Frac _ r :: Rational
r _) = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
pretty (PrimChar _ c :: Char
c _) = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c) Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pretty (PrimString _ s :: String
s _) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s) Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pretty (PrimInt _ i :: Integer
i _) = Integer -> Doc
integer Integer
i Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pretty (PrimWord _ w :: Integer
w _) = Integer -> Doc
integer Integer
w Doc -> Doc -> Doc
<> String -> Doc
text "##"
pretty (PrimFloat _ r :: Rational
r _) = Float -> Doc
float (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pretty (PrimDouble _ r :: Rational
r _) = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> String -> Doc
text "##"
instance Pretty (Exp l) where
prettyPrec :: Indent -> Exp l -> Doc
prettyPrec _ (Lit _ l :: Literal l
l) = Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
l
prettyPrec p :: Indent
p (InfixApp _ a :: Exp l
a op :: QOp l
op b :: Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 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 1 Exp l
b]
prettyPrec p :: Indent
p (NegApp _ e :: Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '-' Doc -> Doc -> Doc
<> Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 2 Exp l
e
prettyPrec p :: Indent
p (App _ a :: Exp l
a b :: Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 3 Exp l
a, Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 4 Exp l
b]
prettyPrec p :: Indent
p (Lambda _loc :: l
_loc patList :: [Pat l]
patList ppBody' :: Exp l
ppBody') = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 '\\' 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 3) [Pat l]
patList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
prettyPrec p :: Indent
p (Let _ (BDecls _ declList :: [Decl l]
declList) letBody :: Exp l
letBody) =
Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 p :: Indent
p (Let _ (IPBinds _ bindList :: [IPBind l]
bindList) letBody :: Exp l
letBody) =
Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 p :: Indent
p (If _ cond :: Exp l
cond thenexp :: Exp l
thenexp elsexp :: Exp l
elsexp) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [String -> Doc
text "if", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond,
String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenexp,
String -> Doc
text "else", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
elsexp]
prettyPrec p :: Indent
p (MultiIf _ alts :: [GuardedRhs l]
alts) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "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 p :: Indent
p (Case _ cond :: Exp l
cond altList :: [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep ([String -> Doc
text "case", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond, String -> Doc
text "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 -> Doc
text "}"] 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 p :: Indent
p (Do _ stmtList :: [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "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 p :: Indent
p (MDo _ stmtList :: [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "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 _ (Var _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec _ (OverloadedLabel _ name :: String
name) = String -> Doc
text ('#'Char -> String -> String
forall a. a -> [a] -> [a]
:String
name)
prettyPrec _ (IPVar _ ipname :: IPName l
ipname) = IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname
prettyPrec _ (Con _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
prettyPrec _ (Tuple _ bxd :: Boxed
bxd expList :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec _ (UnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ (TupleSection _ bxd :: Boxed
bxd mExpList :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec _ (Paren _ e :: 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 _ (LeftSection _ e :: Exp l
e op :: 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 _ (RightSection _ op :: QOp l
op e :: 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 _ (RecConstr _ c :: QName l
c fieldList :: [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 _ (RecUpdate _ e :: Exp l
e fieldList :: [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 _ (List _ list :: [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 _ (ParArray _ arr :: [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 _ (EnumFrom _ e :: Exp l
e) =
[Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text ".."]
prettyPrec _ (EnumFromTo _ from :: Exp l
from to :: Exp l
to) =
[Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec _ (EnumFromThen _ from :: Exp l
from thenE :: 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 ".."]
prettyPrec _ (EnumFromThenTo _ from :: Exp l
from thenE :: Exp l
thenE to :: 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 "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec _ (ParArrayFromTo _ from :: Exp l
from to :: Exp l
to) =
[Doc] -> Doc
bracketColonList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec _ (ParArrayFromThenTo _ from :: Exp l
from thenE :: Exp l
thenE to :: 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 "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
prettyPrec _ (ListComp _ e :: Exp l
e qualList :: [QualStmt l]
qualList) =
[Doc] -> Doc
bracketList ([Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
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 _ (ParComp _ e :: Exp l
e qualLists :: [[QualStmt l]]
qualLists) =
[Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 _ (ParArrayComp _ e :: Exp l
e qualArrs :: [[QualStmt l]]
qualArrs) =
[Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 p :: Indent
p (ExpTypeSig _pos :: l
_pos e :: Exp l
e ty :: Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
prettyPrec _ (BracketExp _ b :: Bracket l
b) = Bracket l -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket l
b
prettyPrec _ (SpliceExp _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec _ (TypQuote _ t :: QName l
t) = String -> Doc
text "\'\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
t
prettyPrec _ (VarQuote _ x :: QName l
x) = String -> Doc
text "\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
x
prettyPrec _ (QuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
prettyPrec _ (XTag _ n :: XName l
n attrs :: [XAttr l]
attrs mattr :: Maybe (Exp l)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char '>']]
prettyPrec _ (XETag _ n :: XName l
n attrs :: [XAttr l]
attrs mattr :: 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 '<' 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 "/>"]
prettyPrec _ (XPcdata _ s :: String
s) = String -> Doc
text String
s
prettyPrec _ (XExpTag _ e :: Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "<%", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "%>"]
prettyPrec _ (XChildTag _ cs :: [Exp l]
cs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<%>" 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 "</%>"]
prettyPrec _ (CorePragma _ s :: String
s e :: 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 ["{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec _ (SCCPragma _ s :: String
s e :: 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 ["{-# SCC", String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec _ (GenPragma _ s :: String
s (a :: Indent
a,b :: Indent
b) (c :: Indent
c,d :: Indent
d) e :: Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "{-# 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 ':', Indent -> Doc
int Indent
b, Char -> Doc
char '-',
Indent -> Doc
int Indent
c, Char -> Doc
char ':', Indent -> Doc
int Indent
d, String -> Doc
text "#-}", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec p :: Indent
p (Proc _ pat :: Pat l
pat e :: Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [String -> Doc
text "proc", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text "->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
prettyPrec p :: Indent
p (LeftArrApp _ l :: Exp l
l r :: Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "-<", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec p :: Indent
p (RightArrApp _ l :: Exp l
l r :: Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 ">-", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec p :: Indent
p (LeftArrHighApp _ l :: Exp l
l r :: Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "-<<", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec p :: Indent
p (RightArrHighApp _ l :: Exp l
l r :: Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 ">>-", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
prettyPrec p :: Indent
p (LCase _ altList :: [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep (String -> Doc
text "\\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 -> Doc
text "}"] 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 _ (TypeApp _ ty :: Type l
ty) = Char -> Doc
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 before :: Indent
before after :: Indent
after exp :: 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 "|")
[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 "|")))
instance Pretty (XAttr l) where
pretty :: XAttr l -> Doc
pretty (XAttr _ n :: XName l
n v :: Exp l
v) =
[Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
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 _ n :: String
n) = String -> Doc
text String
n
pretty (XDomName _ d :: String
d n :: String
n) = String -> Doc
text String
d Doc -> Doc -> Doc
<> Char -> Doc
char ':' Doc -> Doc -> Doc
<> String -> Doc
text String
n
ppLetExp :: (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp :: [a] -> b -> Doc
ppLetExp l :: [a]
l b :: b
b = [Doc] -> Doc
myFsep [String -> Doc
text "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 "in", b -> Doc
forall a. Pretty a => a -> Doc
pretty b
b]
instance Pretty (Bracket l) where
pretty :: Bracket l -> Doc
pretty (ExpBracket _ e :: Exp l
e) = String -> Exp l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[|" Exp l
e
pretty (TExpBracket _ e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "[||", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "||]"]
pretty (PatBracket _ p :: Pat l
p) = String -> Pat l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[p|" Pat l
p
pretty (TypeBracket _ t :: Type l
t) = String -> Type l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[t|" Type l
t
pretty (DeclBracket _ d :: [Decl l]
d) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "[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 "|]"]
ppBracket :: Pretty a => String -> a -> Doc
ppBracket :: String -> a -> Doc
ppBracket o :: String
o x :: a
x = [Doc] -> Doc
myFsep [String -> Doc
text String
o, a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x, String -> Doc
text "|]"]
instance Pretty (Splice l) where
pretty :: Splice l -> Doc
pretty (IdSplice _ s :: String
s) = Char -> Doc
char '$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (TIdSplice _ s :: String
s) = Char -> Doc
char '$' Doc -> Doc -> Doc
<> Char -> Doc
char '$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (TParenSplice _ e :: Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "$$(", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char ')']
pretty (ParenSplice _ e :: Exp l
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "$(", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char ')']
instance Pretty (Pat l) where
prettyPrec :: Indent -> Pat l -> Doc
prettyPrec _ (PVar _ name :: Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
prettyPrec _ (PLit _ (Signless {}) lit :: Literal l
lit) = Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
prettyPrec p :: Indent
p (PLit _ (Negative{}) lit :: Literal l
lit) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '-' Doc -> Doc -> Doc
<> Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
prettyPrec p :: Indent
p (PInfixApp l :: l
l a :: Pat l
a op :: QName l
op b :: Pat l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 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 1 Pat l
b]
prettyPrec p :: Indent
p (PApp _ n :: QName l
n ps :: [Pat l]
ps) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 3) [Pat l]
ps)
prettyPrec _ (PTuple _ bxd :: Boxed
bxd ps :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec _ (PUnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ (PList _ ps :: [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 _ (PParen _ pat :: 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 _ (PRec _ c :: QName l
c fields :: [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 _ (PAsPat _ name :: Name l
name (PIrrPat _ pat :: 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 -> Doc
char '~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat]
prettyPrec _ (PAsPat _ name :: Name l
name pat :: Pat l
pat) =
[Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, Char -> Doc
char '@', Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat]
prettyPrec _ PWildCard {} = Char -> Doc
char '_'
prettyPrec _ (PIrrPat _ pat :: Pat l
pat) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat
prettyPrec p :: Indent
p (PatTypeSig _pos :: l
_pos pat :: Pat l
pat ty :: Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
prettyPrec p :: Indent
p (PViewPat _ e :: Exp l
e pat :: Pat l
pat) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat]
prettyPrec p :: Indent
p (PNPlusK _ n :: Name l
n k :: Integer
k) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> 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 _ (PRPat _ rs :: [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 _ (PXTag _ n :: XName l
n attrs :: [PXAttr l]
attrs mattr :: Maybe (Pat l)
mattr cp :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char '>']]
prettyPrec _ (PXETag _ n :: XName l
n attrs :: [PXAttr l]
attrs mattr :: 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 '<' 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 "/>"]
prettyPrec _ (PXPcdata _ s :: String
s) = String -> Doc
text String
s
prettyPrec _ (PXPatTag _ p :: Pat l
p) =
[Doc] -> Doc
myFsep [String -> Doc
text "<%", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p, String -> Doc
text "%>"]
prettyPrec _ (PXRPats _ ps :: [RPat l]
ps) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<[" 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 "%>"]
prettyPrec _ (PBangPat _ pat :: Pat l
pat) = String -> Doc
text "!" Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat
prettyPrec _ (PSplice _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
prettyPrec _ (PQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
instance Pretty (PXAttr l) where
pretty :: PXAttr l -> Doc
pretty (PXAttr _ n :: XName l
n p :: Pat l
p) =
[Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
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 _ name :: QName l
name pat :: 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 _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (PFieldWildcard{}) = String -> Doc
text ".."
instance Pretty (RPat l) where
pretty :: RPat l -> Doc
pretty (RPOp _ r :: RPat l
r op :: 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 _ r1 :: RPat l
r1 r2 :: 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 '|', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r2]
pretty (RPSeq _ rs :: [RPat l]
rs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 "|)"]
pretty (RPGuard _ r :: Pat l
r gs :: [Stmt l]
gs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 '|' 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 "|)"]
pretty (RPCAs _ n :: Name l
n (RPPat _ (PIrrPat _ p :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPCAs _ n :: Name l
n r :: RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text "@:", RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
pretty (RPAs _ n :: Name l
n (RPPat _ (PIrrPat _ p :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
pretty (RPAs _ n :: Name l
n r :: RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Char -> Doc
char '@', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
pretty (RPPat _ p :: Pat l
p) = Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p
pretty (RPParen _ rp :: 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 '*'
pretty RPStarG{} = String -> Doc
text "*!"
pretty RPPlus{} = Char -> Doc
char '+'
pretty RPPlusG{} = String -> Doc
text "+!"
pretty RPOpt{} = Char -> Doc
char '?'
pretty RPOptG{} = String -> Doc
text "?!"
instance Pretty (Alt l) where
pretty :: Alt l -> Doc
pretty (Alt _pos :: l
_pos e :: Pat l
e gAlts :: Rhs l
gAlts binds :: 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 _loc :: l
_loc e :: Pat l
e from :: Exp l
from) =
Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> String -> Doc
text "<-" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from
pretty (Qualifier _ e :: Exp l
e) = Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
pretty (LetStmt _ (BDecls _ declList :: [Decl l]
declList)) =
[Decl l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [Decl l]
declList
pretty (LetStmt _ (IPBinds _ bindList :: [IPBind l]
bindList)) =
[IPBind l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [IPBind l]
bindList
pretty (RecStmt _ stmtList :: [Stmt l]
stmtList) =
String -> Doc
text "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 l :: [a]
l = String -> Doc
text "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 _ s :: Stmt l
s) = Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt l
s
pretty (ThenTrans _ f :: Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
pretty (ThenBy _ f :: Exp l
f e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f, String -> Doc
text "by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (GroupBy _ e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
pretty (GroupUsing _ f :: Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "using", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
pretty (GroupByUsing _ e :: Exp l
e f :: Exp l
f) = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "by",
Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "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 _ name :: QName l
name e :: 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 _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
pretty (FieldWildcard {}) = String -> Doc
text ".."
instance Pretty (QOp l) where
pretty :: QOp l -> Doc
pretty (QVarOp _ n :: QName l
n) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n
pretty (QConOp _ n :: QName l
n) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n
ppQNameInfix :: QName l -> Doc
ppQNameInfix :: QName l -> Doc
ppQNameInfix name :: 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 '`' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<> Char -> Doc
char '`'
instance Pretty (QName l) where
pretty :: QName l -> Doc
pretty name :: QName l
name = case QName l
name of
UnQual _ (Symbol _ ('#':_)) -> Char -> Doc
char '(' Doc -> Doc -> Doc
<+> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<+> Char -> Doc
char ')'
_ -> 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 _ name :: Name l
name) = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Qual _ m :: ModuleName l
m name :: Name l
name) = ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m Doc -> Doc -> Doc
<> Char -> Doc
char '.' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Special _ sym :: 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 _ n :: Name l
n) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
pretty (ConOp _ n :: 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 :: 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 '`' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char '`'
instance Pretty (Name l) where
pretty :: Name l -> Doc
pretty name :: Name l
name = case Name l
name of
Symbol _ ('#':_) -> Char -> Doc
char '(' Doc -> Doc -> Doc
<+> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<+> Char -> Doc
char ')'
_ -> 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 _ s :: String
s) = String -> Doc
text String
s
ppName (Symbol _ s :: String
s) = String -> Doc
text String
s
instance Pretty (IPName l) where
pretty :: IPName l -> Doc
pretty (IPDup _ s :: String
s) = Char -> Doc
char '?' Doc -> Doc -> Doc
<> String -> Doc
text String
s
pretty (IPLin _ s :: String
s) = Char -> Doc
char '%' Doc -> Doc -> Doc
<> String -> Doc
text String
s
instance PrettyDeclLike (IPBind l) where
wantsBlankline :: IPBind l -> Bool
wantsBlankline _ = Bool
False
instance Pretty (IPBind l) where
pretty :: IPBind l -> Doc
pretty (IPBind _loc :: l
_loc ipname :: IPName l
ipname exp :: 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 _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
pretty (ConName _ n :: 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 "()"
pretty (ListCon {}) = String -> Doc
text "[]"
pretty (FunCon {}) = String -> Doc
text "->"
pretty (TupleCon _ b :: Boxed
b n :: 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
-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 ":"
pretty (UnboxedSingleCon {}) = String -> Doc
text "(# #)"
pretty (ExprHole {}) = String -> Doc
text "_"
isSymbolName :: Name l -> Bool
isSymbolName :: Name l -> Bool
isSymbolName (Symbol {}) = Bool
True
isSymbolName _ = Bool
False
isSymbolQName :: QName l -> Bool
isSymbolQName :: QName l -> Bool
isSymbolQName (UnQual _ n :: Name l
n) = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual _ _ n :: Name l
n) = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Special _ (Cons {})) = Bool
True
isSymbolQName (Special _ (FunCon {})) = Bool
True
isSymbolQName _ = Bool
False
instance (Pretty (Context l)) where
pretty :: Context l -> Doc
pretty (CxEmpty _) = String -> Doc
text "()" Doc -> Doc -> Doc
<+> String -> Doc
text "=>"
pretty (CxSingle _ ctxt :: Asst l
ctxt) = Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty Asst l
ctxt Doc -> Doc -> Doc
<+> String -> Doc
text "=>"
pretty (CxTuple _ context :: [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 "=>"]
instance Pretty (Asst l) where
pretty :: Asst l -> Doc
pretty (TypeA _ t :: Type l
t) = Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
pretty (IParam _ i :: IPName l
i t :: Type l
t) = [Doc] -> Doc
myFsep [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
i, String -> Doc
text "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
pretty (ParenA _ a :: 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
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 p :: Doc
p = [Doc] -> Doc
P.hcat [ Doc
p, Doc
P.colon ]
instance Pretty SrcSpan where
pretty :: SrcSpan -> Doc
pretty srcSpan :: 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 "("
, 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 -> Doc
P.text "-"
, [Doc] -> Doc
P.hcat [ String -> Doc
P.text "("
, 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 ")"
]
]
instance Pretty (Module pos) where
pretty :: Module pos -> Doc
pretty (Module _ mbHead :: Maybe (ModuleHead pos)
mbHead os :: [ModulePragma pos]
os imp :: [ImportDecl pos]
imp decls :: [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
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
Just h :: ModuleHead pos
h -> \x :: [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 _ _mn :: ModuleName pos
_mn os :: [ModulePragma pos]
os n :: XName pos
n attrs :: [XAttr pos]
attrs mattr :: Maybe (Exp pos)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char '>']]]
pretty (XmlHybrid _ mbHead :: Maybe (ModuleHead pos)
mbHead os :: [ModulePragma pos]
os imp :: [ImportDecl pos]
imp decls :: [Decl pos]
decls n :: XName pos
n attrs :: [XAttr pos]
attrs mattr :: Maybe (Exp pos)
mattr cs :: [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 "<%"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(case Maybe (ModuleHead pos)
mbHead of
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
Just h :: ModuleHead pos
h -> \x :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char '>']]])
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP _ Nothing = Doc
empty
maybePP pp :: a -> Doc
pp (Just a :: 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 " |")
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
doc = Char -> Doc
char '#' Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> Char -> Doc
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
doc = Char -> Doc
char ':' Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Char -> Doc
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 dl :: 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 "" Doc -> Doc -> Doc
$+$ Doc
dl else Doc
dl}
topLevel :: Doc -> [Doc] -> Doc
topLevel :: Doc -> [Doc] -> Doc
topLevel header :: Doc
header dl :: [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
PPOffsideRule -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc]
dl
PPSemiColon -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
PPInLine -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
PPNoLayout -> Doc
header Doc -> Doc -> Doc
<+> [Doc] -> Doc
flatBlock [Doc]
dl
ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
ppBody :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody f :: PPHsMode -> Indent
f dl :: [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 PPOffsideRule -> Doc
indent
PPSemiColon -> Doc
indentExplicit
_ -> [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 f :: PPHsMode -> Indent
f dl :: [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
a :: Doc
a $$$ :: Doc -> Doc -> Doc
$$$ b :: 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' [x :: Doc
x] = Doc
x
mySep' (x :: Doc
x:xs :: [Doc]
xs) = Doc
x Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
xs
mySep' [] = String -> Doc
forall a. HasCallStack => String -> a
error "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' (d :: Doc
d:ds :: [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 :: a -> Doc
a b :: a -> Doc
b dl :: 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 _ l :: Literal loc
l) = Literal loc -> Doc
forall a. Pretty a => a -> Doc
pretty Literal loc
l
pretty (P.InfixApp _ a :: PExp loc
a op :: QOp loc
op b :: 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 _ e :: PExp loc
e) = [Doc] -> Doc
myFsep [Char -> Doc
char '-', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.App _ a :: PExp loc
a b :: 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
_loc expList :: [Pat loc]
expList ppBody' :: PExp loc
ppBody') = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
Char -> Doc
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 "->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
ppBody']
pretty (P.Let _ (BDecls _ declList :: [Decl loc]
declList) letBody :: 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 _ (IPBinds _ bindList :: [IPBind loc]
bindList) letBody :: 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 _ cond :: PExp loc
cond thenexp :: PExp loc
thenexp elsexp :: PExp loc
elsexp) =
[Doc] -> Doc
myFsep [String -> Doc
text "if", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond,
String -> Doc
text "then", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenexp,
String -> Doc
text "else", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
elsexp]
pretty (P.MultiIf _ alts :: [GuardedRhs loc]
alts) =
String -> Doc
text "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 _ cond :: PExp loc
cond altList :: [Alt loc]
altList) =
[Doc] -> Doc
myFsep [String -> Doc
text "case", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond, String -> Doc
text "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 _ stmtList :: [Stmt loc]
stmtList) =
String -> Doc
text "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 _ stmtList :: [Stmt loc]
stmtList) =
String -> Doc
text "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 _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.OverloadedLabel _ name :: String
name) = String -> Doc
text String
name
pretty (P.IPVar _ ipname :: IPName loc
ipname) = IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
ipname
pretty (P.Con _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.TupleSection _ bxd :: Boxed
bxd mExpList :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
pretty (P.UnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ e :: 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 _ c :: QName loc
c fieldList :: [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 _ e :: PExp loc
e fieldList :: [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 _ list :: [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 _ arr :: [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 _ e :: PExp loc
e) =
[Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text ".."]
pretty (P.EnumFromTo _ from :: PExp loc
from to :: PExp loc
to) =
[Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.EnumFromThen _ from :: PExp loc
from thenE :: 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 ".."]
pretty (P.EnumFromThenTo _ from :: PExp loc
from thenE :: PExp loc
thenE to :: 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 "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParArrayFromTo _ from :: PExp loc
from to :: PExp loc
to) =
[Doc] -> Doc
bracketColonList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParArrayFromThenTo _ from :: PExp loc
from thenE :: PExp loc
thenE to :: 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 "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
pretty (P.ParComp _ e :: PExp loc
e qualLists :: [[QualStmt loc]]
qualLists) =
[Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
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 _ e :: PExp loc
e qualArrs :: [[QualStmt loc]]
qualArrs) =
[Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
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 _pos :: loc
_pos e :: PExp loc
e ty :: Type loc
ty) =
[Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "::", Type loc -> Doc
forall a. Pretty a => a -> Doc
pretty Type loc
ty]
pretty (P.BracketExp _ b :: Bracket loc
b) = Bracket loc -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket loc
b
pretty (P.SpliceExp _ s :: Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
pretty (P.TypQuote _ t :: QName loc
t) = String -> Doc
text "\'\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
t
pretty (P.VarQuote _ x :: QName loc
x) = String -> Doc
text "\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
x
pretty (P.QuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
pretty (P.XTag _ n :: XName loc
n attrs :: [ParseXAttr loc]
attrs mattr :: Maybe (PExp loc)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char '>']]
pretty (P.XETag _ n :: XName loc
n attrs :: [ParseXAttr loc]
attrs mattr :: 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 '<' 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 "/>"]
pretty (P.XPcdata _ s :: String
s) = String -> Doc
text String
s
pretty (P.XExpTag _ e :: PExp loc
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "<%", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "%>"]
pretty (P.XChildTag _ es :: [PExp loc]
es) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<%>" 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 "</%>"]
pretty (P.CorePragma _ s :: String
s e :: 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 ["{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.SCCPragma _ s :: String
s e :: 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 ["{-# SCC", String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.GenPragma _ s :: String
s (a :: Indent
a,b :: Indent
b) (c :: Indent
c,d :: Indent
d) e :: PExp loc
e) =
[Doc] -> Doc
myFsep [String -> Doc
text "{-# 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 ':', Indent -> Doc
int Indent
b, Char -> Doc
char '-',
Indent -> Doc
int Indent
c, Char -> Doc
char ':', Indent -> Doc
int Indent
d, String -> Doc
text "#-}", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.Proc _ p :: Pat loc
p e :: PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text "proc", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p, String -> Doc
text "->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.LeftArrApp _ l :: PExp loc
l r :: PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text "-<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrApp _ l :: PExp loc
l r :: PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text ">-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.LeftArrHighApp _ l :: PExp loc
l r :: PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text "-<<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.RightArrHighApp _ l :: PExp loc
l r :: PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text ">>-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.AsPat _ name :: Name loc
name (P.IrrPat _ pat :: 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 -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
pretty (P.AsPat _ name :: Name loc
name pat :: PExp loc
pat) =
[Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name, Char -> Doc
char '@', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
pretty (P.WildCard _) = Char -> Doc
char '_'
pretty (P.IrrPat _ pat :: PExp loc
pat) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat
pretty (P.PostOp _ e :: PExp loc
e op :: 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 _ op :: QOp loc
op e :: 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 _ e :: PExp loc
e p :: Pat loc
p) =
[Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "->", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p]
pretty (P.SeqRP _ rs :: [PExp loc]
rs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 "|)"]
pretty (P.GuardRP _ r :: PExp loc
r gs :: [Stmt loc]
gs) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 '|' 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 "|)"]
pretty (P.EitherRP _ r1 :: PExp loc
r1 r2 :: 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 '|', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r2]
pretty (P.CAsRP _ n :: Name loc
n (P.IrrPat _ e :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
pretty (P.CAsRP _ n :: Name loc
n r :: PExp loc
r) = [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n, String -> Doc
text "@:", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
pretty (P.XRPats _ ps :: [PExp loc]
ps) =
[Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<[" 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 "%>"]
pretty (P.BangPat _ e :: PExp loc
e) = String -> Doc
text "!" Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e
pretty (P.LCase _ altList :: [Alt loc]
altList) = String -> Doc
text "\\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 _ ty :: Type loc
ty) = Char -> Doc
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 _ name :: QName loc
name e :: 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 _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
pretty (P.FieldWildcard _) = String -> Doc
text ".."
instance SrcInfo loc => Pretty (P.ParseXAttr loc) where
pretty :: ParseXAttr loc -> Doc
pretty (P.XAttr _ n :: XName loc
n v :: PExp loc
v) =
[Doc] -> Doc
myFsep [XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
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 _) = [Doc] -> Doc
mySep [String -> Doc
text "()", String -> Doc
text "=>"]
pretty (P.CxSingle _ asst :: PAsst loc
asst) = [Doc] -> Doc
mySep [PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst, String -> Doc
text "=>"]
pretty (P.CxTuple _ assts :: [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 "=>"]
instance SrcInfo loc => Pretty (P.PAsst loc) where
pretty :: PAsst loc -> Doc
pretty (P.TypeA _ t :: PType loc
t) = PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
pretty (P.IParam _ i :: IPName loc
i t :: PType loc
t) = [Doc] -> Doc
myFsep [IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
i, String -> Doc
text "::", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
pretty (P.ParenA _ a :: 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 p :: Indent
p (P.TyForall _ mtvs :: Maybe [TyVarBind loc]
mtvs ctxt :: Maybe (PContext loc)
ctxt htype :: PType loc
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ (P.TyStar _) = String -> Doc
text "*"
prettyPrec p :: Indent
p (P.TyFun _ a :: PType loc
a b :: PType loc
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec _ (P.TyTuple _ bxd :: Boxed
bxd l :: [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 -> [Doc] -> Doc
parenList [Doc]
ds
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
prettyPrec _ (P.TyUnboxedSum _ es :: [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 _ (P.TyList _ t :: 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 _ (P.TyParArray _ t :: PType loc
t) = [Doc] -> Doc
bracketColonList [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
prettyPrec p :: Indent
p (P.TyApp _ a :: PType loc
a b :: 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 _ (P.TyVar _ name :: Name loc
name) = Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name
prettyPrec _ (P.TyCon _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
prettyPrec _ (P.TyParen _ t :: PType loc
t) = Doc -> Doc
parens (PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t)
prettyPrec _ (P.TyPred _ asst :: PAsst loc
asst) = PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst
prettyPrec _ (P.TyInfix _ a :: PType loc
a op :: MaybePromotedName loc
op b :: 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 _ (P.TyKind _ t :: PType loc
t k :: 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 "::", Kind loc -> Doc
forall a. Pretty a => a -> Doc
pretty Kind loc
k])
prettyPrec _ (P.TyPromoted _ p :: Promoted loc
p) = Promoted loc -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted loc
p
prettyPrec _ (P.TyEquals _ a :: PType loc
a b :: PType loc
b) = [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, String -> Doc
text "~", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
prettyPrec _ (P.TySplice _ s :: Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
prettyPrec _ (P.TyBang _ b :: BangType loc
b u :: Unpackedness loc
u t :: 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 _ (P.TyWildCard _ mn :: Maybe (Name loc)
mn) = Char -> Doc
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 _ (P.TyQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")