Tom Moertel's Weblog: Tag io

Directory-tree printing in Haskell, part three: lazy I/O

Tom Moertel — Wed, 28 Mar 2007 15:40:00 -0400

This article is part three in a series on introductory Haskell programming. In the first article, we wrote a small program to recursively scan file-system directories and print their contents as ASCII-art trees. In the second article, we refactored the program to make its logic more reusable by separating the directory-scanning logic from the tree-printing logic. In this article, we will address a shortcoming of the refactored version: It must scan directory hierarchies completely before printing their trees, i.e., it must scan and then print, when doing both simultaneously is both more efficient and more user friendly.

Recall from the previous article that our directory-printing program is factored into three pieces of logic:

fsTraverse, which traverses a file-system hierarchy and returns a tree data structure;
showTree, which converts a tree into lovingly crafted ASCII art; and
traverseAndPrint, which prints the tree for a file-system hierarchy by using the first two pieces of logic.

The types of the functions are as follows:

fsTraverse       :: Path -> DentName -> IO DirTree
showTree         :: Tree String -> String
traverseAndPrint :: Path -> IO ()

Note that showTree is a pure function, but the other two return IO actions that may have side effects.

Within traverseAndPrint, fsTraverse and showTree are combined into a composite IO action by the =<< combinator:

putStr . showTree =<< fsTraverse root path

The sequencing semantics of Haskell’s IO monad forces all of the effects of fsTraverse to complete before any following effects can begin. To better understand these sequencing semantics, let’s consider a simple example.

The IO-monad code,

a >> b

can loosely be interpreted as running the action a, which forces its side effects to occur, and then running the action b, which forces its side effects to occur.

In reality, a and b are not actions. They are functions. Like all Haskell functions, they are pure and have no side effects. It’s just that a and b return values that represent actions, and those actions may have side effects, and the semantics of the IO monad guarantee the ordering of those effects (should the actions end up being connected to the runtime’s top-level IO action and executed). If you think that’s weird, hold that thought. For now, all that’s important is that, if the composite action represented by the expression (a >> b) is executed, the effects of a, regardless of how complex, will be executed before the effects of b.

Thus if a represents building a tree by recursively scanning a file-system hierarchy, the entire tree must be built before b ever gets a chance to do its thing. For our particular application, however, that particular sequencing is suboptimal. We know from our earlier, monolithic implementation that the file-system hierarchy can be scanned and printed simultaneously, which is more efficient. Ideally, then, our refactored implementation should be just as efficient.

In this article, we will look at one way to maintain the clean, logical separation of the a part from the b part while allowing the parts’ effects to be interleaved for efficiency. We will use an extension to the Haskell language to make the directory-scanning action lazy so that it builds the tree as the tree is consumed.

Ready? Let’s dive in.

Lazy I/O

I’ll be up front: we are going to be naughty. We are going to break the effect-ordering guarantees of the IO monad, but, if we are careful, we can get away with it. In fact, if you have used Haskell’s getContents or readFile functions, you have already used the fruits of this very naughtiness.

Before we go down the dark path, however, let’s spend a moment understanding why we might want to be naughty. Currently, our tree-building code builds the entire tree for a file-system hierarchy as one large IO action. If the hierarchy turns out to be large, the tree could gobble up lots of memory before the printing process has the chance to consume it. Further, if the underlying file-system operations are expensive, we could wait a long time before seeing any output from our program.

If we could produce the tree lazily, both of these problems would go away. As we built the tree, our tree-printing process would consume it, keeping the overall memory footprint low and keeping us informed of progress with timely output.

To better visualize our tree-building code’s laziness or lack thereof, let’s artificially raise the cost of visiting a file-system node. We will introduce fsVisit to simulate a costly file-system operation that takes 0.1 second to complete:

fsVisit :: DirNode -> IO DentName
fsVisit (_, name) = do
    usleep 100000
    return name

Now let’s work fsVisit into each step of our file-system-traversal logic by revising fsTraverseStep:

fsTraverseStep :: DirNode -> IO (DentName, [DirNode])
fsTraverseStep dnode@(path, node) = do
    name     <- fsVisit dnode
    children <- fsGetChildren (path ++ "/" ++ node)
    return (name, children)

Now have a slow version of our original tlist program. I recommend that you download the source code and compile it so that you can run the program locally and experience the timing of its output.

If you run the program on a directory that contains a handful of files, it will pause for a second or two while it performs our artificially expensive directory scan. Finally, the scan completed, the program will print the directory tree all at once.

Now let’s make the tree-building process lazy. For this, we need the unsafeInterleaveIO combinator, an extension to Haskell 98. (We will examine why it is “unsafe” later.) Here is its type signature:

unsafeInterleaveIO :: IO a -> IO a

What the combinator does is convert an action into a promise to perform the action later, should its result be needed. It takes an IO action, which might take a long time to carry out, and returns a substitute action that produces a value immediately. That value, however, is a placeholder: when you try to consume it, you will be made to wait while the real value is computed by performing the original action.

This ability to defer work via promises is exactly what we need to make our directory scans lazy. We can return each node of the tree as a pair of promises, one to compute the node’s root, and one to compute the node’s children. Let’s modify fsTraverseStep to do just that:

import System.IO.Unsafe -- add to imports at top of code

fsTraverseStep dnode@(path, node) = do
    name     <- unsafeInterleaveIO $ fsVisit dnode
    children <- unsafeInterleaveIO $
                fsGetChildren (path ++ "/" ++ node)
    return (name, children)

Now run this modified version of the program. (For convenience, you can download this version of the source code.) Notice how each line of the directory tree is printed as it is visited in the file-system scan. We have made our tree-building process lazy!

Or have we? Let’s modify fsGetChildren to print the list of visible children as they are discovered:

fsGetChildren path = do
    contents <- getDirectoryContents path `catch` const (return [])
    let visibles = sort . filter (`notElem` [".", ".."]) $ contents
    print visibles  -- <--- add this line
    return (map ((,) path) visibles)

Recompiling and re-running our “lazy” program shows that all of the children are found before any of the printing occurs. In other words, even if we are visiting each node lazily, we are still finding all of the nodes in the hierarchy before the first node of the resulting tree is emitted from fsTraverse.

To see why, let’s examine the source code for unfoldTreeM, which is the library function we used to build the tree using our fsTraverseStep function:

unfoldTreeM :: (b -> IO (a, [b])) -> b -> IO (Tree a)
unfoldTreeM step seed = do
    (root, seeds) <- step seed                -- (1)
    children <- mapM (unfoldTreeM step) seeds -- (2)
    return (Node root children)               -- (3)

When unfoldTreeM calls our step function in line (1), it gets back a pair of promises, one for the root of the tree and another for the seeds from which to build the root’s children. In line (2), we see the problem: In order to convert seeds into a list of child nodes, unfoldTreeM calls mapM to recursively apply itself to seeds. The mapM action is sequenced before the return in line (3), and thus the value of seeds is consumed before the new tree Node can be constructed. In other words, because the mapM action isn’t deferred and because it depends on the value of seeds, it forces us to make good on our seeds promise earlier than we would like.

To get around this problem, we can create a lazy variant of unfoldTreeM. This version defers the mapM action until the children value is consumed:

lazyUnfoldTreeM :: (b -> IO (a, [b])) -> b -> IO (Tree a)
lazyUnfoldTreeM step seed = do
    (root, seeds) <- step seed
    children <- unsafeInterleaveIO $
                mapM (lazyUnfoldTreeM step) seeds
    return (Node root children)

Then we can use this version in our high-level fsTraverse function:

fsTraverse = curry (lazyUnfoldTreeM fsTraverseStep)

These changes made, we have a fully lazy version of the tree-building code. To see it in action, download this version of the whole program’s source code, compile it, and give it a try. If you add the print line to fsGetChildren like we did earlier, you’ll see that this version expands each directory only when its contents are needed. Now our lazy directory-tree-building code works as we would expect.

Mission accomplished.

Optional: Hiding the plumbing

[Note: The technique described in this section is hacky. I’m including it because it’s fun, not because I think it’s good Haskell-programming practice.]

It’s unfortunate that we had to create our own version of the library function unfoldTreeM. With its introduction, we lost some of our code’s tidiness. Can we get our clean code back?

Maybe we can. Recall that unfoldTreeM works for any monad. What if we created a LazyIO monad that was just like IO except that each action within it was performed only when its value was consumed? With this monad, we could eliminate the need for a special, lazy version of unfoldTreeM: the normal version would “do the right thing,” using our monad.

Let’s create our LazyIO monad. First, we’ll need a new module,

module LazyIO
 ( LazyIO(), runLazy, deferIO )
where

and, of course, we’ll need to import unsafeInterleaveIO:

import System.IO.Unsafe (unsafeInterleaveIO)

We will define LazyIO to be a type wrapper around the regular IO type:

newtype LazyIO a = LazyIO { unLazyIO :: IO a }

Note that our module definition, above, does not export the LazyIO type’s data constructor. The only way, then, to construct and destruct values will be through our interface.

To construct a value, we will provide deferIO, which converts a normal IO action into a LazyIO action:

deferIO :: IO a -> LazyIO a
deferIO = LazyIO

To get a regular IO action “out” of our monad, we will provide runLazy which converts a LazyIO action into an IO action that is deferred until it is consumed:

runLazy :: LazyIO a -> IO a
runLazy = unsafeInterleaveIO . unLazyIO

The key to our monad is that the only way to get an IO action out of LazyIO is through runLazy and thus through unsafeInterleaveIO. In fact, injecting an IO action into our monad and then immediately pulling it out again is identical to deferring it with unsafeInterleaveIO:

(runLazy . deferIO) = unsafeInterleaveIO

But what makes a monad interesting are its return and bind definitions. Here are ours:

instance Monad LazyIO where
    return     = LazyIO . return
    ma >>= fmb = LazyIO $ runLazy ma >>= unLazyIO . fmb

Our return simply returns the given value in the underlying IO monad and wraps the resulting action with the LazyIO constructor. The implication is that the only way to unwrap the action is via runLazy, which will defer it.

Likewise, our bind (>>=) creates a composite LazyIO action from another LazyIO action and a function that produces a LazyIO action given the result of the first action. The composite action and the first action are deferred. (Deferring the action produced by fmb would be redundant because the value it produces is the value of the composite action, which is already deferred.)

Exercise: Is LazyIO really a monad? Prove (or disprove) that it satisfies the monad laws.

To see the effect of our monad, let’s apply its definitions to the following simple lazy IO action.

runLazy $ do
    x <- return 5
    deferIO (print x)

With a little expansion, application, and simplification (try it), we arrive at the following:

unsafeInterleaveIO $ do
    x <- unsafeInterleaveIO (return 5)
    print x

Note that the entire, composite IO action is deferred, as are the actions upon which it depends, which is exactly what we want.

Now we can return to housecleaning. With our new monad, we can banish both unsafeInterleaveIO and our custom, lazy version of unfoldTreeM from our otherwise uncluttered code.

Step one of the housecleaning is to modify fsTraverseStep to use the LazyIO monad instead of explicit calls to unsafeInterleaveIO:

import LazyIO   -- add to module imports at top of code

fsTraverseStep :: DirNode -> LazyIO (DentName, [DirNode])
fsTraverseStep dnode@(path, node) = do
    name     <- deferIO (fsVisit dnode)
    children <- deferIO (fsGetChildren (path ++ "/" ++ node))
    return (name, children)

Step two is to rewrite fsTraverse in terms of runLazy and the plain-old unfoldTreeM provided by the Data.Tree library:

fsTraverse :: Path -> DentName -> IO DirTree
fsTraverse p n = runLazy (unfoldTreeM fsTraverseStep (p,n))

Step three is to remove lazyUnfoldTreeM from our code: Snip!

And we’re done. The code:

To compile, here’s the command to use:

ghc -O2 -o tlist-slow-lazy-final --make tlist-slow-lazy-final.hs

Give the program a test run and convince yourself that it works as advertised.

Why unsafeInterleaveIO is “unsafe”

Now let’s get back to the “unsafe” part of unsafeInterleaveIO. What’s that about?

Haskell programmers label as “unsafe” those functions that allow you to circumvent Haskell’s safety guarantees. It’s a blunt way of letting you know that, if you use one of these functions, you can shoot yourself in the foot if your aim is bad. Thus, by using an “unsafe” function, you place the burden of proving that your code is safe upon yourself.

As we have already seen, we can use unsafeInterleaveIO to get around the side-effect ordering guarantees that Haskell’s IO monad normally provides. If we’re not careful, this could come back to bite us.

Using unsafeInterleaveIO on an action effectively removes the action from the normal world of IO actions and places it into its own parallel world, where it can run on its own schedule. Creating these parallel worlds is safe as long as we don’t attempt to do anything that depends upon the ordering of effects across worlds.

For example, take a look at this small Haskell program that will let us compare the output of a simple test under normal and unsafe-interleaved I/O sequencing:

{- file: unsafe-demo.hs -}

module Main where

import System.Environment
import System.IO.Unsafe

main = do
    args <- getArgs
    if args == ["lazy"]
        then doTest (unsafeInterleaveIO getLine)
        else doTest getLine

doTest myGetLine = do
    line1 <- myGetLine    -- (1)
    line2 <- myGetLine    -- (2)
    putStrLn line2
    putStrLn line1

The main function checks the command line to see if we have passed the “lazy” argument. If so, it passes (unsafeInterleaveIO getLine) to doTest; otherwise, it passes the straight getLine function.

The doTest function, in turn, constructs an IO action that reads two lines from the standard input using whichever version of getLine we have provided. First it reads line1, then line2. Finally, it prints the lines in the opposite order: first line2, then line1.

Let’s test this program on the following two-line file:

$ cat onetwo.txt
one
two

Ready? First, let’s run the straight-IO version:

$ runhaskell unsafe-demo.hs < onetwo.txt
two
one

As we would expect, the program read the lines from the file and printed them in reverse order.

Now, let’s pass the “lazy” flag, which wraps the getLine calls with unsafeInterleaveIO:

$ runhaskell unsafe-demo.hs lazy < onetwo.txt
one
two

For some reason, when we printed line2 we got the first line of the file, not the second. Likewise, when we printed line1, we got the second line. What happened?

What happened is that in lines (1) and (2) of the code, myGetLine evaluated to (unsafeInterleaveIO getLine). Thus line1 and line2 were bound to placeholder values that were connected to deferred getLine actions, each existing in its own parallel world and utterly unconnected to each other or to the main, normal IO world. The only thing, then, that could determine the order in which the two actions were performed was the order in which their values were consumed. And, because we printed line2 first, its deferred getLine action was the first to be performed, and so it read the first line of the input from the file. By the time we printed line1, causing its deferred getLine action to be performed, the first line of the file had already been consumed, and so the second line was returned.

Oops.

After this demonstration, we might wonder whether our lazy tree-building code is safe. After all, we’re using unsafeInterleaveIO like crazy behind the scenes. Let’s think about it.

Recall that, once detached from the main IO world, the only thing that determines when a deferred action is performed is when its value is consumed. That knowledge gives us the key to unlock the safety argument for our tree-building code.

Recall the type of fsTraverse:

fsTraverse :: Path -> DentName -> IO DirTree

The action that fsTraverse produces returns a DirTree value, which is a type synonym for a Tree of DentName values (file names). The Tree data type has only one constructor:

data Tree a = Node { rootLabel :: a,
                     subForest :: [Tree a] }

Each Node represents a tree: a root label and a sub-forest of children trees. Because of this representation, we cannot visit a node in a tree without first having visited all of its ancestors. In order to get to a child node in the tree, for example, we must go through the subForest value of its parent. Attempting to consume that value will force the attached, deferred action to be performed. That action, in turn, will fetch the contents of the parent’s directory and package each item, including the child we’re trying to get, into its own Node, the root and subForest of which will contain deferred actions for scanning further into the file-system hierarchy. Thus a top-down sequencing will be imposed on the deferred IO actions attached to those nodes. Fortunately, we want a top-down traversal because that’s the way we must descend directory hierarchies in the file system. Therefore, we have good reason to be assured of the safety of using unsafeInterleaveIO for this particular application.

For other applications, however, we must repeat this safety analysis anew, lest we allow the parallel words of our deferred actions to collide in unpleasant ways. Caveat coder.

Review and next time

In this installment of our ever-lengthening series of articles on directory printing, we revised our refactored directory-printing code to restore the efficiency of our original, monolithic implementation. In doing so, we experimented with lazy I/O and deferring IO actions by using the unsafeInterleaveIO function.

At first we inserted a customized version of the library function unfoldTreeM into our code to effect the desired laziness, but a little monad hacking allowed us to get rid of this intrusion. When we were done, we not only had a lean, lazy directory printer but also a new (and potentially unsafe) LazyIO library, which might prove useful in the future.

We also looked at the kind of problems that unsafeInterleaveIO can cause if we are not careful. Nevertheless, we were able to argue that our particular use of this function is safe: the Tree data structure ensures that we must consume tree nodes in the top-down order in which our directory-scanning must occur.

Still, our directory-printing code has problems. We haven’t yet improved its lackluster error-handling policy. Nor have we made the directory-scanning code amenable to uses beyond our immediate needs for directory printing. Next time, we will solve both of these problems.

Directory-tree printing in Haskell, part two: refactoring

Tom Moertel — Wed, 07 Mar 2007 16:04:00 -0500

In my previous article on writing a simple directory-tree printer in Haskell, I wrote a small program to recursively scan file-system directories and print their contents as ASCII-art trees. The program made for an approachable example of how to use Haskell for “imperative” tasks, but it has a few problems.

First, the directory-scanning logic and tree-printing logic are intertwined. Neither is reusable. Second, both bits of logic are rigid, specialized for this particular task. Even if you could reuse them, you wouldn’t want to.

In this article, the second in a series, we will explore ways to make our original code more reusable. We will separate the directory scanning from the tree printing, harness the power of some old friends from Haskell’s libraries, and think about the costs and benefits of our changes.

The plan

Recall our original directory tree–listing solution, the core of which I will reprint below:

tlist path =
    visit (if "/" `isPrefixOf` path then "" else ".") "" "" "" path

visit path leader tie arm node = do
    putStrLn (leader ++ arm ++ tie ++ node)
    visitChildren (path ++ "/" ++ node) (leader ++ extension)
  where
    extension = case arm of ""  -> ""; "`" -> "    "; _   -> "|   "

visitChildren path leader =
    whenM (doesDirectoryExist path) $ do
        contents <- getDirectoryContents path
            `catch` (\e -> return [show e])
        let visibles = sort . filter (`notElem` [".", ".."]) $ contents
            arms = replicate (length visibles - 1) "|" ++ ["`"]
        zipWithM_ (visit path leader "-- ") arms visibles

The tlist function kicks off the process for a particular file-system path, handing off to visit which recursively descends the directory tree from the root node. The visit function calls visitChildren to expand the subtree, if any, for each node visited. The visitChildren function, in turn, calls back to visit to repeat the process for each child in the subtree. In effect, we are traversing the tree rooted at path, printing each node in passing.

To separate the traversal part from the printing part, we will introduce a tree data structure. The file system–traversal code will emit a tree, and the tree-showing code will consume a tree. We will rewrite our old tlist function, which we might as well rename to the more descriptive traverseAndPrint, to glue the two pieces together with the tree serving as glue:

traverseAndPrint :: Path -> IO ()
traverseAndPrint path = do
    tree <- fsTraverse root path
    putStrLn (showTree tree)
  where
    root = if "/" `isPrefixOf` path then "" else "."

That’s the plan. Now let’s carry it out.

Step 1: Introduce the intermediate tree data structure

To make our desired separation possible, let’s introduce the tree data structure. Conveniently enough, the Data.Tree library provides the structure for us:

data Tree a = Node {rootLabel :: a, subForest :: Forest a}

Let’s also define some descriptive type synonyms to help us think about our data:

type Path       = String           -- path
type DentName   = String           -- directory-entry name
type DirNode    = (Path, DentName) -- directory-path/dentname pair
type DirTree    = Tree DentName    -- file-system tree

(Unlike last time, in this article I’ll place type annotations on all top-level declarations to help you see how the data flows between the pieces of our code.)

To give you an idea of what the tree structure looks like, here’s an example DirTree value:

exampleTree :: DirTree
exampleTree = Node "root" [
                Node "subdir1" [
                  Node "file1.1" []
                , Node "file1.2" []
                , Node "subdir1.3" [
                    Node "file1.3.1" [] ] ]
              , Node "file1" [] ]

Now let’s revise our old code to show a tree in this structure.

Step 2: Write the tree-showing code

This step is easy. We just copy and paste our old code, remove the I/O related bits, and tweak for clarity:

-- Purely functional tree-to-string formatting

showTree :: Tree String -> String
showTree t = unlines (showNode "" "" "" t)

showNode :: String -> String -> String -> Tree String -> [String]
showNode leader tie arm node = do
    nodeRep : showChildren node (leader ++ extension)
  where
    nodeRep   = leader ++ arm ++ tie ++ rootLabel node
    extension = case arm of ""  -> ""; "`" -> "    "; _   -> "|   "

showChildren :: Tree String -> String -> [String]
showChildren node leader =
    let children = subForest node
        arms     = replicate (length children - 1) "|" ++ ["`"]
    in  concat (zipWith (showNode leader "-- ") arms children)

There are two main differences between this code and the old code. First, instead of processing directory nodes in the file system, we are processing tree nodes of the Tree data type. Second, because the code is pure, that is, free of side effects, its result is a String, not an IO action.

Lets take this code for a spin in GHCi. We’ll ask it to show our example tree from earlier in the article.

Ok, modules loaded: Main.
*Main> putStr (showTree exampleTree)
root
|-- subdir1
|   |-- file1.1
|   |-- file1.2
|   `-- subdir1.3
|       `-- file1.3.1
`-- file1

Great. Let’s move on.

Step 3: Write the directory-traversal code

In this step, we want to write the code that recursively scans (traverses) a directory hierarchy and returns a DirTree that represents the hierarchy. The following code, which does just that, is a straightforward extraction of our old code’s visit and visitChildren functions:

-- Effectful directory-traversal code that returns a tree
-- representing the directory hierarchy rooted at 'path/node'.

fsTraverse :: Path -> DentName -> IO DirTree
fsTraverse path node =
    Node node `liftM` fsTraverseChildren (path ++ "/" ++ node)

fsTraverseChildren :: Path -> IO (Forest DentName)
fsTraverseChildren path =
    mapM (uncurry fsTraverse) =<< fsGetChildren path

The fsTraverse function takes advantage of liftM to “lift” the pure function (Node node) into the IO monad, where it is applied to the result of the effectful fsTraverseChildren function. It is shorter and more communicative of our intent than the following equivalent code:

do childForest <- fsTraverseChildren (path ++ "/" ++ node)
   return (Node node childForest)

While extracting these functions from our original code, I took the liberty of factoring out the code that grabs the contents of a directory. This code now lives in its own helper function:

-- helper to get traversable directory entries

fsGetChildren :: Path -> IO [DirNode]
fsGetChildren path = do
    contents <- getDirectoryContents path `catch` const (return [])
    let visibles = sort . filter (`notElem` [".", ".."]) $ contents
    return (map ((,) path) visibles)

This bit of code differs from the code in the previous article in that it treats any error encountered when scanning a directory as if the directory were empty. That’s what the

... `catch` const (return [])

addendum does. It says that any error caught while scanning the directory will be handled by a constant policy, that of returning an empty list.

This policy tends to be what we want in practice because the two most common errors we expect to encounter here will be “oops, that’s a file, so it can’t have children” and “oops, you’re not allowed to scan that directory.” This error-handling policy will, however, throw away potentially useful information, say, in the rare case that the error is something like “oops, your hard drive caught on fire and is about to explode: start running now.” (Maybe we’ll revisit our policy later.)

Step 4: Connect the traversal code to the printing code

We can traverse file-system hierarchies to produce trees. We can print trees. To traverse and print a hierarchy, then, requires nothing but a little glue. Conveniently, we have already written the needed glue, traverseAndPrint, when we formulated our plan. Here is a slightly more concise version:

traverseAndPrint :: Path -> IO ()
traverseAndPrint path =
    putStr . showTree =<< fsTraverse root path
  where
    root = if "/" `isPrefixOf` path then "" else "."

Now we have a complete solution. Let’s give it a spin in GHCi. I’ll traverse and print the Darcs repository that holds the code for this article.

*Main> traverseAndPrint "_darcs" 
_darcs
|-- inventories
|-- inventory
|-- patches
|   |-- 20070226210515-8fbd9-42e4...74102.gz
|   |-- 20070226210634-8fbd9-86cd...490ef.gz
|   |-- 20070227053004-8fbd9-122b...5023d.gz
|   |--   [ entries omitted for brevity ]
|   |-- 20070227233827-8fbd9-94ab...4852f.gz
|   |-- 20070228181747-8fbd9-db9b...e8ce6.gz
|   |-- 20070303192612-8fbd9-ff2a...3d7bb.gz
|   `-- pending
|-- prefs
|   |-- author
|   |-- binaries
|   |-- boring
|   `-- motd
`-- pristine
    |-- Makefile
    `-- tlist.hs

(I shortened some of the longer file names to prevent them from escaping the narrow text column of my blog.)

Very well. Now let’s see if we can tighten our code.

Step 5: Simplify

One benefit of breaking monolithic code into composable pieces is that the pieces are often amenable to further simplification. Our fsTraverse function, for example, was extracted from our old code, where it combined directory-scanning and tree-printing knowledge. Now, the tree-printing knowledge factored out, it combines directory-scanning and tree-building knowledge. But the Tree data type, as you might expect, already contains that second piece of knowledge. So we can simplify fsTraverse further by removing this duplicated know-how.

The function that makes the simplification possible is unfoldTreeM:

*Main> :t unfoldTreeM
unfoldTreeM :: (Monad m) => (b -> m (a, [b])) -> b -> m (Tree a)

This function, which is parametrized by a step function, grows a tree from a single seed value. The step function is what we provide to guide each step of the process. It consumes a seed value and produces a tree node and a list of seeds from which the node’s children can be grown. The unfoldTreeM function calls our step function recursively on the seeds until the entire tree is grown. (If our step function were not effectful, requiring I/O, we could use the pure function unfoldTree instead of unfoldTreeM to build our trees.)

Our directory-scanning step function parallels our earlier fsTraverse function, which I will reprint below for comparison, but eliminates knowledge of the Tree data structure.

fsTraverse :: Path -> DentName -> IO DirTree
fsTraverse path node =
    Node node `liftM` fsTraverseChildren (path ++ "/" ++ node)

fsTraverseStep :: DirNode -> IO (DentName, [DirNode])
fsTraverseStep (path, node) =
    (,) node `liftM` fsGetChildren (path ++ "/" ++ node)

Note that a DirNode is simply a (Path, DentName) pair. Thus the first argument of fsTraverseStep is equivalent to the first two arguments of fsTraverse. This pairing is convenient because the seed values we produce are also DirNodes, and this parity is required by the type of unfoldTreeM. (Had our step function retained the two-argument form, we could have used the uncurry combinator to transform it into the form required for unfoldTreeM. Later, we’ll use curry to perform the opposite transformation.)

Now we can use unfoldTreeM to build file-system hierarchies. Let’s try it using GHCi:

*Main> unfoldTreeM fsTraverseStep (".", "_darcs")
Node {rootLabel = "_darcs", subForest = [ {- more nodes here -} ]}

The final step of our simplification is to rewrite fsTraverse in terms of unfoldTreeM:

fsTraverse :: Path -> DentName -> IO DirTree
fsTraverse = curry (unfoldTreeM fsTraverseStep)

Note the use of curry to adapt unfoldTreeM’s arguments into the form implied by fsTraverse’s type signature.

The final code (for now)

Our simplification done, here is our complete, refactored program:

module Main (main) where

import Control.Monad
import Data.List
import Data.Tree
import System.Directory
import System.Environment

-- Some convenient type synonyms

type Path       = String           -- path
type DentName   = String           -- directory-entry name
type DirNode    = (Path, DentName) -- directory-path/dentname pair
type DirTree    = Tree DentName    -- file-system tree

-- High-level program logic:  get args and print a tree for each

main :: IO ()
main = do
    args <- getArgs
    mapM_ traverseAndPrint (if null args then ["."] else args)

traverseAndPrint :: Path -> IO ()
traverseAndPrint path =
    putStr . showTree =<< fsTraverse root path
  where
    root = if "/" `isPrefixOf` path then "" else "."

-- Effectful tree-builder for file-system hierarchies

fsTraverse :: Path -> DentName -> IO DirTree
fsTraverse = curry (unfoldTreeM fsTraverseStep)

fsTraverseStep :: DirNode -> IO (DentName, [DirNode])
fsTraverseStep (path, node) =
    (,) node `liftM` fsGetChildren (path ++ "/" ++ node)

-- Helper to get traversable directory entries

fsGetChildren :: Path -> IO [DirNode]
fsGetChildren path = do
    contents <- getDirectoryContents path `catch` const (return [])
    let visibles = sort . filter (`notElem` [".", ".."]) $ contents
    return (map ((,) path) visibles)

-- Purely functional tree-to-string formatting

showTree :: Tree String -> String
showTree t = unlines (showNode "" "" "" t)

showNode :: String -> String -> String -> Tree String -> [String]
showNode leader tie arm node =
    nodeRep : showChildren node (leader ++ extension)
  where
    nodeRep   = leader ++ arm ++ tie ++ rootLabel node
    extension = case arm of ""  -> ""; "`" -> "    "; _   -> "|   "

showChildren :: Tree String -> String -> [String]
showChildren node leader =
    let children = subForest node
        arms     = replicate (length children - 1) "|" ++ ["`"]
    in  concat (zipWith (showNode leader "-- ") arms children)

Let’s review

We have refactored our original, small, monolithic solution into a collection of more reusable code snippets. The total “cost” of our new solution is certainly higher than before – the code is twice as long – but we can reasonably expect that by reusing this code we can reduce the cost of future solutions that might require similar functionality.

Say, for example, we need to write some code to count the files and directories within a hierarchy. Building upon our new code, we can write it easily, as a one-liner in GHCi even:

*Main> print . length . flatten =<< fsTraverse "." "_darcs"
27

Still, there is much about our code that could be better. First, unlike our old solution, our new solution builds the entire tree before it begins to emit output. If the tree is large, its memory footprint could be daunting. Second, our error-handling policy is mildly embarrassing. Third, our directory-traversal code isn’t flexible. What if we want to get the size of each file we visit during the traversal? Right now, there’s no easy way to do it.

Fortunately, we aren’t done yet. Haskell offers us many opportunities for abstraction and parametrization that we are not taking advantage of. In the next article, we’ll exploit a few of these opportunities to make our code a little more flexible and a little more idiomatic.

See you then.