diff --git a/EXAMPLES/Examples.hs b/EXAMPLES/Examples.hs new file mode 100644 --- /dev/null +++ b/EXAMPLES/Examples.hs @@ -0,0 +1,61 @@ +module Main + where + +import System.Directory.Tree +import qualified Data.Foldable as F +import qualified Data.Traversable as T + +-- for main2: +import Data.Digest.Pure.MD5 +import qualified Data.ByteString.Lazy as B + + +main = darcsInitialize + +-- simple example of creating a directory by hand and writing to disk: here we +-- replicate (kind of) running the command "darcs initialize" in the current +-- directory: +darcsInitialize = writeDirectory ("source_dir" :/ darcs_d) + where darcs_d = Dir "_darcs" [prist_d, prefs_d, patch_d, inven_f, forma_f] + + prist_d = Dir "pristine.hashed" [hash_f] + prefs_d = Dir "prefs" [motd_f, bori_f, bina_f] + patch_d = Dir "patches" [] + inven_f = File "hashed_inventory" "" + forma_f = File "format" "hashed\ndarcs-2\n" + + hash_f = File "da39a3ee5..." "" + motd_f = File "motd" "" + bori_f = File "boring" "# Boring file regexps:\n..." + bina_f = File "binaries" "# Binary file regexps:\n..." + + +-- here we read directories from different locations on the disk and combine +-- them into a new directory structure, ignoring the anchored base directory, +-- then simply 'print' the structure to screen: +combineDirectories = + do (_:/d1) <- readDirectory "../dir1/" + (b:/d2) <- readDirectory "/home/me/dir2" + let readme = File "README" "nothing to see here" + + -- anchor to the parent directory: + print $ b:/Dir "Combined_Dir_Test" [d1,d2,readme] + + +-- read two directory structures using readFile from Data.ByteString, and build +-- up an MD5 hash of all the files in each directory, compare the two hashes +-- to see if the directories are identical in their files. (note: doesn't take +-- into account directory name mis-matches) +verifyDirectories = + do (_:/bsd1) <- readByteStrs "./dir_modified" + (_:/bsd2) <- readByteStrs "./dir" + let hash1 = hashDir bsd1 + let hash2 = hashDir bsd2 + print $ if hash1 == hash2 + then "directories match with hash: " ++ show hash1 + else show hash1 ++ " doesn't match " ++ show hash2 + + where readByteStrs = readDirectoryWith B.readFile + hashDir = md5Finalize. F.foldl' md5Update md5InitialContext + + diff --git a/EXAMPLES/LazyExamples.hs b/EXAMPLES/LazyExamples.hs new file mode 100644 --- /dev/null +++ b/EXAMPLES/LazyExamples.hs @@ -0,0 +1,36 @@ +module Main + where + +import System.Directory.Tree +import qualified Data.Foldable as F +import System.IO +import Control.Monad + + + +main = du "/etc" + + + +-- Here are a few examples of using the directory-tree package to recreate +-- the basic functionality of some linux command-line tools. This module +-- uses the lazy directory building IO provided by `readDirectoryWithL`: + + + +-- the command `ls `. Try: +-- ghci> ls "/" +-- ...IO is done lazily. +ls :: FileName -> IO () +ls d = do (_ :/ Dir _ c) <- readDirectoryWithL readFile d + mapM_ (putStrLn . name) c + + + +-- the command `du -bs 2> /dev/null` gets the total size of all files +-- under the supplied directory. We use a more compositional style here, where +-- (<=<) is equivalent to (.) but for monadic functions (a -> m b): +du :: FileName -> IO () +du = print . F.foldl' (+) 0 . free <=< readDirectoryWithL (hFileSize <=< readHs) + where readHs = flip openFile ReadMode + diff --git a/System/Directory/Tree.hs b/System/Directory/Tree.hs --- a/System/Directory/Tree.hs +++ b/System/Directory/Tree.hs @@ -9,18 +9,23 @@ -- Stability : experimental -- Portability: portable -- --- Provides a simple data structure mirroring a directory tree on the --- filesystem, as well as useful functions for reading and writing --- file and directory structures in the IO monad. +-- Provides a simple data structure mirroring a directory tree on the +-- filesystem, as well as useful functions for reading and writing file +-- and directory structures in the IO monad. -- -- Errors are caught in a special constructor in the DirTree type. -- --- Defined instances of Functor, Traversable and Foldable allow for +-- Defined instances of Functor, Traversable and Foldable allow for -- easily operating on a directory of files. For example, you could use -- Foldable.foldr to create a hash of the entire contents of a directory. +-- +-- The functions `readDirectoryWithL` and `buildL` allow for doing +-- directory-traversing IO lazily as required by the execution of pure +-- code. This allows you to treat large directories the same way as you +-- would a lazy infinite list. -- --- The AnchoredDirTree type is a simple wrapper for DirTree to keep track --- of a base directory context for the DirTree. +-- The AnchoredDirTree type is a simple wrapper for DirTree to keep +-- track of a base directory context for the DirTree. -- -- Please send me any requests, bugs, or other feedback on this module! -- @@ -36,12 +41,14 @@ -- * High level IO functions , readDirectory , readDirectoryWith + , readDirectoryWithL , writeDirectory , writeDirectoryWith -- * Lower level functions , zipPaths , build + , buildL , openDirectory , writeJustDirs @@ -52,23 +59,54 @@ , failed , failures , failedMap - -- ** Misc. + -- ** Tree Manipulations + , flattenDir + , sortDir + , filterDir , free + -- ** Operators + , () ) where {- TODO: - - add whatever needed to make an efficient 'du' simple - - look at using 'withFile' ? - - strictness ? what does this do when called on a big - directory tree and we only use the top level ? + NEXT: + - performance improvements, we want lazy dir functions to run in constant + space if possible. + - v1.0.0 will have a completely stable API, i.e. no added/modified functions - - add some tests + NEXT MAYBE: - tree combining functions - tree searching based on file names - look into comonad abstraction + + THE FUTURE!: + -`par` annotations for multithreaded directory traversal(?) + -} +{- +CHANGES: + 0.3.0 + -remove does not exist errors from DirTrees returned by `read*` + functions + -add lazy `readDirectoryWithL` function which uses unsafePerformIO + internally (and safely, we hope) to do DirTree-producing IO as + needed by consuming function + -writeDirectory now returns a DirTree to reflect what was written + successfully to Disk. This lets us inspect for write failures with + (passed_DirTree == returned_DirTree) and easily inspect failures in + the returned DirTree + -added functor instance for the AnchoredDirTree type + 0.9.0: + -removed `sort` from `getDirsFiles`, move it to the Eq instance + -Eq instance now only compares name, for directories we sort contents + (see info re. Ord below) and recursively compare + -Ord instance now works like this: + 1) compare constructor: Failed < Dir < File + 2) compare `name` + -added sortDir function +-} import System.Directory import System.FilePath @@ -78,11 +116,14 @@ import Data.Ord (comparing) import Data.List (sort, (\\)) +import Data.Maybe (mapMaybe) import Control.Applicative import qualified Data.Traversable as T import qualified Data.Foldable as F + -- exported functions affected: `buildL`, `readDirectoryWithL` +import System.IO.Unsafe(unsafePerformIO) @@ -91,19 +132,36 @@ -- Strings representing a file's contents or anything else you can think of. -- We catch any IO errors in the Failed constructor. an Exception can be -- converted to a String with 'show'. -data DirTree a = Dir { name :: FileName, - contents :: [DirTree a] } - | File { name :: FileName, - file :: a } - | Failed { name :: FileName, - err :: IOException } - deriving (Show, Eq) +data DirTree a = Failed { name :: FileName, + err :: IOException } + | Dir { name :: FileName, + contents :: [DirTree a] } + | File { name :: FileName, + file :: a } + deriving Show + +-- | Two DirTrees are equal if they have the same constructor, the same name +-- (and in the case of `Dir`s) their sorted `contents` are equal: +instance Eq (DirTree a) where + (Failed n _) == (Failed n' _) = n == n' + (File n _) == (File n' _) = n == n' + (Dir n cs) == (Dir n' cs') = (n == n') && (sort cs == sort cs') + _ == _ = False -instance (Ord a)=> Ord (DirTree a) where - compare = comparing name +-- | FIRST: Failed < Dir < File, THEN: compare `on` name +instance Ord (DirTree a) where + compare (Failed _ _) (Dir _ _) = LT + compare (Failed _ _) (File _ _) = LT + compare (Dir _ _) (Failed _ _) = GT + compare (Dir _ _) (File _ _) = LT + compare (File _ _) (Failed _ _) = GT + compare (File _ _) (Dir _ _) = GT + compare t t' = comparing name t t' + + -- | a simple wrapper to hold a base directory name, which can be either -- an absolute or relative path. This lets us give the DirTree a context, -- while still letting us store only directory and file NAMES (not full paths) @@ -128,7 +186,14 @@ +-- for convenience: +instance Functor AnchoredDirTree where + fmap f (b:/d) = b :/ fmap f d + +-- given the same fixity as <$>, is that right? +infixl 4 + ---------------------------- --[ HIGH LEVEL FUNCTIONS ]-- @@ -138,35 +203,59 @@ -- | build an AnchoredDirTree, given the path to a directory, opening the files -- using readFile. -- Uses `readDirectoryWith` internally and has the effect of traversing the --- entire directory structure, so is not suitable for running on large directory --- trees (suggestions or patches welcomed): +-- entire directory structure. See `readDirectoryWithL` for lazy production +-- of a DirTree structure. readDirectory :: FilePath -> IO (AnchoredDirTree String) readDirectory = readDirectoryWith readFile + -- | same as readDirectory but allows us to, for example, use -- ByteString.readFile to return a tree of ByteStrings. readDirectoryWith :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) -readDirectoryWith f p = do (b:/t) <- build p - t' <- T.mapM f t - return $ b:/t' - +readDirectoryWith f p = do (b:/t) <- buildWith' buildAtOnce' f p + let t' = removeNonexistent t + return ( b:/t') --- | write a DirTree of strings to disk. clobbers files of the same name. --- doesn't affect files in the directories (if any already exist) with --- different names: -writeDirectory :: AnchoredDirTree String -> IO () + +-- | A "lazy" version of `readDirectoryWith` that does IO operations as needed +-- i.e. as the tree is traversed in pure code. +-- /NOTE:/ This function uses unsafePerformIO under the hood. I believe our use +-- here is safe, but this function is experimental in this release: +readDirectoryWithL :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) +readDirectoryWithL f p = do (b:/t) <- buildWith' buildLazilyUnsafe' f p + let t' = removeNonexistent t + return ( b:/t') + + +-- | write a DirTree of strings to disk. Clobbers files of the same name. +-- Doesn't affect files in the directories (if any already exist) with +-- different names. Returns a new AnchoredDirTree where failures were +-- lifted into a `Failed` constructor: +writeDirectory :: AnchoredDirTree String -> IO (AnchoredDirTree ()) writeDirectory = writeDirectoryWith writeFile --- | writes the directory structure to disc, then uses the provided function to --- write the contents of Files to disc. -writeDirectoryWith :: (FilePath -> a -> IO ()) -> AnchoredDirTree a -> IO () -writeDirectoryWith f t = do writeJustDirs t - F.mapM_ (uncurry f) (zipPaths t) +-- | writes the directory structure to disk and uses the provided function to +-- write the contents of `Files` to disk. The return value of the function will +-- become the new `contents` of the returned, where IO errors at each node are +-- replaced with `Failed` constructors. The returned tree can be compared to +-- the passed tree to see what operations, if any, failed: +writeDirectoryWith :: (FilePath -> a -> IO b) -> AnchoredDirTree a -> IO (AnchoredDirTree b) +writeDirectoryWith f (b:/t) = (b:/) <$> write' b t + where write' b' (File n a) = handleDT n $ + File n <$> f (b'n) a + write' b' (Dir n cs) = handleDT n $ + do let bas = b'n + createDirectoryIfMissing True bas + Dir n <$> mapM (write' bas) cs + -- INTERESTING: have to rebuild Failed constr. to get to typecheck: + write' _ (Failed n e) = return $ Failed n e + + ----------------------------- --[ LOWER LEVEL FUNCTIONS ]-- ----------------------------- @@ -183,31 +272,57 @@ -- the Failed constructor. The 'file' fields initially are populated with full -- paths to the files they are abstracting. build :: FilePath -> IO (AnchoredDirTree FilePath) -build p = do let base = baseDir p - tree <- build' p - -- we make sure the directory tree is free of non-existent - -- file errors, which are artifacts of the "non-atomic" - -- nature of traversing a system firectory tree. - let treeClean = removeNonexistent tree - return (base :/ treeClean) - --- HELPER: not exported: -build' :: FilePath -> IO (DirTree FilePath) -build' p = - handle (return . Failed n) $ +build = buildWith' buildAtOnce' return -- we say 'return' here to get + -- back a tree of FilePaths + + +-- | identical to `build` but does directory reading IO lazily as needed: +buildL :: FilePath -> IO (AnchoredDirTree FilePath) +buildL = buildWith' buildLazilyUnsafe' return + + + + + -- -- -- helpers: -- -- -- + + +type UserIO a = FilePath -> IO a +type Builder a = UserIO a -> FilePath -> IO (DirTree a) + +-- remove non-existent file errors, which are artifacts of the "non-atomic" +-- nature of traversing a system firectory tree: +buildWith' :: Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a) +buildWith' bf' f p = + do tree <- bf' f p + return (baseDir p :/ removeNonexistent tree) + + + +-- IO function passed to our builder and finally executed here: +buildAtOnce' :: Builder a +buildAtOnce' f p = handleDT n $ do isFile <- doesFileExist p if isFile - -- store full path to the file in 'file' field: - then return (File n p) - -- else is directory, build a Dir from contents: + then File n <$> f p else do cs <- getDirsFiles p - Dir n <$> T.mapM (build' . combine p) cs - -- the directory to build, located under "base": + Dir n <$> T.mapM (buildAtOnce' f . combine p) cs where n = topDir p +-- using unsafePerformIO to get "lazy" traversal: +buildLazilyUnsafe' :: Builder a +buildLazilyUnsafe' f p = handleDT n $ + do isFile <- doesFileExist p + if isFile + then File n <$> f p + -- HERE IS THE UNSAFE CODE: + else Dir n . fmap (rec . combine p) <$> getDirsFiles p + + where rec = unsafePerformIO . buildLazilyUnsafe' f + n = topDir p + ----------------- --[ UTILITIES ]-- @@ -235,27 +350,56 @@ -- | returns a list of 'Failed' constructors only: failures :: DirTree a -> [DirTree a] -failures (Dir _ cs) = concatMap failures cs -failures (File _ _) = [] -failures f = [f] +failures = filter failed . flattenDir -- | maps a function to convert Failed DirTrees to Files or Dirs failedMap :: (FileName -> IOException -> DirTree a) -> DirTree a -> DirTree a -failedMap f (Dir n cs) = Dir n $map (failedMap f) cs -failedMap f (Failed n e) = f n e -failedMap _ fle = fle +failedMap f = transform unFail + where unFail (Failed n e) = f n e + unFail c = c + ---- OTHER ---- + -- | strips away base directory wrapper: free :: AnchoredDirTree a -> DirTree a free (_:/t) = t +-- | applies the predicate to each constructor in the tree, removing it (and +-- its children, of course) when the predicate returns False. The topmost +-- constructor will always be preserved: +filterDir :: (DirTree a -> Bool) -> DirTree a -> DirTree a +filterDir p = transform filterD + where filterD (Dir n cs) = Dir n $ filter p cs + filterD c = c + +-- | Flattens a `DirTree` into a (never empty) list of tree constructors. `Dir` +-- constructors will have [] as their `contents`: +flattenDir :: DirTree a -> [ DirTree a ] +flattenDir (Dir n cs) = Dir n [] : concatMap flattenDir cs +flattenDir f = [f] + + +-- | Sort the `contents` of every `Dir` constructor, see Ord instance above: +sortDir :: DirTree a -> DirTree a +sortDir = transform sortD + where sortD (Dir n cs) = Dir n (sort cs) + sortD c = c + + +-- | Allows for a function on a bare DirTree to be applied to an AnchoredDirTree +-- within a Functor. Very similar to and useful in combination with `<$>`: +() :: (Functor f) => (DirTree a -> DirTree b) -> f (AnchoredDirTree a) -> + f (AnchoredDirTree b) +() f = fmap (\(b :/ t) -> b :/ f t) + + --------------- --[ HELPERS ]-- --------------- @@ -269,7 +413,7 @@ -- path, trie-style, from the root. The filepath will be relative to the current -- directory. -- This allows us to, for example, mapM_ 'uncurry writeFile' over a DirTree of --- strings. +-- strings, although `writeDirectory` does a better job of this. zipPaths :: AnchoredDirTree a -> DirTree (FilePath, a) zipPaths (b :/ t) = zipP b t where zipP p (File n a) = File n (pn , a) @@ -288,13 +432,10 @@ -- | writes the directory structure (not files) of a DirTree to the anchored --- directory. can be preparation for writing files: -writeJustDirs :: AnchoredDirTree a -> IO () -writeJustDirs (b:/t) = write' b t - where write' b' (Dir n cs) = do let bas = b' n - createDirectoryIfMissing True bas - mapM_ (write' bas) cs - write' _ _ = return () +-- directory. Returns a structure identical to the supplied tree with errors +-- replaced by `Failed` constructors: +writeJustDirs :: AnchoredDirTree a -> IO (AnchoredDirTree a) +writeJustDirs = writeDirectoryWith (const return) ----- the let expression is an annoying hack, because dropFileName "." == "" @@ -304,10 +445,19 @@ getDirsFiles :: String -> IO [FilePath] getDirsFiles cs = do let cs' = if null cs then "." else cs dfs <- getDirectoryContents cs' - return $ sort $ dfs \\ [".",".."] + return $ dfs \\ [".",".."] +---- FAILURE HELPERS: ---- + + +-- handles an IO exception by returning a Failed constructor filled with that +-- exception: +handleDT :: FileName -> IO (DirTree a) -> IO (DirTree a) +handleDT n = handle (return . Failed n) + + -- DoesNotExist errors not present at the topmost level could happen if a -- named file or directory is deleted after being listed by -- getDirectoryContents but before we can get it into memory. @@ -315,9 +465,18 @@ -- raised by the internal implementation of this module: -- This leaves the error if it exists in the top (user-supplied) level: removeNonexistent :: DirTree a -> DirTree a -removeNonexistent (Dir n cs) = - Dir n $ map removeNonexistent $ filter isOkConstructor cs - +removeNonexistent = filterDir isOkConstructor where isOkConstructor c = not (failed c) || isOkError c isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err -removeNonexistent f = f + + +---- THIS COULD BE USEFUL TO EXPORT: + +-- at Dir constructor, apply transformation function to all of directory's +-- contents, then remove the Nothing's and recurse. +-- ALWAYS PRESERVES TOPMOST CONSTRUCTOR: +transform :: (DirTree a -> DirTree a) -> DirTree a -> DirTree a +transform f t = case f t of + (Dir n cs) -> Dir n $ map (transform f) cs + t' -> t' + diff --git a/directory-tree.cabal b/directory-tree.cabal --- a/directory-tree.cabal +++ b/directory-tree.cabal @@ -1,5 +1,5 @@ name: directory-tree -version: 0.2.1 +version: 0.9.0 homepage: http://coder.bsimmons.name/blog/2009/05/directory-tree-module-released/ synopsis: A simple directory-like tree datatype, with useful IO functions description: A simple directory-like tree datatype, with useful IO functions and Foldable and Traversable instance @@ -39,13 +39,18 @@ > import qualified Data.ByteString.Lazy as B > do (_ :/ dTree) <- readDirectoryWith B.readFile "./" . - *NOTE:* the IO functions like `readDirectoryWith` in this library use standard lazy IO - IOfunctions and will (necessarily) traverse an entire system directory tree before - returning a DirTree constructor. This unfortunately makes it not suitable for large - directory trees. - - Any ideas or suggestions for improvements would be most welcomed :-) + This version also offers an experimental function `readDirectoryWithL` that does + lazy directory IO, allowing you to treat the returned `DirTree` as if it were a + normal lazily-generated data structure. . + For example, the following does only the amount of IO necessary to list the file + names of the children of the root directory, similar to "ls /": + . + > do d <- readDirectoryWithL readFile "/" + > mapM_ (putStrLn . name) $ contents $ free d + . + Any ideas or suggestions for improvements are most welcome :-) + . category: Data, System license: BSD3 @@ -56,7 +61,7 @@ cabal-version: >= 1.2.0 build-type: Simple tested-with: GHC <=6.12.1 -extra-source-files: examples.hs +extra-source-files: EXAMPLES/Examples.hs, EXAMPLES/LazyExamples.hs library diff --git a/examples.hs b/examples.hs deleted file mode 100644 --- a/examples.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Main - where - -import System.Directory.Tree -import qualified Data.Foldable as F -import qualified Data.Traversable as T - --- for main2: -import Data.Digest.Pure.MD5 -import qualified Data.ByteString.Lazy as B - - -main = darcsInitialize - --- simple example of creating a directory by hand and writing to disk: here we --- replicate (kind of) running the command "darcs initialize" in the current --- directory: -darcsInitialize = writeDirectory ("source_dir" :/ darcs_d) - where darcs_d = Dir "_darcs" [prist_d, prefs_d, patch_d, inven_f, forma_f] - - prist_d = Dir "pristine.hashed" [hash_f] - prefs_d = Dir "prefs" [motd_f, bori_f, bina_f] - patch_d = Dir "patches" [] - inven_f = File "hashed_inventory" "" - forma_f = File "format" "hashed\ndarcs-2\n" - - hash_f = File "da39a3ee5..." "" - motd_f = File "motd" "" - bori_f = File "boring" "# Boring file regexps:\n..." - bina_f = File "binaries" "# Binary file regexps:\n..." - - --- here we read directories from different locations on the disk and combine --- them into a new directory structure, ignoring the anchored base directory, --- then simply 'print' the structure to screen: -combineDirectories = - do (_:/d1) <- readDirectory "../dir1/" - (b:/d2) <- readDirectory "/home/me/dir2" - let readme = File "README" "nothing to see here" - - -- anchor to the parent directory: - print $ b:/Dir "Combined_Dir_Test" [d1,d2,readme] - - --- read two directory structures using readFile from Data.ByteString, and build --- up an MD5 hash of all the files in each directory, compare the two hashes --- to see if the directories are identical in their files. (note: doesn't take --- into account directory name mis-matches) -verifyDirectories = - do (_:/bsd1) <- readByteStrs "./dir_modified" - (_:/bsd2) <- readByteStrs "./dir" - let hash1 = hashDir bsd1 - let hash2 = hashDir bsd2 - print $ if hash1 == hash2 - then "directories match with hash: " ++ show hash1 - else show hash1 ++ " doesn't match " ++ show hash2 - - where readByteStrs = readDirectoryWith B.readFile - hashDir = md5Finalize. F.foldl' md5Update md5InitialContext - -