Poiché "fold" non è abbastanza potente per scrivere un albero abbastanza-stampante con indentazione, quale combinatore di ordine elevato è?

Question

dato, per esempio, il seguente tipo di dati ad albero:

data Tree a = Node [Tree a] | Leaf a deriving Show 
type Sexp = Tree String 

Come si esprimo una funzione di "bella" con un combinatore di ordine superiore, che stampa l'albero con una corretta indentazione? Per esempio:

sexp = 
    Node [ 
     Leaf "aaa", 
     Leaf "bbb", 
     Node [ 
      Leaf "ccc", 
      Leaf "ddd", 
      Node [ 
       Leaf "eee", 
       Leaf "fff"], 
      Leaf "ggg", 
      Leaf "hhh"], 
     Leaf "jjj", 
     Leaf "kkk"] 
pretty = ???? 
main = print $ pretty sexp 

Voglio che il risultato di tale programma sia:

(aaa 
    bbb 
    (ccc 
     ddd 
     (eee 
      fff) 
     ggg 
     hhh) 
    jjj 
    kkk) 

Qui è una soluzione incompleta, utilizzando una "piega", come il combinatore, che non implementa l'indentazione:

fold f g (Node children) = f (map (fold f g) children) 
fold f g (Leaf terminal) = g terminal 
pretty = fold (\ x -> "(" ++ (foldr1 ((++) . (++ " ")) x) ++ ")") show 
main = putStrLn $ pretty sexp 

non è ovviamente possibile scrivere la funzione che voglio utilizzare fold, dal momento che dimentica la struttura ad albero. Quindi, qual è un corretto combinatore di alto ordine che è abbastanza generico da permettermi di scrivere la funzione che voglio, ma meno potente della scrittura di una funzione ricorsiva diretta?

Answer 1

fold è sufficientemente potente; il trucco è che avremo bisogno di istanziare r come monod del lettore del livello di indentazione corrente.

fold :: ([r] -> r) -> (a -> r) -> (Tree a -> r) 
fold node leaf (Node children) = node (map (fold node leaf) children) 
fold node leaf (Leaf terminal) = leaf terminal 

pretty :: forall a . Show a => Tree a -> String 
pretty tree = fold node leaf tree 0 where 

    node :: [Int -> String] -> Int -> String 
    node children level = 
    let childLines = map ($ level + 1) children 
    in unlines ([indent level "Node ["] ++ childLines ++ [indent level "]"]) 

    leaf :: a -> Int -> String 
    leaf a level = indent level (show a) 

    indent :: Int -> String -> String -- two space indentation 
    indent n s = replicate (2 * n) ' ' ++ s 

prendere atto attenzione che mi passa un parametro in più per la chiamata a fold. Questo è lo stato iniziale di indentazione e funziona perché con questa specializzazione di r, fold restituisce una funzione.

Answer 2

E 'semplicemente

onLast f xs = init xs ++ [f (last xs)] 

pretty :: Sexp -> String 
pretty = unlines . fold (node . concat) (:[]) where 
    node [] = [""] 
    node (x:xs) = ('(' : x) : map (" " ++) (onLast (++ ")") xs)