haskell-unix-tree.md

Unix tree in Haskell

My take on pretty printing a rose tree like the unix tree command does. Inspired by this blog post of a version in OCaml.

It is pure and idiomatic without using any library functions. Thanks to laziness, it doesn't wait to return until the whole string is built. As such it will print a finite prefix of large or infinite trees (see example below).

I might make an actual command line tool out of this at some point.

-- | Rose tree of 'String', good for representing unix directory structure
data Tree = Node String [Tree]

-- | Show instance for rendering 'Tree' like the unix @tree@ command
instance Show Tree where
    show (Node x subtree) = x ++ go subtree ""
      where
      go [] _ = ""
      go [Node x ts] indent =
        "\n" ++ indent ++ "└── " ++ x ++ go ts (indent ++ "    ")
      go (Node x ts : xs) indent =
        "\n" ++ indent ++ "├── " ++ x ++ go ts (indent ++ "│   ") ++ go xs indent

-- | An example 'Tree'
test :: Tree
test = Node "." [ Node "a" [ Node "aa" []
                           , Node "ab" [ Node "aba" []]
                           ]
                , Node "b" [ Node "ba" []
                           , Node "bb" [ Node "bba" []
                                       , Node "bbb" []
                                       ]
                           ]
                , Node "c" [ Node "ca" []
                           , Node "cb" [ Node "cba" [ Node "cbaa" []
                                                    , Node "cbab" []
                                                    ]
                                       ]
                           , Node "cc" []
                           , Node "cd" (repeat (Node "cda" [])) -- repeat forever
                           ]
                ]

Output:

ghci> print test
.
├── a
│   ├── aa
│   └── ab
│       └── aba
├── b
│   ├── ba
│   └── bb
│       ├── bba
│       └── bbb
└── c
    ├── ca
    ├── cb
    │   └── cba
    │       ├── cbaa
    │       └── cbab
    ├── cc
    └── cd
        ├── cda
        ├── cda
        ├── cda
     ^C  ├── cda
        ├── cda
        ├── cda
       Interrupted.

This is the OCaml version from the linked article:

(* A type of non-empty trees of strings. *)
type tree = [
  |`Node of string * tree list
]
;;

(* [print_tree tree] prints a rendering of [tree]. *)
let rec print_tree
          ?(pad : (string * string)= ("", ""))
          (tree : tree) : unit =
  let pd, pc = pad in
  match tree with
  | `Node (tag, cs) ->
     Printf.printf "%s%s\n" pd tag;
     let n = List.length cs - 1 in
     List.iteri (
         fun i c ->
         let pad =
           (pc ^ (if i = n then "`-- " else "|-- "),
            pc ^ (if i = n then "    " else "|   ")) in
         print_tree ~pad c
       ) cs
;;

(* An example tree. *)
let tree =
  `Node ("."
        , [
            `Node ("S", [
                      `Node ("T", [
                                `Node ("U", [])]);
                      `Node ("V", [])])
          ;  `Node ("W", [])
          ])
;;

(* Print the example tree. *)
let () =  print_tree tree
;;

Generic rose trees:

{-# LANGUAGE FlexibleInstances #-}

data Tree a = Node a [Tree a]

class Pretty a where
    pretty :: a -> String

instance Pretty String where
    pretty = id

instance Pretty a => Show (Tree a) where
    show (Node x subtree) = pretty x ++ prettyTree subtree ""

prettyTree [] _ = ""

prettyTree [Node x ts] indent =
  "\n" ++ indent ++ "└── " ++ pretty x ++ prettyTree ts (indent ++ "    ")

prettyTree (Node x ts : xs) indent =
  "\n" ++ indent ++ "├── " ++ pretty x ++ prettyTree ts (indent ++ "│   ") ++ prettyTree xs indent


test :: Tree String
test = Node "." [ Node "a" [ Node "aa" []
                           , Node "ab" [ Node "aba" []]
                           ]
                , Node "b" [ Node "ba" []
                           , Node "bb" [ Node "bba" []
                                       , Node "bbb" []
                                       ]
                           ]
                , Node "c" [ Node "ca" []
                           , Node "cb" [ Node "cba" [ Node "cbaa" []
                                                    , Node "cbab" []
                                                    ]
                                       ]
                           , Node "cc" []
                           , Node "cd" []
                           ]
                ]