Haskell: how to keep count

Question

I'm walking a directory recursively, in a conventional way. This is a working prototype:

traverseFlatDst :: FilePath -> Int -> Int -> FilePath -> IO ()
traverseFlatDst dstRoot total totw srcDir = do
  (dirs, files) <- listDir srcDir
  mapM_ (\file -> putStrLn (printf "%s" (strp file))) files    -- tracing
  let traverse = traverseFlatDst dstRoot total totw
  mapM_ traverse dirs

I have a not so unusual request: every trace line should be numbered (it is not really for tracing). Like this:

traverseFlatDst :: FilePath -> Int -> Int -> FilePath -> IO ()
traverseFlatDst dstRoot total totw srcDir = do
  (dirs, files) <- listDir srcDir
  mapM_ (\file -> putStrLn (printf "%d: %s" counterFromNowhere (strp file))) files
  let traverse = traverseFlatDst dstRoot total totw
  mapM_ traverse dirs

All the solutions I've seen so far are ugly beyond imagination, if applicable at all. Is there a nice way to manage it?

Answer 1

You can accomplish this by adding an additional effect to your function; namely, the state effect.

import Control.Monad.State

printPath :: (PrintfArg t, Show a) => (t, a) -> IO ()
printPath (l, file) = printf "%d : %s\n" l (show file)

traverseFlatDst :: Path Abs Dir -> IO ()
traverseFlatDst =
  let loop srcDir = do
        (dirs, files) <- listDir srcDir
        i <- get
        put (i + length files)
        mapM_ (liftIO . printPath) $ zip [i..] files
        mapM_ loop dirs
  in \s -> evalStateT (loop s) 0

(NB: I've also removed unused parameters for clarity).

However, I don't suggest writing this function this way. Semantically, your function is collecting a bunch of file paths. Instead of printing them, you should just return them from the function; you can always print them later! The logic of the modified version is actually quite simpler:

traverseFlatDst' :: Path Abs Dir -> IO [Path Abs File]
traverseFlatDst' srcDir = do
  (dirs, files) <- listDir srcDir
  (concat . (files:)) <$> mapM traverseFlatDst' dirs

You can use this function to print the files with numbers without keeping track of some state explicitly, since you have access to all the files 'at once':

> traverseFlatDst' somePath >>= mapM_ printPath . zip [0..]

Note also that the 2nd version is much more strict than the first; it will traverse the entire directory tree before starting to print anything. As a general rule, the strict version is better anyways, but if you want the lazy version, you can write it using unsafeInterleaveIO:

import System.IO.Unsafe (unsafeInterleaveIO)

traverseFlatDst' :: Path Abs Dir -> IO [Path Abs File]
traverseFlatDst' srcDir = do
  (dirs, files) <- listDir srcDir
  files' <- unsafeInterleaveIO $ mapM traverseFlatDst' dirs
  return $ concat $ files:files'

Answer 2

I would probably use a streaming library like streaming to separate enumerating the files from adding the numbers and from printing the decorated entries:

import Streaming
import qualified Streaming.Prelude as S

traverseFlatDst :: FilePath -> Int -> Int -> FilePath -> Stream (Of FilePath) IO ()
traverseFlatDst dstRoot total totw srcDir = do
  (dirs, files) <- liftIO $ listDir srcDir
  S.each files
  mapM_ (traverseFlatDst dstRoot total totw) dirs

decorate :: Stream (Of FilePath) IO r -> Stream (Of (Int,FilePath)) IO r
decorate stream = S.zip (S.enumFrom 1) stream

display:: Stream (Of (Int,FilePath)) IO () -> IO ()
display = S.mapM_ $ \(index,path) ->  putStrLn $ show index ++ " " ++ path

Where S.each, S.zip, S.mapM_ are from streaming.

Answer 3

From nowhere? Of course not.

You can zip your files with numbers, though, and then mapM over them:

mapM_ (\(file, counter) -> putStrLn (printf "%d: %s" counter (strp file))) (zip [0..] files)

Answer 4

Final solution, borrowed from How to implement a global counter using Monad?

import Data.IORef

type Counter = Int -> IO Int

makeCounter :: IO Counter
makeCounter = do
  r <- newIORef 0
  return (\i -> do modifyIORef r (+i)
                   readIORef r)


printPath :: Counter -> FilePath -> IO ()
printPath counter file = do
  n <- counter 1
  putStrLn (printf "%d : %s" n (strp file))


traverseFlatDst :: FilePath -> Int -> Int -> Counter -> FilePath -> IO ()
traverseFlatDst dstRoot total totw cnt srcDir = do
  (dirs, files) <- listDir srcDir
  let iterate = printPath cnt
  mapM_  iterate files                -- tracing
  let traverse = traverseFlatDst dstRoot total totw cnt
  mapM_ traverse dirs


groom :: FilePath -> FilePath -> Int -> IO ()
groom src dst total = do
  counter <- makeCounter
  let totWidth = length $ show total
  traverseFlatDst dst total totWidth counter src
  putStrLn (printf "total: %d, width: %d" total totWidth)

Still caged and can't be used anywhere, but it's OK. Not ugly.

Answer 5

This solution doesn't require additional libraries, processes each file the moment it is found and, for the sake of separating concerns, doesn't require traverseFlatDst to know what is being done with the produced files.

This last feature is achieved by passing a small effectful state machine (a step function, really) as a parameter to traverseFlatDst, and making traverseFlatDst polymorphic in the machine state, so it doesn't know anything about it:

{-# language RankNTypes #-}
import Control.Monad (foldM)

type Source e = forall s. (s -> e -> IO s) -> s -> IO s

traverseFlatDst :: FilePath -> Int -> Int -> FilePath -> Source FilePath
traverseFlatDst dstRoot total totw srcDir step state = do
  (dirs, files) <- listDir srcDir
  state' <- foldM step state files
  foldM (\s path -> traverseFlatDst dstRoot total totw path step s) state' dirs

-- Pass this as the step argument to traverseFlatDst
-- The counter is the state.
step :: Int -> FilePath -> IO Int
step index path = do
    putStrLn $ show index ++ " " ++ path
    return $ succ index