Так как "сгиб" недостаточно мощный, чтобы написать красивое дерево с отступом, какой комбинатор высокого порядка?

Учитывая, например, следующий тип данных дерева:

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

Как выразить "симпатичную" функцию с помощью комбинатора высокого порядка, который печатает дерево с соответствующим отступом? Например:

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

Я хочу, чтобы результатом этой программы было:

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

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

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

Очевидно, что невозможно записать функцию, которую я хочу использовать fold, поскольку она забывает древовидную структуру. Итак, что такое правильный комбинатор высокого порядка, который достаточно общий, чтобы позволить мне написать функцию, которую я хочу, но менее мощный, чем запись прямой рекурсивной функции?

Ответ 1

fold достаточно силен; трюк заключается в том, что нам нужно создать экземпляр r в качестве монады-читателя текущего уровня отступов.

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

Обратите внимание, что я передаю дополнительный параметр вызову fold. Это начальное состояние отступов, и оно работает, потому что при этой специализации r функция fold возвращает функцию.

Ответ 1

Ответ 2