-- | Working with directories. module Control.Shell.Directory where import qualified System.Directory as Dir import Control.Monad import Control.Shell.Base import Control.Shell.Control import Control.Shell.File -- | Get the current working directory. pwd :: Shell FilePath pwd = envWorkDir <$> getEnv -- | Recursively copy a directory. If the target is a directory that already -- exists, the source directory is copied into that directory using its -- current name. cpdir :: FilePath -> FilePath -> Shell () cpdir f t = do e <- getEnv let fromdir = absPath e f todir = absPath e t assert ("`" ++ fromdir ++ "' is not a directory") (isDirectory fromdir) exists <- isDirectory todir if exists then do mkdir True (todir takeFileName fromdir) go fromdir (todir takeFileName fromdir) else mkdir True todir >> go fromdir todir where go from to = do forEachDirectory_ from (\dir -> mkdir True (to dir)) forEachFile_ from $ \file -> do let file' = to file assert (errOverwrite file') (not <$> isDirectory file') cp (from file) file' errOverwrite d = "cannot overwrite directory `" ++ d ++ "' with non-directory" -- | Recursively perform an action on each subdirectory of the given directory. -- The path passed to the callback is relative to the given directory. -- The action will *not* be performed on the given directory itself. forEachDirectory :: FilePath -> (FilePath -> Shell a) -> Shell [a] forEachDirectory r f = do e <- getEnv go (absPath e $ if null r then "." else r) "" where go dir subdir = do let dir' = dir subdir files <- ls dir' fromdirs <- filterM (\d -> isDirectory (dir' d)) files xs <- forM fromdirs $ \d -> do let d' = subdir d x <- f d' (x:) <$> go dir d' return (concat xs) -- | Like 'forEachDirectory', but discards its result. forEachDirectory_ :: FilePath -> (FilePath -> Shell ()) -> Shell () forEachDirectory_ r f = do e <- getEnv go (absPath e $ if null r then "." else r) "" where go dir subdir = do let dir' = dir subdir files <- ls dir' fromdirs <- filterM (\d -> isDirectory (dir' d)) files forM_ fromdirs $ \d -> let d' = subdir d in f d' >> go dir d' -- | Perform an action on each file in the given directory. -- This function will traverse any subdirectories of the given as well. -- File paths are given relative to the given directory; the current working -- directory is not affected. forEachFile :: FilePath -> (FilePath -> Shell a) -> Shell [a] forEachFile r f = do e <- getEnv go (absPath e $ if null r then "." else r) "" where go dir subdir = do let dir' = dir subdir files <- ls dir' -- For each file in this directory... onlyfiles <- filterM (\fl -> isFile (dir' fl)) files xs <- mapM (\x -> f (subdir x)) onlyfiles -- For each subdirectory... fromdirs <- filterM (\fl -> isDirectory (dir' fl)) files xss <- forM fromdirs $ \d -> do go dir (subdir d) return $ concat (xs:xss) -- | Like @forEachFile@ but only performs a side effect. forEachFile_ :: FilePath -> (FilePath -> Shell ()) -> Shell () forEachFile_ r f = do e <- getEnv go (absPath e $ if null r then "." else r) "" where go dir subdir = do let dir' = dir subdir files <- ls dir' filterM (\fl -> isFile (dir' fl)) files >>= mapM_ (f . (subdir )) fromdirs <- filterM (\fl -> isDirectory (dir' fl)) files forM_ fromdirs $ \d -> go dir (subdir d) -- | List the contents of a directory, sans @.@ and @..@. ls :: FilePath -> Shell [FilePath] ls dir = do e <- getEnv contents <- unsafeLiftIO $ Dir.getDirectoryContents (absPath e dir) return [f | f <- contents, f /= ".", f /= ".."] -- | Create a directory. Optionally create any required missing directories as -- well. mkdir :: Bool -> FilePath -> Shell () mkdir True dir = do e <- getEnv unsafeLiftIO $ Dir.createDirectoryIfMissing True (absPath e dir) mkdir _ dir = do e <- getEnv unsafeLiftIO $ Dir.createDirectory (absPath e dir) -- | Recursively remove a directory. Follows symlinks, so be careful. rmdir :: FilePath -> Shell () rmdir dir = do e <- getEnv unsafeLiftIO $ Dir.removeDirectoryRecursive (absPath e dir) -- | Do something with the user's home directory. withHomeDirectory :: (FilePath -> Shell a) -> Shell a withHomeDirectory act = liftIO Dir.getHomeDirectory >>= act -- | Perform an action with the user's home directory as the working directory. inHomeDirectory :: Shell a -> Shell a inHomeDirectory act = withHomeDirectory $ flip inDirectory act -- | Do something with the given application's data directory. withAppDirectory :: String -> (FilePath -> Shell a) -> Shell a withAppDirectory app act = liftIO (Dir.getAppUserDataDirectory app) >>= act -- | Do something with the given application's data directory as the working -- directory. inAppDirectory :: FilePath -> Shell a -> Shell a inAppDirectory app act = withAppDirectory app $ flip inDirectory act -- | Execute a command in the given working directory, then restore the -- previous working directory. inDirectory :: FilePath -> Shell a -> Shell a inDirectory dir act = do env <- getEnv inEnv (env {envWorkDir = absPath env dir}) act -- | Does the given path lead to a directory? isDirectory :: FilePath -> Shell Bool isDirectory dir = do e <- getEnv unsafeLiftIO $ Dir.doesDirectoryExist (absPath e dir) -- | Does the given path lead to a file? isFile :: FilePath -> Shell Bool isFile f = do e <- getEnv unsafeLiftIO $ Dir.doesFileExist (absPath e f)