summaryrefslogtreecommitdiff
path: root/src/CC/Term/Pretty.idr
blob: 04e3109ff4b3310a61a2898fd3aa43e98699a0dd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
module CC.Term.Pretty

import CC.Name
import CC.Term

import Text.PrettyPrint.Prettyprinter

--------------------------------------------------------------------------------

startPrec, leftAppPrec, appPrec : Prec
startPrec = Open
leftAppPrec = Backtick
appPrec = App

prettyVar : (ctx : Context) -> (k : Nat) -> (0 _ : IsVar k n ctx) -> Doc ann
prettyVar (_ :< n) 0 (Here eq) = pretty n
prettyVar (ctx :< _) (S k) (There prf) = prettyVar ctx k prf

prettyTerm : {ctx : Context} -> Prec -> Term ctx -> Doc ann
prettyTerm d (Var k _ prf) = prettyVar ctx k prf
prettyTerm d (Abs n t) =
  let (names, body) = mapFst (pretty n ::) $ getNames t in
  parenthesise (d > startPrec) $ group $
    backslash <+> concatWith (\x, y => x <+> comma <+> line <+> y) names <++>
    pretty "=>" <+> softline <+> body
  where
  getNames : {ctx : Context} -> Term ctx -> (List (Doc ann), Doc ann)
  getNames (Abs n t) = mapFst (pretty n ::) (getNames t)
  getNames t = ([], prettyTerm startPrec t)
prettyTerm d (App t u) =
  parenthesise (d >= appPrec) $ group $
  prettyTerm leftAppPrec t <++> prettyTerm appPrec u
prettyTerm d (Let n t u) =
  parenthesise (d > startPrec) $ group $ align $
    pretty "let" <++>
    (group $ align $ hang 2 $ pretty n <++> pretty "=" <+> line <+> prettyTerm startPrec t) <+>
    pretty ";" <+> line <+>
    prettyTerm startPrec u

export
{ctx : Context} -> Pretty (Term ctx) where
  prettyPrec = prettyTerm