Pretty Printing our Pretty Program with Pretty

Tell me if you’ve heard this one before. You’re making some complicated data structure in Haskell. Something like the following:

data Expr =
   EVal Int
   | EIdent String
   | EFunc String [String] [Expr]
   | ECall String [Expr]
   | ELet String Expr
   | EWhile Expr [Expr]
   | EShizzy Expr Expr Expr
   | EIfElse Expr Expr Expr
   | EReturn Expr
     deriving (Show)

You throw that deriving (Show) because it’ll totally help you debug! Time goes by, and you use your fancy Expr to write a robust imperative function:

test = EFunc "testFunc" ["gatito",
                         "moogle"]
       [ELet "foo"
        $ ECall "petCat" $ [EIdent "gatito",
                            EIdent "moogle"],
        EWhile (ECall "catsPlacated" [])
        [EShizzy
         (EIfElse
          (EVal 5)
          (ELet "foo"
           $ ECall "malloc" [ECall "sizeof" [EVal 2]])
          (ECall "petCat" $ [EIdent "gatito",
                             EIdent "moogle"]))
         (ECall "petCat" $ [EIdent "gatito",
                            EIdent "moogle"])
         (ELet "foo" $ ECall "safeLeakMemory" [])
        ],
        EReturn $ EIdent "foo"
       ]

You’re still good, you got Rainbow Delimiters to keep that all sorted. Now, more time goes by and you’re in the repl and something doesn’t work. What was this test thing again?

*Shizzy> test
EFunc "testFunc" ["gatito","moogle"] [ELet "foo" (ECall "petCat" [EIdent "gatito",EIdent "moogle"]),EWhile (ECall "catsPlacated" []) [EShizzy (EIfElse (EVal 5) (ELet "foo" (ECall "malloc" [ECall "sizeof" [EVal 2]])) (ECall "petCat" [EIdent "gatito",EIdent "moogle"])) (ECall "petCat" [EIdent "gatito",EIdent "moogle"]) (ELet "foo" (ECall "safeLeakMemory" []))],EReturn (EIdent "foo")]

Well that’s unfortunate. What do we do now? Aside from the fact that this is completely useless to us, this certainly wouldn’t be OK to print out to a user…

The good news is that pretty printing is a snap thanks to the HughesPJ Pretty Printer. One simply has to implement the Pretty class for one’s type, and then they can get some reasonable output:

testFunc(gatito moogle) {
  let foo = petCat(gatito moogle)
  while(catsPlacated()) {
      +--
          {
            if (5) let foo = malloc(sizeof(2))
            else petCat(gatito moogle)
          }
      +++
      + +
      +++
    {
      petCat(gatito moogle)
    }
      +++
      + +
      +++
          {
            let foo = safeLeakMemory()
          }
      +--
  }
  produceResult foo
}

Let’s see how we get there, constructor by constructor.

EVal and EIdent

First up are the easy ones: EVal and EIdent, which represent bare values:

instance Pretty Expr where
   pPrint (EVal v) =
      int v
   pPrint (EIdent s) =
      text s

First we have to declare our instance, but next we can just print the values. int pretty prints an integer, and text pretty prints a string.

EFunc and ECall

Next we have function calls and definitions:

   pPrint (EFunc n a b) =
      text n
      <> (parens $ hsep $ fmap text a) <+> lbrace
      $+$ (nest 2 $ vcat $ fmap pPrint b)
      $+$ rbrace
   pPrint (ECall n a) =
      text n <> (parens $ hsep $ fmap pPrint a)

There are some operators here that require explanation. All of these operators have type (Doc -> Doc -> Doc ), and are used to combine two Doc into one. A Doc is the type of thing that can be pretty printed, which is returned by calls to pPrint and various other primitive pretty printing functions provided by the library (like text and int)

<> glues the thing on the left next to the thing on the right with no space in between, where <+> does the same, but leaves 1 space in between. Similarly, $$ and $+$ glues the thing on the right to the bottom of the thing on the left. $+$ allows the right hand side to overlap with the left (more on this later). There are also hsep, and vcat which takes lists of Doc. These functions work similarly to <>, $$ and friends; they glue Docs together horizontally and vertically. *cat are the non-plus variants, and *sep are the plus variants.

Other functions introduced here are parens, which takes a Doc and surrounds it by parens. lbrace and rbrace insert { and } respectively. There is a braces function as well, but I didn’t use it because I want to control how the braces are shown. Finally, we have nest, which indents its argument. This function is great because it takes into account outer nest calls, so we can get arbitrary nesting.

ELet, EWhile, EIfElse, and EReturn

   pPrint (ELet n e) =
      text "let" <+> text n <+> equals <+> pPrint e
   pPrint (EWhile p b) =
      text "while" <> (parens $ pPrint p) <+> lbrace
      $+$ (nest 2 $ vcat $ fmap pPrint b)
      $+$ rbrace
   pPrint (EIfElse p t f) =
      text "if" <+> (parens $ pPrint p) <+> pPrint t
      $+$ text "else" <+> pPrint f
   pPrint (EReturn v) =
      text "produceResult" <+> pPrint v

Nothing particularly fancy here. in ELet, we have equals which inserts an equals sign and we have more nesting throughout. As you can see, this is very simple once you get the hang of it; there are few abstract instances involved, and most functions do what they say.

EShizzy

As we all know, any programming language that doesn’t have Shizzy statements isn’t worth knowing, so of course I implement them:

   pPrint (EShizzy u d t) =
      onFire
      $+$ (nest 6 (lbrace $+$ (nest 2 (pPrint u)) 
                          $+$ rbrace))
      $+$ noRules
      $+$ (lbrace $+$ (nest 2 (pPrint d)) $+$ rbrace)
      $+$ noRules
      $+$ (nest 6 (lbrace $+$ (nest 2 (pPrint t)) 
                          $+$ rbrace))
      $+$ onFire
      where
         onFire = nest 2 $ text "+--"
         noRules = nest 2 $ (text "+++" $$ text "+ +" 
                                        $$ text "+++")

This produces the following output as we’d expect:

      +--
          {
            if (5) let foo = malloc(sizeof(2))
            else petCat(gatito moogle)
          }
      +++
      + +
      +++
    {
      petCat(gatito moogle)
    }
      +++
      + +
      +++
          {
            let foo = safeLeakMemory()
          }
      +--

and this gives me a good opportunity to demonstrate the difference between $$ and $+$. Let’s swap all the plus variants out:

      onFire
      $$ (nest 6 (lbrace $$ (nest 2 (pPrint u)) 
                         $$ rbrace))
      $$ noRules
      $$ (lbrace $$ (nest 2 (pPrint d)) 
                 $$ rbrace)
      $$ noRules
      $$ (nest 6 (lbrace $$ (nest 2 (pPrint t)) $$ rbrace))
      $$ onFire
      where
         onFire = nest 2 $ text "+--"
         noRules = nest 2 $ (text "+++" $$ text "+ +" 
                                        $$ text "+++")

Now, the pretty printer outputs the following:

  +-- { if (5) let foo = malloc(sizeof(2))
        else petCat(gatito moogle)
      }
  +++
  + +
  +++
{ petCat(gatito moogle)
} +++
  + +
  +++ { let foo = safeLeakMemory()
      }
  +--

Basically, if something is nested far enough that it would appear after the end of the left hand side argument, it is pasted to the right of it instead of below it. Honestly, it’s pretty strange behavior to me, I say just avoid $$ for the most part and you’ll be fine. It’s not a huge stretch for me to think of a use for this, but I think I’d just use <> or <+> if I wanted this to happen.

Regardless, I’ve worked on projects that use this pretty printing library before, and now that I’ve given it a shot I know why!