module Agda.Compiler.MAlonzo.Pretty where
import qualified Agda.Utils.Haskell.Syntax as HS
import Text.PrettyPrint (empty)
import Agda.Compiler.MAlonzo.Encode
import Agda.Utils.Pretty
prettyPrint :: Pretty a => a -> String
prettyPrint :: forall a. Pretty a => a -> String
prettyPrint = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty
instance Pretty HS.Module where
pretty :: Module -> Doc
pretty (HS.Module ModuleName
m [ModulePragma]
pragmas [ImportDecl]
imps [Decl]
decls) =
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ModulePragma]
pragmas
, [ Doc
"" | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma]
pragmas ]
, [ Doc
"module" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ModuleName
m Doc -> Doc -> Doc
<+> Doc
"where" ]
, [ Doc
"" ]
, forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ImportDecl]
imps
, [ Doc
"" ]
, forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Decl]
decls
]
instance Pretty HS.ModulePragma where
pretty :: ModulePragma -> Doc
pretty (HS.LanguagePragma [Name]
ps) =
Doc
"{-#" Doc -> Doc -> Doc
<+> Doc
"LANGUAGE" Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name]
ps) Doc -> Doc -> Doc
<+> Doc
"#-}"
pretty (HS.OtherPragma String
p) =
String -> Doc
text String
p
instance Pretty HS.ImportDecl where
pretty :: ImportDecl -> Doc
pretty HS.ImportDecl{ importModule :: ImportDecl -> ModuleName
HS.importModule = ModuleName
m
, importQualified :: ImportDecl -> Bool
HS.importQualified = Bool
q
, importSpecs :: ImportDecl -> Maybe (Bool, [ImportSpec])
HS.importSpecs = Maybe (Bool, [ImportSpec])
specs } =
forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep [ Doc
"import"
, if Bool
q then Doc
"qualified" else Doc
empty
, forall a. Pretty a => a -> Doc
pretty ModuleName
m
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty forall {a}. Pretty a => (Bool, [a]) -> Doc
prSpecs Maybe (Bool, [ImportSpec])
specs ]
where prSpecs :: (Bool, [a]) -> Doc
prSpecs (Bool
hide, [a]
specs) =
forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep [ if Bool
hide then Doc
"hiding" else Doc
empty
, Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [a]
specs ]
instance Pretty HS.ImportSpec where
pretty :: ImportSpec -> Doc
pretty (HS.IVar Name
x) = forall a. Pretty a => a -> Doc
pretty Name
x
instance Pretty HS.Decl where
pretty :: Decl -> Doc
pretty = \case
HS.TypeDecl Name
f [TyVarBind]
xs Type
t ->
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"type" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Name
f Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [TyVarBind]
xs) Doc -> Doc -> Doc
<+> Doc
"="
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t ]
HS.DataDecl DataOrNew
newt Name
d [TyVarBind]
xs [ConDecl]
cons [Deriving]
derv ->
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty DataOrNew
newt Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Name
d Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [TyVarBind]
xs)
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConDecl]
cons then Doc
empty
else Doc
"=" Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
" |" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ConDecl]
cons)
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => [(QName, t Type)] -> Doc
prDeriving [Deriving]
derv ]
where
prDeriving :: [(QName, t Type)] -> Doc
prDeriving [] = Doc
empty
prDeriving [(QName, t Type)]
ds = Doc
"deriving" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {t :: * -> *}. Foldable t => (QName, t Type) -> Doc
prDer [(QName, t Type)]
ds)
prDer :: (QName, t Type) -> Doc
prDer (QName
d, t Type
ts) = forall a. Pretty a => a -> Doc
pretty (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
HS.TyApp (QName -> Type
HS.TyCon QName
d) t Type
ts)
HS.TypeSig [Name]
fs Type
t ->
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep (forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Name]
fs)) Doc -> Doc -> Doc
<+> Doc
"::"
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t ]
HS.FunBind [Match]
ms -> forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Match]
ms
HS.LocalBind Strictness
s Name
f Rhs
rhs ->
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Strictness
s forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty Name
f
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc
prettyRhs String
"=" Rhs
rhs
]
HS.PatSyn Pat
p1 Pat
p2 -> forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"pattern" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Pat
p1 Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Pat
p2 ]
HS.FakeDecl String
s -> String -> Doc
text String
s
HS.Comment String
s -> forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Doc
"--" Doc -> Doc -> Doc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) (String -> [String]
lines String
s)
instance Pretty HS.ConDecl where
pretty :: ConDecl -> Doc
pretty (HS.ConDecl Name
c [(Maybe Strictness, Type)]
sts) =
forall a. Pretty a => a -> Doc
pretty Name
c Doc -> Doc -> Doc
<+>
forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe Strictness
s, Type
t) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty forall a. Pretty a => a -> Doc
pretty Maybe Strictness
s forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10 Type
t) [(Maybe Strictness, Type)]
sts)
instance Pretty HS.Strictness where
pretty :: Strictness -> Doc
pretty Strictness
HS.Strict = Doc
"!"
pretty Strictness
HS.Lazy = Doc
empty
instance Pretty HS.Match where
pretty :: Match -> Doc
pretty (HS.Match Name
f [Pat]
ps Rhs
rhs Maybe Binds
wh) =
Maybe Binds -> Doc -> Doc
prettyWhere Maybe Binds
wh forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Name
f Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10) [Pat]
ps)
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc
prettyRhs String
"=" Rhs
rhs ]
prettyWhere :: Maybe HS.Binds -> Doc -> Doc
prettyWhere :: Maybe Binds -> Doc -> Doc
prettyWhere Maybe Binds
Nothing Doc
doc = Doc
doc
prettyWhere (Just Binds
b) Doc
doc =
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat [ Doc
doc, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"where", Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Binds
b ] ]
instance Pretty HS.Pat where
prettyPrec :: Int -> Pat -> Doc
prettyPrec Int
pr Pat
pat =
case Pat
pat of
HS.PVar Name
x -> forall a. Pretty a => a -> Doc
pretty Name
x
HS.PLit Literal
l -> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
pr Literal
l
HS.PAsPat Name
x Pat
p -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Name
x forall a. Semigroup a => a -> a -> a
<> Doc
"@" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
11 Pat
p
Pat
HS.PWildCard -> Doc
"_"
HS.PBangPat Pat
p -> Doc
"!" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
11 Pat
p
HS.PApp QName
c [Pat]
ps -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
9) forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty QName
c Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10) [Pat]
ps)
HS.PatTypeSig Pat
p Type
t -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Pat
p Doc -> Doc -> Doc
<+> Doc
"::", Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t ]
HS.PIrrPat Pat
p -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ Doc
"~" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
11 Pat
p
prettyRhs :: String -> HS.Rhs -> Doc
prettyRhs :: String -> Rhs -> Doc
prettyRhs String
eq (HS.UnGuardedRhs Exp
e) = String -> Doc
text String
eq Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp
e
prettyRhs String
eq (HS.GuardedRhss [GuardedRhs]
rhss) = forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> GuardedRhs -> Doc
prettyGuardedRhs String
eq) [GuardedRhs]
rhss
prettyGuardedRhs :: String -> HS.GuardedRhs -> Doc
prettyGuardedRhs :: String -> GuardedRhs -> Doc
prettyGuardedRhs String
eq (HS.GuardedRhs [Stmt]
ss Exp
e) =
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"|" Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
sep (forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Stmt]
ss) Doc -> Doc -> Doc
<+> String -> Doc
text String
eq
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Exp
e ]
instance Pretty HS.Binds where
pretty :: Binds -> Doc
pretty (HS.BDecls [Decl]
ds) = forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Decl]
ds
instance Pretty HS.DataOrNew where
pretty :: DataOrNew -> Doc
pretty DataOrNew
HS.DataType = Doc
"data"
pretty DataOrNew
HS.NewType = Doc
"newtype"
instance Pretty HS.TyVarBind where
pretty :: TyVarBind -> Doc
pretty (HS.UnkindedVar Name
x) = forall a. Pretty a => a -> Doc
pretty Name
x
instance Pretty HS.Type where
prettyPrec :: Int -> Type -> Doc
prettyPrec Int
pr Type
t =
case Type
t of
HS.TyForall [TyVarBind]
xs Type
t ->
Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ (Doc
"forall" Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [TyVarBind]
xs)) forall a. Semigroup a => a -> a -> a
<> Doc
"."
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t ]
HS.TyFun Type
a Type
b ->
Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
4) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
5 Type
a Doc -> Doc -> Doc
<+> Doc
"->", forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
4 Type
b ]
HS.TyCon QName
c -> forall a. Pretty a => a -> Doc
pretty QName
c
HS.TyVar Name
x -> forall a. Pretty a => a -> Doc
pretty Name
x
HS.TyApp (HS.TyCon (HS.UnQual (HS.Ident String
"[]"))) Type
t ->
Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t
t :: Type
t@HS.TyApp{} ->
Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
9) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
9 Type
f
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10) [Type]
ts ]
where
Type
f : [Type]
ts = Type -> [Type] -> [Type]
appView Type
t []
appView :: Type -> [Type] -> [Type]
appView (HS.TyApp Type
a Type
b) [Type]
as = Type -> [Type] -> [Type]
appView Type
a (Type
b forall a. a -> [a] -> [a]
: [Type]
as)
appView Type
t [Type]
as = Type
t forall a. a -> [a] -> [a]
: [Type]
as
HS.FakeType String
s -> String -> Doc
text String
s
instance Pretty HS.Stmt where
pretty :: Stmt -> Doc
pretty (HS.Qualifier Exp
e) = forall a. Pretty a => a -> Doc
pretty Exp
e
pretty (HS.Generator Pat
p Exp
e) = forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Pat
p Doc -> Doc -> Doc
<+> Doc
"<-", Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Exp
e ]
instance Pretty HS.Literal where
prettyPrec :: Int -> Literal -> Doc
prettyPrec Int
pr = \case
HS.Int Integer
n -> forall n. (Ord n, Num n) => n -> Doc -> Doc
parensIfNeg Integer
n forall a b. (a -> b) -> a -> b
$ Integer -> Doc
integer Integer
n
HS.Frac Rational
x -> forall n. (Ord n, Num n) => n -> Doc -> Doc
parensIfNeg Double
d forall a b. (a -> b) -> a -> b
$ Double -> Doc
double Double
d
where
d :: Double
d = forall a. Fractional a => Rational -> a
fromRational Rational
x
HS.Char Char
c -> String -> Doc
text (forall a. Show a => a -> String
show Char
c)
HS.String Text
s -> String -> Doc
text (forall a. Show a => a -> String
show Text
s)
where
parensIfNeg :: (Ord n, Num n) => n -> Doc -> Doc
parensIfNeg :: forall n. (Ord n, Num n) => n -> Doc -> Doc
parensIfNeg n
x =
if n
x forall a. Ord a => a -> a -> Bool
< n
0 then Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
10) else forall a. a -> a
id
instance Pretty HS.Exp where
prettyPrec :: Int -> Exp -> Doc
prettyPrec Int
pr Exp
e =
case Exp
e of
HS.Var QName
x -> forall a. Pretty a => a -> Doc
pretty QName
x
HS.Con QName
c -> forall a. Pretty a => a -> Doc
pretty QName
c
HS.Lit Literal
l -> forall a. Pretty a => a -> Doc
pretty Literal
l
HS.InfixApp Exp
a QOp
qop Exp
b -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 Exp
a
, forall a. Pretty a => a -> Doc
pretty QOp
qop Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 Exp
b ]
HS.Ann Exp
e Type
ty -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 Exp
e
, Doc
"::"
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 Type
ty
]
HS.App{} -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
9) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
9 Exp
f
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10) [Exp]
es ]
where
Exp
f : [Exp]
es = Exp -> [Exp] -> [Exp]
appView Exp
e []
appView :: Exp -> [Exp] -> [Exp]
appView (HS.App Exp
f Exp
e) [Exp]
es = Exp -> [Exp] -> [Exp]
appView Exp
f (Exp
e forall a. a -> [a] -> [a]
: [Exp]
es)
appView Exp
f [Exp]
es = Exp
f forall a. a -> [a] -> [a]
: [Exp]
es
HS.Lambda [Pat]
ps Exp
e -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"\\" Doc -> Doc -> Doc
<+> forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
10) [Pat]
ps) Doc -> Doc -> Doc
<+> Doc
"->"
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Exp
e ]
HS.Let Binds
bs Exp
e -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"let" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Binds
bs Doc -> Doc -> Doc
<+> Doc
"in"
, forall a. Pretty a => a -> Doc
pretty Exp
e ]
HS.If Exp
a Exp
b Exp
c -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Doc
"if" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp
a
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"then" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp
b
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"else" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 Exp
c ]
HS.Case Exp
e [Alt]
bs -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat [ Doc
"case" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Exp
e Doc -> Doc -> Doc
<+> Doc
"of"
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [Alt]
bs ]
HS.ExpTypeSig Exp
e Type
t -> Bool -> Doc -> Doc
mparens (Int
pr forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Exp
e Doc -> Doc -> Doc
<+> Doc
"::"
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pretty Type
t ]
HS.NegApp Exp
exp -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Doc
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty Exp
exp
HS.FakeExp String
s -> String -> Doc
text String
s
instance Pretty HS.Alt where
pretty :: Alt -> Doc
pretty (HS.Alt Pat
pat Rhs
rhs Maybe Binds
wh) =
Maybe Binds -> Doc -> Doc
prettyWhere Maybe Binds
wh forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ forall a. Pretty a => a -> Doc
pretty Pat
pat, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc
prettyRhs String
"->" Rhs
rhs ]
instance Pretty HS.ModuleName where
pretty :: ModuleName -> Doc
pretty ModuleName
m = String -> Doc
text String
s
where HS.ModuleName String
s = ModuleName -> ModuleName
encodeModuleName ModuleName
m
instance Pretty HS.QName where
pretty :: QName -> Doc
pretty QName
q = Bool -> Doc -> Doc
mparens (QName -> Bool
isOperator QName
q) (QName -> Doc
prettyQName QName
q)
instance Pretty HS.Name where
pretty :: Name -> Doc
pretty (HS.Ident String
s) = String -> Doc
text String
s
pretty (HS.Symbol String
s) = String -> Doc
text String
s
instance Pretty HS.QOp where
pretty :: QOp -> Doc
pretty (HS.QVarOp QName
x)
| QName -> Bool
isOperator QName
x = QName -> Doc
prettyQName QName
x
| Bool
otherwise = Doc
"`" forall a. Semigroup a => a -> a -> a
<> QName -> Doc
prettyQName QName
x forall a. Semigroup a => a -> a -> a
<> Doc
"`"
isOperator :: HS.QName -> Bool
isOperator :: QName -> Bool
isOperator QName
q =
case QName
q of
HS.Qual ModuleName
_ Name
x -> Name -> Bool
isOp Name
x
HS.UnQual Name
x -> Name -> Bool
isOp Name
x
where
isOp :: Name -> Bool
isOp HS.Symbol{} = Bool
True
isOp HS.Ident{} = Bool
False
prettyQName :: HS.QName -> Doc
prettyQName :: QName -> Doc
prettyQName (HS.Qual ModuleName
m Name
x) = forall a. Pretty a => a -> Doc
pretty ModuleName
m forall a. Semigroup a => a -> a -> a
<> Doc
"." forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty Name
x
prettyQName (HS.UnQual Name
x) = forall a. Pretty a => a -> Doc
pretty Name
x