haskell - pretty-print 的 JavaScript 对象

Question

我选择将这个问题集中在 JSON 对象和 wl-pprint-annotated 上( here is the paper behind that library ) 因为它们使拥有 MVCE 变得容易，但我的问题实际上不在于仅打印 JSON 对象的 pretty-print ，而且我可以灵活使用我使用的 pretty-print 库。

考虑以下简化的 JavaScript 对象数据类型:

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

我如何定义一个 pretty-print 函数，以通常的方式将其输出包装到多行？ 我的意思是:只要有可能， pretty-print 输出应该放在一行上。如果这是不可能的，我希望最外面的对象在内部对象之前开始添加换行符。

这是使用 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 ]

现在，一些测试用例。

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" }

我希望最后的输出改为

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

我正在寻找一种解决方案，它以某种方式适合 Haskell 中现有的 pretty-print 库之一(实际上，我的 pretty-print 不仅仅是 JSON 的一个子集)。

我不是在寻找定义 prettyObject :: Object -> String 的解决方案- 这种方法的全部意义在于 Doc 的渲染取决于它在打印精美的大图中的位置。

Answer 1

您正在使用的 pretty-print 库已经可以做到这一点； (您刚刚告诉它做不同的事情!)通常这个系列(WL) pretty-print 可以很好地处理这种情况。

注意您的 Union 的位置:

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

在您的文本中逻辑上选择中断的那一点，即键值对的开头，您没有 Union在您的 Doc结构体。选择是在 {..} 处做出的。封闭块开始；如果你仔细检查输出，这正是它给你的:

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

您需要一个函数来为键值对实现所需的逻辑:

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

indent'就像 indent ，但提供了一个不缩进的明确替代方案。 flatAlt提供了一种在文本展平时使用的替代方案，您的文本将被展平(您可能已经猜到) flatten .您还需要重新构建 prettyObject因此:

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

注意没有明确的 Union ，但是 sep = group . vsep和 group = \x -> Union (flatten x) x .您现在有一个联合，对应于关于在何处展平文本的逻辑选择。

结果:

>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"
}

针对评论中的问题，提供flat替代的方法是使用 flatAlt ， 当然!这里唯一的问题是您想对列表的单个元素(最后一个)执行此操作 - 但这是列表的问题，而不是 Doc .欢迎使用 Data.Sequence或任何其他 Traversable ，其中大多数“类似列表”的功能类似于 punctuate工作，如果这是一个操作，你需要很多。

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>