module Curry.FlatCurry.Pretty
( ppProg, ppHeader, ppExports, ppImport, ppTypeDecl, ppTypeExpr
, ppFuncDecl, ppExpr, ppLiteral, ppOpDecl
) where
import Data.Char (ord)
import Curry.Base.Pretty
import Curry.FlatCurry.Type
ppProg :: Prog -> Doc
ppProg :: Prog -> Doc
ppProg (Prog m :: String
m is :: [String]
is ts :: [TypeDecl]
ts fs :: [FuncDecl]
fs os :: [OpDecl]
os) = [Doc] -> Doc
sepByBlankLine
[ String -> [TypeDecl] -> [FuncDecl] -> Doc
ppHeader String
m [TypeDecl]
ts [FuncDecl]
fs
, [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
ppImport [String]
is)
, [Doc] -> Doc
vcat ((OpDecl -> Doc) -> [OpDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map OpDecl -> Doc
ppOpDecl [OpDecl]
os)
, [Doc] -> Doc
sepByBlankLine ((TypeDecl -> Doc) -> [TypeDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeDecl -> Doc
ppTypeDecl [TypeDecl]
ts)
, [Doc] -> Doc
sepByBlankLine ((FuncDecl -> Doc) -> [FuncDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FuncDecl -> Doc
ppFuncDecl [FuncDecl]
fs)
]
ppHeader :: String -> [TypeDecl] -> [FuncDecl] -> Doc
m :: String
m ts :: [TypeDecl]
ts fs :: [FuncDecl]
fs = [Doc] -> Doc
sep
[String -> Doc
text "module" Doc -> Doc -> Doc
<+> String -> Doc
text String
m, [TypeDecl] -> [FuncDecl] -> Doc
ppExports [TypeDecl]
ts [FuncDecl]
fs, String -> Doc
text "where"]
ppExports :: [TypeDecl] -> [FuncDecl] -> Doc
ppExports :: [TypeDecl] -> [FuncDecl] -> Doc
ppExports ts :: [TypeDecl]
ts fs :: [FuncDecl]
fs = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
list ((TypeDecl -> Doc) -> [TypeDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeDecl -> Doc
ppTypeExport [TypeDecl]
ts [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [FuncDecl] -> [Doc]
ppFuncExports [FuncDecl]
fs)
ppTypeExport :: TypeDecl -> Doc
ppTypeExport :: TypeDecl -> Doc
ppTypeExport (Type qn :: QName
qn vis :: Visibility
vis _ cs :: [ConsDecl]
cs)
| Visibility
vis Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Private = Doc
empty
| (ConsDecl -> Bool) -> [ConsDecl] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ConsDecl -> Bool
isPublicCons [ConsDecl]
cs = QName -> Doc
ppPrefixOp QName
qn Doc -> Doc -> Doc
<+> String -> Doc
text "(..)"
| Bool
otherwise = QName -> Doc
ppPrefixOp QName
qn Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
list ([ConsDecl] -> [Doc]
ppConsExports [ConsDecl]
cs))
where isPublicCons :: ConsDecl -> Bool
isPublicCons (Cons _ _ v :: Visibility
v _) = Visibility
v Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Public
ppTypeExport (TypeSyn qn :: QName
qn vis :: Visibility
vis _ _ )
| Visibility
vis Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Private = Doc
empty
| Bool
otherwise = QName -> Doc
ppPrefixOp QName
qn
ppConsExports :: [ConsDecl] -> [Doc]
ppConsExports :: [ConsDecl] -> [Doc]
ppConsExports cs :: [ConsDecl]
cs = [ QName -> Doc
ppPrefixOp QName
qn | Cons qn :: QName
qn _ Public _ <- [ConsDecl]
cs]
ppFuncExports :: [FuncDecl] -> [Doc]
ppFuncExports :: [FuncDecl] -> [Doc]
ppFuncExports fs :: [FuncDecl]
fs = [ QName -> Doc
ppPrefixOp QName
qn | Func qn :: QName
qn _ Public _ _ <- [FuncDecl]
fs]
ppImport :: String -> Doc
ppImport :: String -> Doc
ppImport m :: String
m = String -> Doc
text "import" Doc -> Doc -> Doc
<+> String -> Doc
text String
m
ppOpDecl :: OpDecl -> Doc
ppOpDecl :: OpDecl -> Doc
ppOpDecl (Op qn :: QName
qn fix :: Fixity
fix n :: Integer
n) = Fixity -> Doc
ppFixity Fixity
fix Doc -> Doc -> Doc
<+> Integer -> Doc
integer Integer
n Doc -> Doc -> Doc
<+> QName -> Doc
ppInfixOp QName
qn
ppFixity :: Fixity -> Doc
ppFixity :: Fixity -> Doc
ppFixity InfixOp = String -> Doc
text "infix"
ppFixity InfixlOp = String -> Doc
text "infixl"
ppFixity InfixrOp = String -> Doc
text "infixr"
ppTypeDecl :: TypeDecl -> Doc
ppTypeDecl :: TypeDecl -> Doc
ppTypeDecl (Type qn :: QName
qn _ vs :: [TVarIndex]
vs cs :: [ConsDecl]
cs) = String -> Doc
text "data" Doc -> Doc -> Doc
<+> QName -> Doc
ppQName QName
qn
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppTVarIndex [TVarIndex]
vs) Doc -> Doc -> Doc
$+$ [ConsDecl] -> Doc
ppConsDecls [ConsDecl]
cs
ppTypeDecl (TypeSyn qn :: QName
qn _ vs :: [TVarIndex]
vs ty :: TypeExpr
ty) = String -> Doc
text "type" Doc -> Doc -> Doc
<+> QName -> Doc
ppQName QName
qn
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppTVarIndex [TVarIndex]
vs) Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TVarIndex -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty
ppConsDecls :: [ConsDecl] -> Doc
ppConsDecls :: [ConsDecl] -> Doc
ppConsDecls cs :: [ConsDecl]
cs = Doc -> Doc
indent (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
$
(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 '|')) ((ConsDecl -> Doc) -> [ConsDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ConsDecl -> Doc
ppConsDecl [ConsDecl]
cs)
ppConsDecl :: ConsDecl -> Doc
ppConsDecl :: ConsDecl -> Doc
ppConsDecl (Cons qn :: QName
qn _ _ tys :: [TypeExpr]
tys) = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ QName -> Doc
ppPrefixOp QName
qn Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TVarIndex -> TypeExpr -> Doc
ppTypeExpr 2) [TypeExpr]
tys
ppTypeExpr :: Int -> TypeExpr -> Doc
ppTypeExpr :: TVarIndex -> TypeExpr -> Doc
ppTypeExpr _ (TVar v :: TVarIndex
v) = TVarIndex -> Doc
ppTVarIndex TVarIndex
v
ppTypeExpr p :: TVarIndex
p (FuncType ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep
[TVarIndex -> TypeExpr -> Doc
ppTypeExpr 1 TypeExpr
ty1, Doc
rarrow, TVarIndex -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty2]
ppTypeExpr p :: TVarIndex
p (TCons qn :: QName
qn tys :: [TypeExpr]
tys) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([TypeExpr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeExpr]
tys)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep
(QName -> Doc
ppPrefixOp QName
qn Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TVarIndex -> TypeExpr -> Doc
ppTypeExpr 2) [TypeExpr]
tys)
ppTypeExpr p :: TVarIndex
p (ForallType vs :: [TVarIndex]
vs ty :: TypeExpr
ty)
| [TVarIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TVarIndex]
vs = TVarIndex -> TypeExpr -> Doc
ppTypeExpr TVarIndex
p TypeExpr
ty
| Bool
otherwise = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [TVarIndex] -> Doc
ppQuantifiedVars [TVarIndex]
vs Doc -> Doc -> Doc
<+> TVarIndex -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty
ppQuantifiedVars :: [TVarIndex] -> Doc
ppQuantifiedVars :: [TVarIndex] -> Doc
ppQuantifiedVars vs :: [TVarIndex]
vs
| [TVarIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TVarIndex]
vs = Doc
empty
| Bool
otherwise = String -> Doc
text "forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppTVarIndex [TVarIndex]
vs) Doc -> Doc -> Doc
<+> Char -> Doc
char '.'
ppTVarIndex :: TVarIndex -> Doc
ppTVarIndex :: TVarIndex -> Doc
ppTVarIndex i :: TVarIndex
i = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [String]
vars [String] -> TVarIndex -> String
forall a. [a] -> TVarIndex -> a
!! TVarIndex
i
where vars :: [String]
vars = [ if TVarIndex
n TVarIndex -> TVarIndex -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [Char
c] else Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: TVarIndex -> String
forall a. Show a => a -> String
show TVarIndex
n
| TVarIndex
n <- [0 :: Int ..], Char
c <- ['a' .. 'z']
]
ppFuncDecl :: FuncDecl -> Doc
ppFuncDecl :: FuncDecl -> Doc
ppFuncDecl (Func qn :: QName
qn _ _ ty :: TypeExpr
ty r :: Rule
r)
= [Doc] -> Doc
hsep [QName -> Doc
ppPrefixOp QName
qn, String -> Doc
text "::", TVarIndex -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty]
Doc -> Doc -> Doc
$+$ QName -> Doc
ppPrefixOp QName
qn Doc -> Doc -> Doc
<+> Rule -> Doc
ppRule Rule
r
ppRule :: Rule -> Doc
ppRule :: Rule -> Doc
ppRule (Rule vs :: [TVarIndex]
vs e :: Expr
e) = [Doc] -> Doc
fsep ((TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppVarIndex [TVarIndex]
vs) Doc -> Doc -> Doc
<+> Doc
equals
Doc -> Doc -> Doc
<+> Doc -> Doc
indent (TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e)
ppRule (External _) = String -> Doc
text "external"
ppExpr :: Int -> Expr -> Doc
ppExpr :: TVarIndex -> Expr -> Doc
ppExpr _ (Var v :: TVarIndex
v) = TVarIndex -> Doc
ppVarIndex TVarIndex
v
ppExpr _ (Lit l :: Literal
l) = Literal -> Doc
ppLiteral Literal
l
ppExpr p :: TVarIndex
p (Comb _ qn :: QName
qn es :: [Expr]
es) = TVarIndex -> QName -> [Expr] -> Doc
ppComb TVarIndex
p QName
qn [Expr]
es
ppExpr p :: TVarIndex
p (Free vs :: [TVarIndex]
vs e :: Expr
e)
| [TVarIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TVarIndex]
vs = TVarIndex -> Expr -> Doc
ppExpr TVarIndex
p Expr
e
| Bool
otherwise = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep
[ String -> Doc
text "let" Doc -> Doc -> Doc
<+> [Doc] -> Doc
list ((TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppVarIndex [TVarIndex]
vs)
Doc -> Doc -> Doc
<+> String -> Doc
text "free"
, String -> Doc
text "in" Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e
]
ppExpr p :: TVarIndex
p (Let ds :: [(TVarIndex, Expr)]
ds e :: Expr
e) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep
[String -> Doc
text "let" Doc -> Doc -> Doc
<+> [(TVarIndex, Expr)] -> Doc
ppDecls [(TVarIndex, Expr)]
ds, String -> Doc
text "in" Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e]
ppExpr p :: TVarIndex
p (Or e1 :: Expr
e1 e2 :: Expr
e2) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TVarIndex -> Expr -> Doc
ppExpr 1 Expr
e1 Doc -> Doc -> Doc
<+> String -> Doc
text "?" Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 1 Expr
e2
ppExpr p :: TVarIndex
p (Case ct :: CaseType
ct e :: Expr
e bs :: [BranchExpr]
bs) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CaseType -> Doc
ppCaseType CaseType
ct Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e Doc -> Doc -> Doc
<+> String -> Doc
text "of"
Doc -> Doc -> Doc
$$ Doc -> Doc
indent ([Doc] -> Doc
vcat ((BranchExpr -> Doc) -> [BranchExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BranchExpr -> Doc
ppBranch [BranchExpr]
bs))
ppExpr p :: TVarIndex
p (Typed e :: Expr
e ty :: TypeExpr
ty) = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> TVarIndex -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty
ppVarIndex :: VarIndex -> Doc
ppVarIndex :: TVarIndex -> Doc
ppVarIndex i :: TVarIndex
i = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ 'v' Char -> String -> String
forall a. a -> [a] -> [a]
: TVarIndex -> String
forall a. Show a => a -> String
show TVarIndex
i
ppLiteral :: Literal -> Doc
ppLiteral :: Literal -> Doc
ppLiteral (Intc i :: Integer
i) = Integer -> Doc
integer Integer
i
ppLiteral (Floatc f :: Double
f) = Double -> Doc
double Double
f
ppLiteral (Charc c :: Char
c) = String -> Doc
text (Char -> String
showEscape Char
c)
showEscape :: Char -> String
showEscape :: Char -> String
showEscape c :: Char
c
| TVarIndex
o TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = "'\\00" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TVarIndex -> String
forall a. Show a => a -> String
show TVarIndex
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
| TVarIndex
o TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
< 32 = "'\\0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TVarIndex -> String
forall a. Show a => a -> String
show TVarIndex
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
| TVarIndex
o TVarIndex -> TVarIndex -> Bool
forall a. Eq a => a -> a -> Bool
== 127 = "'\\127'"
| Bool
otherwise = Char -> String
forall a. Show a => a -> String
show Char
c
where o :: TVarIndex
o = Char -> TVarIndex
ord Char
c
ppComb :: Int -> QName -> [Expr] -> Doc
ppComb :: TVarIndex -> QName -> [Expr] -> Doc
ppComb _ qn :: QName
qn [] = QName -> Doc
ppPrefixOp QName
qn
ppComb p :: TVarIndex
p qn :: QName
qn [e1 :: Expr
e1,e2 :: Expr
e2]
| QName -> Bool
isInfixOp QName
qn = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [TVarIndex -> Expr -> Doc
ppExpr 1 Expr
e1, QName -> Doc
ppInfixOp QName
qn, TVarIndex -> Expr -> Doc
ppExpr 1 Expr
e2]
ppComb p :: TVarIndex
p qn :: QName
qn es :: [Expr]
es = Bool -> Doc -> Doc
parenIf (TVarIndex
p TVarIndex -> TVarIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep (QName -> Doc
ppPrefixOp QName
qn Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TVarIndex -> Expr -> Doc
ppExpr 1) [Expr]
es)
ppDecls :: [(VarIndex, Expr)] -> Doc
ppDecls :: [(TVarIndex, Expr)] -> Doc
ppDecls = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> ([(TVarIndex, Expr)] -> [Doc]) -> [(TVarIndex, Expr)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TVarIndex, Expr) -> Doc) -> [(TVarIndex, Expr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TVarIndex, Expr) -> Doc
ppDecl
ppDecl :: (VarIndex, Expr) -> Doc
ppDecl :: (TVarIndex, Expr) -> Doc
ppDecl (v :: TVarIndex
v, e :: Expr
e) = TVarIndex -> Doc
ppVarIndex TVarIndex
v Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e
ppCaseType :: CaseType -> Doc
ppCaseType :: CaseType -> Doc
ppCaseType Rigid = String -> Doc
text "case"
ppCaseType Flex = String -> Doc
text "fcase"
ppBranch :: BranchExpr -> Doc
ppBranch :: BranchExpr -> Doc
ppBranch (Branch p :: Pattern
p e :: Expr
e) = Pattern -> Doc
ppPattern Pattern
p Doc -> Doc -> Doc
<+> Doc
rarrow Doc -> Doc -> Doc
<+> TVarIndex -> Expr -> Doc
ppExpr 0 Expr
e
ppPattern :: Pattern -> Doc
ppPattern :: Pattern -> Doc
ppPattern (Pattern c :: QName
c [v1 :: TVarIndex
v1,v2 :: TVarIndex
v2])
| QName -> Bool
isInfixOp QName
c = TVarIndex -> Doc
ppVarIndex TVarIndex
v1 Doc -> Doc -> Doc
<+> QName -> Doc
ppInfixOp QName
c Doc -> Doc -> Doc
<+> TVarIndex -> Doc
ppVarIndex TVarIndex
v2
ppPattern (Pattern c :: QName
c vs :: [TVarIndex]
vs) = [Doc] -> Doc
fsep (QName -> Doc
ppPrefixOp QName
c Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TVarIndex -> Doc) -> [TVarIndex] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TVarIndex -> Doc
ppVarIndex [TVarIndex]
vs)
ppPattern (LPattern l :: Literal
l) = Literal -> Doc
ppLiteral Literal
l
ppPrefixOp :: QName -> Doc
ppPrefixOp :: QName -> Doc
ppPrefixOp qn :: QName
qn = Bool -> Doc -> Doc
parenIf (QName -> Bool
isInfixOp QName
qn) (QName -> Doc
ppQName QName
qn)
ppInfixOp :: QName -> Doc
ppInfixOp :: QName -> Doc
ppInfixOp qn :: QName
qn = if QName -> Bool
isInfixOp QName
qn then QName -> Doc
ppQName QName
qn else Doc -> Doc
bquotes (QName -> Doc
ppQName QName
qn)
ppQName :: QName -> Doc
ppQName :: QName -> Doc
ppQName (m :: String
m, i :: String
i) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ '.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
i
isInfixOp :: QName -> Bool
isInfixOp :: QName -> Bool
isInfixOp = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "~!@#$%^&*+-=<>:?./|\\") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
forall a b. (a, b) -> b
snd
indent :: Doc -> Doc
indent :: Doc -> Doc
indent = TVarIndex -> Doc -> Doc
nest 2