directory-tree 0.2.1 → 0.9.0

raw patch · 5 files changed

+341/−141 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• EXAMPLES/Examples.hs +61/−0
• EXAMPLES/LazyExamples.hs +36/−0
• System/Directory/Tree.hs +231/−72
• directory-tree.cabal +13/−8
• examples.hs +0/−61

@@ -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++

@@ -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 <dir>`. 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 <dir> 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       +

@@ -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 (p</>n , 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'+

@@ -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

@@ -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--