{-# Language DeriveFoldable #-}
{-# Language DeriveFunctor #-}
{-# Language DeriveTraversable #-}
{-# Language FlexibleContexts #-}
{-# Language LambdaCase #-}
{-# Language MultiWayIf #-}
{-|
Description:
  Recursively list the contents of a directory while avoiding
  symlink loops.

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 'System.Directory.Contents.Zipper.DirZipper' for zipper-based navigation.

-}
module System.Directory.Contents 
  (
  -- * Directory hierarchy tree
    DirTree(..)
  , Symlink(..)
  , FileName
  -- ** Constructing directory trees
  , buildDirTree
  , dereferenceSymlinks
  -- ** Lower level tree construction
  -- *** Extracting basic file information
  , filePath
  , fileName
  -- *** Building and manipulating a map of sibling files
  , fileNameMap
  , insertSibling
  , removeSibling
  , withFirstChild
  -- * Basic directory tree navigation
  , walkDirTree
  , walkContents
  -- * Filtering a directory tree
  , pruneDirTree
  , DirTreeMaybe(..)
  , withDirTreeMaybe
  , withDirTreeMaybeF
  , witherDirTree
  , filterADirTree
  , mapMaybeDirTree
  , catMaybesDirTree
  , filterDirTree
  -- * Displaying a directory tree
  , drawDirTree
  , drawDirTreeWith
  , printDirTree
  -- * Miscellaneous
  , mkRelative
  , alternative
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Writer
import Data.List
import qualified Data.Map as Map
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tree as DataTree
import Data.Witherable
import System.Directory
import System.FilePath

import System.Directory.Contents.Types
import System.Directory.Contents.Zipper

-- * Construct

-- | 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
--
buildDirTree :: FilePath -> IO (Maybe (DirTree FilePath))
buildDirTree :: FilePath -> IO (Maybe (DirTree FilePath))
buildDirTree FilePath
root = Map FilePath FilePath -> FilePath -> IO (Maybe (DirTree FilePath))
build Map FilePath FilePath
forall k a. Map k a
Map.empty FilePath
root
  where
    build :: Map FilePath FilePath -> FilePath -> IO (Maybe (DirTree FilePath))
build Map FilePath FilePath
seen FilePath
path = do
      FilePath
canon <- FilePath -> IO FilePath
canonicalizePath FilePath
path
      Bool
isPath <- FilePath -> IO Bool
doesPathExist FilePath
path
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
      let pathExists :: Bool
pathExists = Bool
isPath Bool -> Bool -> Bool
|| Bool
isDir
      Maybe Bool
isSym <- if Bool
pathExists then (Bool -> Maybe Bool) -> IO Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (FilePath -> IO Bool
pathIsSymbolicLink FilePath
path) else Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
      [FilePath]
subpaths <- if Bool
isDir then FilePath -> IO [FilePath]
listDirectory FilePath
path else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      [FilePath]
subcanons <- (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO FilePath
canonicalizePath ([FilePath] -> IO [FilePath])
-> ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
        (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool)
-> (FilePath -> IO Bool) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
pathIsSymbolicLink) ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath
path FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
subpaths
      let seen' :: Map FilePath FilePath
seen' = Map FilePath FilePath
-> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map FilePath FilePath
seen (Map FilePath FilePath -> Map FilePath FilePath)
-> Map FilePath FilePath -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)] -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
subcanons [FilePath]
subpaths
          buildSubpaths :: IO [DirTree FilePath]
buildSubpaths = [Maybe (DirTree FilePath)] -> [DirTree FilePath]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (DirTree FilePath)] -> [DirTree FilePath])
-> IO [Maybe (DirTree FilePath)] -> IO [DirTree FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Maybe (DirTree FilePath)))
-> [FilePath] -> IO [Maybe (DirTree FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
            (Map FilePath FilePath -> FilePath -> IO (Maybe (DirTree FilePath))
build (FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
canon FilePath
path Map FilePath FilePath
seen') (FilePath -> IO (Maybe (DirTree FilePath)))
-> (FilePath -> FilePath)
-> FilePath
-> IO (Maybe (DirTree FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
path FilePath -> FilePath -> FilePath
</>)) [FilePath]
subpaths
      if | Bool -> Bool
not Bool
isPath -> Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DirTree FilePath)
forall a. Maybe a
Nothing
         | Maybe Bool
isSym Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True -> case FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
canon Map FilePath FilePath
seen' of
             Maybe FilePath
Nothing -> do
               FilePath
s <- FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
path
               DirTree FilePath -> Maybe (DirTree FilePath)
forall a. a -> Maybe a
Just (DirTree FilePath -> Maybe (DirTree FilePath))
-> ([DirTree FilePath] -> DirTree FilePath)
-> [DirTree FilePath]
-> Maybe (DirTree FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Symlink FilePath -> DirTree FilePath
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
path (Symlink FilePath -> DirTree FilePath)
-> ([DirTree FilePath] -> Symlink FilePath)
-> [DirTree FilePath]
-> DirTree FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Map FilePath (DirTree FilePath) -> Symlink FilePath
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s (Map FilePath (DirTree FilePath) -> Symlink FilePath)
-> ([DirTree FilePath] -> Map FilePath (DirTree FilePath))
-> [DirTree FilePath]
-> Symlink FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DirTree FilePath] -> Map FilePath (DirTree FilePath)
forall a. [DirTree a] -> Map FilePath (DirTree a)
fileNameMap ([DirTree FilePath] -> Maybe (DirTree FilePath))
-> IO [DirTree FilePath] -> IO (Maybe (DirTree FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [DirTree FilePath]
buildSubpaths
             Just FilePath
_ -> do
               FilePath
target <- FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
path
               FilePath
canonRoot <- FilePath -> IO FilePath
canonicalizePath FilePath
root
               let startingPoint :: FilePath
startingPoint = FilePath -> FilePath
takeFileName FilePath
root
               FilePath
canonSym <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
target
               Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath)))
-> Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath))
forall a b. (a -> b) -> a -> b
$ DirTree FilePath -> Maybe (DirTree FilePath)
forall a. a -> Maybe a
Just (DirTree FilePath -> Maybe (DirTree FilePath))
-> DirTree FilePath -> Maybe (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink FilePath -> DirTree FilePath
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
path (Symlink FilePath -> DirTree FilePath)
-> Symlink FilePath -> DirTree FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Symlink FilePath
forall a. FilePath -> FilePath -> Symlink a
Symlink_Internal FilePath
target (FilePath -> Symlink FilePath) -> FilePath -> Symlink FilePath
forall a b. (a -> b) -> a -> b
$
                FilePath
startingPoint FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
mkRelative FilePath
canonRoot FilePath
canonSym
         | Bool
isDir -> DirTree FilePath -> Maybe (DirTree FilePath)
forall a. a -> Maybe a
Just (DirTree FilePath -> Maybe (DirTree FilePath))
-> ([DirTree FilePath] -> DirTree FilePath)
-> [DirTree FilePath]
-> Maybe (DirTree FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Map FilePath (DirTree FilePath) -> DirTree FilePath
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
path (Map FilePath (DirTree FilePath) -> DirTree FilePath)
-> ([DirTree FilePath] -> Map FilePath (DirTree FilePath))
-> [DirTree FilePath]
-> DirTree FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DirTree FilePath] -> Map FilePath (DirTree FilePath)
forall a. [DirTree a] -> Map FilePath (DirTree a)
fileNameMap ([DirTree FilePath] -> Maybe (DirTree FilePath))
-> IO [DirTree FilePath] -> IO (Maybe (DirTree FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [DirTree FilePath]
buildSubpaths
         | Bool
otherwise -> Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath)))
-> Maybe (DirTree FilePath) -> IO (Maybe (DirTree FilePath))
forall a b. (a -> b) -> a -> b
$ DirTree FilePath -> Maybe (DirTree FilePath)
forall a. a -> Maybe a
Just (DirTree FilePath -> Maybe (DirTree FilePath))
-> DirTree FilePath -> Maybe (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> DirTree FilePath
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
path FilePath
path

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

-}
dereferenceSymlinks :: DirTree FilePath -> IO (DirTree FilePath)
dereferenceSymlinks :: DirTree FilePath -> IO (DirTree FilePath)
dereferenceSymlinks DirTree FilePath
toppath = DirTree FilePath -> DirTree FilePath -> IO (DirTree FilePath)
deref DirTree FilePath
toppath DirTree FilePath
toppath
  where
    deref :: DirTree FilePath -> DirTree FilePath -> IO (DirTree FilePath)
deref DirTree FilePath
top DirTree FilePath
cur = case DirTree FilePath
cur of
      DirTree_Dir FilePath
p Map FilePath (DirTree FilePath)
xs -> FilePath -> Map FilePath (DirTree FilePath) -> DirTree FilePath
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
p (Map FilePath (DirTree FilePath) -> DirTree FilePath)
-> IO (Map FilePath (DirTree FilePath)) -> IO (DirTree FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirTree FilePath -> IO (DirTree FilePath))
-> Map FilePath (DirTree FilePath)
-> IO (Map FilePath (DirTree FilePath))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map FilePath a -> m (Map FilePath b)
mapM (DirTree FilePath -> DirTree FilePath -> IO (DirTree FilePath)
deref DirTree FilePath
top) Map FilePath (DirTree FilePath)
xs
      DirTree_File FilePath
p FilePath
x -> DirTree FilePath -> IO (DirTree FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirTree FilePath -> IO (DirTree FilePath))
-> DirTree FilePath -> IO (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> DirTree FilePath
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
p FilePath
x
      DirTree_Symlink FilePath
p Symlink FilePath
sym -> case Symlink FilePath
sym of
        Symlink_External FilePath
_ Map FilePath (DirTree FilePath)
paths ->
          if Map FilePath (DirTree FilePath) -> Bool
forall k a. Map k a -> Bool
Map.null Map FilePath (DirTree FilePath)
paths
            then do
              Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
p
              DirTree FilePath -> IO (DirTree FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirTree FilePath -> IO (DirTree FilePath))
-> DirTree FilePath -> IO (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
isDir
                then FilePath -> Map FilePath (DirTree FilePath) -> DirTree FilePath
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
p Map FilePath (DirTree FilePath)
forall k a. Map k a
Map.empty
                else FilePath -> FilePath -> DirTree FilePath
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
p FilePath
p
            else DirTree FilePath -> IO (DirTree FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirTree FilePath -> IO (DirTree FilePath))
-> DirTree FilePath -> IO (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Map FilePath (DirTree FilePath) -> DirTree FilePath
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
p Map FilePath (DirTree FilePath)
paths
        Symlink_Internal FilePath
_ FilePath
r -> do
          let startingPoint :: FilePath
startingPoint = FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ DirTree FilePath -> FilePath
forall a. DirTree a -> FilePath
filePath DirTree FilePath
top
          let target :: Maybe (DirTree FilePath)
target = FilePath -> DirTree FilePath -> Maybe (DirTree FilePath)
forall a. FilePath -> DirTree a -> Maybe (DirTree a)
walkDirTree (FilePath
startingPoint FilePath -> FilePath -> FilePath
</> FilePath
r) DirTree FilePath
top
          DirTree FilePath -> IO (DirTree FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirTree FilePath -> IO (DirTree FilePath))
-> DirTree FilePath -> IO (DirTree FilePath)
forall a b. (a -> b) -> a -> b
$ case Maybe (DirTree FilePath)
target of
            Maybe (DirTree FilePath)
Nothing -> FilePath -> Symlink FilePath -> DirTree FilePath
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
p Symlink FilePath
sym
            Just DirTree FilePath
t -> DirTree FilePath
t

-- * Navigate
-- | 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 'System.Directory.Contents.Zipper.DirZipper'.
walkDirTree :: FilePath -> DirTree a -> Maybe (DirTree a)
walkDirTree :: forall a. FilePath -> DirTree a -> Maybe (DirTree a)
walkDirTree FilePath
target DirTree a
p =
  let pathSegments :: [FilePath]
pathSegments = FilePath -> [FilePath]
splitDirectories FilePath
target
      walk :: [FilePath] -> DirTree a -> Maybe (DirTree a)
      walk :: forall a. [FilePath] -> DirTree a -> Maybe (DirTree a)
walk [] DirTree a
path = DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just DirTree a
path
      walk (FilePath
c : [FilePath]
gc) DirTree a
path = case DirTree a
path of
        DirTree_Dir FilePath
a Map FilePath (DirTree a)
xs
          | FilePath -> FilePath
takeFileName FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
c -> [Maybe (DirTree a)] -> Maybe (DirTree a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
alternative ([Maybe (DirTree a)] -> Maybe (DirTree a))
-> [Maybe (DirTree a)] -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> DirTree a -> Maybe (DirTree a)
forall a. [FilePath] -> DirTree a -> Maybe (DirTree a)
walk [FilePath]
gc (DirTree a -> Maybe (DirTree a))
-> [DirTree a] -> [Maybe (DirTree a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath (DirTree a) -> [DirTree a]
forall k a. Map k a -> [a]
Map.elems Map FilePath (DirTree a)
xs
        DirTree_File FilePath
a a
f
          | FilePath -> FilePath
takeFileName FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
c Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
gc -> DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
a a
f
        DirTree_Symlink FilePath
a (Symlink_Internal FilePath
s FilePath
t)
          | FilePath -> FilePath
takeFileName FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
c Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
gc -> DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
a
            (FilePath -> FilePath -> Symlink a
forall a. FilePath -> FilePath -> Symlink a
Symlink_Internal FilePath
s FilePath
t)
        DirTree_Symlink FilePath
a (Symlink_External FilePath
_ Map FilePath (DirTree a)
xs)
          | FilePath -> FilePath
takeFileName FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
c -> [Maybe (DirTree a)] -> Maybe (DirTree a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
alternative ([Maybe (DirTree a)] -> Maybe (DirTree a))
-> [Maybe (DirTree a)] -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> DirTree a -> Maybe (DirTree a)
forall a. [FilePath] -> DirTree a -> Maybe (DirTree a)
walk [FilePath]
gc (DirTree a -> Maybe (DirTree a))
-> [DirTree a] -> [Maybe (DirTree a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath (DirTree a) -> [DirTree a]
forall k a. Map k a -> [a]
Map.elems Map FilePath (DirTree a)
xs
        DirTree a
_ -> Maybe (DirTree a)
forall a. Maybe a
Nothing
  in [FilePath] -> DirTree a -> Maybe (DirTree a)
forall a. [FilePath] -> DirTree a -> Maybe (DirTree a)
walk [FilePath]
pathSegments DirTree a
p

-- | 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
--'System.Directory.Contents.Zipper.DirZipper'.
walkContents :: FilePath -> DirTree a -> Maybe (DirTree a)
walkContents :: forall a. FilePath -> DirTree a -> Maybe (DirTree a)
walkContents FilePath
p = (DirZipper a -> DirTree a)
-> Maybe (DirZipper a) -> Maybe (DirTree a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DirZipper a -> DirTree a
forall a. DirZipper a -> DirTree a
focused (Maybe (DirZipper a) -> Maybe (DirTree a))
-> (DirTree a -> Maybe (DirZipper a))
-> DirTree a
-> Maybe (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
followRelative FilePath
p (DirZipper a -> Maybe (DirZipper a))
-> (DirTree a -> DirZipper a) -> DirTree a -> Maybe (DirZipper a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> DirZipper a
forall a. DirTree a -> DirZipper a
zipped

-- * Filter
-- | This wrapper really just represents the no-path/empty case so that
-- filtering works
newtype DirTreeMaybe a = DirTreeMaybe { forall a. DirTreeMaybe a -> Maybe (DirTree a)
unDirTreeMaybe :: Maybe (DirTree a) }
  deriving (Int -> DirTreeMaybe a -> FilePath -> FilePath
[DirTreeMaybe a] -> FilePath -> FilePath
DirTreeMaybe a -> FilePath
(Int -> DirTreeMaybe a -> FilePath -> FilePath)
-> (DirTreeMaybe a -> FilePath)
-> ([DirTreeMaybe a] -> FilePath -> FilePath)
-> Show (DirTreeMaybe a)
forall a. Show a => Int -> DirTreeMaybe a -> FilePath -> FilePath
forall a. Show a => [DirTreeMaybe a] -> FilePath -> FilePath
forall a. Show a => DirTreeMaybe a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DirTreeMaybe a -> FilePath -> FilePath
showsPrec :: Int -> DirTreeMaybe a -> FilePath -> FilePath
$cshow :: forall a. Show a => DirTreeMaybe a -> FilePath
show :: DirTreeMaybe a -> FilePath
$cshowList :: forall a. Show a => [DirTreeMaybe a] -> FilePath -> FilePath
showList :: [DirTreeMaybe a] -> FilePath -> FilePath
Show, ReadPrec [DirTreeMaybe a]
ReadPrec (DirTreeMaybe a)
Int -> ReadS (DirTreeMaybe a)
ReadS [DirTreeMaybe a]
(Int -> ReadS (DirTreeMaybe a))
-> ReadS [DirTreeMaybe a]
-> ReadPrec (DirTreeMaybe a)
-> ReadPrec [DirTreeMaybe a]
-> Read (DirTreeMaybe a)
forall a. Read a => ReadPrec [DirTreeMaybe a]
forall a. Read a => ReadPrec (DirTreeMaybe a)
forall a. Read a => Int -> ReadS (DirTreeMaybe a)
forall a. Read a => ReadS [DirTreeMaybe a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (DirTreeMaybe a)
readsPrec :: Int -> ReadS (DirTreeMaybe a)
$creadList :: forall a. Read a => ReadS [DirTreeMaybe a]
readList :: ReadS [DirTreeMaybe a]
$creadPrec :: forall a. Read a => ReadPrec (DirTreeMaybe a)
readPrec :: ReadPrec (DirTreeMaybe a)
$creadListPrec :: forall a. Read a => ReadPrec [DirTreeMaybe a]
readListPrec :: ReadPrec [DirTreeMaybe a]
Read, DirTreeMaybe a -> DirTreeMaybe a -> Bool
(DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> (DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> Eq (DirTreeMaybe a)
forall a. Eq a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
== :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
$c/= :: forall a. Eq a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
/= :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
Eq, Eq (DirTreeMaybe a)
Eq (DirTreeMaybe a) =>
(DirTreeMaybe a -> DirTreeMaybe a -> Ordering)
-> (DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> (DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> (DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> (DirTreeMaybe a -> DirTreeMaybe a -> Bool)
-> (DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a)
-> (DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a)
-> Ord (DirTreeMaybe a)
DirTreeMaybe a -> DirTreeMaybe a -> Bool
DirTreeMaybe a -> DirTreeMaybe a -> Ordering
DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (DirTreeMaybe a)
forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Ordering
forall a.
Ord a =>
DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
$ccompare :: forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Ordering
compare :: DirTreeMaybe a -> DirTreeMaybe a -> Ordering
$c< :: forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
< :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
$c<= :: forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
<= :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
$c> :: forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
> :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
$c>= :: forall a. Ord a => DirTreeMaybe a -> DirTreeMaybe a -> Bool
>= :: DirTreeMaybe a -> DirTreeMaybe a -> Bool
$cmax :: forall a.
Ord a =>
DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
max :: DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
$cmin :: forall a.
Ord a =>
DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
min :: DirTreeMaybe a -> DirTreeMaybe a -> DirTreeMaybe a
Ord, (forall a b. (a -> b) -> DirTreeMaybe a -> DirTreeMaybe b)
-> (forall a b. a -> DirTreeMaybe b -> DirTreeMaybe a)
-> Functor DirTreeMaybe
forall a b. a -> DirTreeMaybe b -> DirTreeMaybe a
forall a b. (a -> b) -> DirTreeMaybe a -> DirTreeMaybe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DirTreeMaybe a -> DirTreeMaybe b
fmap :: forall a b. (a -> b) -> DirTreeMaybe a -> DirTreeMaybe b
$c<$ :: forall a b. a -> DirTreeMaybe b -> DirTreeMaybe a
<$ :: forall a b. a -> DirTreeMaybe b -> DirTreeMaybe a
Functor, (forall m. Monoid m => DirTreeMaybe m -> m)
-> (forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m)
-> (forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m)
-> (forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b)
-> (forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b)
-> (forall a. (a -> a -> a) -> DirTreeMaybe a -> a)
-> (forall a. (a -> a -> a) -> DirTreeMaybe a -> a)
-> (forall a. DirTreeMaybe a -> [a])
-> (forall a. DirTreeMaybe a -> Bool)
-> (forall a. DirTreeMaybe a -> Int)
-> (forall a. Eq a => a -> DirTreeMaybe a -> Bool)
-> (forall a. Ord a => DirTreeMaybe a -> a)
-> (forall a. Ord a => DirTreeMaybe a -> a)
-> (forall a. Num a => DirTreeMaybe a -> a)
-> (forall a. Num a => DirTreeMaybe a -> a)
-> Foldable DirTreeMaybe
forall a. Eq a => a -> DirTreeMaybe a -> Bool
forall a. Num a => DirTreeMaybe a -> a
forall a. Ord a => DirTreeMaybe a -> a
forall m. Monoid m => DirTreeMaybe m -> m
forall a. DirTreeMaybe a -> Bool
forall a. DirTreeMaybe a -> Int
forall a. DirTreeMaybe a -> [a]
forall a. (a -> a -> a) -> DirTreeMaybe a -> a
forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m
forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b
forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => DirTreeMaybe m -> m
fold :: forall m. Monoid m => DirTreeMaybe m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> DirTreeMaybe a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b
foldr :: forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> DirTreeMaybe a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b
foldl :: forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> DirTreeMaybe a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> DirTreeMaybe a -> a
foldr1 :: forall a. (a -> a -> a) -> DirTreeMaybe a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> DirTreeMaybe a -> a
foldl1 :: forall a. (a -> a -> a) -> DirTreeMaybe a -> a
$ctoList :: forall a. DirTreeMaybe a -> [a]
toList :: forall a. DirTreeMaybe a -> [a]
$cnull :: forall a. DirTreeMaybe a -> Bool
null :: forall a. DirTreeMaybe a -> Bool
$clength :: forall a. DirTreeMaybe a -> Int
length :: forall a. DirTreeMaybe a -> Int
$celem :: forall a. Eq a => a -> DirTreeMaybe a -> Bool
elem :: forall a. Eq a => a -> DirTreeMaybe a -> Bool
$cmaximum :: forall a. Ord a => DirTreeMaybe a -> a
maximum :: forall a. Ord a => DirTreeMaybe a -> a
$cminimum :: forall a. Ord a => DirTreeMaybe a -> a
minimum :: forall a. Ord a => DirTreeMaybe a -> a
$csum :: forall a. Num a => DirTreeMaybe a -> a
sum :: forall a. Num a => DirTreeMaybe a -> a
$cproduct :: forall a. Num a => DirTreeMaybe a -> a
product :: forall a. Num a => DirTreeMaybe a -> a
Foldable, Functor DirTreeMaybe
Foldable DirTreeMaybe
(Functor DirTreeMaybe, Foldable DirTreeMaybe) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> DirTreeMaybe a -> f (DirTreeMaybe b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    DirTreeMaybe (f a) -> f (DirTreeMaybe a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> DirTreeMaybe a -> m (DirTreeMaybe b))
-> (forall (m :: * -> *) a.
    Monad m =>
    DirTreeMaybe (m a) -> m (DirTreeMaybe a))
-> Traversable DirTreeMaybe
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DirTreeMaybe (m a) -> m (DirTreeMaybe a)
forall (f :: * -> *) a.
Applicative f =>
DirTreeMaybe (f a) -> f (DirTreeMaybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DirTreeMaybe a -> m (DirTreeMaybe b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTreeMaybe a -> f (DirTreeMaybe b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTreeMaybe a -> f (DirTreeMaybe b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTreeMaybe a -> f (DirTreeMaybe b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
DirTreeMaybe (f a) -> f (DirTreeMaybe a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
DirTreeMaybe (f a) -> f (DirTreeMaybe a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DirTreeMaybe a -> m (DirTreeMaybe b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DirTreeMaybe a -> m (DirTreeMaybe b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
DirTreeMaybe (m a) -> m (DirTreeMaybe a)
sequence :: forall (m :: * -> *) a.
Monad m =>
DirTreeMaybe (m a) -> m (DirTreeMaybe a)
Traversable)

instance Filterable DirTreeMaybe where
  catMaybes :: forall a. DirTreeMaybe (Maybe a) -> DirTreeMaybe a
catMaybes (DirTreeMaybe Maybe (DirTree (Maybe a))
Nothing) = Maybe (DirTree a) -> DirTreeMaybe a
forall a. Maybe (DirTree a) -> DirTreeMaybe a
DirTreeMaybe Maybe (DirTree a)
forall a. Maybe a
Nothing
  catMaybes (DirTreeMaybe (Just DirTree (Maybe a)
x)) = Maybe (DirTree a) -> DirTreeMaybe a
forall a. Maybe (DirTree a) -> DirTreeMaybe a
DirTreeMaybe (Maybe (DirTree a) -> DirTreeMaybe a)
-> Maybe (DirTree a) -> DirTreeMaybe a
forall a b. (a -> b) -> a -> b
$ do
    let go :: DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
        go :: forall a.
DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
go = \case
          DirTree_Dir FilePath
p Map FilePath (DirTree (Maybe a))
xs -> do
            Map FilePath (Maybe (DirTree a))
out <- (DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Map FilePath (DirTree (Maybe a))
-> WriterT
     (Set FilePath) Identity (Map FilePath (Maybe (DirTree a)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map FilePath a -> m (Map FilePath b)
mapM DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a.
DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
go Map FilePath (DirTree (Maybe a))
xs
            Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a. a -> WriterT (Set FilePath) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a b. (a -> b) -> a -> b
$ DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Map FilePath (DirTree a) -> DirTree a
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
p (Map FilePath (DirTree a) -> DirTree a)
-> Map FilePath (DirTree a) -> DirTree a
forall a b. (a -> b) -> a -> b
$ Map FilePath (Maybe (DirTree a)) -> Map FilePath (DirTree a)
forall a. Map FilePath (Maybe a) -> Map FilePath a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes Map FilePath (Maybe (DirTree a))
out
          DirTree_File FilePath
p Maybe a
f -> case Maybe a
f of
            Maybe a
Nothing -> Set FilePath -> WriterT (Set FilePath) Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (FilePath -> Set FilePath
forall a. a -> Set a
Set.singleton FilePath
p) WriterT (Set FilePath) Identity ()
-> Writer (Set FilePath) (Maybe (DirTree a))
-> Writer (Set FilePath) (Maybe (DirTree a))
forall a b.
WriterT (Set FilePath) Identity a
-> WriterT (Set FilePath) Identity b
-> WriterT (Set FilePath) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a. a -> WriterT (Set FilePath) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DirTree a)
forall a. Maybe a
Nothing
            Just a
f' -> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a. a -> WriterT (Set FilePath) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a b. (a -> b) -> a -> b
$ DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
p a
f'
          DirTree_Symlink FilePath
p (Symlink_External FilePath
s Map FilePath (DirTree (Maybe a))
xs) -> do
            Map FilePath (Maybe (DirTree a))
out <- (DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Map FilePath (DirTree (Maybe a))
-> WriterT
     (Set FilePath) Identity (Map FilePath (Maybe (DirTree a)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map FilePath a -> m (Map FilePath b)
mapM DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a.
DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
go Map FilePath (DirTree (Maybe a))
xs
            Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a. a -> WriterT (Set FilePath) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a b. (a -> b) -> a -> b
$ DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
p (FilePath -> Map FilePath (DirTree a) -> Symlink a
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s (Map FilePath (DirTree a) -> Symlink a)
-> Map FilePath (DirTree a) -> Symlink a
forall a b. (a -> b) -> a -> b
$ Map FilePath (Maybe (DirTree a)) -> Map FilePath (DirTree a)
forall a. Map FilePath (Maybe a) -> Map FilePath a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes Map FilePath (Maybe (DirTree a))
out)
          DirTree_Symlink FilePath
p (Symlink_Internal FilePath
s FilePath
r) -> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a. a -> WriterT (Set FilePath) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a)))
-> Maybe (DirTree a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a b. (a -> b) -> a -> b
$
             DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
p (FilePath -> FilePath -> Symlink a
forall a. FilePath -> FilePath -> Symlink a
Symlink_Internal FilePath
s FilePath
r)
        removeStaleSymlinks :: Set FilePath -> DirTree a -> Maybe (DirTree a)
        removeStaleSymlinks :: forall a. Set FilePath -> DirTree a -> Maybe (DirTree a)
removeStaleSymlinks Set FilePath
xs DirTree a
d = case DirTree a
d of
          DirTree_Symlink FilePath
p (Symlink_Internal FilePath
s FilePath
r) ->
            let startingPoint :: FilePath
startingPoint = case FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ DirTree (Maybe a) -> FilePath
forall a. DirTree a -> FilePath
filePath DirTree (Maybe a)
x of
                  FilePath
"." -> FilePath
""
                  FilePath
a -> FilePath
a
            in
              if (FilePath
startingPoint FilePath -> FilePath -> FilePath
</> FilePath
r) FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
xs
              then Maybe (DirTree a)
forall a. Maybe a
Nothing
              else DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
p (FilePath -> FilePath -> Symlink a
forall a. FilePath -> FilePath -> Symlink a
Symlink_Internal FilePath
s FilePath
r)
          DirTree_Symlink FilePath
p (Symlink_External FilePath
s Map FilePath (DirTree a)
cs) ->
            if Map FilePath (DirTree a) -> Bool
forall k a. Map k a -> Bool
Map.null Map FilePath (DirTree a)
cs Bool -> Bool -> Bool
&& FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (DirTree (Maybe a) -> FilePath
forall a. DirTree a -> FilePath
filePath DirTree (Maybe a)
x FilePath -> FilePath -> FilePath
</> FilePath
s) Set FilePath
xs
            then Maybe (DirTree a)
forall a. Maybe a
Nothing
            else DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
p (FilePath -> Map FilePath (DirTree a) -> Symlink a
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s Map FilePath (DirTree a)
cs)
          DirTree_File FilePath
p a
f -> DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
p a
f
          DirTree_Dir FilePath
p Map FilePath (DirTree a)
fs -> DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Map FilePath (DirTree a) -> DirTree a
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
p (Map FilePath (DirTree a) -> DirTree a)
-> Map FilePath (DirTree a) -> DirTree a
forall a b. (a -> b) -> a -> b
$
            Map FilePath (Maybe (DirTree a)) -> Map FilePath (DirTree a)
forall a. Map FilePath (Maybe a) -> Map FilePath a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (Map FilePath (Maybe (DirTree a)) -> Map FilePath (DirTree a))
-> Map FilePath (Maybe (DirTree a)) -> Map FilePath (DirTree a)
forall a b. (a -> b) -> a -> b
$ Set FilePath -> DirTree a -> Maybe (DirTree a)
forall a. Set FilePath -> DirTree a -> Maybe (DirTree a)
removeStaleSymlinks Set FilePath
xs (DirTree a -> Maybe (DirTree a))
-> Map FilePath (DirTree a) -> Map FilePath (Maybe (DirTree a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath (DirTree a)
fs
    let (Maybe (DirTree a)
out, Set FilePath
removals) = Writer (Set FilePath) (Maybe (DirTree a))
-> (Maybe (DirTree a), Set FilePath)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Set FilePath) (Maybe (DirTree a))
 -> (Maybe (DirTree a), Set FilePath))
-> Writer (Set FilePath) (Maybe (DirTree a))
-> (Maybe (DirTree a), Set FilePath)
forall a b. (a -> b) -> a -> b
$ DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
forall a.
DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))
go DirTree (Maybe a)
x
    Set FilePath -> DirTree a -> Maybe (DirTree a)
forall a. Set FilePath -> DirTree a -> Maybe (DirTree a)
removeStaleSymlinks Set FilePath
removals (DirTree a -> Maybe (DirTree a))
-> Maybe (DirTree a) -> Maybe (DirTree a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (DirTree a)
out

instance Witherable DirTreeMaybe

-- | Map a function that could produce an empty result over a 'DirTree'
withDirTreeMaybe
  :: (DirTreeMaybe a -> DirTreeMaybe b)
  -> DirTree a
  -> Maybe (DirTree b)
withDirTreeMaybe :: forall a b.
(DirTreeMaybe a -> DirTreeMaybe b)
-> DirTree a -> Maybe (DirTree b)
withDirTreeMaybe DirTreeMaybe a -> DirTreeMaybe b
f = DirTreeMaybe b -> Maybe (DirTree b)
forall a. DirTreeMaybe a -> Maybe (DirTree a)
unDirTreeMaybe (DirTreeMaybe b -> Maybe (DirTree b))
-> (DirTree a -> DirTreeMaybe b) -> DirTree a -> Maybe (DirTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTreeMaybe a -> DirTreeMaybe b
f (DirTreeMaybe a -> DirTreeMaybe b)
-> (DirTree a -> DirTreeMaybe a) -> DirTree a -> DirTreeMaybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (DirTree a) -> DirTreeMaybe a
forall a. Maybe (DirTree a) -> DirTreeMaybe a
DirTreeMaybe (Maybe (DirTree a) -> DirTreeMaybe a)
-> (DirTree a -> Maybe (DirTree a)) -> DirTree a -> DirTreeMaybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just

-- | Map a function that could produce an empty result in the given functor
withDirTreeMaybeF
  :: Functor f
  => (DirTreeMaybe a -> f (DirTreeMaybe b))
  -> DirTree a
  -> f (Maybe (DirTree b))
withDirTreeMaybeF :: forall (f :: * -> *) a b.
Functor f =>
(DirTreeMaybe a -> f (DirTreeMaybe b))
-> DirTree a -> f (Maybe (DirTree b))
withDirTreeMaybeF DirTreeMaybe a -> f (DirTreeMaybe b)
f = (DirTreeMaybe b -> Maybe (DirTree b))
-> f (DirTreeMaybe b) -> f (Maybe (DirTree b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DirTreeMaybe b -> Maybe (DirTree b)
forall a. DirTreeMaybe a -> Maybe (DirTree a)
unDirTreeMaybe (f (DirTreeMaybe b) -> f (Maybe (DirTree b)))
-> (DirTree a -> f (DirTreeMaybe b))
-> DirTree a
-> f (Maybe (DirTree b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTreeMaybe a -> f (DirTreeMaybe b)
f (DirTreeMaybe a -> f (DirTreeMaybe b))
-> (DirTree a -> DirTreeMaybe a) -> DirTree a -> f (DirTreeMaybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (DirTree a) -> DirTreeMaybe a
forall a. Maybe (DirTree a) -> DirTreeMaybe a
DirTreeMaybe (Maybe (DirTree a) -> DirTreeMaybe a)
-> (DirTree a -> Maybe (DirTree a)) -> DirTree a -> DirTreeMaybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just

-- | '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'.
witherDirTree
  :: Applicative f
  => (a -> f (Maybe b))
  -> DirTree a
  -> f (Maybe (DirTree b))
witherDirTree :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> DirTree a -> f (Maybe (DirTree b))
witherDirTree = (DirTreeMaybe a -> f (DirTreeMaybe b))
-> DirTree a -> f (Maybe (DirTree b))
forall (f :: * -> *) a b.
Functor f =>
(DirTreeMaybe a -> f (DirTreeMaybe b))
-> DirTree a -> f (Maybe (DirTree b))
withDirTreeMaybeF ((DirTreeMaybe a -> f (DirTreeMaybe b))
 -> DirTree a -> f (Maybe (DirTree b)))
-> ((a -> f (Maybe b)) -> DirTreeMaybe a -> f (DirTreeMaybe b))
-> (a -> f (Maybe b))
-> DirTree a
-> f (Maybe (DirTree b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> DirTreeMaybe a -> f (DirTreeMaybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> DirTreeMaybe a -> f (DirTreeMaybe b)
wither

-- | 'filterA' for 'DirTree'. See 'witherDirTree'.
filterADirTree
  :: Applicative f
  => (a -> f Bool)
  -> DirTree a
  -> f (Maybe (DirTree a))
filterADirTree :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> DirTree a -> f (Maybe (DirTree a))
filterADirTree = (DirTreeMaybe a -> f (DirTreeMaybe a))
-> DirTree a -> f (Maybe (DirTree a))
forall (f :: * -> *) a b.
Functor f =>
(DirTreeMaybe a -> f (DirTreeMaybe b))
-> DirTree a -> f (Maybe (DirTree b))
withDirTreeMaybeF ((DirTreeMaybe a -> f (DirTreeMaybe a))
 -> DirTree a -> f (Maybe (DirTree a)))
-> ((a -> f Bool) -> DirTreeMaybe a -> f (DirTreeMaybe a))
-> (a -> f Bool)
-> DirTree a
-> f (Maybe (DirTree a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f Bool) -> DirTreeMaybe a -> f (DirTreeMaybe a)
forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> DirTreeMaybe a -> f (DirTreeMaybe a)
filterA

-- | 'mapMaybe' for 'DirTree'. See 'witherDirTree'.
mapMaybeDirTree :: (a -> Maybe b) -> DirTree a -> Maybe (DirTree b)
mapMaybeDirTree :: forall a b. (a -> Maybe b) -> DirTree a -> Maybe (DirTree b)
mapMaybeDirTree = (DirTreeMaybe a -> DirTreeMaybe b)
-> DirTree a -> Maybe (DirTree b)
forall a b.
(DirTreeMaybe a -> DirTreeMaybe b)
-> DirTree a -> Maybe (DirTree b)
withDirTreeMaybe ((DirTreeMaybe a -> DirTreeMaybe b)
 -> DirTree a -> Maybe (DirTree b))
-> ((a -> Maybe b) -> DirTreeMaybe a -> DirTreeMaybe b)
-> (a -> Maybe b)
-> DirTree a
-> Maybe (DirTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> DirTreeMaybe a -> DirTreeMaybe b
forall a b. (a -> Maybe b) -> DirTreeMaybe a -> DirTreeMaybe b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe

-- | 'catMaybes' for 'DirTree'. See 'witherDirTree'.
catMaybesDirTree :: DirTree (Maybe a) -> Maybe (DirTree a)
catMaybesDirTree :: forall a. DirTree (Maybe a) -> Maybe (DirTree a)
catMaybesDirTree = (DirTreeMaybe (Maybe a) -> DirTreeMaybe a)
-> DirTree (Maybe a) -> Maybe (DirTree a)
forall a b.
(DirTreeMaybe a -> DirTreeMaybe b)
-> DirTree a -> Maybe (DirTree b)
withDirTreeMaybe DirTreeMaybe (Maybe a) -> DirTreeMaybe a
forall a. DirTreeMaybe (Maybe a) -> DirTreeMaybe a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes

-- | 'Data.Witherable.filter' for 'DirTree'. See 'witherDirTree'.
filterDirTree :: (a -> Bool) -> DirTree a -> Maybe (DirTree a)
filterDirTree :: forall a. (a -> Bool) -> DirTree a -> Maybe (DirTree a)
filterDirTree = (DirTreeMaybe a -> DirTreeMaybe a)
-> DirTree a -> Maybe (DirTree a)
forall a b.
(DirTreeMaybe a -> DirTreeMaybe b)
-> DirTree a -> Maybe (DirTree b)
withDirTreeMaybe ((DirTreeMaybe a -> DirTreeMaybe a)
 -> DirTree a -> Maybe (DirTree a))
-> ((a -> Bool) -> DirTreeMaybe a -> DirTreeMaybe a)
-> (a -> Bool)
-> DirTree a
-> Maybe (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> DirTreeMaybe a -> DirTreeMaybe a
forall a. (a -> Bool) -> DirTreeMaybe a -> DirTreeMaybe a
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
Data.Witherable.filter

-- | Remove empty directories from the 'DirTree'
pruneDirTree :: DirTree a -> Maybe (DirTree a)
pruneDirTree :: forall a. DirTree a -> Maybe (DirTree a)
pruneDirTree = \case
  DirTree_Dir FilePath
a Map FilePath (DirTree a)
xs ->
    (Map FilePath (DirTree a) -> DirTree a)
-> Map FilePath (DirTree a) -> Maybe (DirTree a)
forall {k} {a} {a}.
(Map k (DirTree a) -> a) -> Map k (DirTree a) -> Maybe a
sub (FilePath -> Map FilePath (DirTree a) -> DirTree a
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
a) Map FilePath (DirTree a)
xs
  DirTree_File FilePath
a a
f ->
    DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
DirTree_File FilePath
a a
f
  DirTree_Symlink FilePath
a (Symlink_External FilePath
s Map FilePath (DirTree a)
xs) ->
    (Map FilePath (DirTree a) -> DirTree a)
-> Map FilePath (DirTree a) -> Maybe (DirTree a)
forall {k} {a} {a}.
(Map k (DirTree a) -> a) -> Map k (DirTree a) -> Maybe a
sub (FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
a (Symlink a -> DirTree a)
-> (Map FilePath (DirTree a) -> Symlink a)
-> Map FilePath (DirTree a)
-> DirTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Map FilePath (DirTree a) -> Symlink a
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s) Map FilePath (DirTree a)
xs
  DirTree_Symlink FilePath
a (Symlink_Internal FilePath
s FilePath
t) ->
    DirTree a -> Maybe (DirTree a)
forall a. a -> Maybe a
Just (DirTree a -> Maybe (DirTree a)) -> DirTree a -> Maybe (DirTree a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
a (FilePath -> FilePath -> Symlink a
forall a. FilePath -> FilePath -> Symlink a
Symlink_Internal FilePath
s FilePath
t)
  where
    sub :: (Map k (DirTree a) -> a) -> Map k (DirTree a) -> Maybe a
sub Map k (DirTree a) -> a
c Map k (DirTree a)
xs =
      let ys :: Map k (DirTree a)
ys = (DirTree a -> Maybe (DirTree a))
-> Map k (DirTree a) -> Map k (DirTree a)
forall a b. (a -> Maybe b) -> Map k a -> Map k b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe DirTree a -> Maybe (DirTree a)
forall a. DirTree a -> Maybe (DirTree a)
pruneDirTree Map k (DirTree a)
xs
      in if Map k (DirTree a) -> Bool
forall k a. Map k a -> Bool
Map.null Map k (DirTree a)
ys then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Map k (DirTree a) -> a
c Map k (DirTree a)
ys

-- * Display
-- | Produces a tree drawing (using only text) of a 'DirTree' hierarchy.
drawDirTree :: DirTree a -> Text
drawDirTree :: forall a. DirTree a -> Text
drawDirTree = FilePath -> Text
T.pack (FilePath -> Text) -> (DirTree a -> FilePath) -> DirTree a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> a -> FilePath) -> DirTree a -> FilePath
forall a. (FilePath -> a -> FilePath) -> DirTree a -> FilePath
drawDirTreeWith FilePath -> a -> FilePath
forall a b. a -> b -> a
const

-- | Apply a rendering function to each file when drawing the directory hierarchy
drawDirTreeWith :: (String -> a -> String) -> DirTree a -> String
drawDirTreeWith :: forall a. (FilePath -> a -> FilePath) -> DirTree a -> FilePath
drawDirTreeWith FilePath -> a -> FilePath
f = Tree FilePath -> FilePath
DataTree.drawTree (Tree FilePath -> FilePath)
-> (DirTree a -> Tree FilePath) -> DirTree a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> Tree FilePath
pathToTree
  where
    pathToTree :: DirTree a -> Tree FilePath
pathToTree = \case
      DirTree_File FilePath
p a
a ->
        FilePath -> [Tree FilePath] -> Tree FilePath
forall a. a -> [Tree a] -> Tree a
DataTree.Node (FilePath -> a -> FilePath
f (FilePath -> FilePath
takeFileName FilePath
p) a
a) []
      DirTree_Dir FilePath
p Map FilePath (DirTree a)
ps ->
        FilePath -> [Tree FilePath] -> Tree FilePath
forall a. a -> [Tree a] -> Tree a
DataTree.Node (FilePath -> FilePath
takeFileName FilePath
p) ([Tree FilePath] -> Tree FilePath)
-> [Tree FilePath] -> Tree FilePath
forall a b. (a -> b) -> a -> b
$ DirTree a -> Tree FilePath
pathToTree (DirTree a -> Tree FilePath) -> [DirTree a] -> [Tree FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath (DirTree a) -> [DirTree a]
forall k a. Map k a -> [a]
Map.elems Map FilePath (DirTree a)
ps
      DirTree_Symlink FilePath
p (Symlink_Internal FilePath
s FilePath
_) ->
        FilePath -> [Tree FilePath] -> Tree FilePath
forall a. a -> [Tree a] -> Tree a
DataTree.Node (FilePath -> FilePath -> FilePath
showSym FilePath
p FilePath
s) []
      DirTree_Symlink FilePath
p (Symlink_External FilePath
s Map FilePath (DirTree a)
xs) ->
        FilePath -> [Tree FilePath] -> Tree FilePath
forall a. a -> [Tree a] -> Tree a
DataTree.Node (FilePath -> FilePath -> FilePath
showSym FilePath
p FilePath
s) ([Tree FilePath] -> Tree FilePath)
-> [Tree FilePath] -> Tree FilePath
forall a b. (a -> b) -> a -> b
$ DirTree a -> Tree FilePath
pathToTree (DirTree a -> Tree FilePath) -> [DirTree a] -> [Tree FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath (DirTree a) -> [DirTree a]
forall k a. Map k a -> [a]
Map.elems Map FilePath (DirTree a)
xs
    showSym :: FilePath -> FilePath -> FilePath
showSym FilePath
p FilePath
s = FilePath -> FilePath
takeFileName FilePath
p FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" -> " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s

-- | Print the 'DirTree' as a tree. For example:
--
-- @
--
-- System
-- |
-- `- Directory
--    |
--    `- Contents.hs
--
-- @
printDirTree :: DirTree a -> IO ()
printDirTree :: forall a. DirTree a -> IO ()
printDirTree = FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (DirTree a -> FilePath) -> DirTree a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (DirTree a -> Text) -> DirTree a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> Text
forall a. DirTree a -> Text
drawDirTree

-- * Utilities

-- | Make one filepath relative to another
mkRelative :: FilePath -> FilePath -> FilePath
mkRelative :: FilePath -> FilePath -> FilePath
mkRelative FilePath
root FilePath
fp = case FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath -> FilePath
dropTrailingPathSeparator FilePath
root) FilePath
fp of
  Maybe FilePath
Nothing -> []
  Just FilePath
r ->
    -- Remove the leading slash - we know it'll be there because
    -- we removed the trailing slash (if it was there) from the root
    Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
r

-- | Get the first 'Alternative'
alternative :: Alternative f => [f a] -> f a
alternative :: forall (f :: * -> *) a. Alternative f => [f a] -> f a
alternative = Alt f a -> f a
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f a -> f a) -> ([f a] -> Alt f a) -> [f a] -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Alt f a] -> Alt f a
forall a. Monoid a => [a] -> a
mconcat ([Alt f a] -> Alt f a) -> ([f a] -> [Alt f a]) -> [f a] -> Alt f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Alt f a) -> [f a] -> [Alt f a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt