4
\$\begingroup\$

I recently watched a video in which the speaker said that Haskell is not suited for real-world tasks, such as copying files from one folder to another. So I tried to write a program that copies a given file system tree to a new location. The usage of the program is

copy_tree <source path> <target path>

If the target path does not exists, it is created. Then all folders and files under <source path> are copied to <target path>. Here is my copy_tree.hs source. I would like to have feedback and suggestions on how to improve it. Especially, I would like to make it as succinct and as idiomatic as possible.

One thing that I do not like very much is that the code calls doesDirectoryExist twice.

import System.Directory
import System.Environment
import System.FilePath


getSubitems path = getSubitemsRec ""
  where
    getChildren path = do
        isDir <- doesDirectoryExist path
        if isDir
          then fmap (filter (`notElem` [".", ".."])) (getDirectoryContents path)
          else return []

    getSubitemsRec relPath = do
        children <- getChildren (path </> relPath)
        let relChildren = [relPath </> p | p <- children]
        nephewItems <- mapM getSubitemsRec relChildren
        return (relChildren ++ (concat nephewItems))


copyItem baseSourcePath baseTargetPath relativePath = do
    let sourcePath = baseSourcePath </> relativePath
    let targetPath = baseTargetPath </> relativePath

    putStrLn $ "Copying " ++ sourcePath ++ " to " ++ targetPath
    isDir <- doesDirectoryExist sourcePath
    if isDir
      then createDirectoryIfMissing False targetPath
      else copyFile sourcePath targetPath


copyTree s t = do
    subItems <- getSubitems s
    createDirectoryIfMissing True t
    mapM_ (copyItem s t) subItems


main = do
    args <- getArgs
    if (length args) == 2
      then copyTree (args !! 0) (args !! 1)
      else putStrLn "Usage: copy_tree <source> <target>"
\$\endgroup\$
1
\$\begingroup\$

One thing that I do not like very much is that the code calls doesDirectoryExist twice.

You can return the result of the doesDirectoryExist from getSubitems and pass it to copyItem, obviating the duplicate call.

Especially, I would like to make it as succinct and as idiomatic as possible.

You can use low precedence <$> instead of fmap to remove some parentheses.

Also "." and ".." should be returned once from getDirectoryContents, so you can replace the

(filter (`notElem` [".", ".."])) 

with (\\ [".", ".."]).

Slight Behavior Difference between copyTree and copyTree'

Behavior of copyTree' is slightly different from copyTree, in that it will accept files as well as directories as parameter s. This is due to the fact that getSubitems' includes the input parameter (path, root of the subtree) in the descendants list it returns. You can get back the previous behavior by ignoring the first value returning from the getSubitems' in copyTree'. But I left the change in copyTree' as is for a behavior more consistent with cp -R of POSIX.

Modified Code

import Data.Functor ((<$>))
import Data.List ((\\))

getSubitems' :: FilePath -> IO [(Bool, FilePath)]
getSubitems' path = getSubitemsRec ""
  where
    getChildren path =  (\\ [".", ".."]) <$> getDirectoryContents path

    getSubitemsRec relPath = do
        let absPath = path </> relPath
        isDir <- doesDirectoryExist absPath
        children <- if isDir then getChildren absPath else return []
        let relChildren = [relPath </> p | p <- children]
        ((isDir, relPath) :) . concat <$> mapM getSubitemsRec relChildren

copyItem' baseSourcePath baseTargetPath (isDir, relativePath) = do
    let sourcePath = baseSourcePath </> relativePath
    let targetPath = baseTargetPath </> relativePath

    putStrLn $ "Copying " ++ sourcePath ++ " to " ++ targetPath
    if isDir
      then createDirectoryIfMissing False targetPath
      else copyFile sourcePath targetPath

copyTree' s t = do
    createDirectoryIfMissing True t
    subItems <- getSubitems' s
    mapM_ (copyItem' s t) subItems
\$\endgroup\$
  • \$\begingroup\$ Thanks for the answer (+1). What do you mean that the behavior is (of (\\ [".", ".."])) is slightly different? Since getDirectoryContents returns these two strings at the front of the list, in this case the behaviour should be the same. \$\endgroup\$ – Giorgio Nov 10 '14 at 14:05
  • \$\begingroup\$ I'll clarify it with an edit. You're right: expected behavior is the same for \`. I meant that the behavior of getSubitems'` is slightly different from getSubitems in that in returns the root item (parameter path) also. \$\endgroup\$ – abuzittin gillifirca Nov 11 '14 at 6:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.