module Language.Haskell.Pretty
(
Pretty,
prettyPrintStyleMode,
prettyPrintWithMode,
prettyPrint,
P.Style(..),
P.style,
P.Mode(..),
PPHsMode(..),
Indent,
PPLayout(..),
defaultMode
) where
import Language.Haskell.Syntax
import Control.Monad (ap)
import qualified Text.PrettyPrint as P
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
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,
:: Bool
}
defaultMode :: PPHsMode
defaultMode :: PPHsMode
defaultMode = PPHsMode :: Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Bool
-> PPLayout
-> Bool
-> Bool
-> PPHsMode
PPHsMode{
classIndent :: Indent
classIndent = 8,
doIndent :: Indent
doIndent = 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,
comments :: Bool
comments = Bool
True
}
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
ap
*> :: 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
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# 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 -> a) -> s -> a
forall a b. (a -> b) -> a -> b
$ 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 -> b) -> s -> b
forall a b. (a -> b) -> a -> b
$ 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 -> a) -> s -> a
forall a b. (a -> b) -> a -> b
$ s
s of _ -> DocM s b -> s -> b
forall s a. DocM s a -> s -> a
unDocM DocM s b
k (s -> b) -> s -> b
forall a b. (a -> b) -> a -> b
$ 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 :: s
_s -> 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 :: 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
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)}
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
instance Pretty HsModule where
pretty :: HsModule -> Doc
pretty (HsModule pos :: SrcLoc
pos m :: Module
m mbExports :: Maybe [HsExportSpec]
mbExports imp :: [HsImportDecl]
imp decls :: [HsDecl]
decls) =
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> [Doc] -> Doc
topLevel (Module -> Maybe [HsExportSpec] -> Doc
ppHsModuleHeader Module
m Maybe [HsExportSpec]
mbExports)
((HsImportDecl -> Doc) -> [HsImportDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsImportDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsImportDecl]
imp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
decls)
ppHsModuleHeader :: Module -> Maybe [HsExportSpec] -> Doc
m :: Module
m mbExportList :: Maybe [HsExportSpec]
mbExportList = [Doc] -> Doc
mySep [
String -> Doc
text "module",
Module -> Doc
forall a. Pretty a => a -> Doc
pretty Module
m,
([HsExportSpec] -> Doc) -> Maybe [HsExportSpec] -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ([Doc] -> Doc
parenList ([Doc] -> Doc)
-> ([HsExportSpec] -> [Doc]) -> [HsExportSpec] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExportSpec -> Doc) -> [HsExportSpec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsExportSpec -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe [HsExportSpec]
mbExportList,
String -> Doc
text "where"]
instance Pretty Module where
pretty :: Module -> Doc
pretty (Module modName :: String
modName) = String -> Doc
text String
modName
instance Pretty HsExportSpec where
pretty :: HsExportSpec -> Doc
pretty (HsEVar name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name
pretty (HsEAbs name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name
pretty (HsEThingAll name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name Doc -> Doc -> Doc
<<>> String -> Doc
text "(..)"
pretty (HsEThingWith name :: HsQName
name nameList :: [HsCName]
nameList) =
HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
parenList ([Doc] -> Doc) -> ([HsCName] -> [Doc]) -> [HsCName] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsCName -> Doc) -> [HsCName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsCName -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsCName] -> Doc) -> [HsCName] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsCName]
nameList)
pretty (HsEModuleContents m :: Module
m) = String -> Doc
text "module" Doc -> Doc -> Doc
<+> Module -> Doc
forall a. Pretty a => a -> Doc
pretty Module
m
instance Pretty HsImportDecl where
pretty :: HsImportDecl -> Doc
pretty (HsImportDecl pos :: SrcLoc
pos m :: Module
m qual :: Bool
qual mbName :: Maybe Module
mbName mbSpecs :: Maybe (Bool, [HsImportSpec])
mbSpecs) =
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep [String -> Doc
text "import",
if Bool
qual then String -> Doc
text "qualified" else Doc
empty,
Module -> Doc
forall a. Pretty a => a -> Doc
pretty Module
m,
(Module -> Doc) -> Maybe Module -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\m' :: Module
m' -> String -> Doc
text "as" Doc -> Doc -> Doc
<+> Module -> Doc
forall a. Pretty a => a -> Doc
pretty Module
m') Maybe Module
mbName,
((Bool, [HsImportSpec]) -> Doc)
-> Maybe (Bool, [HsImportSpec]) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (Bool, [HsImportSpec]) -> Doc
forall a. Pretty a => (Bool, [a]) -> Doc
exports Maybe (Bool, [HsImportSpec])
mbSpecs]
where
exports :: (Bool, [a]) -> Doc
exports (b :: Bool
b,specList :: [a]
specList) =
if Bool
b then String -> Doc
text "hiding" Doc -> Doc -> Doc
<+> Doc
specs else Doc
specs
where specs :: Doc
specs = [Doc] -> Doc
parenList ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty ([a] -> Doc) -> [a] -> Doc
forall a b. (a -> b) -> a -> b
$ [a]
specList
instance Pretty HsImportSpec where
pretty :: HsImportSpec -> Doc
pretty (HsIVar name :: HsName
name) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name
pretty (HsIAbs name :: HsName
name) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name
pretty (HsIThingAll name :: HsName
name) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name Doc -> Doc -> Doc
<<>> String -> Doc
text "(..)"
pretty (HsIThingWith name :: HsName
name nameList :: [HsCName]
nameList) =
HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
parenList ([Doc] -> Doc) -> ([HsCName] -> [Doc]) -> [HsCName] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsCName -> Doc) -> [HsCName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsCName -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsCName] -> Doc) -> [HsCName] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsCName]
nameList)
instance Pretty HsDecl where
pretty :: HsDecl -> Doc
pretty (HsTypeDecl loc :: SrcLoc
loc name :: HsName
name nameList :: [HsName]
nameList htype :: HsType
htype) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "type", HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty [HsName]
nameList
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
htype])
pretty (HsDataDecl loc :: SrcLoc
loc context :: HsContext
context name :: HsName
name nameList :: [HsName]
nameList constrList :: [HsConDecl]
constrList derives :: [HsQName]
derives) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
loc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "data", HsContext -> Doc
ppHsContext HsContext
context, HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty [HsName]
nameList)
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 '|'))
((HsConDecl -> Doc) -> [HsConDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsConDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsConDecl]
constrList))
Doc -> Doc -> Doc
$$$ [HsQName] -> Doc
ppHsDeriving [HsQName]
derives)
pretty (HsNewTypeDecl pos :: SrcLoc
pos context :: HsContext
context name :: HsName
name nameList :: [HsName]
nameList constr :: HsConDecl
constr derives :: [HsQName]
derives) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "newtype", HsContext -> Doc
ppHsContext HsContext
context, HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty [HsName]
nameList)
Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> (HsConDecl -> Doc
forall a. Pretty a => a -> Doc
pretty HsConDecl
constr Doc -> Doc -> Doc
$$$ [HsQName] -> Doc
ppHsDeriving [HsQName]
derives)
pretty (HsClassDecl pos :: SrcLoc
pos context :: HsContext
context name :: HsName
name nameList :: [HsName]
nameList []) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "class", HsContext -> Doc
ppHsContext HsContext
context, HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty [HsName]
nameList)
pretty (HsClassDecl pos :: SrcLoc
pos context :: HsContext
context name :: HsName
name nameList :: [HsName]
nameList declList :: [HsDecl]
declList) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "class", HsContext -> Doc
ppHsContext HsContext
context, HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty [HsName]
nameList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
declList)
pretty (HsInstDecl pos :: SrcLoc
pos context :: HsContext
context name :: HsQName
name args :: [HsType]
args []) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "instance", HsContext -> Doc
ppHsContext HsContext
context, HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsType -> Doc) -> [HsType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsType -> Doc
ppHsAType [HsType]
args)
pretty (HsInstDecl pos :: SrcLoc
pos context :: HsContext
context name :: HsQName
name args :: [HsType]
args declList :: [HsDecl]
declList) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ( [String -> Doc
text "instance", HsContext -> Doc
ppHsContext HsContext
context, HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (HsType -> Doc) -> [HsType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsType -> Doc
ppHsAType [HsType]
args [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "where"])
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
declList)
pretty (HsDefaultDecl pos :: SrcLoc
pos htypes :: [HsType]
htypes) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "default" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((HsType -> Doc) -> [HsType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsType -> Doc
forall a. Pretty a => a -> Doc
pretty [HsType]
htypes)
pretty (HsTypeSig pos :: SrcLoc
pos nameList :: [HsName]
nameList qualType :: HsQualType
qualType) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ((Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsName] -> [Doc]) -> [HsName] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsName] -> [Doc]) -> [HsName] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [HsName]
nameList)
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "::", HsQualType -> Doc
forall a. Pretty a => a -> Doc
pretty HsQualType
qualType])
pretty (HsForeignImport pos :: SrcLoc
pos conv :: String
conv safety :: HsSafety
safety entity :: String
entity name :: HsName
name ty :: HsType
ty) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "foreign", String -> Doc
text "import", String -> Doc
text String
conv, HsSafety -> Doc
forall a. Pretty a => a -> Doc
pretty HsSafety
safety] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
entity then [] else [String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
entity)]) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name, String -> Doc
text "::", HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
ty]
pretty (HsForeignExport pos :: SrcLoc
pos conv :: String
conv entity :: String
entity name :: HsName
name ty :: HsType
ty) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "foreign", String -> Doc
text "export", String -> Doc
text String
conv] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
entity then [] else [String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
entity)]) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name, String -> Doc
text "::", HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
ty]
pretty (HsFunBind matches :: [HsMatch]
matches) =
[Doc] -> Doc
ppBindings ((HsMatch -> Doc) -> [HsMatch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsMatch -> Doc
forall a. Pretty a => a -> Doc
pretty [HsMatch]
matches)
pretty (HsPatBind pos :: SrcLoc
pos pat :: HsPat
pat rhs :: HsRhs
rhs whereDecls :: [HsDecl]
whereDecls) =
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep [HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
pat, HsRhs -> Doc
forall a. Pretty a => a -> Doc
pretty HsRhs
rhs] Doc -> Doc -> Doc
$$$ [HsDecl] -> Doc
ppWhere [HsDecl]
whereDecls
pretty (HsInfixDecl pos :: SrcLoc
pos assoc :: HsAssoc
assoc prec :: Indent
prec opList :: [HsOp]
opList) =
Doc -> Doc
blankline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
mySep ([HsAssoc -> Doc
forall a. Pretty a => a -> Doc
pretty HsAssoc
assoc, Indent -> Doc
int Indent
prec]
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsOp] -> [Doc]) -> [HsOp] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsOp -> Doc) -> [HsOp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsOp -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsOp] -> [Doc]) -> [HsOp] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [HsOp]
opList))
instance Pretty HsAssoc where
pretty :: HsAssoc -> Doc
pretty HsAssocNone = String -> Doc
text "infix"
pretty HsAssocLeft = String -> Doc
text "infixl"
pretty HsAssocRight = String -> Doc
text "infixr"
instance Pretty HsSafety where
pretty :: HsSafety -> Doc
pretty HsSafe = String -> Doc
text "safe"
pretty HsUnsafe = String -> Doc
text "unsafe"
instance Pretty HsMatch where
pretty :: HsMatch -> Doc
pretty (HsMatch pos :: SrcLoc
pos f :: HsName
f ps :: [HsPat]
ps rhs :: HsRhs
rhs whereDecls :: [HsDecl]
whereDecls) =
SrcLoc -> Doc -> Doc
markLine SrcLoc
pos (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
myFsep ([Doc]
lhs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [HsRhs -> Doc
forall a. Pretty a => a -> Doc
pretty HsRhs
rhs])
Doc -> Doc -> Doc
$$$ [HsDecl] -> Doc
ppWhere [HsDecl]
whereDecls
where
lhs :: [Doc]
lhs = case [HsPat]
ps of
l :: HsPat
l:r :: HsPat
r:ps' :: [HsPat]
ps' | HsName -> Bool
isSymbolName HsName
f ->
let hd :: [Doc]
hd = [HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
l, HsName -> Doc
ppHsName HsName
f, HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
r] in
if [HsPat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsPat]
ps' then [Doc]
hd
else Doc -> Doc
parens ([Doc] -> Doc
myFsep [Doc]
hd) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> HsPat -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 2) [HsPat]
ps'
_ -> HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
f Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> HsPat -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 2) [HsPat]
ps
ppWhere :: [HsDecl] -> Doc
ppWhere :: [HsDecl] -> Doc
ppWhere [] = Doc
empty
ppWhere l :: [HsDecl]
l = Indent -> Doc -> Doc
nest 2 (String -> Doc
text "where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
l))
instance Pretty HsConDecl where
pretty :: HsConDecl -> Doc
pretty (HsRecDecl _pos :: SrcLoc
_pos name :: HsName
name fieldList :: [([HsName], HsBangType)]
fieldList) =
HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([([HsName], HsBangType)] -> [Doc])
-> [([HsName], HsBangType)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([HsName], HsBangType) -> Doc)
-> [([HsName], HsBangType)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([HsName], HsBangType) -> Doc
ppField ([([HsName], HsBangType)] -> Doc)
-> [([HsName], HsBangType)] -> Doc
forall a b. (a -> b) -> a -> b
$ [([HsName], HsBangType)]
fieldList)
pretty (HsConDecl _pos :: SrcLoc
_pos name :: HsName
name@(HsSymbol _) [l :: HsBangType
l, r :: HsBangType
r]) =
[Doc] -> Doc
myFsep [Indent -> HsBangType -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype HsBangType
l, HsName -> Doc
ppHsName HsName
name,
Indent -> HsBangType -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype HsBangType
r]
pretty (HsConDecl _pos :: SrcLoc
_pos name :: HsName
name typeList :: [HsBangType]
typeList) =
[Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ HsName -> Doc
ppHsName HsName
name Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (HsBangType -> Doc) -> [HsBangType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> HsBangType -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype) [HsBangType]
typeList
ppField :: ([HsName],HsBangType) -> Doc
ppField :: ([HsName], HsBangType) -> Doc
ppField (names :: [HsName]
names, ty :: HsBangType
ty) =
[Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsName] -> [Doc]) -> [HsName] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsName -> Doc) -> [HsName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsName -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsName] -> [Doc]) -> [HsName] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [HsName]
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[String -> Doc
text "::", HsBangType -> Doc
forall a. Pretty a => a -> Doc
pretty HsBangType
ty]
instance Pretty HsBangType where
prettyPrec :: Indent -> HsBangType -> Doc
prettyPrec _ (HsBangedTy ty :: HsType
ty) = Char -> Doc
char '!' Doc -> Doc -> Doc
<<>> HsType -> Doc
ppHsAType HsType
ty
prettyPrec p :: Indent
p (HsUnBangedTy ty :: HsType
ty) = Indent -> HsType -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
p HsType
ty
ppHsDeriving :: [HsQName] -> Doc
ppHsDeriving :: [HsQName] -> Doc
ppHsDeriving [] = Doc
empty
ppHsDeriving [d :: HsQName
d] = String -> Doc
text "deriving" Doc -> Doc -> Doc
<+> HsQName -> Doc
ppHsQName HsQName
d
ppHsDeriving ds :: [HsQName]
ds = String -> Doc
text "deriving" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((HsQName -> Doc) -> [HsQName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsQName -> Doc
ppHsQName [HsQName]
ds)
instance Pretty HsQualType where
pretty :: HsQualType -> Doc
pretty (HsQualType context :: HsContext
context htype :: HsType
htype) =
[Doc] -> Doc
myFsep [HsContext -> Doc
ppHsContext HsContext
context, HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
htype]
ppHsBType :: HsType -> Doc
ppHsBType :: HsType -> Doc
ppHsBType = Indent -> HsType -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype
ppHsAType :: HsType -> Doc
ppHsAType :: HsType -> Doc
ppHsAType = Indent -> HsType -> 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 HsType where
prettyPrec :: Indent -> HsType -> Doc
prettyPrec p :: Indent
p (HsTyFun a :: HsType
a b :: HsType
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 [HsType -> Doc
ppHsBType HsType
a, String -> Doc
text "->", HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
b]
prettyPrec _ (HsTyTuple l :: [HsType]
l) = [Doc] -> Doc
parenList ([Doc] -> Doc) -> ([HsType] -> [Doc]) -> [HsType] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType -> Doc) -> [HsType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsType -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsType] -> Doc) -> [HsType] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsType]
l
prettyPrec p :: Indent
p (HsTyApp a :: HsType
a b :: HsType
b)
| HsType
a HsType -> HsType -> Bool
forall a. Eq a => a -> a -> Bool
== HsType
list_tycon = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
b
| Bool
otherwise = 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 [HsType -> Doc
forall a. Pretty a => a -> Doc
pretty HsType
a, HsType -> Doc
ppHsAType HsType
b]
prettyPrec _ (HsTyVar name :: HsName
name) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name
prettyPrec _ (HsTyCon name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name
instance Pretty HsRhs where
pretty :: HsRhs -> Doc
pretty (HsUnGuardedRhs e :: HsExp
e) = Doc
equals Doc -> Doc -> Doc
<+> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e
pretty (HsGuardedRhss guardList :: [HsGuardedRhs]
guardList) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([HsGuardedRhs] -> [Doc]) -> [HsGuardedRhs] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsGuardedRhs -> Doc) -> [HsGuardedRhs] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsGuardedRhs -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsGuardedRhs] -> Doc) -> [HsGuardedRhs] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsGuardedRhs]
guardList
instance Pretty HsGuardedRhs where
pretty :: HsGuardedRhs -> Doc
pretty (HsGuardedRhs _pos :: SrcLoc
_pos guard :: HsExp
guard body :: HsExp
body) =
[Doc] -> Doc
myFsep [Char -> Doc
char '|', HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
guard, Doc
equals, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
body]
instance Pretty HsLiteral where
pretty :: HsLiteral -> Doc
pretty (HsInt i :: Integer
i) = Integer -> Doc
integer Integer
i
pretty (HsChar c :: Char
c) = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
pretty (HsString s :: String
s) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)
pretty (HsFrac r :: Rational
r) = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
pretty (HsCharPrim c :: Char
c) = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c) Doc -> Doc -> Doc
<<>> Char -> Doc
char '#'
pretty (HsStringPrim s :: String
s) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s) Doc -> Doc -> Doc
<<>> Char -> Doc
char '#'
pretty (HsIntPrim i :: Integer
i) = Integer -> Doc
integer Integer
i Doc -> Doc -> Doc
<<>> Char -> Doc
char '#'
pretty (HsFloatPrim r :: Rational
r) = Float -> Doc
float (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<<>> Char -> Doc
char '#'
pretty (HsDoublePrim 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 HsExp where
pretty :: HsExp -> Doc
pretty (HsLit l :: HsLiteral
l) = HsLiteral -> Doc
forall a. Pretty a => a -> Doc
pretty HsLiteral
l
pretty (HsInfixApp a :: HsExp
a op :: HsQOp
op b :: HsExp
b) = [Doc] -> Doc
myFsep [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
a, HsQOp -> Doc
forall a. Pretty a => a -> Doc
pretty HsQOp
op, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
b]
pretty (HsNegApp e :: HsExp
e) = [Doc] -> Doc
myFsep [Char -> Doc
char '-', HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e]
pretty (HsApp a :: HsExp
a b :: HsExp
b) = [Doc] -> Doc
myFsep [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
a, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
b]
pretty (HsLambda _loc :: SrcLoc
_loc expList :: [HsPat]
expList body :: HsExp
body) = [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]
: (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty [HsPat]
expList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "->", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
body]
pretty (HsLet expList :: [HsDecl]
expList letBody :: HsExp
letBody) =
[Doc] -> Doc
myFsep [String -> Doc
text "let" Doc -> Doc -> Doc
<+> (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
expList),
String -> Doc
text "in", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
letBody]
pretty (HsIf cond :: HsExp
cond thenexp :: HsExp
thenexp elsexp :: HsExp
elsexp) =
[Doc] -> Doc
myFsep [String -> Doc
text "if", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
cond,
String -> Doc
text "then", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
thenexp,
String -> Doc
text "else", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
elsexp]
pretty (HsCase cond :: HsExp
cond altList :: [HsAlt]
altList) =
[Doc] -> Doc
myFsep [String -> Doc
text "case", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
cond, String -> Doc
text "of"]
Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((HsAlt -> Doc) -> [HsAlt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsAlt -> Doc
forall a. Pretty a => a -> Doc
pretty [HsAlt]
altList)
pretty (HsDo stmtList :: [HsStmt]
stmtList) =
String -> Doc
text "do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((HsStmt -> Doc) -> [HsStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsStmt -> Doc
forall a. Pretty a => a -> Doc
pretty [HsStmt]
stmtList)
pretty (HsVar name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name
pretty (HsCon name :: HsQName
name) = HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name
pretty (HsTuple expList :: [HsExp]
expList) = [Doc] -> Doc
parenList ([Doc] -> Doc) -> ([HsExp] -> [Doc]) -> [HsExp] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExp -> Doc) -> [HsExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsExp] -> Doc) -> [HsExp] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsExp]
expList
pretty (HsParen e :: HsExp
e) = Doc -> Doc
parens (Doc -> Doc) -> (HsExp -> Doc) -> HsExp -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty (HsExp -> Doc) -> HsExp -> Doc
forall a b. (a -> b) -> a -> b
$ HsExp
e
pretty (HsLeftSection e :: HsExp
e op :: HsQOp
op) = Doc -> Doc
parens (HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e Doc -> Doc -> Doc
<+> HsQOp -> Doc
forall a. Pretty a => a -> Doc
pretty HsQOp
op)
pretty (HsRightSection op :: HsQOp
op e :: HsExp
e) = Doc -> Doc
parens (HsQOp -> Doc
forall a. Pretty a => a -> Doc
pretty HsQOp
op Doc -> Doc -> Doc
<+> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e)
pretty (HsRecConstr c :: HsQName
c fieldList :: [HsFieldUpdate]
fieldList) =
HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
c Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([HsFieldUpdate] -> [Doc]) -> [HsFieldUpdate] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldUpdate -> Doc) -> [HsFieldUpdate] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsFieldUpdate -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsFieldUpdate] -> Doc) -> [HsFieldUpdate] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsFieldUpdate]
fieldList)
pretty (HsRecUpdate e :: HsExp
e fieldList :: [HsFieldUpdate]
fieldList) =
HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([HsFieldUpdate] -> [Doc]) -> [HsFieldUpdate] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldUpdate -> Doc) -> [HsFieldUpdate] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsFieldUpdate -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsFieldUpdate] -> Doc) -> [HsFieldUpdate] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsFieldUpdate]
fieldList)
pretty (HsAsPat name :: HsName
name (HsIrrPat e :: HsExp
e)) =
[Doc] -> Doc
myFsep [HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name Doc -> Doc -> Doc
<<>> Char -> Doc
char '@', Char -> Doc
char '~' Doc -> Doc -> Doc
<<>> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e]
pretty (HsAsPat name :: HsName
name e :: HsExp
e) = [Doc] -> Doc
hcat [HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name, Char -> Doc
char '@', HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e]
pretty HsWildCard = Char -> Doc
char '_'
pretty (HsIrrPat e :: HsExp
e) = Char -> Doc
char '~' Doc -> Doc -> Doc
<<>> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e
pretty (HsList list :: [HsExp]
list) =
[Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([HsExp] -> [Doc]) -> [HsExp] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsExp] -> [Doc]) -> [HsExp] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExp -> Doc) -> [HsExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsExp] -> Doc) -> [HsExp] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsExp]
list
pretty (HsEnumFrom e :: HsExp
e) =
[Doc] -> Doc
bracketList [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e, String -> Doc
text ".."]
pretty (HsEnumFromTo from :: HsExp
from to :: HsExp
to) =
[Doc] -> Doc
bracketList [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
from, String -> Doc
text "..", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
to]
pretty (HsEnumFromThen from :: HsExp
from thenE :: HsExp
thenE) =
[Doc] -> Doc
bracketList [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
from Doc -> Doc -> Doc
<<>> Doc
comma, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
thenE, String -> Doc
text ".."]
pretty (HsEnumFromThenTo from :: HsExp
from thenE :: HsExp
thenE to :: HsExp
to) =
[Doc] -> Doc
bracketList [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
from Doc -> Doc -> Doc
<<>> Doc
comma, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
thenE,
String -> Doc
text "..", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
to]
pretty (HsListComp e :: HsExp
e stmtList :: [HsStmt]
stmtList) =
[Doc] -> Doc
bracketList ([HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e, Char -> Doc
char '|']
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsStmt] -> [Doc]) -> [HsStmt] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsStmt -> Doc) -> [HsStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsStmt -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsStmt] -> [Doc]) -> [HsStmt] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [HsStmt]
stmtList))
pretty (HsExpTypeSig _pos :: SrcLoc
_pos e :: HsExp
e ty :: HsQualType
ty) =
[Doc] -> Doc
myFsep [HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e, String -> Doc
text "::", HsQualType -> Doc
forall a. Pretty a => a -> Doc
pretty HsQualType
ty]
instance Pretty HsPat where
prettyPrec :: Indent -> HsPat -> Doc
prettyPrec _ (HsPVar name :: HsName
name) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name
prettyPrec _ (HsPLit lit :: HsLiteral
lit) = HsLiteral -> Doc
forall a. Pretty a => a -> Doc
pretty HsLiteral
lit
prettyPrec _ (HsPNeg p :: HsPat
p) = [Doc] -> Doc
myFsep [Char -> Doc
char '-', HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
p]
prettyPrec p :: Indent
p (HsPInfixApp a :: HsPat
a op :: HsQName
op b :: HsPat
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 [HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
a, HsQOp -> Doc
forall a. Pretty a => a -> Doc
pretty (HsQName -> HsQOp
HsQConOp HsQName
op), HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
b]
prettyPrec p :: Indent
p (HsPApp n :: HsQName
n ps :: [HsPat]
ps) = 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 (HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
n Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty [HsPat]
ps)
prettyPrec _ (HsPTuple ps :: [HsPat]
ps) = [Doc] -> Doc
parenList ([Doc] -> Doc) -> ([HsPat] -> [Doc]) -> [HsPat] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsPat] -> Doc) -> [HsPat] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsPat]
ps
prettyPrec _ (HsPList ps :: [HsPat]
ps) =
[Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([HsPat] -> [Doc]) -> [HsPat] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([HsPat] -> [Doc]) -> [HsPat] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsPat -> Doc) -> [HsPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsPat] -> Doc) -> [HsPat] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsPat]
ps
prettyPrec _ (HsPParen p :: HsPat
p) = Doc -> Doc
parens (Doc -> Doc) -> (HsPat -> Doc) -> HsPat -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty (HsPat -> Doc) -> HsPat -> Doc
forall a b. (a -> b) -> a -> b
$ HsPat
p
prettyPrec _ (HsPRec c :: HsQName
c fields :: [HsPatField]
fields) =
HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
c Doc -> Doc -> Doc
<<>> ([Doc] -> Doc
braceList ([Doc] -> Doc) -> ([HsPatField] -> [Doc]) -> [HsPatField] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsPatField -> Doc) -> [HsPatField] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsPatField -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsPatField] -> Doc) -> [HsPatField] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsPatField]
fields)
prettyPrec _ (HsPAsPat name :: HsName
name (HsPIrrPat pat :: HsPat
pat)) =
[Doc] -> Doc
myFsep [HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name Doc -> Doc -> Doc
<<>> Char -> Doc
char '@', Char -> Doc
char '~' Doc -> Doc -> Doc
<<>> HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
pat]
prettyPrec _ (HsPAsPat name :: HsName
name pat :: HsPat
pat) =
[Doc] -> Doc
hcat [HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
name, Char -> Doc
char '@', HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
pat]
prettyPrec _ HsPWildCard = Char -> Doc
char '_'
prettyPrec _ (HsPIrrPat pat :: HsPat
pat) = Char -> Doc
char '~' Doc -> Doc -> Doc
<<>> HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
pat
instance Pretty HsPatField where
pretty :: HsPatField -> Doc
pretty (HsPFieldPat name :: HsQName
name pat :: HsPat
pat) =
[Doc] -> Doc
myFsep [HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name, Doc
equals, HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
pat]
instance Pretty HsAlt where
pretty :: HsAlt -> Doc
pretty (HsAlt _pos :: SrcLoc
_pos e :: HsPat
e gAlts :: HsGuardedAlts
gAlts decls :: [HsDecl]
decls) =
[Doc] -> Doc
myFsep [HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
e, HsGuardedAlts -> Doc
forall a. Pretty a => a -> Doc
pretty HsGuardedAlts
gAlts] Doc -> Doc -> Doc
$$$ [HsDecl] -> Doc
ppWhere [HsDecl]
decls
instance Pretty HsGuardedAlts where
pretty :: HsGuardedAlts -> Doc
pretty (HsUnGuardedAlt e :: HsExp
e) = String -> Doc
text "->" Doc -> Doc -> Doc
<+> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e
pretty (HsGuardedAlts altList :: [HsGuardedAlt]
altList) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([HsGuardedAlt] -> [Doc]) -> [HsGuardedAlt] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsGuardedAlt -> Doc) -> [HsGuardedAlt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsGuardedAlt -> Doc
forall a. Pretty a => a -> Doc
pretty ([HsGuardedAlt] -> Doc) -> [HsGuardedAlt] -> Doc
forall a b. (a -> b) -> a -> b
$ [HsGuardedAlt]
altList
instance Pretty HsGuardedAlt where
pretty :: HsGuardedAlt -> Doc
pretty (HsGuardedAlt _pos :: SrcLoc
_pos e :: HsExp
e body :: HsExp
body) =
[Doc] -> Doc
myFsep [Char -> Doc
char '|', HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e, String -> Doc
text "->", HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
body]
instance Pretty HsStmt where
pretty :: HsStmt -> Doc
pretty (HsGenerator _loc :: SrcLoc
_loc e :: HsPat
e from :: HsExp
from) =
HsPat -> Doc
forall a. Pretty a => a -> Doc
pretty HsPat
e Doc -> Doc -> Doc
<+> String -> Doc
text "<-" Doc -> Doc -> Doc
<+> HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
from
pretty (HsQualifier e :: HsExp
e) = HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e
pretty (HsLetStmt declList :: [HsDecl]
declList) =
String -> Doc
text "let" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [HsDecl]
declList)
instance Pretty HsFieldUpdate where
pretty :: HsFieldUpdate -> Doc
pretty (HsFieldUpdate name :: HsQName
name e :: HsExp
e) =
[Doc] -> Doc
myFsep [HsQName -> Doc
forall a. Pretty a => a -> Doc
pretty HsQName
name, Doc
equals, HsExp -> Doc
forall a. Pretty a => a -> Doc
pretty HsExp
e]
instance Pretty HsQOp where
pretty :: HsQOp -> Doc
pretty (HsQVarOp n :: HsQName
n) = HsQName -> Doc
ppHsQNameInfix HsQName
n
pretty (HsQConOp n :: HsQName
n) = HsQName -> Doc
ppHsQNameInfix HsQName
n
ppHsQNameInfix :: HsQName -> Doc
ppHsQNameInfix :: HsQName -> Doc
ppHsQNameInfix name :: HsQName
name
| HsName -> Bool
isSymbolName (HsQName -> HsName
getName HsQName
name) = HsQName -> Doc
ppHsQName HsQName
name
| Bool
otherwise = Char -> Doc
char '`' Doc -> Doc -> Doc
<<>> HsQName -> Doc
ppHsQName HsQName
name Doc -> Doc -> Doc
<<>> Char -> Doc
char '`'
instance Pretty HsQName where
pretty :: HsQName -> Doc
pretty name :: HsQName
name = Bool -> Doc -> Doc
parensIf (HsName -> Bool
isSymbolName (HsQName -> HsName
getName HsQName
name)) (HsQName -> Doc
ppHsQName HsQName
name)
ppHsQName :: HsQName -> Doc
ppHsQName :: HsQName -> Doc
ppHsQName (UnQual name :: HsName
name) = HsName -> Doc
ppHsName HsName
name
ppHsQName (Qual m :: Module
m name :: HsName
name) = Module -> Doc
forall a. Pretty a => a -> Doc
pretty Module
m Doc -> Doc -> Doc
<<>> Char -> Doc
char '.' Doc -> Doc -> Doc
<<>> HsName -> Doc
ppHsName HsName
name
ppHsQName (Special sym :: HsSpecialCon
sym) = String -> Doc
text (HsSpecialCon -> String
specialName HsSpecialCon
sym)
instance Pretty HsOp where
pretty :: HsOp -> Doc
pretty (HsVarOp n :: HsName
n) = HsName -> Doc
ppHsNameInfix HsName
n
pretty (HsConOp n :: HsName
n) = HsName -> Doc
ppHsNameInfix HsName
n
ppHsNameInfix :: HsName -> Doc
ppHsNameInfix :: HsName -> Doc
ppHsNameInfix name :: HsName
name
| HsName -> Bool
isSymbolName HsName
name = HsName -> Doc
ppHsName HsName
name
| Bool
otherwise = Char -> Doc
char '`' Doc -> Doc -> Doc
<<>> HsName -> Doc
ppHsName HsName
name Doc -> Doc -> Doc
<<>> Char -> Doc
char '`'
instance Pretty HsName where
pretty :: HsName -> Doc
pretty name :: HsName
name = Bool -> Doc -> Doc
parensIf (HsName -> Bool
isSymbolName HsName
name) (HsName -> Doc
ppHsName HsName
name)
ppHsName :: HsName -> Doc
ppHsName :: HsName -> Doc
ppHsName (HsIdent s :: String
s) = String -> Doc
text String
s
ppHsName (HsSymbol s :: String
s) = String -> Doc
text String
s
instance Pretty HsCName where
pretty :: HsCName -> Doc
pretty (HsVarName n :: HsName
n) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
n
pretty (HsConName n :: HsName
n) = HsName -> Doc
forall a. Pretty a => a -> Doc
pretty HsName
n
isSymbolName :: HsName -> Bool
isSymbolName :: HsName -> Bool
isSymbolName (HsSymbol _) = Bool
True
isSymbolName _ = Bool
False
getName :: HsQName -> HsName
getName :: HsQName -> HsName
getName (UnQual s :: HsName
s) = HsName
s
getName (Qual _ s :: HsName
s) = HsName
s
getName (Special HsCons) = String -> HsName
HsSymbol ":"
getName (Special HsFunCon) = String -> HsName
HsSymbol "->"
getName (Special s :: HsSpecialCon
s) = String -> HsName
HsIdent (HsSpecialCon -> String
specialName HsSpecialCon
s)
specialName :: HsSpecialCon -> String
specialName :: HsSpecialCon -> String
specialName HsUnitCon = "()"
specialName HsListCon = "[]"
specialName HsFunCon = "->"
specialName (HsTupleCon n :: Indent
n) = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Indent -> Char -> String
forall a. Indent -> a -> [a]
replicate (Indent
nIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
-1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
specialName HsCons = ":"
ppHsContext :: HsContext -> Doc
ppHsContext :: HsContext -> Doc
ppHsContext [] = Doc
empty
ppHsContext context :: HsContext
context = [Doc] -> Doc
mySep [[Doc] -> Doc
parenList ((HsAsst -> Doc) -> HsContext -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsAsst -> Doc
ppHsAsst HsContext
context), String -> Doc
text "=>"]
ppHsAsst :: HsAsst -> Doc
ppHsAsst :: HsAsst -> Doc
ppHsAsst (a :: HsQName
a,ts :: [HsType]
ts) = [Doc] -> Doc
myFsep (HsQName -> Doc
ppHsQName HsQName
a Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (HsType -> Doc) -> [HsType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map HsType -> Doc
ppHsAType [HsType]
ts)
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
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
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 Doc
space 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
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
case PPLayout
e of
PPOffsideRule -> 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
PPSemiColon -> 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
_ -> [Doc] -> Doc
flatBlock [Doc]
dl
ppBindings :: [Doc] -> Doc
ppBindings :: [Doc] -> Doc
ppBindings 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] -> Doc
vcat [Doc]
dl
PPSemiColon -> [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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl
_ -> [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 ([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
markLine :: SrcLoc -> Doc -> Doc
markLine :: SrcLoc -> Doc -> Doc
markLine loc :: SrcLoc
loc doc :: Doc
doc = do
PPHsMode
e <- DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
let y :: Indent
y = SrcLoc -> Indent
srcLine SrcLoc
loc
let line :: a -> Doc
line l :: a
l =
String -> Doc
text ("{-# LINE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ " \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
srcFilename SrcLoc
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\" #-}")
if PPHsMode -> Bool
linePragmas PPHsMode
e then (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice (Indent -> Doc
forall a. Show a => a -> Doc
line Indent
y Doc -> Doc -> Doc
$$) (Indent -> Doc
forall a. Show a => a -> Doc
line (Indent
yIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
+1) Doc -> Doc -> Doc
<+>) Doc
doc
else Doc
doc