{-# LANGUAGE CPP #-}
module System.Directory.Tree (
DirTree (..)
, AnchoredDirTree (..)
, FileName
, readDirectory
, readDirectoryWith
, readDirectoryWithL
, writeDirectory
, writeDirectoryWith
, build
, buildL
, openDirectory
, writeJustDirs
, zipPaths
, free
, equalShape
, comparingShape
, successful
, anyFailed
, failed
, failures
, failedMap
, flattenDir
, sortDir
, sortDirShape
, filterDir
, transformDir
, dropTo
, (</$>)
, _contents, _err, _file, _name
, _anchor, _dirTree
) where
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
import System.IO.Unsafe(unsafeInterleaveIO)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
data DirTree a = Failed { DirTree a -> FileName
name :: FileName,
DirTree a -> IOException
err :: IOException }
| Dir { name :: FileName,
DirTree a -> [DirTree a]
contents :: [DirTree a] }
| File { name :: FileName,
DirTree a -> a
file :: a }
deriving Int -> DirTree a -> ShowS
[DirTree a] -> ShowS
DirTree a -> FileName
(Int -> DirTree a -> ShowS)
-> (DirTree a -> FileName)
-> ([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 -> FileName
forall a.
(Int -> a -> ShowS) -> (a -> FileName) -> ([a] -> ShowS) -> Show a
showList :: [DirTree a] -> ShowS
$cshowList :: forall a. Show a => [DirTree a] -> ShowS
show :: DirTree a -> FileName
$cshow :: forall a. Show a => DirTree a -> FileName
showsPrec :: Int -> DirTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DirTree a -> ShowS
Show
instance (Eq a)=> Eq (DirTree a) where
(File n :: FileName
n a :: a
a) == :: DirTree a -> DirTree a -> Bool
== (File n' :: FileName
n' a' :: a
a') = FileName
n FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
n' Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
(Dir n :: FileName
n cs :: [DirTree a]
cs) == (Dir n' :: FileName
n' cs' :: [DirTree a]
cs') =
FileName
n FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
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'
d :: DirTree a
d == d' :: DirTree a
d' = DirTree a -> DirTree a -> Bool
forall a b. DirTree a -> DirTree b -> Bool
equalShape DirTree a
d DirTree a
d'
instance (Ord a,Eq a) => Ord (DirTree a) where
compare :: DirTree a -> DirTree a -> Ordering
compare (File n :: FileName
n a :: a
a) (File n' :: FileName
n' a' :: a
a') =
case FileName -> FileName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FileName
n FileName
n' of
EQ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
a'
el :: Ordering
el -> Ordering
el
compare (Dir n :: FileName
n cs :: [DirTree a]
cs) (Dir n' :: FileName
n' cs' :: [DirTree a]
cs') =
case FileName -> FileName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FileName
n FileName
n' of
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'
el :: Ordering
el -> Ordering
el
compare d :: DirTree a
d d' :: DirTree a
d' = DirTree a -> DirTree a -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingShape DirTree a
d DirTree a
d'
data AnchoredDirTree a = (:/) { AnchoredDirTree a -> FileName
anchor :: FilePath, AnchoredDirTree a -> DirTree a
dirTree :: DirTree a }
deriving (Int -> AnchoredDirTree a -> ShowS
[AnchoredDirTree a] -> ShowS
AnchoredDirTree a -> FileName
(Int -> AnchoredDirTree a -> ShowS)
-> (AnchoredDirTree a -> FileName)
-> ([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 -> FileName
forall a.
(Int -> a -> ShowS) -> (a -> FileName) -> ([a] -> ShowS) -> Show a
showList :: [AnchoredDirTree a] -> ShowS
$cshowList :: forall a. Show a => [AnchoredDirTree a] -> ShowS
show :: AnchoredDirTree a -> FileName
$cshow :: forall a. Show a => AnchoredDirTree a -> FileName
showsPrec :: Int -> AnchoredDirTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
min :: AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
$cmin :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
max :: AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
$cmax :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> AnchoredDirTree a
>= :: 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
$c< :: forall a. Ord a => AnchoredDirTree a -> AnchoredDirTree a -> Bool
compare :: AnchoredDirTree a -> AnchoredDirTree a -> Ordering
$ccompare :: forall a.
Ord a =>
AnchoredDirTree a -> AnchoredDirTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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
/= :: AnchoredDirTree a -> AnchoredDirTree a -> Bool
$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
Eq)
type FileName = String
instance Functor DirTree where
fmap :: (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 :: (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 :: (a -> f b) -> DirTree a -> f (DirTree b)
traverse f :: a -> f b
f (Dir n :: FileName
n cs :: [DirTree a]
cs) = FileName -> [DirTree b] -> DirTree b
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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)
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)
T.traverse a -> f b
f) [DirTree a]
cs
traverse f :: a -> f b
f (File n :: FileName
n a :: a
a) = FileName -> b -> DirTree b
forall a. FileName -> a -> DirTree a
File FileName
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 _ (Failed n :: FileName
n e :: IOException
e) = DirTree b -> f (DirTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> IOException -> DirTree b
forall a. FileName -> IOException -> DirTree a
Failed FileName
n IOException
e)
instance Functor AnchoredDirTree where
fmap :: (a -> b) -> AnchoredDirTree a -> AnchoredDirTree b
fmap f :: a -> b
f (b :: FileName
b:/d :: DirTree a
d) = FileName
b FileName -> DirTree b -> AnchoredDirTree b
forall a. FileName -> DirTree a -> AnchoredDirTree a
:/ (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
infixl 4 </$>
readDirectory :: FilePath -> IO (AnchoredDirTree String)
readDirectory :: FileName -> IO (AnchoredDirTree FileName)
readDirectory = (FileName -> IO FileName)
-> FileName -> IO (AnchoredDirTree FileName)
forall a. (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
readDirectoryWith FileName -> IO FileName
readFile
readDirectoryWith :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWith :: (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
readDirectoryWith f :: FileName -> IO a
f p :: FileName
p = Builder a
-> (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
forall a.
Builder a -> UserIO a -> FileName -> IO (AnchoredDirTree a)
buildWith' Builder a
forall a. Builder a
buildAtOnce' FileName -> IO a
f FileName
p
readDirectoryWithL :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a)
readDirectoryWithL :: (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
readDirectoryWithL f :: FileName -> IO a
f p :: FileName
p = Builder a
-> (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
forall a.
Builder a -> UserIO a -> FileName -> IO (AnchoredDirTree a)
buildWith' Builder a
forall a. Builder a
buildLazilyUnsafe' FileName -> IO a
f FileName
p
writeDirectory :: AnchoredDirTree String -> IO (AnchoredDirTree ())
writeDirectory :: AnchoredDirTree FileName -> IO (AnchoredDirTree ())
writeDirectory = (FileName -> FileName -> IO ())
-> AnchoredDirTree FileName -> IO (AnchoredDirTree ())
forall a b.
(FileName -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith FileName -> FileName -> IO ()
writeFile
writeDirectoryWith :: (FilePath -> a -> IO b) -> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith :: (FileName -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith f :: FileName -> a -> IO b
f (b :: FileName
b:/t :: DirTree a
t) = (FileName
bFileName -> DirTree b -> AnchoredDirTree b
forall a. FileName -> 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
<$> FileName -> DirTree a -> IO (DirTree b)
write' FileName
b DirTree a
t
where write' :: FileName -> DirTree a -> IO (DirTree b)
write' b' :: FileName
b' (File n :: FileName
n a :: a
a) = FileName -> IO (DirTree b) -> IO (DirTree b)
forall a. FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT FileName
n (IO (DirTree b) -> IO (DirTree b))
-> IO (DirTree b) -> IO (DirTree b)
forall a b. (a -> b) -> a -> b
$
FileName -> b -> DirTree b
forall a. FileName -> a -> DirTree a
File FileName
n (b -> DirTree b) -> IO b -> IO (DirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileName -> a -> IO b
f (FileName
b'FileName -> ShowS
</>FileName
n) a
a
write' b' :: FileName
b' (Dir n :: FileName
n cs :: [DirTree a]
cs) = FileName -> IO (DirTree b) -> IO (DirTree b)
forall a. FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT FileName
n (IO (DirTree b) -> IO (DirTree b))
-> IO (DirTree b) -> IO (DirTree b)
forall a b. (a -> b) -> a -> b
$
do let bas :: FileName
bas = FileName
b'FileName -> ShowS
</>FileName
n
Bool -> FileName -> IO ()
createDirectoryIfMissing Bool
True FileName
bas
FileName -> [DirTree b] -> DirTree b
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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)
mapM (FileName -> DirTree a -> IO (DirTree b)
write' FileName
bas) [DirTree a]
cs
write' _ (Failed n :: FileName
n e :: IOException
e) = DirTree b -> IO (DirTree b)
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
$ FileName -> IOException -> DirTree b
forall a. FileName -> IOException -> DirTree a
Failed FileName
n IOException
e
openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree Handle)
openDirectory :: FileName -> IOMode -> IO (AnchoredDirTree Handle)
openDirectory p :: FileName
p m :: IOMode
m = (FileName -> IO Handle) -> FileName -> IO (AnchoredDirTree Handle)
forall a. (FileName -> IO a) -> FileName -> IO (AnchoredDirTree a)
readDirectoryWith ((FileName -> IOMode -> IO Handle)
-> IOMode -> FileName -> IO Handle
forall a b c. (a -> b -> c) -> b -> a -> c
flip FileName -> IOMode -> IO Handle
openFile IOMode
m) FileName
p
build :: FilePath -> IO (AnchoredDirTree FilePath)
build :: FileName -> IO (AnchoredDirTree FileName)
build = Builder FileName
-> (FileName -> IO FileName)
-> FileName
-> IO (AnchoredDirTree FileName)
forall a.
Builder a -> UserIO a -> FileName -> IO (AnchoredDirTree a)
buildWith' Builder FileName
forall a. Builder a
buildAtOnce' FileName -> IO FileName
forall (m :: * -> *) a. Monad m => a -> m a
return
buildL :: FilePath -> IO (AnchoredDirTree FilePath)
buildL :: FileName -> IO (AnchoredDirTree FileName)
buildL = Builder FileName
-> (FileName -> IO FileName)
-> FileName
-> IO (AnchoredDirTree FileName)
forall a.
Builder a -> UserIO a -> FileName -> IO (AnchoredDirTree a)
buildWith' Builder FileName
forall a. Builder a
buildLazilyUnsafe' FileName -> IO FileName
forall (m :: * -> *) a. Monad m => a -> m a
return
type UserIO a = FilePath -> IO a
type Builder a = UserIO a -> FilePath -> IO (DirTree a)
buildWith' :: Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a)
buildWith' :: Builder a -> UserIO a -> FileName -> IO (AnchoredDirTree a)
buildWith' bf' :: Builder a
bf' f :: UserIO a
f p :: FileName
p =
do DirTree a
tree <- Builder a
bf' UserIO a
f FileName
p
AnchoredDirTree a -> IO (AnchoredDirTree a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
baseDir FileName
p FileName -> DirTree a -> AnchoredDirTree a
forall a. FileName -> DirTree a -> AnchoredDirTree a
:/ DirTree a -> DirTree a
forall a. DirTree a -> DirTree a
removeNonexistent DirTree a
tree)
buildAtOnce' :: Builder a
buildAtOnce' :: Builder a
buildAtOnce' f :: UserIO a
f p :: FileName
p = FileName -> IO (DirTree a) -> IO (DirTree a)
forall a. FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT FileName
n (IO (DirTree a) -> IO (DirTree a))
-> IO (DirTree a) -> IO (DirTree a)
forall a b. (a -> b) -> a -> b
$
do Bool
isFile <- FileName -> IO Bool
doesFileExist FileName
p
if Bool
isFile
then FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
n (a -> DirTree a) -> IO a -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIO a
f FileName
p
else do [FileName]
cs <- FileName -> IO [FileName]
getDirsFiles FileName
p
FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
n ([DirTree a] -> DirTree a) -> IO [DirTree a] -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileName -> IO (DirTree a)) -> [FileName] -> IO [DirTree a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (Builder a
forall a. Builder a
buildAtOnce' UserIO a
f (FileName -> IO (DirTree a)) -> ShowS -> FileName -> IO (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> ShowS
combine FileName
p) [FileName]
cs
where n :: FileName
n = ShowS
topDir FileName
p
unsafeMapM :: (a -> IO b) -> [a] -> IO [b]
unsafeMapM :: (a -> IO b) -> [a] -> IO [b]
unsafeMapM _ [] = [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
unsafeMapM f :: a -> IO b
f (x :: a
x:xs :: [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 (m :: * -> *) a. Monad m => a -> m a
return (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ys)
buildLazilyUnsafe' :: Builder a
buildLazilyUnsafe' :: Builder a
buildLazilyUnsafe' f :: UserIO a
f p :: FileName
p = FileName -> IO (DirTree a) -> IO (DirTree a)
forall a. FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT FileName
n (IO (DirTree a) -> IO (DirTree a))
-> IO (DirTree a) -> IO (DirTree a)
forall a b. (a -> b) -> a -> b
$
do Bool
isFile <- FileName -> IO Bool
doesFileExist FileName
p
if Bool
isFile
then FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
n (a -> DirTree a) -> IO a -> IO (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIO a
f FileName
p
else do
[FileName]
files <- FileName -> IO [FileName]
getDirsFiles FileName
p
[DirTree a]
dirTrees <- (FileName -> IO (DirTree a)) -> [FileName] -> IO [DirTree a]
forall a b. (a -> IO b) -> [a] -> IO [b]
unsafeMapM (FileName -> IO (DirTree a)
rec (FileName -> IO (DirTree a)) -> ShowS -> FileName -> IO (DirTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> ShowS
combine FileName
p) [FileName]
files
DirTree a -> IO (DirTree a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
n [DirTree a]
dirTrees)
where rec :: FileName -> IO (DirTree a)
rec = Builder a
forall a. Builder a
buildLazilyUnsafe' UserIO a
f
n :: FileName
n = ShowS
topDir FileName
p
anyFailed :: DirTree a -> Bool
anyFailed :: 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
successful :: DirTree a -> Bool
successful :: DirTree a -> Bool
successful = [DirTree 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
failed :: DirTree a -> Bool
failed :: DirTree a -> Bool
failed (Failed _ _) = Bool
True
failed _ = Bool
False
failures :: DirTree a -> [DirTree a]
failures :: 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
failedMap :: (FileName -> IOException -> DirTree a) -> DirTree a -> DirTree a
failedMap :: (FileName -> IOException -> DirTree a) -> DirTree a -> DirTree a
failedMap f :: FileName -> 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 n :: FileName
n e :: IOException
e) = FileName -> IOException -> DirTree a
f FileName
n IOException
e
unFail c :: DirTree a
c = DirTree a
c
sortDir :: (Ord a)=> DirTree a -> DirTree a
sortDir :: 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
sortDirShape :: DirTree a -> DirTree a
sortDirShape :: 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
sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a
sortDirBy cf :: 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 n :: FileName
n cs :: [DirTree a]
cs) = FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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 c :: DirTree a
c = DirTree a
c
equalShape :: DirTree a -> DirTree b -> Bool
equalShape :: DirTree a -> DirTree b -> Bool
equalShape d :: DirTree a
d 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
comparingShape :: DirTree a -> DirTree b -> Ordering
comparingShape :: DirTree a -> DirTree b -> Ordering
comparingShape (Dir n :: FileName
n cs :: [DirTree a]
cs) (Dir n' :: FileName
n' cs' :: [DirTree b]
cs') =
case FileName -> FileName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FileName
n FileName
n' of
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')
el :: 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
comp :: [DirTree a] -> [DirTree b] -> Ordering
comp [] [] = Ordering
EQ
comp [] (_:_) = Ordering
LT
comp (_:_) [] = Ordering
GT
comp (x :: DirTree a
x:xs :: [DirTree a]
xs) (y :: DirTree b
y:ys :: [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
EQ -> [DirTree a] -> [DirTree b] -> Ordering
comp [DirTree a]
xs [DirTree b]
ys
other :: Ordering
other -> Ordering
other
comparingShape t :: DirTree a
t t' :: DirTree b
t' = DirTree a -> DirTree b -> Ordering
forall a a1. DirTree a -> DirTree a1 -> Ordering
comparingConstr DirTree a
t DirTree b
t'
comparingConstr :: DirTree a -> DirTree a1 -> Ordering
comparingConstr :: DirTree a -> DirTree a1 -> Ordering
comparingConstr (Failed _ _) (Dir _ _) = Ordering
LT
comparingConstr (Failed _ _) (File _ _) = Ordering
LT
comparingConstr (File _ _) (Failed _ _) = Ordering
GT
comparingConstr (File _ _) (Dir _ _) = Ordering
GT
comparingConstr (Dir _ _) (Failed _ _) = Ordering
GT
comparingConstr (Dir _ _) (File _ _) = Ordering
LT
comparingConstr t :: DirTree a
t t' :: DirTree a1
t' = FileName -> FileName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (DirTree a -> FileName
forall a. DirTree a -> FileName
name DirTree a
t) (DirTree a1 -> FileName
forall a. DirTree a -> FileName
name DirTree a1
t')
{-# DEPRECATED free "Use record 'dirTree'" #-}
free :: AnchoredDirTree a -> DirTree a
free :: AnchoredDirTree a -> DirTree a
free = AnchoredDirTree a -> DirTree a
forall a. AnchoredDirTree a -> DirTree a
dirTree
dropTo :: FileName -> AnchoredDirTree a -> Maybe (AnchoredDirTree a)
dropTo :: FileName -> AnchoredDirTree a -> Maybe (AnchoredDirTree a)
dropTo n' :: FileName
n' (p :: FileName
p :/ Dir n :: FileName
n ds' :: [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 (d :: DirTree a
d:ds :: [DirTree a]
ds) | FileName -> FileName -> Bool
equalFilePath FileName
n' (DirTree a -> FileName
forall a. DirTree a -> FileName
name DirTree a
d) = AnchoredDirTree a -> Maybe (AnchoredDirTree a)
forall a. a -> Maybe a
Just ((FileName
pFileName -> ShowS
</>FileName
n) FileName -> DirTree a -> AnchoredDirTree a
forall a. FileName -> DirTree a -> AnchoredDirTree a
:/ DirTree a
d)
| Bool
otherwise = [DirTree a] -> Maybe (AnchoredDirTree a)
search [DirTree a]
ds
dropTo _ _ = Maybe (AnchoredDirTree a)
forall a. Maybe a
Nothing
filterDir :: (DirTree a -> Bool) -> DirTree a -> DirTree a
filterDir :: (DirTree a -> Bool) -> DirTree a -> DirTree a
filterDir p :: 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 n :: FileName
n cs :: [DirTree a]
cs) = FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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 c :: DirTree a
c = DirTree a
c
flattenDir :: DirTree a -> [ DirTree a ]
flattenDir :: DirTree a -> [DirTree a]
flattenDir (Dir n :: FileName
n cs :: [DirTree a]
cs) = FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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 f :: DirTree a
f = [DirTree a
f]
(</$>) :: (Functor f) => (DirTree a -> DirTree b) -> f (AnchoredDirTree a) ->
f (AnchoredDirTree b)
</$> :: (DirTree a -> DirTree b)
-> f (AnchoredDirTree a) -> f (AnchoredDirTree b)
(</$>) f :: DirTree a -> DirTree b
f = (AnchoredDirTree a -> AnchoredDirTree b)
-> f (AnchoredDirTree a) -> f (AnchoredDirTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b :: FileName
b :/ t :: DirTree a
t) -> FileName
b FileName -> DirTree b -> AnchoredDirTree b
forall a. FileName -> DirTree a -> AnchoredDirTree a
:/ DirTree a -> DirTree b
f DirTree a
t)
zipPaths :: AnchoredDirTree a -> DirTree (FilePath, a)
zipPaths :: AnchoredDirTree a -> DirTree (FileName, a)
zipPaths (b :: FileName
b :/ t :: DirTree a
t) = FileName -> DirTree a -> DirTree (FileName, a)
forall b. FileName -> DirTree b -> DirTree (FileName, b)
zipP FileName
b DirTree a
t
where zipP :: FileName -> DirTree b -> DirTree (FileName, b)
zipP p :: FileName
p (File n :: FileName
n a :: b
a) = FileName -> (FileName, b) -> DirTree (FileName, b)
forall a. FileName -> a -> DirTree a
File FileName
n (FileName
pFileName -> ShowS
</>FileName
n , b
a)
zipP p :: FileName
p (Dir n :: FileName
n cs :: [DirTree b]
cs) = FileName -> [DirTree (FileName, b)] -> DirTree (FileName, b)
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
n ([DirTree (FileName, b)] -> DirTree (FileName, b))
-> [DirTree (FileName, b)] -> DirTree (FileName, b)
forall a b. (a -> b) -> a -> b
$ (DirTree b -> DirTree (FileName, b))
-> [DirTree b] -> [DirTree (FileName, b)]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> DirTree b -> DirTree (FileName, b)
zipP (FileName -> DirTree b -> DirTree (FileName, b))
-> FileName -> DirTree b -> DirTree (FileName, b)
forall a b. (a -> b) -> a -> b
$ FileName
pFileName -> ShowS
</>FileName
n) [DirTree b]
cs
zipP _ (Failed n :: FileName
n e :: IOException
e) = FileName -> IOException -> DirTree (FileName, b)
forall a. FileName -> IOException -> DirTree a
Failed FileName
n IOException
e
topDir, baseDir :: FilePath -> FilePath
topDir :: ShowS
topDir = [FileName] -> FileName
forall a. [a] -> a
last ([FileName] -> FileName) -> (FileName -> [FileName]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> [FileName]
splitDirectories
baseDir :: ShowS
baseDir = [FileName] -> FileName
joinPath ([FileName] -> FileName) -> (FileName -> [FileName]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileName] -> [FileName]
forall a. [a] -> [a]
init ([FileName] -> [FileName])
-> (FileName -> [FileName]) -> FileName -> [FileName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> [FileName]
splitDirectories
writeJustDirs :: AnchoredDirTree a -> IO (AnchoredDirTree a)
writeJustDirs :: AnchoredDirTree a -> IO (AnchoredDirTree a)
writeJustDirs = (FileName -> a -> IO a)
-> AnchoredDirTree a -> IO (AnchoredDirTree a)
forall a b.
(FileName -> a -> IO b)
-> AnchoredDirTree a -> IO (AnchoredDirTree b)
writeDirectoryWith ((a -> IO a) -> FileName -> a -> IO a
forall a b. a -> b -> a
const a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return)
getDirsFiles :: String -> IO [FilePath]
getDirsFiles :: FileName -> IO [FileName]
getDirsFiles cs :: FileName
cs = do let cs' :: FileName
cs' = if FileName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FileName
cs then "." else FileName
cs
[FileName]
dfs <- FileName -> IO [FileName]
getDirectoryContents FileName
cs'
[FileName] -> IO [FileName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileName] -> IO [FileName]) -> [FileName] -> IO [FileName]
forall a b. (a -> b) -> a -> b
$ [FileName]
dfs [FileName] -> [FileName] -> [FileName]
forall a. Eq a => [a] -> [a] -> [a]
\\ [".",".."]
handleDT :: FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT :: FileName -> IO (DirTree a) -> IO (DirTree a)
handleDT n :: FileName
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 (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
. FileName -> IOException -> DirTree a
forall a. FileName -> IOException -> DirTree a
Failed FileName
n)
removeNonexistent :: DirTree a -> DirTree a
removeNonexistent :: 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 c :: 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
transformDir :: (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir :: (DirTree a -> DirTree a) -> DirTree a -> DirTree a
transformDir f :: DirTree a -> DirTree a
f t :: DirTree a
t = case DirTree a -> DirTree a
f DirTree a
t of
(Dir n :: FileName
n cs :: [DirTree a]
cs) -> FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
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
t' :: DirTree a
t' -> DirTree a
t'
_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)
_contents :: ([DirTree a] -> f [DirTree a]) -> DirTree a -> f (DirTree a)
_contents _f_a6s2 :: [DirTree a] -> f [DirTree a]
_f_a6s2 (Failed _name_a6s3 :: FileName
_name_a6s3 _err_a6s4 :: IOException
_err_a6s4)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> IOException -> DirTree a
forall a. FileName -> IOException -> DirTree a
Failed FileName
_name_a6s3 IOException
_err_a6s4)
_contents _f_a6s5 :: [DirTree a] -> f [DirTree a]
_f_a6s5 (Dir _name_a6s6 :: FileName
_name_a6s6 _contents'_a6s7 :: [DirTree a]
_contents'_a6s7)
= ((\ _contents_a6s8 :: [DirTree a]
_contents_a6s8 -> FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
_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 _f_a6s9 :: [DirTree a] -> f [DirTree a]
_f_a6s9 (File _name_a6sa :: FileName
_name_a6sa _file_a6sb :: a
_file_a6sb)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
_name_a6sa a
_file_a6sb)
_err :: (IOException -> f IOException) -> DirTree a -> f (DirTree a)
_err _f_a6sd :: IOException -> f IOException
_f_a6sd (Failed _name_a6se :: FileName
_name_a6se _err'_a6sf :: IOException
_err'_a6sf)
= ((\ _err_a6sg :: IOException
_err_a6sg -> FileName -> IOException -> DirTree a
forall a. FileName -> IOException -> DirTree a
Failed FileName
_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 _f_a6sh :: IOException -> f IOException
_f_a6sh (Dir _name_a6si :: FileName
_name_a6si _contents_a6sj :: [DirTree a]
_contents_a6sj)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
_name_a6si [DirTree a]
_contents_a6sj)
_err _f_a6sk :: IOException -> f IOException
_f_a6sk (File _name_a6sl :: FileName
_name_a6sl _file_a6sm :: a
_file_a6sm)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
_name_a6sl a
_file_a6sm)
_file :: (a -> f a) -> DirTree a -> f (DirTree a)
_file _f_a6so :: a -> f a
_f_a6so (Failed _name_a6sp :: FileName
_name_a6sp _err_a6sq :: IOException
_err_a6sq)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> IOException -> DirTree a
forall a. FileName -> IOException -> DirTree a
Failed FileName
_name_a6sp IOException
_err_a6sq)
_file _f_a6sr :: a -> f a
_f_a6sr (Dir _name_a6ss :: FileName
_name_a6ss _contents_a6st :: [DirTree a]
_contents_a6st)
= DirTree a -> f (DirTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
_name_a6ss [DirTree a]
_contents_a6st)
_file _f_a6su :: a -> f a
_f_a6su (File _name_a6sv :: FileName
_name_a6sv _file'_a6sw :: a
_file'_a6sw)
= ((\ _file_a6sx :: a
_file_a6sx -> FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
_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 :: (FileName -> f FileName) -> DirTree a -> f (DirTree a)
_name _f_a6sz :: FileName -> f FileName
_f_a6sz (Failed _name'_a6sA :: FileName
_name'_a6sA _err_a6sC :: IOException
_err_a6sC)
= ((\ _name_a6sB :: FileName
_name_a6sB -> FileName -> IOException -> DirTree a
forall a. FileName -> IOException -> DirTree a
Failed FileName
_name_a6sB IOException
_err_a6sC)
(FileName -> DirTree a) -> f FileName -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileName -> f FileName
_f_a6sz FileName
_name'_a6sA))
_name _f_a6sD :: FileName -> f FileName
_f_a6sD (Dir _name'_a6sE :: FileName
_name'_a6sE _contents_a6sG :: [DirTree a]
_contents_a6sG)
= ((\ _name_a6sF :: FileName
_name_a6sF -> FileName -> [DirTree a] -> DirTree a
forall a. FileName -> [DirTree a] -> DirTree a
Dir FileName
_name_a6sF [DirTree a]
_contents_a6sG)
(FileName -> DirTree a) -> f FileName -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileName -> f FileName
_f_a6sD FileName
_name'_a6sE))
_name _f_a6sH :: FileName -> f FileName
_f_a6sH (File _name'_a6sI :: FileName
_name'_a6sI _file_a6sK :: a
_file_a6sK)
= ((\ _name_a6sJ :: FileName
_name_a6sJ -> FileName -> a -> DirTree a
forall a. FileName -> a -> DirTree a
File FileName
_name_a6sJ a
_file_a6sK)
(FileName -> DirTree a) -> f FileName -> f (DirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileName -> f FileName
_f_a6sH FileName
_name'_a6sI))
_anchor :: (FileName -> f FileName)
-> AnchoredDirTree a -> f (AnchoredDirTree a)
_anchor _f_a7wT :: FileName -> f FileName
_f_a7wT (_anchor'_a7wU :: FileName
_anchor'_a7wU :/ _dirTree_a7wW :: DirTree a
_dirTree_a7wW)
= ((\ _anchor_a7wV :: FileName
_anchor_a7wV -> FileName -> DirTree a -> AnchoredDirTree a
forall a. FileName -> DirTree a -> AnchoredDirTree a
(:/) FileName
_anchor_a7wV DirTree a
_dirTree_a7wW)
(FileName -> AnchoredDirTree a)
-> f FileName -> f (AnchoredDirTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileName -> f FileName
_f_a7wT FileName
_anchor'_a7wU))
_dirTree :: (DirTree t -> f (DirTree a))
-> AnchoredDirTree t -> f (AnchoredDirTree a)
_dirTree _f_a7wZ :: DirTree t -> f (DirTree a)
_f_a7wZ (_anchor_a7x0 :: FileName
_anchor_a7x0 :/ _dirTree'_a7x1 :: DirTree t
_dirTree'_a7x1)
= ((\ _dirTree_a7x2 :: DirTree a
_dirTree_a7x2 -> FileName -> DirTree a -> AnchoredDirTree a
forall a. FileName -> DirTree a -> AnchoredDirTree a
(:/) FileName
_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))