Pretty-printing JavaScript objects

I've chosen to center this question around JSON objects and wl-pprint-annotated (here is the paper behind that library) because they make it easy to have an MVCE, but my problem is not actually around pretty-printing just JSON objects and I am flexible for which pretty-printing library I use.

Consider the following simplified JavaScript object data type:

data Object = Object [(String, Object)]
            | String String

How can I defined a pretty-printing function that wraps its output to multiple lines in the usual way? What I mean by that is: the pretty-printed output should, whenever possible fit on one line. When that is not possible, I expect the outermost objects to start adding newlines before the inner ones.

Here is one attempt using wl-pprint-annotated:

{-# LANGUAGE OverloadedString #-}
import Text.PrettyPrint.Annotated.WL

prettyObject :: Object -> Doc a 
prettyObject (String str) = "\"" <> text str <> "\""
prettyObject (Object fields) = Union ("{" <+> hsep fields' <+> "}")
                                     ("{" <#> indent 2 (vsep fields') <#> "}")

   where
     fields' :: [Doc a]
     fields' = punctuate "," [ text key <> ":" <+> prettyObject val
                             | (key,val) <- fields ]

Now, some test cases.

ghci> o1 = Object [("key1", String "val1")]
ghci> o2 = Object [("key2", String "val2"), ("looooooooooong key3", String "loooooooooooong val3"),("key4", String "val4")]
ghci> o3 = Object [("key5", String "val5"), ("key6", o2), ("key7", String "val7")]
ghci> prettyObject o1
{ key1: "val1" }
ghci> prettyObject o2
{
  key2: "val2",
  looooooooooong key3: "loooooooooooong val3",
  key4: "val4"
}
ghci> prettyObject o3
{ key5: { key1: "val1" }, key6: {
  key2: "val2",
  looooooooooong key3: "loooooooooooong val3",
  key4: "val4"
}, key7: "val7" }

I would like the last output to instead be

{
  key5: { key1: "val1" },
  key6: {
    key2: "val2",
    looooooooooong key3: "loooooooooooong val3",
    key4: "val4"
  },
  key7: "val7"
}

I am looking for a solution which somehow fits with one of the existing pretty-printing libraries in Haskell (in reality, I'm pretty-printing much more than just a subset of JSON).

I am not looking for a solution which defines a prettyObject :: Object -> String - the whole point of this approach is that the rendering of the Doc depends on where it is in the big picture of what is being pretty-printed.

Solution

The pretty print library you are using can already do this; (you have just told it to do a different thing!) generally this family (WL) of pretty printers handles this case pretty well.

Note the positioning of your Union:

prettyObject (Object fields) = Union <one line> <many line>

At the point in your text where you are logically making the choice to break, which is at the beginning of a key-value pair, you don't have a Union in your Doc structure. The choice is made at the point where a {..} enclosed block begins; and if you scrutinize the output, that is exactly what it gives you:

{ key5: { key1: "val1" }, key6: { ----- line break here
  key2: "val2",

You need a function to implement your desired logic for key-value pairs:

indent' k x = flatAlt (indent k x) (flatten x) 
prettyKVPair (k,v) = indent' 2 $ text k <> ":" <+> pretty v

indent' is like indent, but provides an explicit alternative which is not indented. flatAlt provides an alternative which is used when the text is flattened, and your text will be flattened by (you may have guessed) flatten. You also need to re-structure prettyObject accordingly:

prettyObject :: Object -> Doc a 
prettyObject (Object fields) = sep $ "{" : fields' ++ [ "}" ] where 
  fields' = punctuate "," $ map prettyKVPair fields
...

Note there is no explicit Union, but sep = group . vsep and group = \x -> Union (flatten x) x. You now have a union corresponding to logical choices about where you flatten your text.

The result:

>pretty o1
{ key1: "val1" }
>pretty o2
{
  key2: "val2",
  looooooooooong key3: "loooooooooooong val3",
  key4: "val4"
}
>pretty o3
{
  key5: "val5",
  key6: {
    key2: "val2",
    looooooooooong key3: "loooooooooooong val3",
    key4: "val4"
  },
  key7: "val7"
}

In response to the question in the comment, the way to provide a flat alternative is to use flatAlt, of course! The only issue here is you want to do this for a single element (the last one) of a list - but this is an issue with lists, not Doc. Feel free to use Data.Sequence or any other Traversable, with which most of the 'list-like' functions like punctuate work, if this is an operation you need a lot.

flattenedOf a b = flatAlt a (flatten b) # useful combinator

trailingSep _ [] = [] 
trailingSep s xs = as ++ [ (a <> s) `flattenedOf` a ]
  where as = init xs; a = last xs 

...
prettyObject (Object fields) = <unchanged> where 
  fields' = trailingSep "," $ <unchanged>