diff --git a/System/Directory/Tree.hs b/System/Directory/Tree.hs --- a/System/Directory/Tree.hs +++ b/System/Directory/Tree.hs @@ -1,4 +1,3 @@ - -------------------------------------------------------------------- -- | -- Module : System.Directory.Tree @@ -47,11 +46,13 @@ , writeDirectoryWith -- * Lower level functions - , zipPaths , build , buildL , openDirectory , writeJustDirs + -- ** Manipulating FilePaths + , zipPaths + , free -- * Utility functions -- ** Shape comparison and equality @@ -68,11 +69,21 @@ , sortDir , sortDirShape , filterDir - , free + -- ** Navigation + , dropTo -- ** Operators , () + + -- * Lenses + {- | These are compatible with the "lens" library + -} + , _contents, _err, _file, _name + , _anchor, _dirTree ) where + + + {- TODO: NEXT: @@ -82,7 +93,7 @@ NEXT MAYBE: - tree combining functions - - tree searching based on file names + - more tree searching based on file names - look into comonad abstraction THE FUTURE!: @@ -119,6 +130,13 @@ -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 @@ -138,7 +156,6 @@ import System.IO.Unsafe(unsafePerformIO) - -- | 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. @@ -180,13 +197,14 @@ --- | 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 = FilePath :/ DirTree a +-- | 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 @@ -291,7 +309,7 @@ -- 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 + -- back a tree of FilePaths -- | identical to `build` but does directory reading IO lazily as needed: @@ -335,7 +353,7 @@ then File n <$> f p -- HERE IS THE UNSAFE CODE: else Dir n . fmap (rec . combine p) <$> getDirsFiles p - + -- TODO: this should really be unsafeInterleaveIO where rec = unsafePerformIO . buildLazilyUnsafe' f n = topDir p @@ -391,6 +409,7 @@ sortDirShape = sortDirBy comparingShape where -- HELPER: +sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a sortDirBy cf = transform sortD where sortD (Dir n cs) = Dir n (sortBy cf cs) sortD c = c @@ -401,6 +420,7 @@ 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 @@ -421,6 +441,7 @@ -- HELPER: a non-recursive comparison +comparingConstr :: DirTree a -> DirTree a1 -> Ordering comparingConstr (Failed _ _) (Dir _ _) = LT comparingConstr (Failed _ _) (File _ _) = LT comparingConstr (File _ _) (Failed _ _) = GT @@ -436,12 +457,22 @@ ---- OTHER ---- - --- | strips away base directory wrapper: +{-# DEPRECATED free "Use record 'dirTree'" #-} +-- | DEPRECATED. Use record 'dirTree' instead. free :: AnchoredDirTree a -> DirTree a -free (_:/t) = t +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: @@ -474,7 +505,7 @@ ---- CONSTRUCTOR IDENTIFIERS ---- - +{- isFileC :: DirTree a -> Bool isFileC (File _ _) = True isFileC _ = False @@ -482,18 +513,19 @@ isDirC :: DirTree a -> Bool isDirC (Dir _ _) = True isDirC _ = False - +-} ---- PATH CONVERSIONS ---- --- | tuple up the complete filename with the File contents, by building up the --- path, trie-style, from the root. The filepath will be relative to the current +-- | 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. +-- +-- 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) @@ -560,3 +592,69 @@ (Dir n cs) -> Dir n $ map (transform f) cs t' -> t' +-- Lenses, generated with TH from "lens" ----------- +_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)) diff --git a/directory-tree.cabal b/directory-tree.cabal --- a/directory-tree.cabal +++ b/directory-tree.cabal @@ -1,6 +1,6 @@ name: directory-tree -version: 0.10.1 -homepage: http://coder.bsimmons.name/blog/2009/05/directory-tree-module-released/ +version: 0.11.0 +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 . @@ -51,6 +51,16 @@ . Any ideas or suggestions for improvements are most welcome :-) . + /CHANGES/: from 0.10.1 + . + - added records for AnchoredDirTree: 'anchor', 'dirTree' + . + - 'free' deprecated in favor of 'dirTree' + . + - added a new function 'dropTo' + . + - implemented lenses compatible with "lens" package + . category: Data, System license: BSD3 @@ -60,7 +70,7 @@ maintainer: Brandon Simmons cabal-version: >= 1.6 build-type: Simple -tested-with: GHC <=6.12.1 +tested-with: GHC <=7.4.1 extra-source-files: EXAMPLES/Examples.hs, EXAMPLES/LazyExamples.hs source-repository head