{- |
    Module      :  $Header$
    Description :  A pretty printer for Curry
    Copyright   :  (c) 1999 - 2004 Wolfgang Lux
                       2005        Martin Engelke
                       2011 - 2015 Björn Peemöller
                       2016        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module implements a pretty printer for Curry expressions. It was
    derived from the Haskell pretty printer provided in Simon Marlow's
    Haskell parser.
-}
{-# LANGUAGE CPP #-}
module Curry.Syntax.Pretty
  ( ppModule, ppInterface, ppIDecl, ppDecl, ppIdent, ppPattern, ppFieldPatt
  , ppExpr, ppOp, ppStmt, ppFieldExpr, ppQualTypeExpr, ppTypeExpr, ppKindExpr
  , ppAlt, ppQIdent, ppConstraint, ppInstanceType, ppConstr, ppNewConstr
  , ppFieldDecl, ppEquation, ppMIdent
  ) where

#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif

import Curry.Base.Ident
import Curry.Base.Pretty

import Curry.Syntax.Type
import Curry.Syntax.Utils (opName)

-- TODO use span infos

-- |Pretty print a module
ppModule :: Module a -> Doc
ppModule :: Module a -> Doc
ppModule (Module _ ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds) = [ModulePragma]
-> ModuleIdent -> Maybe ExportSpec -> [ImportDecl] -> Doc
ppModuleHeader [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is Doc -> Doc -> Doc
$$ [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppSepBlock [Decl a]
ds

ppModuleHeader :: [ModulePragma] -> ModuleIdent -> Maybe ExportSpec
               -> [ImportDecl] -> Doc
ppModuleHeader :: [ModulePragma]
-> ModuleIdent -> Maybe ExportSpec -> [ImportDecl] -> Doc
ppModuleHeader ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is
  | [ImportDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl]
is   = Doc
header
  | Bool
otherwise = Doc
header Doc -> Doc -> Doc
$+$ String -> Doc
text "" Doc -> Doc -> Doc
$+$ ([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
ppImportDecl [ImportDecl]
is)
  where header :: Doc
header = ([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
ppModulePragma [ModulePragma]
ps)
                 Doc -> Doc -> Doc
$+$ String -> Doc
text "module" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m
                 Doc -> Doc -> Doc
<+> (ExportSpec -> Doc) -> Maybe ExportSpec -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ExportSpec -> Doc
ppExportSpec Maybe ExportSpec
es Doc -> Doc -> Doc
<+> String -> Doc
text "where"

ppModulePragma :: ModulePragma -> Doc
ppModulePragma :: ModulePragma -> Doc
ppModulePragma (LanguagePragma _      exts :: [Extension]
exts) =
  String -> Doc -> Doc
ppPragma "LANGUAGE" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Extension -> Doc) -> [Extension] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> Doc
ppExtension [Extension]
exts
ppModulePragma (OptionsPragma  _ tool :: Maybe Tool
tool args :: String
args) =
  String -> Doc -> Doc
ppPragma "OPTIONS" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> (Tool -> Doc) -> Maybe Tool -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty ((String -> Doc
text "_" Doc -> Doc -> Doc
<>) (Doc -> Doc) -> (Tool -> Doc) -> Tool -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tool -> Doc
ppTool) Maybe Tool
tool Doc -> Doc -> Doc
<+> String -> Doc
text String
args

ppPragma :: String -> Doc -> Doc
ppPragma :: String -> Doc -> Doc
ppPragma kw :: String
kw doc :: Doc
doc = String -> Doc
text "{-#" Doc -> Doc -> Doc
<+> String -> Doc
text String
kw Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"

ppExtension :: Extension -> Doc
ppExtension :: Extension -> Doc
ppExtension (KnownExtension   _ e :: KnownExtension
e) = String -> Doc
text (KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
e)
ppExtension (UnknownExtension _ e :: String
e) = String -> Doc
text String
e

ppTool :: Tool -> Doc
ppTool :: Tool -> Doc
ppTool (UnknownTool t :: String
t) = String -> Doc
text String
t
ppTool t :: Tool
t               = String -> Doc
text (Tool -> String
forall a. Show a => a -> String
show Tool
t)

ppExportSpec :: ExportSpec -> Doc
ppExportSpec :: ExportSpec -> Doc
ppExportSpec (Exporting _ es :: [Export]
es) = [Doc] -> Doc
parenList ((Export -> Doc) -> [Export] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Export -> Doc
ppExport [Export]
es)

ppExport :: Export -> Doc
ppExport :: Export -> Doc
ppExport (Export             _ x :: QualIdent
x) = QualIdent -> Doc
ppQIdent QualIdent
x
ppExport (ExportTypeWith _ tc :: QualIdent
tc cs :: [Ident]
cs) = QualIdent -> Doc
ppQIdent QualIdent
tc Doc -> Doc -> Doc
<> [Doc] -> Doc
parenList ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
cs)
ppExport (ExportTypeAll     _ tc :: QualIdent
tc) = QualIdent -> Doc
ppQIdent QualIdent
tc Doc -> Doc -> Doc
<> String -> Doc
text "(..)"
ppExport (ExportModule       _ m :: ModuleIdent
m) = String -> Doc
text "module" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m

ppImportDecl :: ImportDecl -> Doc
ppImportDecl :: ImportDecl -> Doc
ppImportDecl (ImportDecl _ m :: ModuleIdent
m q :: Bool
q asM :: Maybe ModuleIdent
asM is :: Maybe ImportSpec
is) =
  String -> Doc
text "import" Doc -> Doc -> Doc
<+> Bool -> Doc
ppQualified Bool
q Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m Doc -> Doc -> Doc
<+> (ModuleIdent -> Doc) -> Maybe ModuleIdent -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ModuleIdent -> Doc
ppAs Maybe ModuleIdent
asM
                Doc -> Doc -> Doc
<+> (ImportSpec -> Doc) -> Maybe ImportSpec -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ImportSpec -> Doc
ppImportSpec Maybe ImportSpec
is
  where ppQualified :: Bool -> Doc
ppQualified q' :: Bool
q' = if Bool
q' then String -> Doc
text "qualified" else Doc
empty
        ppAs :: ModuleIdent -> Doc
ppAs m' :: ModuleIdent
m' = String -> Doc
text "as" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m'

ppImportSpec :: ImportSpec -> Doc
ppImportSpec :: ImportSpec -> Doc
ppImportSpec (Importing _ is :: [Import]
is) = [Doc] -> Doc
parenList ((Import -> Doc) -> [Import] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Import -> Doc
ppImport [Import]
is)
ppImportSpec (Hiding    _ is :: [Import]
is) = String -> Doc
text "hiding" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((Import -> Doc) -> [Import] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Import -> Doc
ppImport [Import]
is)

ppImport :: Import -> Doc
ppImport :: Import -> Doc
ppImport (Import             _ x :: Ident
x) = Ident -> Doc
ppIdent Ident
x
ppImport (ImportTypeWith _ tc :: Ident
tc cs :: [Ident]
cs) = Ident -> Doc
ppIdent Ident
tc Doc -> Doc -> Doc
<> [Doc] -> Doc
parenList ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
cs)
ppImport (ImportTypeAll     _ tc :: Ident
tc) = Ident -> Doc
ppIdent Ident
tc Doc -> Doc -> Doc
<> String -> Doc
text "(..)"

ppBlock :: [Decl a] -> Doc
ppBlock :: [Decl a] -> Doc
ppBlock = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Decl a] -> [Doc]) -> [Decl a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl a -> Doc) -> [Decl a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Doc
forall a. Decl a -> Doc
ppDecl

ppSepBlock :: [Decl a] -> Doc
ppSepBlock :: [Decl a] -> Doc
ppSepBlock = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Decl a] -> [Doc]) -> [Decl a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl a -> Doc) -> [Decl a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: Decl a
d -> String -> Doc
text "" Doc -> Doc -> Doc
$+$ Decl a -> Doc
forall a. Decl a -> Doc
ppDecl Decl a
d)

-- |Pretty print a declaration
ppDecl :: Decl a -> Doc
ppDecl :: Decl a -> Doc
ppDecl (InfixDecl _ fix :: Infix
fix p :: Maybe Precedence
p ops :: [Ident]
ops) = Infix -> Maybe Precedence -> Doc
ppPrec Infix
fix Maybe Precedence
p Doc -> Doc -> Doc
<+> [Doc] -> Doc
list ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppInfixOp [Ident]
ops)
ppDecl (DataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs clss :: [QualIdent]
clss) =
  [Doc] -> Doc
sep (String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs "data" Ident
tc [Ident]
tvs Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
       (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
indent ((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 Doc
vbar) ((ConstrDecl -> Doc) -> [ConstrDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Doc
ppConstr [ConstrDecl]
cs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                   [[QualIdent] -> Doc
ppDeriving [QualIdent]
clss]))
ppDecl (ExternalDataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs) = String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs "external data" Ident
tc [Ident]
tvs
ppDecl (NewtypeDecl _ tc :: Ident
tc tvs :: [Ident]
tvs nc :: NewConstrDecl
nc clss :: [QualIdent]
clss) =
  [Doc] -> Doc
sep (String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs "newtype" Ident
tc [Ident]
tvs Doc -> Doc -> Doc
<+> Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
       (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
indent [NewConstrDecl -> Doc
ppNewConstr NewConstrDecl
nc, [QualIdent] -> Doc
ppDeriving [QualIdent]
clss])
ppDecl (TypeDecl _ tc :: Ident
tc tvs :: [Ident]
tvs ty :: TypeExpr
ty) =
  [Doc] -> Doc
sep [String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs "type" Ident
tc [Ident]
tvs Doc -> Doc -> Doc
<+> Doc
equals,Doc -> Doc
indent (Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty)]
ppDecl (TypeSig _ fs :: [Ident]
fs qty :: QualTypeExpr
qty) =
  [Doc] -> Doc
list ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
fs) Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> QualTypeExpr -> Doc
ppQualTypeExpr QualTypeExpr
qty
ppDecl (FunctionDecl _ _ _ eqs :: [Equation a]
eqs) = [Doc] -> Doc
vcat ((Equation a -> Doc) -> [Equation a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Equation a -> Doc
forall a. Equation a -> Doc
ppEquation [Equation a]
eqs)
ppDecl (ExternalDecl   _ vs :: [Var a]
vs) = [Doc] -> Doc
list ((Var a -> Doc) -> [Var a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Var a -> Doc
forall a. Var a -> Doc
ppVar [Var a]
vs) Doc -> Doc -> Doc
<+> String -> Doc
text "external"
ppDecl (PatternDecl _ t :: Pattern a
t rhs :: Rhs a
rhs) = Doc -> Doc -> Rhs a -> Doc
forall a. Doc -> Doc -> Rhs a -> Doc
ppRule (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t) Doc
equals Rhs a
rhs
ppDecl (FreeDecl       _ vs :: [Var a]
vs) = [Doc] -> Doc
list ((Var a -> Doc) -> [Var a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Var a -> Doc
forall a. Var a -> Doc
ppVar [Var a]
vs) Doc -> Doc -> Doc
<+> String -> Doc
text "free"
ppDecl (DefaultDecl   _ tys :: [TypeExpr]
tys) =
  String -> Doc
text "default" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
ppTypeExpr 0) [TypeExpr]
tys)
ppDecl (ClassDecl _ cx :: Context
cx cls :: Ident
cls clsvar :: Ident
clsvar ds :: [Decl a]
ds) =
  String -> Context -> Doc -> Doc -> Doc
ppClassInstHead "class" Context
cx (Ident -> Doc
ppIdent Ident
cls) (Ident -> Doc
ppIdent Ident
clsvar) Doc -> Doc -> Doc
<+>
    Bool -> Doc -> Doc
ppIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds) (String -> Doc
text "where") Doc -> Doc -> Doc
$$
    Bool -> Doc -> Doc
ppIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds) (Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppBlock [Decl a]
ds)
ppDecl (InstanceDecl _ cx :: Context
cx qcls :: QualIdent
qcls inst :: TypeExpr
inst ds :: [Decl a]
ds) =
  String -> Context -> Doc -> Doc -> Doc
ppClassInstHead "instance" Context
cx (QualIdent -> Doc
ppQIdent QualIdent
qcls) (TypeExpr -> Doc
ppInstanceType TypeExpr
inst) Doc -> Doc -> Doc
<+>
    Bool -> Doc -> Doc
ppIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds) (String -> Doc
text "where") Doc -> Doc -> Doc
$$
    Bool -> Doc -> Doc
ppIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds) (Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppBlock [Decl a]
ds)

ppClassInstHead :: String -> Context -> Doc -> Doc -> Doc
ppClassInstHead :: String -> Context -> Doc -> Doc -> Doc
ppClassInstHead kw :: String
kw cx :: Context
cx cls :: Doc
cls ty :: Doc
ty = String -> Doc
text String
kw Doc -> Doc -> Doc
<+> Context -> Doc
ppContext Context
cx Doc -> Doc -> Doc
<+> Doc
cls Doc -> Doc -> Doc
<+> Doc
ty

ppContext :: Context -> Doc
ppContext :: Context -> Doc
ppContext []  = Doc
empty
ppContext [c :: Constraint
c] = Constraint -> Doc
ppConstraint Constraint
c Doc -> Doc -> Doc
<+> Doc
darrow
ppContext cs :: Context
cs  = [Doc] -> Doc
parenList ((Constraint -> Doc) -> Context -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> Doc
ppConstraint Context
cs) Doc -> Doc -> Doc
<+> Doc
darrow

ppConstraint :: Constraint -> Doc
ppConstraint :: Constraint -> Doc
ppConstraint (Constraint _ qcls :: QualIdent
qcls ty :: TypeExpr
ty) = QualIdent -> Doc
ppQIdent QualIdent
qcls Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 2 TypeExpr
ty

ppInstanceType :: InstanceType -> Doc
ppInstanceType :: TypeExpr -> Doc
ppInstanceType = Int -> TypeExpr -> Doc
ppTypeExpr 2

ppDeriving :: [QualIdent] -> Doc
ppDeriving :: [QualIdent] -> Doc
ppDeriving []     = Doc
empty
ppDeriving [qcls :: QualIdent
qcls] = String -> Doc
text "deriving" Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQIdent QualIdent
qcls
ppDeriving qclss :: [QualIdent]
qclss  = String -> Doc
text "deriving" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((QualIdent -> Doc) -> [QualIdent] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualIdent -> Doc
ppQIdent [QualIdent]
qclss)

ppPrec :: Infix -> Maybe Precedence -> Doc
ppPrec :: Infix -> Maybe Precedence -> Doc
ppPrec fix :: Infix
fix p :: Maybe Precedence
p = Infix -> Doc
forall a. Pretty a => a -> Doc
pPrint Infix
fix Doc -> Doc -> Doc
<+> Maybe Precedence -> Doc
ppPrio Maybe Precedence
p
  where
    ppPrio :: Maybe Precedence -> Doc
ppPrio Nothing   = Doc
empty
    ppPrio (Just p' :: Precedence
p') = Precedence -> Doc
integer Precedence
p'

ppTypeDeclLhs :: String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs :: String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs kw :: String
kw tc :: Ident
tc tvs :: [Ident]
tvs = String -> Doc
text String
kw Doc -> Doc -> Doc
<+> Ident -> Doc
ppIdent Ident
tc Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
tvs)

ppConstr :: ConstrDecl -> Doc
ppConstr :: ConstrDecl -> Doc
ppConstr (ConstrDecl     _ c :: Ident
c tys :: [TypeExpr]
tys) =
  [Doc] -> Doc
sep [ Ident -> Doc
ppIdent Ident
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
ppTypeExpr 2) [TypeExpr]
tys) ]
ppConstr (ConOpDecl _ ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) =
  [Doc] -> Doc
sep [ Int -> TypeExpr -> Doc
ppTypeExpr 1 TypeExpr
ty1, Ident -> Doc
ppInfixOp Ident
op Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 1 TypeExpr
ty2 ]
ppConstr (RecordDecl _ c :: Ident
c fs :: [FieldDecl]
fs)      =
  [Doc] -> Doc
sep [ Ident -> Doc
ppIdent Ident
c Doc -> Doc -> Doc
<+> Doc -> Doc
record ([Doc] -> Doc
list ((FieldDecl -> Doc) -> [FieldDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldDecl -> Doc
ppFieldDecl [FieldDecl]
fs)) ]

ppFieldDecl :: FieldDecl -> Doc
ppFieldDecl :: FieldDecl -> Doc
ppFieldDecl (FieldDecl _ ls :: [Ident]
ls ty :: TypeExpr
ty) = [Doc] -> Doc
list ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
ls)
                               Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty

ppNewConstr :: NewConstrDecl -> Doc
ppNewConstr :: NewConstrDecl -> Doc
ppNewConstr (NewConstrDecl _ c :: Ident
c ty :: TypeExpr
ty) = [Doc] -> Doc
sep [Ident -> Doc
ppIdent Ident
c Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 2 TypeExpr
ty]
ppNewConstr (NewRecordDecl _ c :: Ident
c (i :: Ident
i,ty :: TypeExpr
ty)) =
  [Doc] -> Doc
sep [Ident -> Doc
ppIdent Ident
c Doc -> Doc -> Doc
<+> Doc -> Doc
record (Ident -> Doc
ppIdent Ident
i Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty)]

ppQuantifiedVars :: [Ident] -> Doc
ppQuantifiedVars :: [Ident] -> Doc
ppQuantifiedVars tvs :: [Ident]
tvs
  | [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
tvs = Doc
empty
  | Bool
otherwise = String -> Doc
text "forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
tvs) Doc -> Doc -> Doc
<+> Char -> Doc
char '.'

ppEquation :: Equation a -> Doc
ppEquation :: Equation a -> Doc
ppEquation (Equation _ lhs :: Lhs a
lhs rhs :: Rhs a
rhs) = Doc -> Doc -> Rhs a -> Doc
forall a. Doc -> Doc -> Rhs a -> Doc
ppRule (Lhs a -> Doc
forall a. Lhs a -> Doc
ppLhs Lhs a
lhs) Doc
equals Rhs a
rhs

ppLhs :: Lhs a -> Doc
ppLhs :: Lhs a -> Doc
ppLhs (FunLhs   _ f :: Ident
f ts :: [Pattern a]
ts) = Ident -> Doc
ppIdent Ident
f Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2) [Pattern a]
ts)
ppLhs (OpLhs _ t1 :: Pattern a
t1 f :: Ident
f t2 :: Pattern a
t2) = Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 1 Pattern a
t1 Doc -> Doc -> Doc
<+> Ident -> Doc
ppInfixOp Ident
f Doc -> Doc -> Doc
<+> Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 1 Pattern a
t2
ppLhs (ApLhs  _ lhs :: Lhs a
lhs ts :: [Pattern a]
ts) = Doc -> Doc
parens (Lhs a -> Doc
forall a. Lhs a -> Doc
ppLhs Lhs a
lhs) Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2) [Pattern a]
ts)

ppRule :: Doc -> Doc -> Rhs a -> Doc
ppRule :: Doc -> Doc -> Rhs a -> Doc
ppRule lhs :: Doc
lhs eq :: Doc
eq (SimpleRhs _ e :: Expression a
e ds :: [Decl a]
ds) =
  [Doc] -> Doc
sep [Doc
lhs Doc -> Doc -> Doc
<+> Doc
eq, Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e)] Doc -> Doc -> Doc
$$ [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppLocalDefs [Decl a]
ds
ppRule lhs :: Doc
lhs eq :: Doc
eq (GuardedRhs _ es :: [CondExpr a]
es ds :: [Decl a]
ds) =
  [Doc] -> Doc
sep [Doc
lhs, Doc -> Doc
indent ([Doc] -> Doc
vcat ((CondExpr a -> Doc) -> [CondExpr a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> CondExpr a -> Doc
forall a. Doc -> CondExpr a -> Doc
ppCondExpr Doc
eq) [CondExpr a]
es))] Doc -> Doc -> Doc
$$ [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppLocalDefs [Decl a]
ds

ppLocalDefs :: [Decl a] -> Doc
ppLocalDefs :: [Decl a] -> Doc
ppLocalDefs ds :: [Decl a]
ds
  | [Decl a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl a]
ds   = Doc
empty
  | Bool
otherwise = Doc -> Doc
indent (String -> Doc
text "where" Doc -> Doc -> Doc
<+> [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppBlock [Decl a]
ds)

-- ---------------------------------------------------------------------------
-- Interfaces
-- ---------------------------------------------------------------------------

-- |Pretty print an interface
ppInterface :: Interface -> Doc
ppInterface :: Interface -> Doc
ppInterface (Interface m :: ModuleIdent
m is :: [IImportDecl]
is ds :: [IDecl]
ds)
  =  String -> Doc
text "interface" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m Doc -> Doc -> Doc
<+> String -> Doc
text "where" Doc -> Doc -> Doc
<+> Doc
lbrace
  Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (IImportDecl -> Doc) -> [IImportDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IImportDecl -> Doc
ppIImportDecl [IImportDecl]
is [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (IDecl -> Doc) -> [IDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IDecl -> Doc
ppIDecl [IDecl]
ds)
  Doc -> Doc -> Doc
$$ Doc
rbrace

ppIImportDecl :: IImportDecl -> Doc
ppIImportDecl :: IImportDecl -> Doc
ppIImportDecl (IImportDecl _ m :: ModuleIdent
m) = String -> Doc
text "import" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m

-- |Pretty print an interface declaration
ppIDecl :: IDecl -> Doc
ppIDecl :: IDecl -> Doc
ppIDecl (IInfixDecl   _ fix :: Infix
fix p :: Precedence
p op :: QualIdent
op) = Infix -> Maybe Precedence -> Doc
ppPrec Infix
fix (Precedence -> Maybe Precedence
forall a. a -> Maybe a
Just Precedence
p) Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp QualIdent
op
ppIDecl (HidingDataDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs) =
  String -> Doc
text "hiding" Doc -> Doc -> Doc
<+> String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs "data" QualIdent
tc Maybe KindExpr
k [Ident]
tvs
ppIDecl (IDataDecl   _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs hs :: [Ident]
hs) =
  [Doc] -> Doc
sep (String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs "data" QualIdent
tc Maybe KindExpr
k [Ident]
tvs Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
       (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
indent ((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 Doc
vbar) ((ConstrDecl -> Doc) -> [ConstrDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Doc
ppConstr [ConstrDecl]
cs)) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
       [Doc -> Doc
indent ([Ident] -> Doc
ppHiding [Ident]
hs)])
ppIDecl (INewtypeDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs nc :: NewConstrDecl
nc hs :: [Ident]
hs) =
  [Doc] -> Doc
sep [ String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs "newtype" QualIdent
tc Maybe KindExpr
k [Ident]
tvs Doc -> Doc -> Doc
<+> Doc
equals
      , Doc -> Doc
indent (NewConstrDecl -> Doc
ppNewConstr NewConstrDecl
nc)
      , Doc -> Doc
indent ([Ident] -> Doc
ppHiding [Ident]
hs)
      ]
ppIDecl (ITypeDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs ty :: TypeExpr
ty) =
  [Doc] -> Doc
sep [String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs "type" QualIdent
tc Maybe KindExpr
k [Ident]
tvs Doc -> Doc -> Doc
<+> Doc
equals,Doc -> Doc
indent (Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty)]
ppIDecl (IFunctionDecl _ f :: QualIdent
f cm :: Maybe Ident
cm a :: Int
a qty :: QualTypeExpr
qty) =
  [Doc] -> Doc
sep [ QualIdent -> Doc
ppQIdent QualIdent
f, (Ident -> Doc) -> Maybe Ident -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (String -> Doc -> Doc
ppPragma "METHOD" (Doc -> Doc) -> (Ident -> Doc) -> Ident -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Doc
ppIdent) Maybe Ident
cm
      , Int -> Doc
int Int
a, String -> Doc
text "::", QualTypeExpr -> Doc
ppQualTypeExpr QualTypeExpr
qty ]
ppIDecl (HidingClassDecl _ cx :: Context
cx qcls :: QualIdent
qcls k :: Maybe KindExpr
k clsvar :: Ident
clsvar) = String -> Doc
text "hiding" Doc -> Doc -> Doc
<+>
  String -> Context -> Doc -> Doc -> Doc
ppClassInstHead "class" Context
cx (QualIdent -> Maybe KindExpr -> Doc
ppQIdentWithKind QualIdent
qcls Maybe KindExpr
k) (Ident -> Doc
ppIdent Ident
clsvar)
ppIDecl (IClassDecl _ cx :: Context
cx qcls :: QualIdent
qcls k :: Maybe KindExpr
k clsvar :: Ident
clsvar ms :: [IMethodDecl]
ms hs :: [Ident]
hs) =
  String -> Context -> Doc -> Doc -> Doc
ppClassInstHead "class" Context
cx (QualIdent -> Maybe KindExpr -> Doc
ppQIdentWithKind QualIdent
qcls Maybe KindExpr
k) (Ident -> Doc
ppIdent Ident
clsvar) Doc -> Doc -> Doc
<+>
    Doc
lbrace Doc -> Doc -> Doc
$$
    [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (IMethodDecl -> Doc) -> [IMethodDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
indent (Doc -> Doc) -> (IMethodDecl -> Doc) -> IMethodDecl -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IMethodDecl -> Doc
ppIMethodDecl) [IMethodDecl]
ms) Doc -> Doc -> Doc
$$
    Doc
rbrace Doc -> Doc -> Doc
<+> [Ident] -> Doc
ppHiding [Ident]
hs
ppIDecl (IInstanceDecl _ cx :: Context
cx qcls :: QualIdent
qcls inst :: TypeExpr
inst impls :: [IMethodImpl]
impls m :: Maybe ModuleIdent
m) =
  String -> Context -> Doc -> Doc -> Doc
ppClassInstHead "instance" Context
cx (QualIdent -> Doc
ppQIdent QualIdent
qcls) (TypeExpr -> Doc
ppInstanceType TypeExpr
inst) Doc -> Doc -> Doc
<+>
    Doc
lbrace Doc -> Doc -> Doc
$$
    [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (IMethodImpl -> Doc) -> [IMethodImpl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
indent (Doc -> Doc) -> (IMethodImpl -> Doc) -> IMethodImpl -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IMethodImpl -> Doc
ppIMethodImpl) [IMethodImpl]
impls) Doc -> Doc -> Doc
$$
    Doc
rbrace Doc -> Doc -> Doc
<+> (ModuleIdent -> Doc) -> Maybe ModuleIdent -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (String -> Doc -> Doc
ppPragma "MODULE" (Doc -> Doc) -> (ModuleIdent -> Doc) -> ModuleIdent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Doc
ppMIdent) Maybe ModuleIdent
m

ppITypeDeclLhs :: String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs :: String -> QualIdent -> Maybe KindExpr -> [Ident] -> Doc
ppITypeDeclLhs kw :: String
kw tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs =
  String -> Doc
text String
kw Doc -> Doc -> Doc
<+> QualIdent -> Maybe KindExpr -> Doc
ppQIdentWithKind QualIdent
tc Maybe KindExpr
k Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
tvs)

ppIMethodDecl :: IMethodDecl -> Doc
ppIMethodDecl :: IMethodDecl -> Doc
ppIMethodDecl (IMethodDecl _ f :: Ident
f a :: Maybe Int
a qty :: QualTypeExpr
qty) =
  Ident -> Doc
ppIdent Ident
f Doc -> Doc -> Doc
<+> (Int -> Doc) -> Maybe Int -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Int -> Doc
int Maybe Int
a Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> QualTypeExpr -> Doc
ppQualTypeExpr QualTypeExpr
qty

ppIMethodImpl :: IMethodImpl -> Doc
ppIMethodImpl :: IMethodImpl -> Doc
ppIMethodImpl (f :: Ident
f, a :: Int
a) = Ident -> Doc
ppIdent Ident
f Doc -> Doc -> Doc
<+> Int -> Doc
int Int
a

ppQIdentWithKind :: QualIdent -> Maybe KindExpr -> Doc
ppQIdentWithKind :: QualIdent -> Maybe KindExpr -> Doc
ppQIdentWithKind tc :: QualIdent
tc (Just k :: KindExpr
k) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ QualIdent -> Doc
ppQIdent QualIdent
tc Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Int -> KindExpr -> Doc
ppKindExpr 0 KindExpr
k
ppQIdentWithKind tc :: QualIdent
tc Nothing  = QualIdent -> Doc
ppQIdent QualIdent
tc

ppHiding :: [Ident] -> Doc
ppHiding :: [Ident] -> Doc
ppHiding hs :: [Ident]
hs
  | [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
hs   = Doc
empty
  | Bool
otherwise = String -> Doc -> Doc
ppPragma "HIDING" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
ppIdent [Ident]
hs

-- ---------------------------------------------------------------------------
-- Kinds
-- ---------------------------------------------------------------------------

ppKindExpr :: Int -> KindExpr -> Doc
ppKindExpr :: Int -> KindExpr -> Doc
ppKindExpr _ Star              = Char -> Doc
char '*'
ppKindExpr p :: Int
p (ArrowKind k1 :: KindExpr
k1 k2 :: KindExpr
k2) =
  Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Doc] -> Doc
fsep (KindExpr -> [Doc]
ppArrowKind (KindExpr -> KindExpr -> KindExpr
ArrowKind KindExpr
k1 KindExpr
k2)))
  where
  ppArrowKind :: KindExpr -> [Doc]
ppArrowKind (ArrowKind k1' :: KindExpr
k1' k2' :: KindExpr
k2') = Int -> KindExpr -> Doc
ppKindExpr 1 KindExpr
k1' Doc -> Doc -> Doc
<+> Doc
rarrow Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: KindExpr -> [Doc]
ppArrowKind KindExpr
k2'
  ppArrowKind k :: KindExpr
k                   = [Int -> KindExpr -> Doc
ppKindExpr 0 KindExpr
k]

-- ---------------------------------------------------------------------------
-- Types
-- ---------------------------------------------------------------------------

-- |Pretty print a qualified type expression
ppQualTypeExpr :: QualTypeExpr -> Doc
ppQualTypeExpr :: QualTypeExpr -> Doc
ppQualTypeExpr (QualTypeExpr _ cx :: Context
cx ty :: TypeExpr
ty) = Context -> Doc
ppContext Context
cx Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty

-- |Pretty print a type expression
ppTypeExpr :: Int -> TypeExpr -> Doc
ppTypeExpr :: Int -> TypeExpr -> Doc
ppTypeExpr _ (ConstructorType _ tc :: QualIdent
tc) = QualIdent -> Doc
ppQIdent QualIdent
tc
ppTypeExpr p :: Int
p (ApplyType  _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (TypeExpr -> [TypeExpr] -> Doc
ppApplyType TypeExpr
ty1 [TypeExpr
ty2])
  where ppApplyType :: TypeExpr -> [TypeExpr] -> Doc
ppApplyType (ApplyType _ ty1' :: TypeExpr
ty1' ty2' :: TypeExpr
ty2') tys :: [TypeExpr]
tys = TypeExpr -> [TypeExpr] -> Doc
ppApplyType TypeExpr
ty1' (TypeExpr
ty2' TypeExpr -> [TypeExpr] -> [TypeExpr]
forall a. a -> [a] -> [a]
: [TypeExpr]
tys)
        ppApplyType ty :: TypeExpr
ty tys :: [TypeExpr]
tys                  =
          Int -> TypeExpr -> Doc
ppTypeExpr 1 TypeExpr
ty Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
ppTypeExpr 2) [TypeExpr]
tys)
ppTypeExpr _ (VariableType    _ tv :: Ident
tv) = Ident -> Doc
ppIdent Ident
tv
ppTypeExpr _ (TupleType      _ tys :: [TypeExpr]
tys) = [Doc] -> Doc
parenList ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
ppTypeExpr 0) [TypeExpr]
tys)
ppTypeExpr _ (ListType        _ ty :: TypeExpr
ty) = Doc -> Doc
brackets (Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty)
ppTypeExpr p :: Int
p (ArrowType  spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  ([Doc] -> Doc
fsep (TypeExpr -> [Doc]
ppArrowType (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ArrowType SpanInfo
spi TypeExpr
ty1 TypeExpr
ty2)))
  where
  ppArrowType :: TypeExpr -> [Doc]
ppArrowType (ArrowType _ ty1' :: TypeExpr
ty1' ty2' :: TypeExpr
ty2') =
    Int -> TypeExpr -> Doc
ppTypeExpr 1 TypeExpr
ty1' Doc -> Doc -> Doc
<+> Doc
rarrow Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: TypeExpr -> [Doc]
ppArrowType TypeExpr
ty2'
  ppArrowType ty :: TypeExpr
ty                    = [Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty]
ppTypeExpr _ (ParenType       _ ty :: TypeExpr
ty) = Doc -> Doc
parens (Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty)
ppTypeExpr p :: Int
p (ForallType   _ vs :: [Ident]
vs ty :: TypeExpr
ty)
  | [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
vs   = Int -> TypeExpr -> Doc
ppTypeExpr Int
p TypeExpr
ty
  | Bool
otherwise = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Ident] -> Doc
ppQuantifiedVars [Ident]
vs Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
ppTypeExpr 0 TypeExpr
ty

-- ---------------------------------------------------------------------------
-- Literals
-- ---------------------------------------------------------------------------

ppLiteral :: Literal -> Doc
ppLiteral :: Literal -> Doc
ppLiteral (Char   c :: Char
c) = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
ppLiteral (Int    i :: Precedence
i) = Precedence -> Doc
integer Precedence
i
ppLiteral (Float  f :: Double
f) = Double -> Doc
double Double
f
ppLiteral (String s :: String
s) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)

-- ---------------------------------------------------------------------------
-- Patterns
-- ---------------------------------------------------------------------------

-- |Pretty print a constructor term
ppPattern :: Int -> Pattern a -> Doc
ppPattern :: Int -> Pattern a -> Doc
ppPattern p :: Int
p (LiteralPattern _ _ l :: Literal
l) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Literal -> Bool
isNegative Literal
l) (Literal -> Doc
ppLiteral Literal
l)
  where isNegative :: Literal -> Bool
isNegative (Char   _) = Bool
False
        isNegative (Int    i :: Precedence
i) = Precedence
i Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
< 0
        isNegative (Float  f :: Double
f) = Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0.0
        isNegative (String _) = Bool
False
ppPattern p :: Int
p (NegativePattern        _ _ l :: Literal
l) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1)
  (Ident -> Doc
ppInfixOp Ident
minusId Doc -> Doc -> Doc
<> Literal -> Doc
ppLiteral Literal
l)
ppPattern _ (VariablePattern        _ _ v :: Ident
v) = Ident -> Doc
ppIdent Ident
v
ppPattern p :: Int
p (ConstructorPattern  _ _ c :: QualIdent
c ts :: [Pattern a]
ts) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Pattern a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern a]
ts))
  (QualIdent -> Doc
ppQIdent QualIdent
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2) [Pattern a]
ts))
ppPattern p :: Int
p (InfixPattern     _ _ t1 :: Pattern a
t1 c :: QualIdent
c t2 :: Pattern a
t2) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  ([Doc] -> Doc
sep [Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 1 Pattern a
t1 Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp QualIdent
c, Doc -> Doc
indent (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t2)])
ppPattern _ (ParenPattern             _ t :: Pattern a
t) = Doc -> Doc
parens (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t)
ppPattern _ (TuplePattern            _ ts :: [Pattern a]
ts) = [Doc] -> Doc
parenList ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0) [Pattern a]
ts)
ppPattern _ (ListPattern           _ _ ts :: [Pattern a]
ts) = [Doc] -> Doc
bracketList ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0) [Pattern a]
ts)
ppPattern _ (AsPattern              _ v :: Ident
v t :: Pattern a
t) = Ident -> Doc
ppIdent Ident
v Doc -> Doc -> Doc
<> Char -> Doc
char '@' Doc -> Doc -> Doc
<> Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2 Pattern a
t
ppPattern _ (LazyPattern              _ t :: Pattern a
t) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2 Pattern a
t
ppPattern p :: Int
p (FunctionPattern     _ _ f :: QualIdent
f ts :: [Pattern a]
ts) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Pattern a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern a]
ts))
  (QualIdent -> Doc
ppQIdent QualIdent
f Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2) [Pattern a]
ts))
ppPattern p :: Int
p (InfixFuncPattern _ _ t1 :: Pattern a
t1 f :: QualIdent
f t2 :: Pattern a
t2) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  ([Doc] -> Doc
sep [Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 1 Pattern a
t1 Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp QualIdent
f, Doc -> Doc
indent (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t2)])
ppPattern p :: Int
p (RecordPattern       _ _ c :: QualIdent
c fs :: [Field (Pattern a)]
fs) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1)
  (QualIdent -> Doc
ppQIdent QualIdent
c Doc -> Doc -> Doc
<+> Doc -> Doc
record ([Doc] -> Doc
list ((Field (Pattern a) -> Doc) -> [Field (Pattern a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field (Pattern a) -> Doc
forall a. Field (Pattern a) -> Doc
ppFieldPatt [Field (Pattern a)]
fs)))

-- |Pretty print a record field pattern
ppFieldPatt :: Field (Pattern a) -> Doc
ppFieldPatt :: Field (Pattern a) -> Doc
ppFieldPatt (Field _ l :: QualIdent
l t :: Pattern a
t) = QualIdent -> Doc
ppQIdent QualIdent
l Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t

-- ---------------------------------------------------------------------------
-- Expressions
-- ---------------------------------------------------------------------------

ppCondExpr :: Doc -> CondExpr a -> Doc
ppCondExpr :: Doc -> CondExpr a -> Doc
ppCondExpr eq :: Doc
eq (CondExpr _ g :: Expression a
g e :: Expression a
e) =
  Doc
vbar Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep [Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
g Doc -> Doc -> Doc
<+> Doc
eq,Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e)]

-- |Pretty print an expression
ppExpr :: Int -> Expression a -> Doc
ppExpr :: Int -> Expression a -> Doc
ppExpr _ (Literal        _ _ l :: Literal
l) = Literal -> Doc
ppLiteral Literal
l
ppExpr _ (Variable       _ _ v :: QualIdent
v) = QualIdent -> Doc
ppQIdent QualIdent
v
ppExpr _ (Constructor    _ _ c :: QualIdent
c) = QualIdent -> Doc
ppQIdent QualIdent
c
ppExpr _ (Paren            _ e :: Expression a
e) = Doc -> Doc
parens (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e)
ppExpr p :: Int
p (Typed        _ e :: Expression a
e qty :: QualTypeExpr
qty) =
  Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> QualTypeExpr -> Doc
ppQualTypeExpr QualTypeExpr
qty)
ppExpr _ (Tuple           _ es :: [Expression a]
es) = [Doc] -> Doc
parenList ((Expression a -> Doc) -> [Expression a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0) [Expression a]
es)
ppExpr _ (List          _ _ es :: [Expression a]
es) = [Doc] -> Doc
bracketList ((Expression a -> Doc) -> [Expression a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0) [Expression a]
es)
ppExpr _ (ListCompr     _ e :: Expression a
e qs :: [Statement a]
qs) =
  Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e Doc -> Doc -> Doc
<+> Doc
vbar Doc -> Doc -> Doc
<+> [Doc] -> Doc
list ((Statement a -> Doc) -> [Statement a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Statement a -> Doc
forall a. Statement a -> Doc
ppStmt [Statement a]
qs))
ppExpr _ (EnumFrom              _ e :: Expression a
e) = Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e Doc -> Doc -> Doc
<+> String -> Doc
text "..")
ppExpr _ (EnumFromThen      _ e1 :: Expression a
e1 e2 :: Expression a
e2) =
  Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e2 Doc -> Doc -> Doc
<+> String -> Doc
text "..")
ppExpr _ (EnumFromTo        _ e1 :: Expression a
e1 e2 :: Expression a
e2) =
  Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e1 Doc -> Doc -> Doc
<+> String -> Doc
text ".." Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e2)
ppExpr _ (EnumFromThenTo _ e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) =
  Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e2
              Doc -> Doc -> Doc
<+> String -> Doc
text ".." Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e3)
ppExpr p :: Int
p (UnaryMinus          _ e :: Expression a
e) =
  Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Ident -> Doc
ppInfixOp Ident
minusId Doc -> Doc -> Doc
<> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e)
ppExpr p :: Int
p (Apply           _ e1 :: Expression a
e1 e2 :: Expression a
e2) =
  Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) ([Doc] -> Doc
sep [Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e1,Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 2 Expression a
e2)])
ppExpr p :: Int
p (InfixApply   _ e1 :: Expression a
e1 op :: InfixOp a
op e2 :: Expression a
e2) =
  Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Doc] -> Doc
sep [Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e1 Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp (InfixOp a -> QualIdent
forall a. InfixOp a -> QualIdent
opName InfixOp a
op),
                         Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e2)])
ppExpr _ (LeftSection      _ e :: Expression a
e op :: InfixOp a
op) = Doc -> Doc
parens (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp (InfixOp a -> QualIdent
forall a. InfixOp a -> QualIdent
opName InfixOp a
op))
ppExpr _ (RightSection     _ op :: InfixOp a
op e :: Expression a
e) = Doc -> Doc
parens (QualIdent -> Doc
ppQInfixOp (InfixOp a -> QualIdent
forall a. InfixOp a -> QualIdent
opName InfixOp a
op) Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 1 Expression a
e)
ppExpr p :: Int
p (Lambda            _ t :: [Pattern a]
t e :: Expression a
e) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  ([Doc] -> Doc
sep [Doc
backsl Doc -> Doc -> Doc
<> [Doc] -> Doc
fsep ((Pattern a -> Doc) -> [Pattern a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 2) [Pattern a]
t) Doc -> Doc -> Doc
<+> Doc
rarrow, Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e)])
ppExpr p :: Int
p (Let              _ ds :: [Decl a]
ds e :: Expression a
e) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
          ([Doc] -> Doc
sep [String -> Doc
text "let" Doc -> Doc -> Doc
<+> [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppBlock [Decl a]
ds, String -> Doc
text "in" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e])
ppExpr p :: Int
p (Do              _ sts :: [Statement a]
sts e :: Expression a
e) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
          (String -> Doc
text "do" Doc -> Doc -> Doc
<+> ([Doc] -> Doc
vcat ((Statement a -> Doc) -> [Statement a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Statement a -> Doc
forall a. Statement a -> Doc
ppStmt [Statement a]
sts) Doc -> Doc -> Doc
$$ Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e))
ppExpr p :: Int
p (IfThenElse   _ e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
           (String -> Doc
text "if" Doc -> Doc -> Doc
<+>
            [Doc] -> Doc
sep [Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e1,
                 String -> Doc
text "then" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e2,
                 String -> Doc
text "else" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e3])
ppExpr p :: Int
p (Case      _ ct :: CaseType
ct e :: Expression a
e alts :: [Alt a]
alts) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
           (CaseType -> Doc
ppCaseType CaseType
ct Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e Doc -> Doc -> Doc
<+> String -> Doc
text "of" Doc -> Doc -> Doc
$$
            Doc -> Doc
indent ([Doc] -> Doc
vcat ((Alt a -> Doc) -> [Alt a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt a -> Doc
forall a. Alt a -> Doc
ppAlt [Alt a]
alts)))
ppExpr p :: Int
p (Record     _ _ c :: QualIdent
c fs :: [Field (Expression a)]
fs) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  (QualIdent -> Doc
ppQIdent QualIdent
c Doc -> Doc -> Doc
<+> Doc -> Doc
record ([Doc] -> Doc
list ((Field (Expression a) -> Doc) -> [Field (Expression a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field (Expression a) -> Doc
forall a. Field (Expression a) -> Doc
ppFieldExpr [Field (Expression a)]
fs)))
ppExpr _ (RecordUpdate _ e :: Expression a
e fs :: [Field (Expression a)]
fs) =
  Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e Doc -> Doc -> Doc
<+> Doc -> Doc
record ([Doc] -> Doc
list ((Field (Expression a) -> Doc) -> [Field (Expression a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field (Expression a) -> Doc
forall a. Field (Expression a) -> Doc
ppFieldExpr [Field (Expression a)]
fs))

-- |Pretty print a statement
ppStmt :: Statement a -> Doc
ppStmt :: Statement a -> Doc
ppStmt (StmtExpr   _ e :: Expression a
e) = Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e
ppStmt (StmtBind _ t :: Pattern a
t e :: Expression a
e) = [Doc] -> Doc
sep [Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t Doc -> Doc -> Doc
<+> Doc
larrow,Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e)]
ppStmt (StmtDecl  _ ds :: [Decl a]
ds) = String -> Doc
text "let" Doc -> Doc -> Doc
<+> [Decl a] -> Doc
forall a. [Decl a] -> Doc
ppBlock [Decl a]
ds

ppCaseType :: CaseType -> Doc
ppCaseType :: CaseType -> Doc
ppCaseType Rigid = String -> Doc
text "case"
ppCaseType Flex  = String -> Doc
text "fcase"

-- |Pretty print an alternative in a case expression
ppAlt :: Alt a -> Doc
ppAlt :: Alt a -> Doc
ppAlt (Alt _ t :: Pattern a
t rhs :: Rhs a
rhs) = Doc -> Doc -> Rhs a -> Doc
forall a. Doc -> Doc -> Rhs a -> Doc
ppRule (Int -> Pattern a -> Doc
forall a. Int -> Pattern a -> Doc
ppPattern 0 Pattern a
t) Doc
rarrow Rhs a
rhs

-- |Pretty print a free variable
ppVar :: Var a -> Doc
ppVar :: Var a -> Doc
ppVar (Var _ ident :: Ident
ident) = Ident -> Doc
ppIdent Ident
ident

-- |Pretty print a record field expression (Haskell syntax)
ppFieldExpr :: Field (Expression a) -> Doc
ppFieldExpr :: Field (Expression a) -> Doc
ppFieldExpr (Field _ l :: QualIdent
l e :: Expression a
e) = QualIdent -> Doc
ppQIdent QualIdent
l Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Int -> Expression a -> Doc
ppExpr 0 Expression a
e

-- |Pretty print an operator
ppOp :: InfixOp a -> Doc
ppOp :: InfixOp a -> Doc
ppOp (InfixOp     _ op :: QualIdent
op) = QualIdent -> Doc
ppQInfixOp QualIdent
op
ppOp (InfixConstr _ op :: QualIdent
op) = QualIdent -> Doc
ppQInfixOp QualIdent
op

-- ---------------------------------------------------------------------------
-- Names
-- ---------------------------------------------------------------------------

-- |Pretty print an identifier
ppIdent :: Ident -> Doc
ppIdent :: Ident -> Doc
ppIdent x :: Ident
x = Bool -> Doc -> Doc
parenIf (Ident -> Bool
isInfixOp Ident
x) (String -> Doc
text (Ident -> String
idName Ident
x))

ppQIdent :: QualIdent -> Doc
ppQIdent :: QualIdent -> Doc
ppQIdent x :: QualIdent
x = Bool -> Doc -> Doc
parenIf (QualIdent -> Bool
isQInfixOp QualIdent
x) (String -> Doc
text (QualIdent -> String
qualName QualIdent
x))

ppInfixOp :: Ident -> Doc
ppInfixOp :: Ident -> Doc
ppInfixOp x :: Ident
x = Bool -> Doc -> Doc
bquotesIf (Bool -> Bool
not (Ident -> Bool
isInfixOp Ident
x)) (String -> Doc
text (Ident -> String
idName Ident
x))

ppQInfixOp :: QualIdent -> Doc
ppQInfixOp :: QualIdent -> Doc
ppQInfixOp x :: QualIdent
x = Bool -> Doc -> Doc
bquotesIf (Bool -> Bool
not (QualIdent -> Bool
isQInfixOp QualIdent
x)) (String -> Doc
text (QualIdent -> String
qualName QualIdent
x))

ppMIdent :: ModuleIdent -> Doc
ppMIdent :: ModuleIdent -> Doc
ppMIdent m :: ModuleIdent
m = String -> Doc
text (ModuleIdent -> String
moduleName ModuleIdent
m)

-- ---------------------------------------------------------------------------
-- Print printing utilities
-- ---------------------------------------------------------------------------

indent :: Doc -> Doc
indent :: Doc -> Doc
indent = Int -> Doc -> Doc
nest 2

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
list

record :: Doc -> Doc
record :: Doc -> Doc
record doc :: Doc
doc | Doc -> Bool
isEmpty Doc
doc = Doc -> Doc
braces Doc
empty
           | Bool
otherwise   = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
space Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Doc
space

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
list