Text.PrettyPrint: sangría de inicio desde el margen izquierdo

Question

Estoy tratando de generar Javascript usando Text.PrettyPrint. El problema es que nest produce una gran sangría cuando se coloca junto a otro elemento bastante impreso. Por ejemplo, en este código:

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 comienza en la columna 9 en test (a causa de var <+> equals <> empty a la izquierda de ella), y por lo tanto sus líneas subsiguientes se sangran por 9 + 4 = 13 columnas:

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

¿hay una manera de hacer que las muescas del margen izquierdo, por lo que lo anterior no serviría de lugar como

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

?

Answer 1

La solución es, en efecto utilizar wl-pprint (y reemplazar nest con indent). Luego, el código proporcionado produce

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

según lo desee. Para alguien que todavía la intención de trabajar con algo que intenta cortar en pretty, tenga en cuenta que aunque los constructores para Doc no están expuestos, todavía se puede llegar a ellos a través de Generic con -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)))))) 

El problema en su mayoría no está violando cualquiera de las muchas invariantes que la biblioteca tiene bajo el capó.

---

Como nota al margen, también encontré wl-pprint-annotated, una moderna re-escritura de wl-pprint, con la que se tiene acceso a los constructores de datos subyacentes (a costa de tener que tener en cuenta los invariantes involucrados). Este es en realidad el paquete que terminaré usando.

En particular, me permite hacer este tipo de bloque de refuerzo de tal manera que si es lo suficientemente pequeño que va a ir en una sola línea:

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

entonces consigo resultados agradables que hacen de forma automática o no lo hacen abarcar varias líneas:

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

Se podría lograr el resultado deseado mediante la aplicación de vcat a una lista en la que el primer elemento incluye también la definición de variables y asignación.

Ejemplo:

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