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