Text.PrettyPrint: начало отступа от левого поля

Question

Я пытаюсь сгенерировать Javascript, используя Text.PrettyPrint. Проблема в том, что nest производит огромный отступ, когда помещается рядом с другим довольно напечатанным элементом. Например, в этом коде:

import Text.PrettyPrint

fun :: Doc
fun = vcat [ text "function" <+> lbrace
           , nest 4 $ vcat $ replicate 5 $ text "// foo"
           , rbrace
           ]

var :: Doc
var = text "var" <+> text "x"

test :: Doc
test = var <+> equals <+> fun <> semi

fun начинается со столбца 9 в test (из-за var <+> equals <> empty слева от него), и поэтому его последующие строки имеют отступ 9 + 4 = 13 столбцов:

var x = function {
            // foo
            // foo
            // foo
            // foo
            // foo
        };

Есть ли способ визуализировать отступы от левого поля, так что вместо этого будет отображаться

var x = function {
    // foo
    // foo
    // foo
    // foo
    // foo
};

Answer 1

Решение действительно использовать wl-pprint (и заменить nest на indent).Затем данный код выдает

var x = function {
    // foo
    // foo
    // foo
    // foo
    // foo
};

по желанию.Если вы все еще хотите что-то сделать, пытаясь взломать pretty, учтите, что, хотя конструкторы для Doc не открыты, вы все равно можете получить их через Generic с помощью -XPatternSynonyms:

-- | Means of exposing the data constructors of `Doc` from `pretty`
pattern GEmpty              = M1 (L1 (L1 (L1 (M1 U1))))
pattern GNilAbove doc       = M1 (L1 (L1 (R1 (M1 (M1 (K1 doc))))))
pattern GTextBeside d doc   = M1 (L1 (R1 (L1 (M1 (M1 (K1 d) :*: M1 (K1 doc))))))
pattern GNest n doc         = M1 (L1 (R1 (R1 (M1 (M1 (K1 n) :*: M1 (K1 doc))))))
pattern GUnion ldoc rdoc    = M1 (R1 (L1 (L1 (M1 (M1 (K1 ldoc) :*: M1 (K1 rdoc))))))
pattern GNoDoc              = M1 (R1 (L1 (R1 (M1 U1))))
pattern GBeside ldoc s rdoc = M1 (R1 (R1 (L1 (M1 (M1 (K1 ldoc) :*: M1 (K1 s) :*: M1 (K1 rdoc))))))
pattern GAbove ldoc b rdoc  = M1 (R1 (R1 (R1 (M1 (M1 (K1 ldoc) :*: M1 (K1 b) :*: M1 (K1 rdoc))))))

Проблема в основном не в том, чтобы нарушать ни один из множества инвариантов, которые есть у библиотеки под капотом.

---

В качестве примечания я также нашел wl-pprint-annotated, aсовременное переписывание wl-pprint, с помощью которого можно получить доступ к базовым конструкторам данных (ценой необходимости помнить об инвариантах).На самом деле это пакет, который я в конечном итоге буду использовать.

В частности, он позволяет мне сделать такой блок скобок таким, чтобы, если он достаточно мал, он помещался только в одну строку:

-- | Asserts a 'Doc a' cannot render on multiple lines.
oneLine :: Doc a -> Bool
oneLine (WL.FlatAlt d _) = oneLine d
oneLine (WL.Cat a b) = oneLine a && oneLine b
oneLine (WL.Union a b) = oneLine a && oneLine b
oneLine (WL.Annotate _ d) = oneLine d
oneLine WL.Line = False
oneLine _ = True

-- | Make a curly-brace delimited block. When possible, permit fitting everything on one line
block :: Doc a -> Doc a
block b | oneLine b = hsep ["{", b, "}"] `WL.Union` vsep [ "{", indent 2 b, "}" ]
        | otherwise = vsep [ "{", indent 2 b, "}" ]

Тогда я получаю хорошие результаты, которые автоматически выполняют или не занимают несколько строк:

ghci> "function" <> parens "x" <+> block ("return" <+> "x" <> semi)
function(x) { return x; }
ghci> "function" <> parens "x" <+> block ("x" <> "++" <> semi <#> "return" <+> "x" <> semi)
function(x) {
  x++;
  return x;
}

Answer 2

offset = 1 + length (render $ var <+> equals)
hang empty (negate offset) test

Answer 3

Вы можете достичь желаемого результата, применив vcat к списку, в котором первый элемент содержит также определение и назначение переменной.

Пример:

fun :: Doc
fun = vcat [ var <+> equals <+> text "function" <+> lbrace
           , nest 4 $ vcat $ replicate 5 $ text "// foo"
           , rbrace
           ]

var :: Doc
var = text "var" <+> text "x"

test :: Doc
test = fun <> semi