{-# LANGUAGE CPP               #-}
--------------------------------------------------------------------
-- |
-- Module    : System.Directory.Tree
-- Copyright : (c) Brandon Simmons
-- License   : BSD3
--
-- Maintainer:  Brandon Simmons <brandon.m.simmons@gmail.com>
-- 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 { forall a. DirTree a -> FilePath
name :: FileName,
                          forall a. DirTree a -> IOException
err  :: IOException     }
               | Dir    { name     :: FileName,
                          forall a. DirTree a -> [DirTree a]
contents :: [DirTree a] }
               | File   { name :: FileName,
                          forall a. DirTree a -> a
file :: a               }
                 deriving Int -> DirTree a -> ShowS
[DirTree a] -> ShowS
DirTree a -> FilePath
(Int -> DirTree a -> ShowS)
-> (DirTree a -> FilePath)
-> ([DirTree a] -> ShowS)
-> Show (DirTree a)
forall a. Show a => Int -> DirTree a -> ShowS
forall a. Show a => [DirTree a] -> ShowS
forall a. Show a => DirTree a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DirTree a -> ShowS
showsPrec :: Int -> DirTree a -> ShowS
$cshow :: forall a. Show a => DirTree a -> FilePath
show :: DirTree a -> FilePath
$cshowList :: forall a. Show a => [DirTree a] -> ShowS
showList :: [DirTree a] -> ShowS
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 FilePath
n a
a) == :: DirTree a -> DirTree a -> Bool
== (File FilePath
n' a
a') = FilePath
n FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
n' Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
    (Dir FilePath
n [DirTree a]
cs) == (Dir FilePath
n' [DirTree a]
cs') =
        FilePath
n FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
n' Bool -> Bool -> Bool
&& (DirTree a -> DirTree a -> Ordering) -> [DirTree a] -> [DirTree a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr [DirTree a]
cs [DirTree a] -> [DirTree a] -> Bool
forall a. Eq a => a -> a -> Bool
== (DirTree a -> DirTree a -> Ordering) -> [DirTree a] -> [DirTree a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr [DirTree a]
cs'
     -- after comparing above we can hand off to shape equality function:
    DirTree a
d == DirTree a
d' = DirTree a -> DirTree a -> Bool
forall a b. DirTree a -> DirTree b -> Bool
equalShape DirTree a
d DirTree a
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 :: DirTree a -> DirTree a -> Ordering
compare (File FilePath
n a
a) (File FilePath
n' a
a') =
        case FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
n FilePath
n' of
             Ordering
EQ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
a'
             Ordering
el -> Ordering
el
    compare (Dir FilePath
n [DirTree a]
cs) (Dir FilePath
n' [DirTree a]
cs') =
        case FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
n FilePath
n' of
             Ordering
EQ -> ([DirTree a] -> [DirTree a])
-> [DirTree a] -> [DirTree a] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing [DirTree a] -> [DirTree a]
forall a. Ord a => [a] -> [a]
sort [DirTree a]
cs [DirTree a]
cs'
             Ordering
el -> Ordering
el
     -- after comparing above we can hand off to shape ord function:
    compare DirTree a
d DirTree a
d' = DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape DirTree a
d DirTree a
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 = (:/) { forall a. AnchoredDirTree a -> FilePath
anchor :: FilePath, forall a. AnchoredDirTree a -> DirTree a
dirTree :: DirTree a }
                     deriving (Int -> AnchoredDirTree a -> ShowS
[AnchoredDirTree a] -> ShowS
AnchoredDirTree a -> FilePath
(Int -> AnchoredDirTree a -> ShowS)
-> (AnchoredDirTree a -> FilePath)
-> ([AnchoredDirTree a] -> ShowS)
-> Show (AnchoredDirTree a)
forall a. Show a => Int -> AnchoredDirTree a -> ShowS
forall a. Show a => [AnchoredDirTree a] -> ShowS
forall a. Show a => AnchoredDirTree a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AnchoredDirTree a -> ShowS
showsPrec :: Int -> AnchoredDirTree a -> ShowS
$cshow :: forall a. Show a => AnchoredDirTree a -> FilePath
show :: AnchoredDirTree a -> FilePath
$cshowList :: forall a. Show a => [AnchoredDirTree a] -> ShowS
showList :: [AnchoredDirTree a] -> ShowS
Show, Eq (AnchoredDirTree a)
Eq (AnchoredDirTree a) =>
(AnchoredDirTree a -> AnchoredDirTree a -> Ordering)
-> (AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> (AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> (AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> (AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> (AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a)
-> (AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a)
-> Ord (AnchoredDirTree a)
AnchoredDirTree a -> AnchoredDirTree a -> Bool
AnchoredDirTree a -> AnchoredDirTree a -> Ordering
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree 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 (AnchoredDirTree a)
forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> Ordering
forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
$ccompare :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> Ordering
compare :: AnchoredDirTree a -> AnchoredDirTree a -> Ordering
$c< :: forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
< :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$c<= :: forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
<= :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$c> :: forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
> :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$c>= :: forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
>= :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$cmax :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
max :: AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
$cmin :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
min :: AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
Ord, AnchoredDirTree a -> AnchoredDirTree a -> Bool
(AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> (AnchoredDirTree a -> AnchoredDirTree a -> Bool)
-> Eq (AnchoredDirTree a)
forall a. Eq a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
== :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$c/= :: forall a. Eq a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
/= :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
Eq)


-- | an element in a FilePath:
type FileName = String


instance Functor DirTree where
    fmap :: forall a b. (a -> b) -> DirTree a -> DirTree b
fmap = (a -> b) -> DirTree a -> DirTree b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
T.fmapDefault

instance F.Foldable DirTree where
    foldMap :: forall m a. Monoid m => (a -> m) -> DirTree a -> m
foldMap = (a -> m) -> DirTree a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
T.foldMapDefault

instance T.Traversable DirTree where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTree a -> f (DirTree b)
traverse a -> f b
f (Dir FilePath
n [DirTree a]
cs)   = FilePath -> [DirTree b] -> DirTree b
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree b] -> DirTree b) -> f [DirTree b] -> f (DirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirTree a -> f (DirTree b)) -> [DirTree a] -> f [DirTree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
T.traverse ((a -> f b) -> DirTree a -> f (DirTree b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTree a -> f (DirTree b)
T.traverse a -> f b
f) [DirTree a]
cs
    traverse a -> f b
f (File FilePath
n a
a)   = FilePath -> b -> DirTree b
forall a. FilePath -> a -> DirTree a
File FilePath
n (b -> DirTree b) -> f b -> f (DirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    traverse a -> f b
_ (Failed FilePath
n IOException
e) = DirTree b -> f (DirTree b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IOException -> DirTree b
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
n IOException
e)



-- for convenience:
instance Functor AnchoredDirTree where
    fmap :: forall a b. (a -> b) -> AnchoredDirTree a -> AnchoredDirTree b
fmap a -> b
f (FilePath
b:/DirTree a
d) = FilePath
b FilePath -> DirTree b -> AnchoredDirTree b
forall a. FilePath -> DirTree a -> AnchoredDirTree a
:/ (a -> b) -> DirTree a -> DirTree b
forall a b. (a -> b) -> DirTree a -> DirTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DirTree a
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 :: FilePath -> IO (AnchoredDirTree FilePath)
readDirectory = (FilePath -> IO FilePath)
-> FilePath -> IO (AnchoredDirTree FilePath)
forall a. (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWith FilePath -> IO FilePath
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 :: forall a. (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWith FilePath -> IO a
f FilePath
p = Builder a
-> (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
forall a.
Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' Builder a
forall a. Builder a
buildAtOnce' FilePath -> IO a
f FilePath
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 :: forall a. (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWithL FilePath -> IO a
f FilePath
p = Builder a
-> (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
forall a.
Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' Builder a
forall a. Builder a
buildLazilyUnsafe' FilePath -> IO a
f FilePath
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 :: AnchoredDirTree FilePath -> IO (AnchoredDirTree ())
writeDirectory = (FilePath -> FilePath -> IO ())
-> AnchoredDirTree FilePath -> IO (AnchoredDirTree ())
forall a b.
(FilePath -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith FilePath -> FilePath -> IO ()
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 :: forall a b.
(FilePath -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith FilePath -> a -> IO b
f (FilePath
b:/DirTree a
t) = (FilePath
bFilePath -> DirTree b -> AnchoredDirTree b
forall a. FilePath -> DirTree a -> AnchoredDirTree a
:/) (DirTree b -> AnchoredDirTree b)
-> IO (DirTree b) -> IO (AnchoredDirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> DirTree a -> IO (DirTree b)
write' FilePath
b DirTree a
t
    where write' :: FilePath -> DirTree a -> IO (DirTree b)
write' FilePath
b' (File FilePath
n a
a) = FilePath -> IO (DirTree b) -> IO (DirTree b)
forall a. FilePath -> IO (DirTree a) -> IO (DirTree a)
handleDT FilePath
n (IO (DirTree b) -> IO (DirTree b))
-> IO (DirTree b) -> IO (DirTree b)
forall a b. (a -> b) -> a -> b
$
              FilePath -> b -> DirTree b
forall a. FilePath -> a -> DirTree a
File FilePath
n (b -> DirTree b) -> IO b -> IO (DirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> a -> IO b
f (FilePath
b'FilePath -> ShowS
</>FilePath
n) a
a
          write' FilePath
b' (Dir FilePath
n [DirTree a]
cs) = FilePath -> IO (DirTree b) -> IO (DirTree b)
forall a. FilePath -> IO (DirTree a) -> IO (DirTree a)
handleDT FilePath
n (IO (DirTree b) -> IO (DirTree b))
-> IO (DirTree b) -> IO (DirTree b)
forall a b. (a -> b) -> a -> b
$
              do let bas :: FilePath
bas = FilePath
b'FilePath -> ShowS
</>FilePath
n
                 Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
bas
                 FilePath -> [DirTree b] -> DirTree b
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree b] -> DirTree b) -> IO [DirTree b] -> IO (DirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirTree a -> IO (DirTree b)) -> [DirTree a] -> IO [DirTree b]
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 -> DirTree a -> IO (DirTree b)
write' FilePath
bas) [DirTree a]
cs
          write' FilePath
_ (Failed FilePath
n IOException
e) = DirTree b -> IO (DirTree b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirTree b -> IO (DirTree b)) -> DirTree b -> IO (DirTree b)
forall a b. (a -> b) -> a -> b
$ FilePath -> IOException -> DirTree b
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
n IOException
e






    -----------------------------
    --[ LOWER LEVEL FUNCTIONS ]--
    -----------------------------


-- | a simple application of readDirectoryWith openFile:
openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree Handle)
openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree Handle)
openDirectory FilePath
p IOMode
m = (FilePath -> IO Handle) -> FilePath -> IO (AnchoredDirTree Handle)
forall a. (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWith ((FilePath -> IOMode -> IO Handle)
-> IOMode -> FilePath -> IO Handle
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> IOMode -> IO Handle
openFile IOMode
m) FilePath
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 :: FilePath -> IO (AnchoredDirTree FilePath)
build = Builder FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO (AnchoredDirTree FilePath)
forall a.
Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' Builder FilePath
forall a. Builder a
buildAtOnce' FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: FilePath -> IO (AnchoredDirTree FilePath)
buildL = Builder FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO (AnchoredDirTree FilePath)
forall a.
Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' Builder FilePath
forall a. Builder a
buildLazilyUnsafe' FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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' :: forall a.
Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' Builder a
bf' UserIO a
f FilePath
p =
    do DirTree a
tree <- Builder a
bf' UserIO a
f FilePath
p
       AnchoredDirTree a -> IO (AnchoredDirTree a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
baseDir FilePath
p FilePath -> DirTree a -> AnchoredDirTree a
forall a. FilePath -> DirTree a -> AnchoredDirTree a
:/ DirTree a -> DirTree a
forall a. DirTree a -> DirTree a
removeNonexistent DirTree a
tree)



-- IO function passed to our builder and finally executed here:
buildAtOnce' :: Builder a
buildAtOnce' :: forall a. Builder a
buildAtOnce' UserIO a
f FilePath
p = FilePath -> IO (DirTree a) -> IO (DirTree a)
forall a. FilePath -> IO (DirTree a) -> IO (DirTree a)
handleDT FilePath
n (IO (DirTree a) -> IO (DirTree a))
-> IO (DirTree a) -> IO (DirTree a)
forall a b. (a -> b) -> a -> b
$
           do Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
p
              if Bool
isFile
                 then  FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
n (a -> DirTree a) -> IO a -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIO a
f FilePath
p
                 else do [FilePath]
cs <- FilePath -> IO [FilePath]
getDirsFiles FilePath
p
                         FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree a] -> DirTree a) -> IO [DirTree a] -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (DirTree a)) -> [FilePath] -> IO [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) -> [a] -> m [b]
T.mapM (Builder a
forall a. Builder a
buildAtOnce' UserIO a
f (FilePath -> IO (DirTree a)) -> ShowS -> FilePath -> IO (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
combine FilePath
p) [FilePath]
cs
     where n :: FilePath
n = ShowS
topDir FilePath
p


unsafeMapM :: (a -> IO b) -> [a] -> IO [b]
unsafeMapM :: forall a b. (a -> IO b) -> [a] -> IO [b]
unsafeMapM a -> IO b
_    []  = [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
unsafeMapM a -> IO b
f (a
x:[a]
xs) = IO [b] -> IO [b]
forall a. IO a -> IO a
unsafeInterleaveIO IO [b]
io
  where
    io :: IO [b]
io = do
        b
y  <- a -> IO b
f a
x
        [b]
ys <- (a -> IO b) -> [a] -> IO [b]
forall a b. (a -> IO b) -> [a] -> IO [b]
unsafeMapM a -> IO b
f [a]
xs
        [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ys)


-- using unsafeInterleaveIO to get "lazy" traversal:
buildLazilyUnsafe' :: Builder a
buildLazilyUnsafe' :: forall a. Builder a
buildLazilyUnsafe' UserIO a
f FilePath
p = FilePath -> IO (DirTree a) -> IO (DirTree a)
forall a. FilePath -> IO (DirTree a) -> IO (DirTree a)
handleDT FilePath
n (IO (DirTree a) -> IO (DirTree a))
-> IO (DirTree a) -> IO (DirTree a)
forall a b. (a -> b) -> a -> b
$
           do Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
p
              if Bool
isFile
                 then  FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
n (a -> DirTree a) -> IO a -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIO a
f FilePath
p
                 else do
                     [FilePath]
files <- FilePath -> IO [FilePath]
getDirsFiles FilePath
p

                     -- HERE IS THE UNSAFE LINE:
                     [DirTree a]
dirTrees <- (FilePath -> IO (DirTree a)) -> [FilePath] -> IO [DirTree a]
forall a b. (a -> IO b) -> [a] -> IO [b]
unsafeMapM (FilePath -> IO (DirTree a)
rec (FilePath -> IO (DirTree a)) -> ShowS -> FilePath -> IO (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
combine FilePath
p) [FilePath]
files

                     DirTree a -> IO (DirTree a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n [DirTree a]
dirTrees)
     where rec :: FilePath -> IO (DirTree a)
rec = Builder a
forall a. Builder a
buildLazilyUnsafe' UserIO a
f
           n :: FilePath
n = ShowS
topDir FilePath
p




    -----------------
    --[ UTILITIES ]--
    -----------------



---- HANDLING FAILURES ----


-- | True if any Failed constructors in the tree
anyFailed :: DirTree a -> Bool
anyFailed :: forall a. DirTree a -> Bool
anyFailed = Bool -> Bool
not (Bool -> Bool) -> (DirTree a -> Bool) -> DirTree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> Bool
forall a. DirTree a -> Bool
successful

-- | True if there are no Failed constructors in the tree
successful :: DirTree a -> Bool
successful :: forall a. DirTree a -> Bool
successful = [DirTree a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([DirTree a] -> Bool)
-> (DirTree a -> [DirTree a]) -> DirTree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> [DirTree a]
forall a. DirTree a -> [DirTree a]
failures


-- | returns true if argument is a `Failed` constructor:
failed :: DirTree a -> Bool
failed :: forall a. DirTree a -> Bool
failed (Failed FilePath
_ IOException
_) = Bool
True
failed DirTree a
_            = Bool
False


-- | returns a list of 'Failed' constructors only:
failures :: DirTree a -> [DirTree a]
failures :: forall a. DirTree a -> [DirTree a]
failures = (DirTree a -> Bool) -> [DirTree a] -> [DirTree a]
forall a. (a -> Bool) -> [a] -> [a]
filter DirTree a -> Bool
forall a. DirTree a -> Bool
failed ([DirTree a] -> [DirTree a])
-> (DirTree a -> [DirTree a]) -> DirTree a -> [DirTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> [DirTree a]
forall a. DirTree a -> [DirTree a]
flattenDir


-- | maps a function to convert Failed DirTrees to Files or Dirs
failedMap :: (FileName -> IOException -> DirTree a) -> DirTree a -> DirTree a
failedMap :: forall a.
(FilePath -> IOException -> DirTree a) -> DirTree a -> DirTree a
failedMap FilePath -> IOException -> DirTree a
f = (DirTree a -> DirTree a) -> DirTree a -> DirTree a
forall a. (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir DirTree a -> DirTree a
unFail
    where unFail :: DirTree a -> DirTree a
unFail (Failed FilePath
n IOException
e) = FilePath -> IOException -> DirTree a
f FilePath
n IOException
e
          unFail DirTree a
c            = DirTree a
c


---- ORDERING AND EQUALITY ----


-- | Recursively sort a directory tree according to the Ord instance
sortDir :: (Ord a)=> DirTree a -> DirTree a
sortDir :: forall a. Ord a => DirTree a -> DirTree a
sortDir = (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
forall a.
(DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy DirTree a -> DirTree a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Recursively sort a tree as in `sortDir` but ignore the file contents of a
-- File constructor
sortDirShape :: DirTree a -> DirTree a
sortDirShape :: forall a. DirTree a -> DirTree a
sortDirShape = (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
forall a.
(DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape  where

  -- HELPER:
sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy :: forall a.
(DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy DirTree a -> DirTree a -> Ordering
cf = (DirTree a -> DirTree a) -> DirTree a -> DirTree a
forall a. (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir DirTree a -> DirTree a
sortD
    where sortD :: DirTree a -> DirTree a
sortD (Dir FilePath
n [DirTree a]
cs) = FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ((DirTree a -> DirTree a -> Ordering) -> [DirTree a] -> [DirTree a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy DirTree a -> DirTree a -> Ordering
cf [DirTree a]
cs)
          sortD DirTree a
c          = DirTree a
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 :: forall a b. DirTree a -> DirTree b -> Bool
equalShape DirTree a
d DirTree b
d' = DirTree a -> DirTree b -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape DirTree a
d DirTree b
d' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
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 :: forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape (Dir FilePath
n [DirTree a]
cs) (Dir FilePath
n' [DirTree b]
cs') =
    case FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
n FilePath
n' of
         Ordering
EQ -> [DirTree a] -> [DirTree b] -> Ordering
forall {a} {b}. [DirTree a] -> [DirTree b] -> Ordering
comp ([DirTree a] -> [DirTree a]
forall {a}. [DirTree a] -> [DirTree a]
sortCs [DirTree a]
cs) ([DirTree b] -> [DirTree b]
forall {a}. [DirTree a] -> [DirTree a]
sortCs [DirTree b]
cs')
         Ordering
el -> Ordering
el
    where sortCs :: [DirTree a] -> [DirTree a]
sortCs = (DirTree a -> DirTree a -> Ordering) -> [DirTree a] -> [DirTree a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr
           -- stolen from [] Ord instance:
          comp :: [DirTree a] -> [DirTree b] -> Ordering
comp []     []     = Ordering
EQ
          comp []     (DirTree b
_:[DirTree b]
_)  = Ordering
LT
          comp (DirTree a
_:[DirTree a]
_)  []     = Ordering
GT
          comp (DirTree a
x:[DirTree a]
xs) (DirTree b
y:[DirTree b]
ys) = case DirTree a -> DirTree b -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape DirTree a
x DirTree b
y of
                                    Ordering
EQ    -> [DirTree a] -> [DirTree b] -> Ordering
comp [DirTree a]
xs [DirTree b]
ys
                                    Ordering
other -> Ordering
other
 -- else simply compare the flat constructors, non-recursively:
comparingShape DirTree a
t DirTree b
t'  = DirTree a -> DirTree b -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr DirTree a
t DirTree b
t'


 -- HELPER: a non-recursive comparison
comparingConstr :: DirTree a -> DirTree a1 -> Ordering
comparingConstr :: forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr (Failed FilePath
_ IOException
_) (Dir FilePath
_ [DirTree a1]
_)    = Ordering
LT
comparingConstr (Failed FilePath
_ IOException
_) (File FilePath
_ a1
_)   = Ordering
LT
comparingConstr (File FilePath
_ a
_) (Failed FilePath
_ IOException
_)   = Ordering
GT
comparingConstr (File FilePath
_ a
_) (Dir FilePath
_ [DirTree a1]
_)      = Ordering
GT
comparingConstr (Dir FilePath
_ [DirTree a]
_)    (Failed FilePath
_ IOException
_) = Ordering
GT
comparingConstr (Dir FilePath
_ [DirTree a]
_)    (File FilePath
_ a1
_)   = Ordering
LT
 -- else compare on the names of constructors that are the same, without
 -- looking at the contents of Dir constructors:
comparingConstr DirTree a
t DirTree a1
t'  = FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (DirTree a -> FilePath
forall a. DirTree a -> FilePath
name DirTree a
t) (DirTree a1 -> FilePath
forall a. DirTree a -> FilePath
name DirTree a1
t')




---- OTHER ----

{-# DEPRECATED free "Use record 'dirTree'" #-}
-- | DEPRECATED. Use record 'dirTree' instead.
free :: AnchoredDirTree a -> DirTree a
free :: forall a. AnchoredDirTree a -> DirTree a
free = AnchoredDirTree a -> DirTree a
forall a. AnchoredDirTree a -> DirTree a
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 :: forall a.
FilePath -> AnchoredDirTree a -> Maybe (AnchoredDirTree a)
dropTo FilePath
n' (FilePath
p :/ Dir FilePath
n [DirTree a]
ds') = [DirTree a] -> Maybe (AnchoredDirTree a)
forall {a}. [DirTree a] -> Maybe (AnchoredDirTree a)
search [DirTree a]
ds'
    where search :: [DirTree a] -> Maybe (AnchoredDirTree a)
search [] = Maybe (AnchoredDirTree a)
forall a. Maybe a
Nothing
          search (DirTree a
d:[DirTree a]
ds) | FilePath -> FilePath -> Bool
equalFilePath FilePath
n' (DirTree a -> FilePath
forall a. DirTree a -> FilePath
name DirTree a
d) = AnchoredDirTree a -> Maybe (AnchoredDirTree a)
forall a. a -> Maybe a
Just ((FilePath
pFilePath -> ShowS
</>FilePath
n) FilePath -> DirTree a -> AnchoredDirTree a
forall a. FilePath -> DirTree a -> AnchoredDirTree a
:/ DirTree a
d)
                        | Bool
otherwise = [DirTree a] -> Maybe (AnchoredDirTree a)
search [DirTree a]
ds
dropTo FilePath
_ AnchoredDirTree a
_ = Maybe (AnchoredDirTree a)
forall a. Maybe a
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 :: forall a. (DirTree a -> Bool) -> DirTree a -> DirTree a
filterDir DirTree a -> Bool
p = (DirTree a -> DirTree a) -> DirTree a -> DirTree a
forall a. (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir DirTree a -> DirTree a
filterD
    where filterD :: DirTree a -> DirTree a
filterD (Dir FilePath
n [DirTree a]
cs) = FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree a] -> DirTree a) -> [DirTree a] -> DirTree a
forall a b. (a -> b) -> a -> b
$ (DirTree a -> Bool) -> [DirTree a] -> [DirTree a]
forall a. (a -> Bool) -> [a] -> [a]
filter DirTree a -> Bool
p [DirTree a]
cs
          filterD DirTree a
c          = DirTree a
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 :: forall a. DirTree a -> [DirTree a]
flattenDir (Dir FilePath
n [DirTree a]
cs) = FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n [] DirTree a -> [DirTree a] -> [DirTree a]
forall a. a -> [a] -> [a]
: (DirTree a -> [DirTree a]) -> [DirTree a] -> [DirTree a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DirTree a -> [DirTree a]
forall a. DirTree a -> [DirTree a]
flattenDir [DirTree a]
cs
flattenDir DirTree a
f          = [DirTree a
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)
</$> :: forall (f :: * -> *) a b.
Functor f =>
(DirTree a -> DirTree b)
-> f (AnchoredDirTree a) -> f (AnchoredDirTree b)
(</$>) DirTree a -> DirTree b
f = (AnchoredDirTree a -> AnchoredDirTree b)
-> f (AnchoredDirTree a) -> f (AnchoredDirTree b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(FilePath
b :/ DirTree a
t) -> FilePath
b FilePath -> DirTree b -> AnchoredDirTree b
forall a. FilePath -> DirTree a -> AnchoredDirTree a
:/ DirTree a -> DirTree b
f DirTree a
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 :: forall a. AnchoredDirTree a -> DirTree (FilePath, a)
zipPaths (FilePath
b :/ DirTree a
t) = FilePath -> DirTree a -> DirTree (FilePath, a)
forall {b}. FilePath -> DirTree b -> DirTree (FilePath, b)
zipP FilePath
b DirTree a
t
    where zipP :: FilePath -> DirTree b -> DirTree (FilePath, b)
zipP FilePath
p (File FilePath
n b
a)   = FilePath -> (FilePath, b) -> DirTree (FilePath, b)
forall a. FilePath -> a -> DirTree a
File FilePath
n (FilePath
pFilePath -> ShowS
</>FilePath
n , b
a)
          zipP FilePath
p (Dir FilePath
n [DirTree b]
cs)   = FilePath -> [DirTree (FilePath, b)] -> DirTree (FilePath, b)
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree (FilePath, b)] -> DirTree (FilePath, b))
-> [DirTree (FilePath, b)] -> DirTree (FilePath, b)
forall a b. (a -> b) -> a -> b
$ (DirTree b -> DirTree (FilePath, b))
-> [DirTree b] -> [DirTree (FilePath, b)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> DirTree b -> DirTree (FilePath, b)
zipP (FilePath -> DirTree b -> DirTree (FilePath, b))
-> FilePath -> DirTree b -> DirTree (FilePath, b)
forall a b. (a -> b) -> a -> b
$ FilePath
pFilePath -> ShowS
</>FilePath
n) [DirTree b]
cs
          zipP FilePath
_ (Failed FilePath
n IOException
e) = FilePath -> IOException -> DirTree (FilePath, b)
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
n IOException
e


-- extracting pathnames and base names:
topDir, baseDir :: FilePath -> FilePath
topDir :: ShowS
topDir = [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
last ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories
baseDir :: ShowS
baseDir = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
init ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
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 :: forall a. AnchoredDirTree a -> IO (AnchoredDirTree a)
writeJustDirs = (FilePath -> a -> IO a)
-> AnchoredDirTree a -> IO (AnchoredDirTree a)
forall a b.
(FilePath -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith ((a -> IO a) -> FilePath -> a -> IO a
forall a b. a -> b -> a
const a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: FilePath -> IO [FilePath]
getDirsFiles FilePath
cs = do let cs' :: FilePath
cs' = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
cs then FilePath
"." else FilePath
cs
                     [FilePath]
dfs <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
cs'
                     [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
dfs [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath
".",FilePath
".."]



---- FAILURE HELPERS: ----


-- handles an IO exception by returning a Failed constructor filled with that
-- exception:
handleDT :: FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT :: forall a. FilePath -> IO (DirTree a) -> IO (DirTree a)
handleDT FilePath
n = (IOException -> IO (DirTree a)) -> IO (DirTree a) -> IO (DirTree a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (DirTree a -> IO (DirTree a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DirTree a -> IO (DirTree a))
-> (IOException -> DirTree a) -> IOException -> IO (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException -> DirTree a
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
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 :: forall a. DirTree a -> DirTree a
removeNonexistent = (DirTree a -> Bool) -> DirTree a -> DirTree a
forall a. (DirTree a -> Bool) -> DirTree a -> DirTree a
filterDir DirTree a -> Bool
forall a. DirTree a -> Bool
isOkConstructor
     where isOkConstructor :: DirTree a -> Bool
isOkConstructor DirTree a
c = Bool -> Bool
not (DirTree a -> Bool
forall a. DirTree a -> Bool
failed DirTree a
c) Bool -> Bool -> Bool
|| DirTree a -> Bool
forall a. DirTree a -> Bool
isOkError DirTree a
c
           isOkError :: DirTree a -> Bool
isOkError = Bool -> Bool
not (Bool -> Bool) -> (DirTree a -> Bool) -> DirTree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOErrorType -> Bool
isDoesNotExistErrorType (IOErrorType -> Bool)
-> (DirTree a -> IOErrorType) -> DirTree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> IOErrorType
ioeGetErrorType (IOException -> IOErrorType)
-> (DirTree a -> IOException) -> DirTree a -> IOErrorType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> IOException
forall a. DirTree a -> IOException
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 :: forall a. (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir DirTree a -> DirTree a
f DirTree a
t = case DirTree a -> DirTree a
f DirTree a
t of
                     (Dir FilePath
n [DirTree a]
cs) -> FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
n ([DirTree a] -> DirTree a) -> [DirTree a] -> DirTree a
forall a b. (a -> b) -> a -> b
$ (DirTree a -> DirTree a) -> [DirTree a] -> [DirTree a]
forall a b. (a -> b) -> [a] -> [b]
map ((DirTree a -> DirTree a) -> DirTree a -> DirTree a
forall a. (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir DirTree a -> DirTree a
f) [DirTree a]
cs
                     DirTree a
t'         -> DirTree a
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 :: forall (f :: * -> *) a.
Applicative f =>
([DirTree a] -> f [DirTree a]) -> DirTree a -> f (DirTree a)
_contents [DirTree a] -> f [DirTree a]
_f_a6s2 (Failed FilePath
_name_a6s3 IOException
_err_a6s4)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IOException -> DirTree a
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
_name_a6s3 IOException
_err_a6s4)
_contents [DirTree a] -> f [DirTree a]
_f_a6s5 (Dir FilePath
_name_a6s6 [DirTree a]
_contents'_a6s7)
  = ((\ [DirTree a]
_contents_a6s8 -> FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
_name_a6s6 [DirTree a]
_contents_a6s8)
     ([DirTree a] -> DirTree a) -> f [DirTree a] -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([DirTree a] -> f [DirTree a]
_f_a6s5 [DirTree a]
_contents'_a6s7))
_contents [DirTree a] -> f [DirTree a]
_f_a6s9 (File FilePath
_name_a6sa a
_file_a6sb)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
_name_a6sa a
_file_a6sb)
_err :: forall (f :: * -> *) a.
Applicative f =>
(IOException -> f IOException) -> DirTree a -> f (DirTree a)
_err IOException -> f IOException
_f_a6sd (Failed FilePath
_name_a6se IOException
_err'_a6sf)
  = ((\ IOException
_err_a6sg -> FilePath -> IOException -> DirTree a
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
_name_a6se IOException
_err_a6sg)
     (IOException -> DirTree a) -> f IOException -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IOException -> f IOException
_f_a6sd IOException
_err'_a6sf))
_err IOException -> f IOException
_f_a6sh (Dir FilePath
_name_a6si [DirTree a]
_contents_a6sj)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
_name_a6si [DirTree a]
_contents_a6sj)
_err IOException -> f IOException
_f_a6sk (File FilePath
_name_a6sl a
_file_a6sm)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
_name_a6sl a
_file_a6sm)
_file :: forall (f :: * -> *) a.
Applicative f =>
(a -> f a) -> DirTree a -> f (DirTree a)
_file a -> f a
_f_a6so (Failed FilePath
_name_a6sp IOException
_err_a6sq)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IOException -> DirTree a
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
_name_a6sp IOException
_err_a6sq)
_file a -> f a
_f_a6sr (Dir FilePath
_name_a6ss [DirTree a]
_contents_a6st)
  = DirTree a -> f (DirTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
_name_a6ss [DirTree a]
_contents_a6st)
_file a -> f a
_f_a6su (File FilePath
_name_a6sv a
_file'_a6sw)
  = ((\ a
_file_a6sx -> FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
_name_a6sv a
_file_a6sx)
     (a -> DirTree a) -> f a -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a
_f_a6su a
_file'_a6sw))
_name :: forall (f :: * -> *) a.
Functor f =>
(FilePath -> f FilePath) -> DirTree a -> f (DirTree a)
_name FilePath -> f FilePath
_f_a6sz (Failed FilePath
_name'_a6sA IOException
_err_a6sC)
  = ((\ FilePath
_name_a6sB -> FilePath -> IOException -> DirTree a
forall a. FilePath -> IOException -> DirTree a
Failed FilePath
_name_a6sB IOException
_err_a6sC)
     (FilePath -> DirTree a) -> f FilePath -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> f FilePath
_f_a6sz FilePath
_name'_a6sA))
_name FilePath -> f FilePath
_f_a6sD (Dir FilePath
_name'_a6sE [DirTree a]
_contents_a6sG)
  = ((\ FilePath
_name_a6sF -> FilePath -> [DirTree a] -> DirTree a
forall a. FilePath -> [DirTree a] -> DirTree a
Dir FilePath
_name_a6sF [DirTree a]
_contents_a6sG)
     (FilePath -> DirTree a) -> f FilePath -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> f FilePath
_f_a6sD FilePath
_name'_a6sE))
_name FilePath -> f FilePath
_f_a6sH (File FilePath
_name'_a6sI a
_file_a6sK)
  = ((\ FilePath
_name_a6sJ -> FilePath -> a -> DirTree a
forall a. FilePath -> a -> DirTree a
File FilePath
_name_a6sJ a
_file_a6sK)
     (FilePath -> DirTree a) -> f FilePath -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> f FilePath
_f_a6sH FilePath
_name'_a6sI))

--makeLensesFor [("anchor","_anchor"),("dirTree","_dirTree")] ''AnchoredDirTree
_anchor :: forall (f :: * -> *) a.
Functor f =>
(FilePath -> f FilePath)
-> AnchoredDirTree a -> f (AnchoredDirTree a)
_anchor FilePath -> f FilePath
_f_a7wT (FilePath
_anchor'_a7wU :/ DirTree a
_dirTree_a7wW)
  = ((\ FilePath
_anchor_a7wV -> FilePath -> DirTree a -> AnchoredDirTree a
forall a. FilePath -> DirTree a -> AnchoredDirTree a
(:/) FilePath
_anchor_a7wV DirTree a
_dirTree_a7wW)
     (FilePath -> AnchoredDirTree a)
-> f FilePath -> f (AnchoredDirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> f FilePath
_f_a7wT FilePath
_anchor'_a7wU))
_dirTree :: forall (f :: * -> *) t a.
Functor f =>
(DirTree t -> f (DirTree a))
-> AnchoredDirTree t -> f (AnchoredDirTree a)
_dirTree DirTree t -> f (DirTree a)
_f_a7wZ (FilePath
_anchor_a7x0 :/ DirTree t
_dirTree'_a7x1)
  = ((\ DirTree a
_dirTree_a7x2 -> FilePath -> DirTree a -> AnchoredDirTree a
forall a. FilePath -> DirTree a -> AnchoredDirTree a
(:/) FilePath
_anchor_a7x0 DirTree a
_dirTree_a7x2)
     (DirTree a -> AnchoredDirTree a)
-> f (DirTree a) -> f (AnchoredDirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirTree t -> f (DirTree a)
_f_a7wZ DirTree t
_dirTree'_a7x1))