[Haskell-beginners] Directory statistics

[Alexander.Vladislav.Popov]

Hi, haskellers.

I’ve written a program to assess directory utilization in the selected
path. It displays on the console a list indicating directory size and
path. The list is sorted by descending size. I need some criticism and
some models I could follow to write a more concise and expressive
program.

Thanks in advance.
Alexander.

> {-# LANGUAGE ScopedTypeVariables #-}
> module Main (main) where

> import Control.Exception (SomeException, finally, bracket, handle)
> import Control.Monad
> import Data.List
> import System.Directory
> import System.Environment
> import System.IO
> import Text.Printf

> main :: IO ()
> main = do
>        args <- getArgs
>        if null args
>          then
>            putStr "Displays directory utilization in the selected path.\nUsage: dirstat <path>\n"
>          else
>            mapM_ ds3 args

It safely returns a file size. If an error occurs during file opening,
it will return 0.

> filesize :: FilePath -> IO Integer
> filesize path = (withFile path ReadMode hFileSize) `catch` const (return 0)

Get size of a directory.

> ds :: FilePath -> IO Integer
> ds path = do
>     contents <- getDirectoryContents path `catch` const (return [])
>     let visibles = getVisible contents
>     let path' = clrSlash path
>     a <- (liftM sum) $ sequence $ map (\p -> filesize (path' `mkpath` p)) visibles -- size of a current dir
>     (liftM ((+a) . sum)) $ mapM (\p -> ds (path' `mkpath` p)) visibles -- current + children

Returns a list of pairs: (file size, path)

> ds2 :: FilePath -> IO [(Integer, FilePath)]
> ds2 path = do
>     contents <- getDirectoryContents path
>     let visibles = getVisible contents
>     let path' = clrSlash path
>     let paths = map (\p -> path' `mkpath` p) visibles
>     let pairs = map (\p -> (ds p, p)) paths
>     a <- sequenceFst pairs
>     return $ (reverse . sort . filter (\e -> fst e > 0)) a

Compare it to the function *sequence :: (Monad m) => [m a] -> m [a]*

> sequenceFst :: (Monad m) => [(m t, t1)] -> m [(t, t1)]
> {-# INLINE sequenceFst #-}
> sequenceFst ms = foldr k (return []) ms
>                  where
>                    k (ms, p) m' = do { s <- ms; xs <- m'; return ((s,p):xs) }

Driver

> ds3 :: FilePath -> IO ()
> ds3 path = do
>     s <- ds2 path
>     prn s
>         where
>            prn []     = return ()
>            prn (s:ss) = (putStr . showDir) s >> prn ss

Auxiliary

> skipDots     = (`notElem` [".", ".."])
> getVisible   = filter skipDots
> mkpath p1 p2 = p1 ++ "/" ++ p2
> clrSlash     = reverse . dropWhile (\c -> c =='/' || c == '\\') . reverse

Displays information about a directory.

> showDir :: (Integer, String) -> String
> showDir (s,p) = printVolume s 3 ++ "\t" ++ show p ++ "\n"

*Main> shred "1234567890"
["123","456","789","0"]

> shred [] = []
> shred ss =  (take 3 ss) : (shred (drop 3 ss))

*Main> prettyNum "1234567890"
"1 234 567 890"

> prettyNum = concat . intersperse " " . (map reverse) . reverse . shred . reverse

*Main> units (1024*1024*1024)
[1073741824,1048576,1024,1,0]

> units :: Integer -> [Integer]
> units 0 = [0]
> units x = x : units' x
>     where
>       units' 0 = []
>       units' x = y : units' y
>           where
>             y = round (fromIntegral x / 1024)

Just SI prefixes

> prefix = ["B", "K", "M", "G", "T", "P", "E", "Z", "Y"]

*Main> tagged (1024*1024*1024)
[("1 073 741 824","B"),("1 048 576","K"),("1 024","M"),("1","G"),("0","T")]

> tagged x = (map (prettyNum . show) $ units x) `zip` prefix

*Main> printVolume (1024*1024*1024) 5
1 024 M

> printVolume x width = printf "%*s %s" width (fst one) (snd one)
>     where
>        one = head $ dropWhile (\p -> length (fst p) > width) $ tagged x