directory-tree-0.12.1/0000755000000000000000000000000012763325517012735 5ustar0000000000000000directory-tree-0.12.1/Setup.hs0000644000000000000000000000005612763325517014372 0ustar0000000000000000import Distribution.Simple main = defaultMain directory-tree-0.12.1/Test.hs0000644000000000000000000001041712763325517014213 0ustar0000000000000000module Main where -- do a quick test for Darcs: import System.Directory.Tree import Control.Applicative import qualified Data.Foldable as F import System.Directory import System.Process import System.IO.Error(ioeGetErrorType,isPermissionErrorType) import Control.Monad(void) testDir :: FilePath testDir = "/tmp/TESTDIR-LKJHBAE" main :: IO () main = do putStrLn "-- The following tests will either fail with an error " putStrLn "-- message or with an 'undefined' error" -- write our testing directory structure to disk. We include Failed -- constructors which should be discarded: _:/written <- writeDirectory testTree putStrLn "OK" if (fmap (const ()) (filterDir (not . failed) $dirTree testTree)) == filterDir (not . failed) written then return () else error "writeDirectory returned a tree that didn't match" putStrLn "OK" -- make file farthest to the right unreadable: (Dir _ [_,_,Dir "C" [_,_,File "G" p_unreadable]]) <- sortDir . dirTree <$> build testDir setPermissions p_unreadable emptyPermissions{readable = False, writable = True, executable = True, searchable = True} putStrLn "OK" -- read with lazy and standard functions, compare for equality. Also test that our crazy -- operator works correctly inline with <$>: tL <- readDirectoryWithL readFile testDir t@(_:/Dir _ [_,_,Dir "C" [unreadable_constr,_,_]]) <- sortDir id <$> readDirectory testDir if t == tL then return () else error "lazy read /= standard read" putStrLn "OK" -- make sure the unreadable file left the correct error type in a Failed: if isPermissionErrorType $ ioeGetErrorType $ err unreadable_constr then return () else error "wrong error type for Failed file read" putStrLn "OK" -- run lazy fold, concating file contents. compare for equality: tL_again <- sortDir readDirectoryWithL readFile testDir let tL_concated = F.concat $ dirTree tL_again if tL_concated == "abcdef" then return () else error "foldable broke" putStrLn "OK" -- get a lazy DirTree at root directory with lazy Directory traversal: putStrLn "-- If lazy IO is not working, we should be stalled right now " putStrLn "-- as we try to read in the whole root directory tree." putStrLn "-- Go ahead and press CTRL-C if you've read this far" mapM_ putStr =<< (map name . contents . dirTree) <$> readDirectoryWithL readFile "/" putStrLn "\nOK" let undefinedOrdFailed = Failed undefined undefined :: DirTree Char undefinedOrdDir = Dir undefined undefined :: DirTree Char undefinedOrdFile = File undefined undefined :: DirTree Char -- simple equality and sorting if Dir "d" [File "b" "b",File "a" "a"] == Dir "d" [File "a" "a", File "b" "b"] && -- recursive sort order, enforces non-recursive sorting of Dirs Dir "d" [Dir "b" undefined,File "a" "a"] /= Dir "d" [File "a" "a", Dir "c" undefined] && -- check ordering of constructors: undefinedOrdFailed < undefinedOrdDir && undefinedOrdDir < undefinedOrdFile && -- check ordering by dir contents list length: Dir "d" [File "b" "b",File "a" "a"] > Dir "d" [File "a" "a"] && -- recursive ordering on contents: Dir "d" [File "b" "b", Dir "c" [File "a" "b"]] > Dir "d" [File "b" "b", Dir "c" [File "a" "a"]] then putStrLn "OK" else error "Ord/Eq instance is messed up" if Dir "d" [File "b" "b",File "a" "a"] `equalShape` Dir "d" [File "a" undefined, File "b" undefined] then putStrLn "OK" else error "equalShape or comparinghape functions broken" -- clean up by removing the directory: void $ system $ "rm -r " ++ testDir putStrLn "SUCCESS" testTree :: AnchoredDirTree String testTree = "" :/ Dir testDir [dA , dB , dC , Failed "FAAAIIILL" undefined] where dA = Dir "A" [dA1 , dA2 , Failed "FAIL" undefined] dA1 = Dir "A1" [File "A" "a", File "B" "b"] dA2 = Dir "A2" [File "C" "c"] dB = Dir "B" [File "D" "d"] dC = Dir "C" [File "E" "e", File "F" "f", File "G" "g"] directory-tree-0.12.1/directory-tree.cabal0000644000000000000000000000614212763325517016665 0ustar0000000000000000name: directory-tree version: 0.12.1 homepage: http://brandon.si/code/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 . 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. . Importing the library and optional (useful) Foldable and Traverable libraries: . > import System.Directory.Tree > import qualified Data.Foldable as F > import qualified Data.Traversable as T . Write a hand-made directory tree of textfiles (strings) to the disk. Simulates creating a new user Tux's home directory on a unix machine: . > writeDirectory$ "/home" :/ Dir "Tux" [File "README" "Welcome!"] . "read" a directory by opening all the files at a filepath with readFile, returning an 'AnchoredDirTree String' (d2). Then check for any IO failures: . > do (base :/ d2) <- readDirectory "../parent_dir/dir2/" > let failed = anyFailed d2 > if failed then ... . Use Foldable instance function to concat a directory 'dir' of text files into a single file under the same directory: . > do (b :/ dt) <- readDirectory dir > let f = F.concat dt > return$ b :/ File "ALL_TEXT" f . Open all the files in the current directory as lazy bytestrings, ignoring the base path in Anchored wrapper: . > import qualified Data.ByteString.Lazy as B > do (_ :/ dTree) <- readDirectoryWith B.readFile "./" . 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 :-) . /CHANGES/: from 0.11 . - export 'System.Directory.Tree.transformDir' as requested . - add test suite to cabal file . - remove redundant @removeNonexistent@ (thanks to dmwit for patch) . category: Data, System license: BSD3 license-file: LICENSE copyright: (c) 2011, Brandon Simmons author: Brandon Simmons maintainer: Brandon Simmons cabal-version: >= 1.8.0.4 build-type: Simple tested-with: GHC <=7.8.2 extra-source-files: EXAMPLES/Examples.hs, EXAMPLES/LazyExamples.hs source-repository head type: git location: https://github.com/jberryman/directory-tree.git library exposed-modules: System.Directory.Tree build-depends: base <5, filepath <2, directory <2 ghc-options: -Wall test-suite test main-is: Test.hs type: exitcode-stdio-1.0 build-depends: base <5, filepath <2, directory <2 , process ghc-options: -Wall directory-tree-0.12.1/LICENSE0000644000000000000000000000236612763325517013751 0ustar0000000000000000Copyright (c) 2009 Brandon Simmons All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. directory-tree-0.12.1/System/0000755000000000000000000000000012763325517014221 5ustar0000000000000000directory-tree-0.12.1/System/Directory/0000755000000000000000000000000012763325517016165 5ustar0000000000000000directory-tree-0.12.1/System/Directory/Tree.hs0000644000000000000000000005532012763325517017425 0ustar0000000000000000{-# LANGUAGE CPP #-} -------------------------------------------------------------------- -- | -- Module : System.Directory.Tree -- Copyright : (c) Brandon Simmons -- License : BSD3 -- -- Maintainer: Brandon Simmons -- 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. -- -- Errors are caught in a special constructor in the DirTree type. -- -- 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. -- -- Please send me any requests, bugs, or other feedback on this module! -- -------------------------------------------------------------------- module System.Directory.Tree ( -- * Data types for representing directory trees DirTree (..) , AnchoredDirTree (..) , FileName -- * High level IO functions , readDirectory , readDirectoryWith , readDirectoryWithL , writeDirectory , writeDirectoryWith -- * Lower level functions , build , buildL , openDirectory , writeJustDirs -- ** Manipulating FilePaths , zipPaths , free -- * Utility functions -- ** Shape comparison and equality , equalShape , comparingShape -- ** Handling failure , successful , anyFailed , failed , failures , failedMap -- ** Tree Manipulations , flattenDir , sortDir , sortDirShape , filterDir -- *** Low-level , transformDir -- ** Navigation , dropTo -- ** Operators , () -- * Lenses {- | These are compatible with the "lens" library -} , _contents, _err, _file, _name , _anchor, _dirTree ) where {- TODO: 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 NEXT MAYBE: - tree combining functions - more 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 0.10.0 -Eq and Ord instances now compare on free "contents" type variable -we provide `equalShape` function for comparison of shape and filenames of arbitrary trees (ignoring free "contents" variable) -provide a comparingShape used in sortDirShape -provide a `sortDirShape` function that sorts a tree, taking into account the free file "contents" data 0.11.0 - added records for AnchoredDirTree: 'anchor', 'dirTree' - 'free' deprecated in favor of 'dirTree' - added a new function 'dropTo' - implemented lenses compatible with "lens" package, maybe even allowing zipper usage! -} import System.Directory import System.FilePath import System.IO import Control.Exception (handle, IOException) import System.IO.Error(ioeGetErrorType,isDoesNotExistErrorType) import Data.Ord (comparing) import Data.List (sort, sortBy, (\\)) import qualified Data.Traversable as T import qualified Data.Foldable as F -- exported functions affected: `buildL`, `readDirectoryWithL` import System.IO.Unsafe(unsafeInterleaveIO) #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -- | the String in the name field is always a file name, never a full path. -- The free type variable is used in the File constructor and can hold Handles, -- 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 = 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 a)=> Eq (DirTree a) where (File n a) == (File n' a') = n == n' && a == a' (Dir n cs) == (Dir n' cs') = n == n' && sortBy comparingConstr cs == sortBy comparingConstr cs' -- after comparing above we can hand off to shape equality function: d == d' = equalShape d d' -- | First compare constructors: Failed < Dir < File... -- Then compare `name`... -- Then compare free variable parameter of `File` constructors instance (Ord a,Eq a) => Ord (DirTree a) where compare (File n a) (File n' a') = case compare n n' of EQ -> compare a a' el -> el compare (Dir n cs) (Dir n' cs') = case compare n n' of EQ -> comparing sort cs cs' el -> el -- after comparing above we can hand off to shape ord function: compare d d' = comparingShape d d' -- | 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) in -- the DirTree. (uses an infix constructor; don't be scared) data AnchoredDirTree a = (:/) { anchor :: FilePath, dirTree :: DirTree a } deriving (Show, Ord, Eq) -- | an element in a FilePath: type FileName = String instance Functor DirTree where fmap = T.fmapDefault instance F.Foldable DirTree where foldMap = T.foldMapDefault instance T.Traversable DirTree where traverse f (Dir n cs) = Dir n <$> T.traverse (T.traverse f) cs traverse f (File n a) = File n <$> f a traverse _ (Failed n e) = pure (Failed n e) -- 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 ]-- ---------------------------- -- | Build an AnchoredDirTree, given the path to a directory, opening the files -- using readFile. -- Uses @readDirectoryWith readFile@ internally and has the effect of traversing the -- entire directory structure. See `readDirectoryWithL` for lazy production -- of a DirTree structure. readDirectory :: FilePath -> IO (AnchoredDirTree String) readDirectory = readDirectoryWith readFile -- | Build a 'DirTree' rooted at @p@ and using @f@ to fill the 'file' field of 'File' nodes. -- -- The 'FilePath' arguments to @f@ will be the full path to the current file, and -- will include the root @p@ as a prefix. -- For example, the following would return a tree of full 'FilePath's -- like \"..\/tmp\/foo\" and \"..\/tmp\/bar\/baz\": -- -- > readDirectoryWith return "../tmp" -- -- Note though that the 'build' function below already does this. readDirectoryWith :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) readDirectoryWith f p = buildWith' buildAtOnce' f p -- | 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 `unsafeInterleaveIO` under the hood. This means -- that: -- -- * side effects are tied to evaluation order and only run on demand -- * you might receive exceptions in pure code readDirectoryWithL :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) readDirectoryWithL f p = buildWith' buildLazilyUnsafe' f p -- | 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 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 write' _ (Failed n e) = return $ Failed n e ----------------------------- --[ LOWER LEVEL FUNCTIONS ]-- ----------------------------- -- | a simple application of readDirectoryWith openFile: openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree Handle) openDirectory p m = readDirectoryWith (flip openFile m) p -- | builds a DirTree from the contents of the directory passed to it, saving -- the base directory in the Anchored* wrapper. Errors are caught in the tree in -- the Failed constructor. The 'file' fields initially are populated with full -- paths to the files they are abstracting. build :: FilePath -> IO (AnchoredDirTree FilePath) 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 directory 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 then File n <$> f p else do cs <- getDirsFiles p Dir n <$> T.mapM (buildAtOnce' f . combine p) cs where n = topDir p unsafeMapM :: (a -> IO b) -> [a] -> IO [b] unsafeMapM _ [] = return [] unsafeMapM f (x:xs) = unsafeInterleaveIO io where io = do y <- f x ys <- unsafeMapM f xs return (y:ys) -- using unsafeInterleaveIO to get "lazy" traversal: buildLazilyUnsafe' :: Builder a buildLazilyUnsafe' f p = handleDT n $ do isFile <- doesFileExist p if isFile then File n <$> f p else do files <- getDirsFiles p -- HERE IS THE UNSAFE LINE: dirTrees <- unsafeMapM (rec . combine p) files return (Dir n dirTrees) where rec = buildLazilyUnsafe' f n = topDir p ----------------- --[ UTILITIES ]-- ----------------- ---- HANDLING FAILURES ---- -- | True if any Failed constructors in the tree anyFailed :: DirTree a -> Bool anyFailed = not . successful -- | True if there are no Failed constructors in the tree successful :: DirTree a -> Bool successful = null . failures -- | returns true if argument is a `Failed` constructor: failed :: DirTree a -> Bool failed (Failed _ _) = True failed _ = False -- | returns a list of 'Failed' constructors only: failures :: DirTree a -> [DirTree a] 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 = transformDir unFail where unFail (Failed n e) = f n e unFail c = c ---- ORDERING AND EQUALITY ---- -- | Recursively sort a directory tree according to the Ord instance sortDir :: (Ord a)=> DirTree a -> DirTree a sortDir = sortDirBy compare -- | Recursively sort a tree as in `sortDir` but ignore the file contents of a -- File constructor sortDirShape :: DirTree a -> DirTree a sortDirShape = sortDirBy comparingShape where -- HELPER: sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a sortDirBy cf = transformDir sortD where sortD (Dir n cs) = Dir n (sortBy cf cs) sortD c = c -- | Tests equality of two trees, ignoring their free variable portion. Can be -- used to check if any files have been added or deleted, for instance. equalShape :: DirTree a -> DirTree b -> Bool equalShape d d' = comparingShape d d' == EQ -- TODO: we should use equalFilePath here, but how to sort properly? with System.Directory.canonicalizePath, before compare? -- | a compare function that ignores the free "file" type variable: comparingShape :: DirTree a -> DirTree b -> Ordering comparingShape (Dir n cs) (Dir n' cs') = case compare n n' of EQ -> comp (sortCs cs) (sortCs cs') el -> el where sortCs = sortBy comparingConstr -- stolen from [] Ord instance: comp [] [] = EQ comp [] (_:_) = LT comp (_:_) [] = GT comp (x:xs) (y:ys) = case comparingShape x y of EQ -> comp xs ys other -> other -- else simply compare the flat constructors, non-recursively: comparingShape t t' = comparingConstr t t' -- HELPER: a non-recursive comparison comparingConstr :: DirTree a -> DirTree a1 -> Ordering comparingConstr (Failed _ _) (Dir _ _) = LT comparingConstr (Failed _ _) (File _ _) = LT comparingConstr (File _ _) (Failed _ _) = GT comparingConstr (File _ _) (Dir _ _) = GT comparingConstr (Dir _ _) (Failed _ _) = GT comparingConstr (Dir _ _) (File _ _) = LT -- else compare on the names of constructors that are the same, without -- looking at the contents of Dir constructors: comparingConstr t t' = compare (name t) (name t') ---- OTHER ---- {-# DEPRECATED free "Use record 'dirTree'" #-} -- | DEPRECATED. Use record 'dirTree' instead. free :: AnchoredDirTree a -> DirTree a free = dirTree -- | If the argument is a 'Dir' containing a sub-DirTree matching 'FileName' -- then return that subtree, appending the 'name' of the old root 'Dir' to the -- 'anchor' of the AnchoredDirTree wrapper. Otherwise return @Nothing@. dropTo :: FileName -> AnchoredDirTree a -> Maybe (AnchoredDirTree a) dropTo n' (p :/ Dir n ds') = search ds' where search [] = Nothing search (d:ds) | equalFilePath n' (name d) = Just ((pn) :/ d) | otherwise = search ds dropTo _ _ = Nothing -- | 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 = transformDir 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] -- | 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 ]-- --------------- ---- CONSTRUCTOR IDENTIFIERS ---- {- isFileC :: DirTree a -> Bool isFileC (File _ _) = True isFileC _ = False isDirC :: DirTree a -> Bool isDirC (Dir _ _) = True isDirC _ = False -} ---- PATH CONVERSIONS ---- -- | tuple up the complete file path with the 'file' contents, by building up the -- path, trie-style, from the root. The filepath will be relative to \"anchored\" -- directory. -- -- This allows us to, for example, @mapM_ uncurry writeFile@ over a DirTree of -- 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) zipP p (Dir n cs) = Dir n $ map (zipP $ pn) cs zipP _ (Failed n e) = Failed n e -- extracting pathnames and base names: topDir, baseDir :: FilePath -> FilePath topDir = last . splitDirectories baseDir = joinPath . init . splitDirectories ---- IO HELPERS: ---- -- | writes the directory structure (not files) of a DirTree to the anchored -- 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 "." == "" ----- and getDirectoryContents fails epically on "" -- prepares the directory contents list. we sort so that we can be sure of -- a consistent fold/traversal order on the same directory: getDirsFiles :: String -> IO [FilePath] getDirsFiles cs = do let cs' = if null cs then "." else cs dfs <- getDirectoryContents cs' 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. -- So we filter those errors out because the user should not see errors -- 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 = filterDir isOkConstructor where isOkConstructor c = not (failed c) || isOkError c isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err -- | At 'Dir' constructor, apply transformation function to all of directory's -- contents, then remove the Nothing's and recurse. This always preserves the -- topomst constructor. transformDir :: (DirTree a -> DirTree a) -> DirTree a -> DirTree a transformDir f t = case f t of (Dir n cs) -> Dir n $ map (transformDir f) cs t' -> t' -- Lenses, generated with TH from "lens" ----------- -- TODO deprecate these? Pain in the ass to generate, and maybe it's intended -- for users to generate their own lenses. _contents :: Applicative f => ([DirTree a] -> f [DirTree a]) -> DirTree a -> f (DirTree a) _err :: Applicative f => (IOException -> f IOException) -> DirTree a -> f (DirTree a) _file :: Applicative f => (a -> f a) -> DirTree a -> f (DirTree a) _name :: Functor f => (FileName -> f FileName) -> DirTree a -> f (DirTree a) _anchor :: Functor f => (FilePath -> f FilePath) -> AnchoredDirTree a -> f (AnchoredDirTree a) _dirTree :: Functor f => (DirTree t -> f (DirTree a)) -> AnchoredDirTree t -> f (AnchoredDirTree a) --makeLensesFor [("name","_name"),("err","_err"),("contents","_contents"),("file","_file")] ''DirTree _contents _f_a6s2 (Failed _name_a6s3 _err_a6s4) = pure (Failed _name_a6s3 _err_a6s4) _contents _f_a6s5 (Dir _name_a6s6 _contents'_a6s7) = ((\ _contents_a6s8 -> Dir _name_a6s6 _contents_a6s8) <$> (_f_a6s5 _contents'_a6s7)) _contents _f_a6s9 (File _name_a6sa _file_a6sb) = pure (File _name_a6sa _file_a6sb) _err _f_a6sd (Failed _name_a6se _err'_a6sf) = ((\ _err_a6sg -> Failed _name_a6se _err_a6sg) <$> (_f_a6sd _err'_a6sf)) _err _f_a6sh (Dir _name_a6si _contents_a6sj) = pure (Dir _name_a6si _contents_a6sj) _err _f_a6sk (File _name_a6sl _file_a6sm) = pure (File _name_a6sl _file_a6sm) _file _f_a6so (Failed _name_a6sp _err_a6sq) = pure (Failed _name_a6sp _err_a6sq) _file _f_a6sr (Dir _name_a6ss _contents_a6st) = pure (Dir _name_a6ss _contents_a6st) _file _f_a6su (File _name_a6sv _file'_a6sw) = ((\ _file_a6sx -> File _name_a6sv _file_a6sx) <$> (_f_a6su _file'_a6sw)) _name _f_a6sz (Failed _name'_a6sA _err_a6sC) = ((\ _name_a6sB -> Failed _name_a6sB _err_a6sC) <$> (_f_a6sz _name'_a6sA)) _name _f_a6sD (Dir _name'_a6sE _contents_a6sG) = ((\ _name_a6sF -> Dir _name_a6sF _contents_a6sG) <$> (_f_a6sD _name'_a6sE)) _name _f_a6sH (File _name'_a6sI _file_a6sK) = ((\ _name_a6sJ -> File _name_a6sJ _file_a6sK) <$> (_f_a6sH _name'_a6sI)) --makeLensesFor [("anchor","_anchor"),("dirTree","_dirTree")] ''AnchoredDirTree _anchor _f_a7wT (_anchor'_a7wU :/ _dirTree_a7wW) = ((\ _anchor_a7wV -> (:/) _anchor_a7wV _dirTree_a7wW) <$> (_f_a7wT _anchor'_a7wU)) _dirTree _f_a7wZ (_anchor_a7x0 :/ _dirTree'_a7x1) = ((\ _dirTree_a7x2 -> (:/) _anchor_a7x0 _dirTree_a7x2) <$> (_f_a7wZ _dirTree'_a7x1)) directory-tree-0.12.1/EXAMPLES/0000755000000000000000000000000012763325517014153 5ustar0000000000000000directory-tree-0.12.1/EXAMPLES/Examples.hs0000644000000000000000000000443612763325517016274 0ustar0000000000000000module 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 directory-tree-0.12.1/EXAMPLES/LazyExamples.hs0000644000000000000000000000167112763325517017132 0ustar0000000000000000module 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