Safe Haskell | None |
---|---|
Language | Haskell2010 |
Modeled after the linux tree
command (when invoked with the follow-symlinks
option), this module recursively lists the contents of a directory while
avoiding symlink loops. See the documentation of buildDirTree
for an example.
In addition to building the directory-contents tree, this module provides facilities for filtering, displaying, and navigating the directory hierarchy.
See DirZipper
for zipper-based navigation.
Synopsis
- data DirTree a
- = DirTree_Dir FilePath (Map FileName (DirTree a))
- | DirTree_File FilePath a
- | DirTree_Symlink FilePath (Symlink a)
- data Symlink a
- type FileName = String
- buildDirTree :: FilePath -> IO (Maybe (DirTree FilePath))
- dereferenceSymlinks :: DirTree FilePath -> IO (DirTree FilePath)
- filePath :: DirTree a -> FilePath
- fileName :: DirTree a -> FileName
- fileNameMap :: [DirTree a] -> Map FileName (DirTree a)
- insertSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a)
- removeSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a)
- withFirstChild :: Map FileName (DirTree a) -> (DirTree a -> Map FileName (DirTree a) -> x) -> Maybe x
- walkDirTree :: FilePath -> DirTree a -> Maybe (DirTree a)
- walkContents :: FilePath -> DirTree a -> Maybe (DirTree a)
- pruneDirTree :: DirTree a -> Maybe (DirTree a)
- newtype DirTreeMaybe a = DirTreeMaybe {
- unDirTreeMaybe :: Maybe (DirTree a)
- withDirTreeMaybe :: (DirTreeMaybe a -> DirTreeMaybe b) -> DirTree a -> Maybe (DirTree b)
- withDirTreeMaybeF :: Functor f => (DirTreeMaybe a -> f (DirTreeMaybe b)) -> DirTree a -> f (Maybe (DirTree b))
- witherDirTree :: Applicative f => (a -> f (Maybe b)) -> DirTree a -> f (Maybe (DirTree b))
- filterADirTree :: Applicative f => (a -> f Bool) -> DirTree a -> f (Maybe (DirTree a))
- mapMaybeDirTree :: (a -> Maybe b) -> DirTree a -> Maybe (DirTree b)
- catMaybesDirTree :: DirTree (Maybe a) -> Maybe (DirTree a)
- filterDirTree :: (a -> Bool) -> DirTree a -> Maybe (DirTree a)
- drawDirTree :: DirTree a -> Text
- drawDirTreeWith :: (String -> a -> String) -> DirTree a -> String
- printDirTree :: DirTree a -> IO ()
- mkRelative :: FilePath -> FilePath -> FilePath
- alternative :: Alternative f => [f a] -> f a
Directory hierarchy tree
The contents of a directory, represented as a tree. See Symlink
for
special handling of symlinks.
DirTree_Dir FilePath (Map FileName (DirTree a)) | |
DirTree_File FilePath a | |
DirTree_Symlink FilePath (Symlink a) |
Instances
Symlink cycles are prevented by separating symlinks into two categories: those that point to paths already within the directory hierarchy being recursively listed, and those that are not. In the former case, rather than following the symlink and listing the target redundantly, we simply store the symlink reference itself. In the latter case, we treat the symlink as we would any other folder and produce a list of its contents.
The String
argument represents the symlink reference (e.g., "../somefile").
In the Symlink_Internal
case, the second (FilePath
) argument is the path
to the symlink target.
In the Symlink_External
case, the second ([DirTree a]
) argument contains
the contents of the symlink target.
Instances
Functor Symlink Source # | |
Foldable Symlink Source # | |
Defined in System.Directory.Contents.Types fold :: Monoid m => Symlink m -> m # foldMap :: Monoid m => (a -> m) -> Symlink a -> m # foldr :: (a -> b -> b) -> b -> Symlink a -> b # foldr' :: (a -> b -> b) -> b -> Symlink a -> b # foldl :: (b -> a -> b) -> b -> Symlink a -> b # foldl' :: (b -> a -> b) -> b -> Symlink a -> b # foldr1 :: (a -> a -> a) -> Symlink a -> a # foldl1 :: (a -> a -> a) -> Symlink a -> a # elem :: Eq a => a -> Symlink a -> Bool # maximum :: Ord a => Symlink a -> a # minimum :: Ord a => Symlink a -> a # | |
Traversable Symlink Source # | |
Eq a => Eq (Symlink a) Source # | |
Data a => Data (Symlink a) Source # | |
Defined in System.Directory.Contents.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Symlink a -> c (Symlink a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Symlink a) # toConstr :: Symlink a -> Constr # dataTypeOf :: Symlink a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Symlink a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Symlink a)) # gmapT :: (forall b. Data b => b -> b) -> Symlink a -> Symlink a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Symlink a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Symlink a -> r # gmapQ :: (forall d. Data d => d -> u) -> Symlink a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Symlink a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Symlink a -> m (Symlink a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Symlink a -> m (Symlink a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Symlink a -> m (Symlink a) # | |
Ord a => Ord (Symlink a) Source # | |
Defined in System.Directory.Contents.Types | |
Read a => Read (Symlink a) Source # | |
Show a => Show (Symlink a) Source # | |
Generic (Symlink a) Source # | |
type Rep (Symlink a) Source # | |
Defined in System.Directory.Contents.Types type Rep (Symlink a) = D1 (MetaData "Symlink" "System.Directory.Contents.Types" "directory-contents-0.2.0.0-inplace" False) (C1 (MetaCons "Symlink_Internal" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)) :+: C1 (MetaCons "Symlink_External" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map FileName (DirTree a))))) |
type FileName = String Source #
File names, as opposed to file paths, are used to uniquely identify siblings at each level
Constructing directory trees
buildDirTree :: FilePath -> IO (Maybe (DirTree FilePath)) Source #
Recursively list the contents of a FilePath
, representing the results as
a hierarchical DirTree
. This function should produce results similar to
the linux command tree -l
.
For example, given this directory and symlink structure
(as shown by tree -l
):
test ├── A │ ├── a │ ├── A -> ../A [recursive, not followed] │ └── B -> ../B │ ├── A -> ../A [recursive, not followed] │ └── b ├── B │ ├── A -> ../A [recursive, not followed] │ └── b └── C -> ../C └── c
this function will produce the following (as rendered by drawDirTree
):
test | +- A | | | +- A -> ../A | | | +- B -> ../B | | | `- a | +- B | | | +- A -> ../A | | | `- b | `- C -> ../C | `- c
dereferenceSymlinks :: DirTree FilePath -> IO (DirTree FilePath) Source #
De-reference one layer of symlinks
Example
Given:
tmp | +- A | | | `- a | +- a -> A/a | `- C | `- A -> ../A
This function will follow one level of symlinks, producing:
tmp | +- A | | | `- a | +- a | `- C | `- A | `- a
Lower level tree construction
Extracting basic file information
Building and manipulating a map of sibling files
fileNameMap :: [DirTree a] -> Map FileName (DirTree a) Source #
Construct a map of files indexed by filename. Should only be used for a particular generation or level in the directory hierarchy (since that's the only time we can be sure that names are unique)
insertSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a) Source #
Add a sibling to a map of files
removeSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a) Source #
Remove sibling from a map of files
withFirstChild :: Map FileName (DirTree a) -> (DirTree a -> Map FileName (DirTree a) -> x) -> Maybe x Source #
Map a function over the first child and the rest of the children
Basic directory tree navigation
walkDirTree :: FilePath -> DirTree a -> Maybe (DirTree a) Source #
Starting from the root directory, try to walk the given filepath and return
the DirTree
at the end of the route. For example, given the following tree:
src └── System └── Directory └── Contents.hs
walkDirTree "src/System"
should produce
Directory | `- Contents.hs
This function does not dereference symlinks, nor does it handle the special
paths .
and ..
. For more advanced navigation, including handling of special
paths, see DirZipper
.
walkContents :: FilePath -> DirTree a -> Maybe (DirTree a) Source #
Like walkDirTree
but skips the outermost containing directory. Useful for
walking paths relative from the root directory passed to buildDirTree
.
Given the following DirTree
:
src └── System └── Directory └── Contents.hs
walkContents System
should produce
Directory | `- Contents.hs
For more advanced navigation, see
DirZipper
.
Filtering a directory tree
newtype DirTreeMaybe a Source #
This wrapper really just represents the no-path/empty case so that filtering works
DirTreeMaybe | |
|
Instances
withDirTreeMaybe :: (DirTreeMaybe a -> DirTreeMaybe b) -> DirTree a -> Maybe (DirTree b) Source #
Map a function that could produce an empty result over a DirTree
withDirTreeMaybeF :: Functor f => (DirTreeMaybe a -> f (DirTreeMaybe b)) -> DirTree a -> f (Maybe (DirTree b)) Source #
Map a function that could produce an empty result in the given functor
witherDirTree :: Applicative f => (a -> f (Maybe b)) -> DirTree a -> f (Maybe (DirTree b)) Source #
wither
for DirTree
. This represents the case of no paths left after
filtering with Nothing
(something that the DirTree
type can't represent on
its own). NB: Filtering does not remove directories, only files. The
directory structure remains intact. To remove empty directories, see
pruneDirTree
.
filterADirTree :: Applicative f => (a -> f Bool) -> DirTree a -> f (Maybe (DirTree a)) Source #
filterA
for DirTree
. See witherDirTree
.
mapMaybeDirTree :: (a -> Maybe b) -> DirTree a -> Maybe (DirTree b) Source #
mapMaybe
for DirTree
. See witherDirTree
.
catMaybesDirTree :: DirTree (Maybe a) -> Maybe (DirTree a) Source #
catMaybes
for DirTree
. See witherDirTree
.
filterDirTree :: (a -> Bool) -> DirTree a -> Maybe (DirTree a) Source #
filter
for DirTree
. See witherDirTree
.
Displaying a directory tree
drawDirTree :: DirTree a -> Text Source #
Produces a tree drawing (using only text) of a DirTree
hierarchy.
drawDirTreeWith :: (String -> a -> String) -> DirTree a -> String Source #
Apply a rendering function to each file when drawing the directory hierarchy
printDirTree :: DirTree a -> IO () Source #
Print the DirTree
as a tree. For example:
System | `- Directory | `- Contents.hs
Miscellaneous
alternative :: Alternative f => [f a] -> f a Source #
Get the first Alternative