{- |
    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.
-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Curry.Syntax.Pretty
  ( pPrint, pPrintPrec, ppContext, ppInstanceType, ppIMethodImpl
  , ppIdent, ppQIdent, ppInfixOp, ppQInfixOp, ppMIdent
  ) where

import Prelude hiding ((<>))

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

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

instance Pretty (Module a) where
  pPrint :: Module a -> Doc
pPrint (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. Pretty a => [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 ((ImportDecl -> Doc) -> [ImportDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl -> Doc
forall a. Pretty a => a -> Doc
pPrint [ImportDecl]
is)
  where header :: Doc
header = [Doc] -> Doc
vcat ((ModulePragma -> Doc) -> [ModulePragma] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma -> Doc
forall a. Pretty a => a -> Doc
pPrint [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
forall a. Pretty a => a -> Doc
pPrint Maybe ExportSpec
es Doc -> Doc -> Doc
<+> String -> Doc
text "where"

instance Pretty ModulePragma where
  pPrint :: ModulePragma -> Doc
pPrint (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
forall a. Pretty a => a -> Doc
pPrint [Extension]
exts
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint) 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 "#-}"

instance Pretty Extension where
  pPrint :: Extension -> Doc
pPrint (KnownExtension   _ e :: KnownExtension
e) = String -> Doc
text (KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
e)
  pPrint (UnknownExtension _ e :: String
e) = String -> Doc
text String
e

instance Pretty Tool where
  pPrint :: Tool -> Doc
pPrint (UnknownTool t :: String
t) = String -> Doc
text String
t
  pPrint t :: Tool
t               = String -> Doc
text (Tool -> String
forall a. Show a => a -> String
show Tool
t)

instance Pretty ExportSpec where
  pPrint :: ExportSpec -> Doc
pPrint (Exporting _ es :: [Export]
es) = [Doc] -> Doc
parenList ((Export -> Doc) -> [Export] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Export -> Doc
forall a. Pretty a => a -> Doc
pPrint [Export]
es)

instance Pretty Export where
  pPrint :: Export -> Doc
pPrint (Export             _ x :: QualIdent
x) = QualIdent -> Doc
ppQIdent QualIdent
x
  pPrint (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)
  pPrint (ExportTypeAll     _ tc :: QualIdent
tc) = QualIdent -> Doc
ppQIdent QualIdent
tc Doc -> Doc -> Doc
<> String -> Doc
text "(..)"
  pPrint (ExportModule       _ m :: ModuleIdent
m) = String -> Doc
text "module" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m

instance Pretty ImportDecl where
  pPrint :: ImportDecl -> Doc
pPrint (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
forall a. Pretty a => a -> Doc
pPrint 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'

instance Pretty ImportSpec where
  pPrint :: ImportSpec -> Doc
pPrint (Importing _ is :: [Import]
is) = [Doc] -> Doc
parenList ((Import -> Doc) -> [Import] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Import -> Doc
forall a. Pretty a => a -> Doc
pPrint [Import]
is)
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint [Import]
is)

instance Pretty Import where
  pPrint :: Import -> Doc
pPrint (Import             _ x :: Ident
x) = Ident -> Doc
ppIdent Ident
x
  pPrint (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)
  pPrint (ImportTypeAll     _ tc :: Ident
tc) = Ident -> Doc
ppIdent Ident
tc Doc -> Doc -> Doc
<> String -> Doc
text "(..)"

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

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

instance Pretty (Decl a) where
  pPrint :: Decl a -> Doc
pPrint (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)
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint [ConstrDecl]
cs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                   [[QualIdent] -> Doc
ppDeriving [QualIdent]
clss]))
  pPrint (ExternalDataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs) = String -> Ident -> [Ident] -> Doc
ppTypeDeclLhs "external data" Ident
tc [Ident]
tvs
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint NewConstrDecl
nc, [QualIdent] -> Doc
ppDeriving [QualIdent]
clss])
  pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty)]
  pPrint (TypeSig _ fs :: [Ident]
fs ty :: QualTypeExpr
ty) =
    [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
<+> Int -> QualTypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 QualTypeExpr
ty
  pPrint (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. Pretty a => a -> Doc
pPrint [Equation a]
eqs)
  pPrint (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. Pretty a => a -> Doc
pPrint [Var a]
vs) Doc -> Doc -> Doc
<+> String -> Doc
text "external"
  pPrint (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. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t) Doc
equals Rhs a
rhs
  pPrint (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. Pretty a => a -> Doc
pPrint [Var a]
vs) Doc -> Doc -> Doc
<+> String -> Doc
text "free"
  pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0) [TypeExpr]
tys)
  pPrint (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. Pretty a => [a] -> Doc
ppBlock [Decl a]
ds)
  pPrint (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. Pretty a => [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
forall a. Pretty a => a -> Doc
pPrint 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
forall a. Pretty a => a -> Doc
pPrint Context
cs) Doc -> Doc -> Doc
<+> Doc
darrow

instance Pretty Constraint where
  pPrint :: Constraint -> Doc
pPrint (Constraint _ qcls :: QualIdent
qcls ty :: TypeExpr
ty) = QualIdent -> Doc
ppQIdent QualIdent
qcls Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2 TypeExpr
ty

ppInstanceType :: InstanceType -> Doc
ppInstanceType :: TypeExpr -> Doc
ppInstanceType = Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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)

instance Pretty ConstrDecl where
  pPrint :: ConstrDecl -> Doc
pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2) [TypeExpr]
tys) ]
  pPrint (ConOpDecl _ ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) =
    [Doc] -> Doc
sep [ Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 TypeExpr
ty1, Ident -> Doc
ppInfixOp Ident
op Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 TypeExpr
ty2 ]
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint [FieldDecl]
fs)) ]

instance Pretty FieldDecl where
  pPrint :: FieldDecl -> Doc
pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty

instance Pretty NewConstrDecl where
  pPrint :: NewConstrDecl -> Doc
pPrint (NewConstrDecl _ c :: Ident
c ty :: TypeExpr
ty) = [Doc] -> Doc
sep [Ident -> Doc
ppIdent Ident
c Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2 TypeExpr
ty]
  pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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 '.'

instance Pretty (Equation a) where
  pPrint :: Equation a -> Doc
pPrint (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. Pretty a => a -> Doc
pPrint Lhs a
lhs) Doc
equals Rhs a
rhs

instance Pretty (Lhs a) where
  pPrint :: Lhs a -> Doc
pPrint (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. Pretty a => Int -> a -> Doc
pPrintPrec 2) [Pattern a]
ts)
  pPrint (OpLhs _ t1 :: Pattern a
t1 f :: Ident
f t2 :: Pattern a
t2) =
    Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 Pattern a
t1 Doc -> Doc -> Doc
<+> Ident -> Doc
ppInfixOp Ident
f Doc -> Doc -> Doc
<+> Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 Pattern a
t2
  pPrint (ApLhs  _ lhs :: Lhs a
lhs ts :: [Pattern a]
ts) =
    Doc -> Doc
parens (Lhs a -> Doc
forall a. Pretty a => a -> Doc
pPrint 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. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => [a] -> Doc
ppBlock [Decl a]
ds)

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

instance Pretty Interface where
  pPrint :: Interface -> Doc
pPrint (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
forall a. Pretty a => a -> Doc
pPrint [IImportDecl]
is [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (IDecl -> Doc) -> [IDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IDecl -> Doc
forall a. Pretty a => a -> Doc
pPrint [IDecl]
ds)
      Doc -> Doc -> Doc
$$ Doc
rbrace

instance Pretty IImportDecl where
  pPrint :: IImportDecl -> Doc
pPrint (IImportDecl _ m :: ModuleIdent
m) = String -> Doc
text "import" Doc -> Doc -> Doc
<+> ModuleIdent -> Doc
ppMIdent ModuleIdent
m

instance Pretty IDecl where
  pPrint :: IDecl -> Doc
pPrint (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
  pPrint (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
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint [ConstrDecl]
cs)) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
      [Doc -> Doc
indent ([Ident] -> Doc
ppHiding [Ident]
hs)])
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint NewConstrDecl
nc)
        , Doc -> Doc
indent ([Ident] -> Doc
ppHiding [Ident]
hs)
        ]
  pPrint (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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty)]
  pPrint (IFunctionDecl _ f :: QualIdent
f cm :: Maybe Ident
cm a :: Int
a ty :: QualTypeExpr
ty) =
    [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 "::", Int -> QualTypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 QualTypeExpr
ty ]
  pPrint (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)
  pPrint (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
forall a. Pretty a => a -> Doc
pPrint) [IMethodDecl]
ms) Doc -> Doc -> Doc
$$
      Doc
rbrace Doc -> Doc -> Doc
<+> [Ident] -> Doc
ppHiding [Ident]
hs
  pPrint (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)

instance Pretty IMethodDecl where
  pPrint :: IMethodDecl -> Doc
pPrint (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
<+> Int -> QualTypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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
-- ---------------------------------------------------------------------------

instance Pretty KindExpr where
  pPrintPrec :: Int -> KindExpr -> Doc
pPrintPrec _ Star              = Char -> Doc
char '*'
  pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 KindExpr
k]

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

instance Pretty QualTypeExpr where
  pPrint :: QualTypeExpr -> Doc
pPrint (QualTypeExpr _ cx :: Context
cx ty :: TypeExpr
ty) = Context -> Doc
ppContext Context
cx Doc -> Doc -> Doc
<+> Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty

instance Pretty TypeExpr where
  pPrintPrec :: Int -> TypeExpr -> Doc
pPrintPrec _ (ConstructorType _ tc :: QualIdent
tc) = QualIdent -> Doc
ppQIdent QualIdent
tc
  pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 TypeExpr
ty Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2) [TypeExpr]
tys)
  pPrintPrec _ (VariableType    _ tv :: Ident
tv) = Ident -> Doc
ppIdent Ident
tv
  pPrintPrec _ (TupleType      _ tys :: [TypeExpr]
tys) = [Doc] -> Doc
parenList ((TypeExpr -> Doc) -> [TypeExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0) [TypeExpr]
tys)
  pPrintPrec _ (ListType        _ ty :: TypeExpr
ty) = Doc -> Doc
brackets (Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty)
  pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty]
  pPrintPrec _ (ParenType       _ ty :: TypeExpr
ty) = Doc -> Doc
parens (Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty)
  pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 TypeExpr
ty

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

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

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

instance Pretty (Pattern a) where
  pPrintPrec :: Int -> Pattern a -> Doc
pPrintPrec 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
forall a. Pretty a => a -> Doc
pPrint 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
  pPrintPrec 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
forall a. Pretty a => a -> Doc
pPrint Literal
l)
  pPrintPrec _ (VariablePattern        _ _ v :: Ident
v) = Ident -> Doc
ppIdent Ident
v
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 2) [Pattern a]
ts))
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Pattern a
t1 Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp QualIdent
c, Doc -> Doc
indent (Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t2)])
  pPrintPrec _ (ParenPattern             _ t :: Pattern a
t) = Doc -> Doc
parens (Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t)
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 0) [Pattern a]
ts)
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 0) [Pattern a]
ts)
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 2 Pattern a
t
  pPrintPrec _ (LazyPattern              _ t :: Pattern a
t) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2 Pattern a
t
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 2) [Pattern a]
ts))
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Pattern a
t1 Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp QualIdent
f, Doc -> Doc
indent (Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t2)])
  pPrintPrec 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. Pretty a => a -> Doc
pPrint [Field (Pattern a)]
fs)))

instance Pretty a => Pretty (Field a) where
  pPrint :: Field a -> Doc
pPrint (Field _ l :: QualIdent
l t :: a
t) = QualIdent -> Doc
ppQIdent QualIdent
l Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 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. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
g Doc -> Doc -> Doc
<+> Doc
eq, Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e)]

instance Pretty (Expression a) where
  pPrintPrec :: Int -> Expression a -> Doc
pPrintPrec _ (Literal        _ _ l :: Literal
l) = Literal -> Doc
forall a. Pretty a => a -> Doc
pPrint Literal
l
  pPrintPrec _ (Variable       _ _ v :: QualIdent
v) = QualIdent -> Doc
ppQIdent QualIdent
v
  pPrintPrec _ (Constructor    _ _ c :: QualIdent
c) = QualIdent -> Doc
ppQIdent QualIdent
c
  pPrintPrec _ (Paren            _ e :: Expression a
e) = Doc -> Doc
parens (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e)
  pPrintPrec p :: Int
p (Typed        _ e :: Expression a
e ty :: QualTypeExpr
ty)  =
    Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Int -> QualTypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 QualTypeExpr
ty)
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 0) [Expression a]
es)
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 0) [Expression a]
es)
  pPrintPrec _ (ListCompr     _ e :: Expression a
e qs :: [Statement a]
qs) =
    Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => a -> Doc
pPrint [Statement a]
qs))
  pPrintPrec _ (EnumFrom              _ e :: Expression a
e) =
    Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e Doc -> Doc -> Doc
<+> String -> Doc
text "..")
  pPrintPrec _ (EnumFromThen      _ e1 :: Expression a
e1 e2 :: Expression a
e2) =
    Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e2 Doc -> Doc -> Doc
<+> String -> Doc
text "..")
  pPrintPrec _ (EnumFromTo        _ e1 :: Expression a
e1 e2 :: Expression a
e2) =
    Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e1 Doc -> Doc -> Doc
<+> String -> Doc
text ".." Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e2)
  pPrintPrec _ (EnumFromThenTo _ e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) =
    Doc -> Doc
brackets (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e1 Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e2
      Doc -> Doc -> Doc
<+> String -> Doc
text ".." Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e3)
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Expression a
e)
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Expression a
e1, Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 2 Expression a
e2)])
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Expression a
e2)])
  pPrintPrec _ (LeftSection      _ e :: Expression a
e op :: InfixOp a
op) =
    Doc -> Doc
parens (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 1 Expression a
e Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQInfixOp (InfixOp a -> QualIdent
forall a. InfixOp a -> QualIdent
opName InfixOp a
op))
  pPrintPrec _ (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. Pretty a => Int -> a -> Doc
pPrintPrec 1 Expression a
e)
  pPrintPrec 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) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [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. Pretty a => Int -> a -> Doc
pPrintPrec 2) [Pattern a]
t) Doc -> Doc -> Doc
<+> Doc
rarrow,
         Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e)]
  pPrintPrec 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. Pretty a => [a] -> Doc
ppBlock [Decl a]
ds, String -> Doc
text "in" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e])
  pPrintPrec 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. Pretty a => a -> Doc
pPrint [Statement a]
sts) Doc -> Doc -> Doc
$$ Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e))
  pPrintPrec 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. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e1,
          String -> Doc
text "then" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e2,
          String -> Doc
text "else" Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e3])
  pPrintPrec 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
forall a. Pretty a => a -> Doc
pPrint CaseType
ct Doc -> Doc -> Doc
<+> Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => a -> Doc
pPrint [Alt a]
alts)))
  pPrintPrec 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. Pretty a => a -> Doc
pPrint [Field (Expression a)]
fs)))
  pPrintPrec _ (RecordUpdate _ e :: Expression a
e fs :: [Field (Expression a)]
fs) =
    Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 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. Pretty a => a -> Doc
pPrint [Field (Expression a)]
fs))

instance Pretty (Statement a) where
  pPrint :: Statement a -> Doc
pPrint (StmtExpr   _ e :: Expression a
e) = Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e
  pPrint (StmtBind _ t :: Pattern a
t e :: Expression a
e) =
    [Doc] -> Doc
sep [Int -> Pattern a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t Doc -> Doc -> Doc
<+> Doc
larrow, Doc -> Doc
indent (Int -> Expression a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 Expression a
e)]
  pPrint (StmtDecl  _ _ ds :: [Decl a]
ds) = String -> Doc
text "let" Doc -> Doc -> Doc
<+> [Decl a] -> Doc
forall a. Pretty a => [a] -> Doc
ppBlock [Decl a]
ds

instance Pretty CaseType where
  pPrint :: CaseType -> Doc
pPrint Rigid = String -> Doc
text "case"
  pPrint Flex  = String -> Doc
text "fcase"

instance Pretty (Alt a) where
  pPrint :: Alt a -> Doc
pPrint (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. Pretty a => Int -> a -> Doc
pPrintPrec 0 Pattern a
t) Doc
rarrow Rhs a
rhs

instance Pretty (Var a) where
  pPrint :: Var a -> Doc
pPrint (Var _ ident :: Ident
ident) = Ident -> Doc
ppIdent Ident
ident

instance Pretty (InfixOp a) where
  pPrint :: InfixOp a -> Doc
pPrint (InfixOp     _ op :: QualIdent
op) = QualIdent -> Doc
ppQInfixOp QualIdent
op
  pPrint (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