{- | This is the third assignment for IB016, semester spring 2015. Name: Name Surname UID: 123456 == Implementing du In this assignment you will be implementing simplified version of unix utility @du@. This utility can be used to detect filesystem usage by files and directories. Your task is for the first time to implement whole compilable module, including commandline handling. === du usage / commandline options Your program usage should be: @ ./du [options] [files-or-directories] @ You should implement following options: @ -a, --all write counts for all files, not just directories --si like -h, but use powers of 1000 not 1024 (e.g., 1KB, 245MB, 2.1GB) -h, --human-readable print sizes in human readable format (e.g., 1KiB 234MiB 2GiB) -s, --summarize display only a total for each argument -c, --total produce a grand total --help display help and exit @ You don't need to handle invalid options, you can ignore them. Optionally, as a bonus, you can also implement: @ -d, --max-depth print the total for a directory (or file, with --all) only if it is N or fewer levels below the command line argument; --max-depth=0 is the same as --summarize @ In this case, you can assume that option and its value is not separated by space — for short version number follows immediately, while in long option it is separated by @'='@: @-d0 -d10 --max-depth=0 --max-depth=10@. === du behaviour Then @du@ is run without any options, it prints sizes of all its commandline arguments: for files size is printed directly, for directories their size is summarized recursively. Files inside directories are not printed by default. If any options are given, they must precede all files and directories. If no files or directories are given, @du@ should work with current working directory (./). File size can be obtained by function 'hFileSize' from @System.IO@ (alternatively by 'fileSize' from @System.Posix.Files@, but this is not multiplatform). Without --human-readable or -h or --si sizes are printed in kilobytes without unit (1 KiB = 1024 B). With --human-readable or -h sizes are printed with appropriate unit (using binary prefixes ) such that the value is between 1 and 1023. If --si is given, sizes are handled similarly but using 1000-based SI prefixes (and value should be between 1 and 999). Sizes should can be integral, as a bonus you can add one decimal place if value is less then 10, as done by @du@ on linux. All the other commandline options should be handled according to usage given above. If --help is given a short help summarizing options and usage should be given and all other options should be ignored. Combination of @-s@ and @-a@ is not valid, and need not be handled, the same holds for --max-depth=0 and --all. For recursive traversal you will probably need functions from @System.Directory@ module. Feel free to use any other modules in standard Haskell distribution you find suitable. ==== Notes * in basic execution (without @-s@) subdirectories are printed. * in case of error (such as permission error or directory vanishing before it can be explored) program should not stop but print an error message (on 'stderr'), you should handle only 'IOException' and you can use that it is an instance of 'Show' * you can use module @Text.Printf@ for formating * you can ignore anything for which is neither file, nor directory (such as devices, symlinks, pipes,…) * you should not ignore hidden files (on unix beginning with '.') * on linux @du@ is calculating file sizes based on disk allocation, sizes reported by 'hFileSize' can differ ==== Examples Order of files and directories on same level in hierarchy is not relevant and can differ on your system. Also the output in case of error need not match literally. > $ ./du --help > usage: du [options] [files] > -a, --all write counts for all files, not just directories > --si like -h, but use powers of 1000 not 1024 > -h, --human-readable print sizes in human readable format (e.g., 1K 234M 2G) > -s, --summarize display only a total for each argument > -d, --max-depth print the total for a directory (or file, with --all) only if it is N or fewer levels below the command line argument; --max-depth=0 is the same as --summarize > -c, --total produce a grand total > --help display this help and exit > > $ mkdir test; cd test > $ mkdir -p first/second third > $ dd if=/dev/zero of=a bs=1024 count=100 &> /dev/null > $ dd if=/dev/zero of=first/b bs=1024 count=200 &> /dev/null > $ dd if=/dev/zero of=first/c bs=1024 count=300 &> /dev/null > $ dd if=/dev/zero of=first/second/d bs=1024 count=1024 &> /dev/null > > $ ../du > 0 ./third > 1024 ./first/second > 1524 ./first > 1624 . > > $ ../du first third > 1024 first/second > 1524 first > 0 third > > $ ../du -c first third > 1024 first/second > 1524 first > 0 third > 1524 total > > $ ../du first > 1024 first/second > 1524 first > > $ ../du -s first > 1524 first > > $ ../du --summarize first > 1524 first > > $ ../du -h first > 1.0 MiB first/second > 1.4 MiB first > > $ ../du --si first > 1.1 MB first/second > 1.5 MB first > > $ ./du -h -s -c first a > 1.4 MiB first > 100 KiB a > 1.5 MiB total > > $ ./du -a -h first > 200 KiB first/b > 300 KiB first/c > 1.0 MiB first/second/d > 1.0 MiB first/second > 1.4 MiB first > > $ mkdir fourth && chmod -r fourth > $ ../du fourth first > error: fourth: getDirectoryContents: permission denied (Permission denied) > 1024 first/second > 1524 first/ > > $ ./du fifth first > error: fifth: openFile: does not exist (No such file or directory) > 1024 first/second > 1524 first > > $ ../du -d1 > error: ./fourth: getDirectoryContents: permission denied (Permission denied) > 0 ./third > 1524 ./first > 1624 . > > $ ../du --max-depth=1 --human-readable > error: ./fourth: getDirectoryContents: permission denied (Permission denied) > 0.0 B ./third > 1.4 MiB ./first > 1.5 MiB -} module Main ( main ) where import System.Directory import System.IO import System.FilePath import System.Environment import Control.Monad import Control.Applicative import Control.Exception import Control.Monad.Trans.Maybe import Control.Monad.Trans.Class import Data.Maybe import Data.Monoid import Text.Read ( readMaybe ) ifM :: Monad m => m Bool -> m a -> m a -> m a ifM b t f = b >>= \x -> if x then t else f foldDirectoryTree :: (down -> FilePath -> MaybeT IO down) -- ^ dirPre -> (down -> FilePath -> MaybeT IO up) -- ^ file -> (down -> [up] -> FilePath -> MaybeT IO up) -- ^ dirPost -> down -- ^ initial value -> FilePath -- ^ start path -> MaybeT IO up foldDirectoryTree dirPre file dirPost down0 path = ifM (lift $ doesDirectoryExist path) doDir doFile where doFile = handleIOErr $ file down0 path doDir = handleIOErr $ do down <- dirPre down0 path contents <- lift $ getFilesAndDirs path ups <- mapMT (foldDirectoryTree dirPre file dirPost down) contents dirPost down0 ups path fixpaths = map (path ) . filter (\x -> x /= "." && x /= "..") getFilesAndDirs dir = do cont <- fixpaths <$> getDirectoryContents dir filterM (\x -> liftM2 (||) (doesFileExist x) (doesDirectoryExist x)) cont mapMaybeM :: (Monad m, Functor m) => (a -> m (Maybe b)) -> [a] -> m [b] mapMaybeM f xs = catMaybes <$> mapM f xs mapMT :: (Monad m, Functor m) => (a -> MaybeT m b) -> [a] -> MaybeT m [b] mapMT f xs = MaybeT $ Just <$> mapMaybeM (runMaybeT . f) xs data UnitMode = None | HumanReadable | SIHumanReadable deriving ( Eq, Show, Read ) instance Monoid UnitMode where mempty = None a `mappend` None = a _ `mappend` b = b data Config = Config { printAll :: Bool , maxDepth :: Maybe Integer , total :: Bool , unit :: UnitMode , help :: Bool } deriving ( Eq, Show, Read ) instance Monoid Config where mempty = Config { printAll = False, maxDepth = Nothing, total = False, unit = mempty, help = False } a `mappend` b = Config { printAll = printAll a || printAll b , maxDepth = getLast $ Last (maxDepth a) `mappend` Last (maxDepth b) , total = total a || total b , unit = unit a `mappend` unit b , help = help a || help b } type Size = Integer type Level = Integer orNothing :: IOException -> IO (Maybe a) orNothing ex = do hPutStrLn stderr $ "error: " ++ show ex return Nothing handleIOErr :: MaybeT IO a -> MaybeT IO a handleIOErr act = MaybeT . handle orNothing $ runMaybeT act duFile :: (Level, Config) -> FilePath -> MaybeT IO Size duFile (level, conf) file = do h <- lift $ openFile file ReadMode size <- lift $ hFileSize h when (printAll conf || level == 0) $ entry conf file size return size duAccumDir :: (Level, Config) -> [Size] -> FilePath -> MaybeT IO Size duAccumDir (level, conf) sizes dir = do let size = sum sizes when (maybe True (>= level) $ maxDepth conf) $ entry conf dir size return size downOneLevel :: (Level, Config) -> FilePath -> MaybeT IO (Level, Config) downOneLevel (level, conf) _ = return (level + 1, conf) du :: Config -> FilePath -> MaybeT IO Size du config = foldDirectoryTree downOneLevel duFile duAccumDir (0, config) entry :: Config -> FilePath -> Size -> MaybeT IO () entry conf path size = lift . putStrLn $ concat [ sz (unit conf), "\t ", path ] where sz None = show (size `div` 1024) sz HumanReadable = withUnit 1024 ("B" : map (: "iB") us) size sz SIHumanReadable = withUnit 1000 ("B" : map (: "B") us) size us = [ 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y' ] withUnit :: (Integral i, Show i) => i -> [String] -> i -> String withUnit mult units val = loop units (val * 10) where loop [u] v | v < 100 = show (fromIntegral v / 10 :: Double) ++ " " ++ u | otherwise = show (v `div` 10) ++ " " ++ u loop (u:us) v | v `div` mult >= 10 = loop us (v `div` mult) | otherwise = loop [u] v fromArg :: String -> Config fromArg arg = case splitAt 2 arg of ("--", opt) -> let (l, v) = span (/= '=') opt in long l (drop 1 v) (['-', c], val) -> short c val _ -> mempty "" where short opt = get opt $ map (\(s, _, _, c) -> (s, c)) args long opt = get opt $ map (\(_, l, _, c) -> (l, c)) args get opt = fromMaybe mempty . lookup opt args :: [(Char, String, String, String -> Config)] args = [ ( 'a', "all", "write counts for all files, not just directories", \_ -> mempty { printAll = True } ) , ( '\0', "si", "like -h, but use powers of 1000 not 1024", \_ -> mempty { unit = SIHumanReadable } ) , ( 'h', "human-readable", "print sizes in human readable format (e.g., 1K 234M 2G)", \_ -> mempty { unit = HumanReadable } ) , ( 's', "summarize", "display only a total for each argument", \_ -> mempty { maxDepth = Just 0 } ) , ( 'd', "max-depth", "print the total for a directory (or file, with --all) " ++ "only if it is N or fewer levels below the command line " ++ "argument; --max-depth=0 is the same as --summarize", \d -> mempty { maxDepth = readMaybe d } ) , ( 'c', "total", "produce a grand total", \_ -> mempty { total = True } ) , ( '\0', "help", "display this help and exit", \_ -> mempty { help = True } ) ] printHelp :: MaybeT IO () printHelp = lift $ do name <- getProgName putStrLn $ concat [ "usage: ", name, " [options] [files]" ] forM_ args $ \(short, long, desc, _) -> putStrLn $ concat [ " ", s short, l long, desc ] where s '\0' = " " s c = ['-', c] ++ ", " l long = ("--" ++) . take (maxlong + 2) $ long ++ repeat ' ' maxlong = maximum . map length $ map (\(_, l, _, _) -> l) args main :: IO () main = void . runMaybeT $ do (opts, files) <- lift $ span ((== '-') . head) <$> getArgs let config = mconcat $ map fromArg opts if help config then printHelp else do tot <- sum <$> mapMT (du config) (if null files then ["."] else files) when (total config) (entry config "total" tot)