darcs-cabalized-2.0.2: src/Darcs/SlurpDirectory.lhs
% Copyright (C) 2002-2004 David Roundy
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
\chapter{SlurpDirectory}
\section{Introduction}
SlurpDirectory is intended to give a nice lazy way of traversing directory
trees.
\begin{code}
{-# OPTIONS_GHC -cpp #-}
module Darcs.SlurpDirectory ( Slurpy(..), FileContents, empty_slurpy,
slurp, mmap_slurp, slurp_unboring, co_slurp,
slurp_name, is_file, is_dir,
get_filecontents, get_dircontents, get_mtime,
get_length, get_slurp,
get_slurp_context, get_slurp_context_maybe,
get_slurp_context_list,
slurp_removefile, slurp_removedir,
slurp_remove,
slurp_modfile, slurp_hasfile, slurp_hasdir,
slurp_has_anycase, wait_a_moment, undefined_time,
undefined_size,
slurp_has, list_slurpy, list_slurpy_files,
get_path_list,
list_slurpy_dirs,
isFileReallySymlink,
doesFileReallyExist, doesDirectoryReallyExist,
SlurpMonad(..), withSlurpy, write_files
) where
import System.IO
import System.Directory hiding ( getCurrentDirectory, renameFile )
import Workaround ( getCurrentDirectory )
import Darcs.Utils ( withCurrentDirectory, formatPath )
import System.IO.Unsafe ( unsafeInterleaveIO )
import Data.List ( sort, tails, isPrefixOf )
import Control.Monad ( MonadPlus(..) )
import Data.Char ( toLower )
import System.Posix.Types ( EpochTime, FileOffset )
import System.Posix.Files
( getSymbolicLinkStatus, modificationTime,
fileSize,
isRegularFile, isDirectory, isSymbolicLink
)
import System.Posix ( sleep )
import Data.Maybe ( catMaybes, isJust, maybeToList )
import Darcs.SignalHandler ( tryNonSignal )
import Darcs.CheckFileSystem ( can_I_use_mmap )
import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )
import FastPackedString
import FileName ( FileName, fn2fp, fp2fn, norm_path, break_on_dir,
own_name, super_name,
)
#include "impossible.h"
data Slurpy = SlurpDir FileName (Maybe String) [Slurpy]
| SlurpFile FileName (Maybe String,EpochTime,FileOffset) FileContents
type FileContents = PackedString
instance Show Slurpy where
show (SlurpDir fn _ l) =
"Dir " ++ (fn2fp fn) ++ "\n" ++
concat (map show l) ++ "End Dir " ++ (fn2fp fn) ++ "\n"
show (SlurpFile fn _ _) = "File " ++ (fn2fp fn) ++ "\n"
slurp :: FilePath -> IO Slurpy
mmap_slurp :: FilePath -> IO Slurpy
slurp_unboring :: (FilePath->Bool) -> FilePath -> IO Slurpy
empty_slurpy :: Slurpy
empty_slurpy = SlurpDir (fp2fn ".") Nothing []
slurp_name :: Slurpy -> FilePath
is_file :: Slurpy -> Bool
is_dir :: Slurpy -> Bool
get_filecontents :: Slurpy -> FileContents
get_dircontents :: Slurpy -> [Slurpy]
get_mtime :: Slurpy -> EpochTime
get_length :: Slurpy -> FileOffset
instance Eq Slurpy where
s1 == s2 = (slurp_name s1) == (slurp_name s2)
instance Ord Slurpy where
s1 <= s2 = (slurp_name s1) <= (slurp_name s2)
\end{code}
\begin{code}
data SlurpMonad a = SM ((Either String Slurpy)
-> Either String (Slurpy, a))
mksm :: (Slurpy -> Either String (Slurpy, a)) -> SlurpMonad a
mksm x = SM sm where sm (Left e) = Left e
sm (Right s) = x s
instance Monad SlurpMonad where
(SM p) >>= k = SM sm
where sm e = case p e of
Left er -> Left er
Right (s, a) -> case k a of
(SM q) -> q (Right s)
return a = SM ( \s -> case s of
Left e -> Left e
Right x -> Right (x, a) )
fail e = SM ( \s -> case s of
Left x -> Left x
_ -> Left e )
instance MonadPlus SlurpMonad where
mzero = fail "SlurpMonad mzero"
(SM p) `mplus` (SM q) = SM sm
where sm e = case p e of
Left _ -> q e
okay -> okay
instance ReadableDirectory SlurpMonad where
mDoesDirectoryExist d = smDoesDirectoryExist d
mDoesFileExist f = smDoesFileExist f
mInCurrentDirectory = smInSlurpy
mGetDirectoryContents = smGetDirContents
mReadFilePS = smReadFilePS
mReadFilePSs = smReadFilePSs
instance WriteableDirectory SlurpMonad where
mWithCurrentDirectory = modifySubSlurpy
mSetFileExecutable _ _ = return ()
mWriteFilePS = smWriteFilePS
mCreateDirectory = smCreateDirectory
mRename = smRename
mRemoveDirectory = smRemoveDirectory
mRemoveFile = smRemoveFile
\end{code}
\begin{code}
write_file :: Slurpy -> FileName -> IO ()
write_file s fn = case withSlurpy s $ smReadFilePS fn of
Left err -> fail err
Right (_, c) -> do
ensureDirectories (super_name fn)
mWriteFilePS fn c
try_write_file :: Slurpy -> FilePath -> IO ()
try_write_file s fp = let fn = fp2fn fp in
if slurp_hasfile fn s
then write_file s fn
else if slurp_hasdir fn s
then ensureDirectories fn
else return ()
ensureDirectories :: WriteableDirectory m => FileName -> m ()
ensureDirectories d = do
isPar <- mDoesDirectoryExist d
if isPar
then return ()
else ensureDirectories (super_name d) >> (mCreateDirectory d)
write_files :: Slurpy -> [FilePath] -> IO ()
write_files s fps = mapM_ (try_write_file s) fps
withSlurpy :: Slurpy -> SlurpMonad a -> Either String (Slurpy, a)
withSlurpy s (SM f) = f (Right s)
smDoesDirectoryExist :: FileName -> SlurpMonad Bool
smDoesDirectoryExist d = mksm $ \s -> (Right (s, slurp_hasdir d s))
smDoesFileExist :: FileName -> SlurpMonad Bool
smDoesFileExist f = mksm $ \s -> (Right (s, slurp_hasfile f s))
-- smInSlurpy doesn't make any changes to the subdirectory.
smInSlurpy :: FileName -> SlurpMonad a -> SlurpMonad a
smInSlurpy d job = mksm sm
where sm s = case get_slurp d s of
Just s' | is_dir s' -> case withSlurpy s' job of
Left e -> Left e
Right (_,a) -> Right (s, a)
_ -> Left $ "smInSlurpy: Couldn't find directory " ++
formatPath (fn2fp d)
fromSlurpFile :: FileName -> (Slurpy -> a) -> SlurpMonad a
fromSlurpFile f job = mksm sm
where sm s = case get_slurp f s of
Just s' | is_file s' -> Right (s, job s')
_ -> Left $ "fromSlurpFile: Couldn't find file " ++
formatPath (fn2fp f)
modifySubSlurpy :: FileName -> SlurpMonad a -> SlurpMonad a
modifySubSlurpy d job = mksm sm
where sm s = case get_slurp_context d s of
Just (ctx, sub@(SlurpDir _ _ _)) ->
case withSlurpy sub job of
Left e -> Left e
Right (sub',a) -> Right (ctx sub', a)
_ -> Left $ "modifySubSlurpy: Couldn't find directory " ++
formatPath (fn2fp d)
modifyFileSlurpy :: FileName -> (Slurpy -> Slurpy) -> SlurpMonad ()
modifyFileSlurpy f job = mksm sm
where sm s = case get_slurp_context f s of
Just (ctx, sf@(SlurpFile _ _ _)) -> Right (ctx $ job sf, ())
_ -> Left $ "modifyFileSlurpy: Couldn't find file " ++
formatPath (fn2fp f)
insertSlurpy :: FileName -> Slurpy -> SlurpMonad ()
insertSlurpy f news = mksm $ \s ->
if slurp_hasfile f s || slurp_hasdir f s || not (slurp_hasdir (super_name f) s)
then Left $ "Error creating file "++fn2fp f
else Right (addslurp f news s, ())
smReadFilePS :: FileName -> SlurpMonad PackedString
smReadFilePS f = fromSlurpFile f get_filecontents
smReadFilePSs :: FileName -> SlurpMonad [PackedString]
smReadFilePSs f = fromSlurpFile f (linesPS . get_filecontents)
smGetDirContents :: SlurpMonad [FileName]
smGetDirContents = mksm $ \s -> Right (s, map slurp_fn $ get_dircontents s)
smWriteFilePS :: FileName -> PackedString -> SlurpMonad ()
smWriteFilePS f ps = modifyFileSlurpy f (\_ -> sl)
`mplus` insertSlurpy f sl
where sl = SlurpFile (own_name f) undef_time_size ps
smCreateDirectory :: FileName -> SlurpMonad ()
smCreateDirectory a = mksm sm
where sm s = case slurp_adddir a s of
Just s' -> Right (s', ())
Nothing -> Left $ "Error creating directory "++fn2fp a
smRename :: FileName -> FileName -> SlurpMonad ()
smRename a b = mksm sm
where sm s = case slurp_move a b s of
Just s' -> Right (s', ())
Nothing ->
-- Workaround for some old patches having moves when the source file doesn't exist.
if (slurp_has (fn2fp a) s)
then Left $ "Error moving "++fn2fp a++" to "++fn2fp b
else Right (s, ())
smRemove :: FileName -> SlurpMonad ()
smRemove f = mksm sm
where sm s = case slurp_remove f s of
Nothing -> Left $ fn2fp f++" does not exist."
Just s' -> Right (s', ())
smRemoveFile :: FileName -> SlurpMonad ()
smRemoveFile f =
do exists <- mDoesFileExist f
if exists then smRemove f
else fail $ "File "++fn2fp f++" does not exist."
smRemoveDirectory :: FileName -> SlurpMonad ()
smRemoveDirectory f =
do exists <- mDoesDirectoryExist f
if exists then smRemove f
else fail $ "Directory "++fn2fp f++" does not exist."
\end{code}
Here are a few access functions.
\begin{code}
slurp_name (SlurpFile f _ _) = fn2fp f
slurp_name (SlurpDir d _ _) = fn2fp d
slurp_fn :: Slurpy -> FileName
slurp_fn (SlurpFile f _ _) = f
slurp_fn (SlurpDir d _ _) = d
slurp_setname :: FileName -> Slurpy -> Slurpy
slurp_setname f (SlurpDir _ x c) = SlurpDir f x c
slurp_setname f (SlurpFile _ m c) = SlurpFile f m c
is_file (SlurpDir _ _ _) = False
is_file (SlurpFile _ _ _) = True
is_dir (SlurpDir _ _ _) = True
is_dir (SlurpFile _ _ _) = False
get_filecontents (SlurpFile _ _ c) = c
get_filecontents _ = bug "Can't get_filecontents on SlurpDir."
get_dircontents (SlurpDir _ _ c) = sort c
get_dircontents _ = bug "Can't get_dircontents on SlurpFile."
get_mtime (SlurpFile _ (_,t,_) _) = t
get_mtime _ = bug "can't get_mtime on SlurpDir."
get_length (SlurpFile _ (_,_,l) _) = l
get_length _ = bug "can't get_length on SlurpDir."
undefined_time :: EpochTime
undefined_time = -1
undefined_size :: FileOffset
undefined_size = -1
undef_time_size :: (Maybe String, EpochTime, FileOffset)
undef_time_size = (Nothing, undefined_time, undefined_size)
wait_a_moment :: IO ()
wait_a_moment = do { sleep 1; return () }
-- HACKERY: In ghc 6.1, sleep has the type signature IO Int; it
-- returns an integer just like sleep(3) does. To stay compatible
-- with older versions, though, we just ignore sleep's return
-- value. Hackery, like I said.
isFileReallySymlink :: FilePath -> IO Bool
isFileReallySymlink f = do fs <- getSymbolicLinkStatus f
return (isSymbolicLink fs)
doesFileReallyExist :: FilePath -> IO Bool
doesFileReallyExist f = do fs <- getSymbolicLinkStatus f
return (isRegularFile fs)
doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist f = do fs <- getSymbolicLinkStatus f
return (isDirectory fs)
\end{code}
slurp is how we get a slurpy in the first place\ldots
\begin{code}
slurp = slurp_unboring (\_->True)
mmap_slurp d = do canmmap <- can_I_use_mmap
if canmmap then genslurp True (\_->True) d
else genslurp False (\_->True) d
slurp_unboring = genslurp False
genslurp :: Bool -> (FilePath -> Bool)
-> FilePath -> IO Slurpy
genslurp usemm nb dirname = do
isdir <- doesDirectoryExist dirname
ms <- if isdir
then withCurrentDirectory dirname $
do actualname <- getCurrentDirectory
genslurp_helper usemm nb (reverse actualname) "" "."
else do former_dir <- getCurrentDirectory
genslurp_helper usemm nb (reverse former_dir) "" dirname
case ms of
Just s -> return s
Nothing -> fail $ "Unable to read directory " ++ dirname ++
" (it appears to be neither file nor directory)"
unsafeInterleaveMapIO :: (a -> IO b) -> [a] -> IO [b]
unsafeInterleaveMapIO _ [] = return []
unsafeInterleaveMapIO f (x:xs)
= do x' <- f x
xs' <- unsafeInterleaveIO $ unsafeInterleaveMapIO f xs
return (x':xs')
genslurp_helper :: Bool -> (FilePath -> Bool)
-> FilePath -> String -> String -> IO (Maybe Slurpy)
genslurp_helper usemm nb formerdir fullpath dirname = do
fs <- getSymbolicLinkStatus fulldirname
if isRegularFile fs
then do let mtime = (Nothing, modificationTime fs, fileSize fs)
ls <- unsafeInterleaveIO $ myReadFileLinesPSetc fulldirname
return $ Just $ SlurpFile (fp2fn dirname) mtime ls
else if isDirectory fs || (isSymbolicLink fs && dirname == ".")
then do sl <- unsafeInterleaveIO $
do fnames <- getDirectoryContents fulldirname
unsafeInterleaveMapIO
(\f -> genslurp_helper usemm nb fulldirname'
(fullpath///f) f)
$ filter (nb . (fullpath///)) $ filter not_hidden fnames
return $ Just $ SlurpDir (fp2fn dirname) Nothing $ catMaybes sl
else return Nothing
where fulldirname' = formerdir\\\dirname
fulldirname = reverse fulldirname'
myReadFileLinesPSetc = if usemm then mmapFilePS
else readFilePS
not_hidden :: FilePath -> Bool
not_hidden "." = False
not_hidden ".." = False
not_hidden _ = True
(\\\) :: FilePath -> FilePath -> FilePath
(\\\) "" d = d
(\\\) d "." = d
(\\\) d subdir = reverse subdir ++ "/" ++ d
(///) :: FilePath -> FilePath -> FilePath
(///) "" d = d
(///) d "." = d
(///) d subdir = d ++ "/" ++ subdir
co_slurp :: Slurpy -> FilePath -> IO Slurpy
co_slurp guide dirname = do
isdir <- doesDirectoryExist dirname
if isdir
then withCurrentDirectory dirname $ do
actualname <- getCurrentDirectory
Just slurpy <- co_slurp_helper (reverse actualname) guide
return slurpy
else error "Error coslurping!!! Please report this."
co_slurp_helper :: FilePath -> Slurpy -> IO (Maybe Slurpy)
co_slurp_helper former_dir (SlurpDir d _ c) = unsafeInterleaveIO $ do
let d' = fn2fp d
fn' = former_dir\\\d'
fn = reverse fn'
efs <- tryNonSignal $ getSymbolicLinkStatus fn
case efs of
Right fs
| isDirectory fs || (isSymbolicLink fs && d' == ".") ->
do sl <- unsafeInterleaveIO
$ unsafeInterleaveMapIO (co_slurp_helper fn') c
return $ Just $ SlurpDir d Nothing $ catMaybes sl
_ -> return Nothing
co_slurp_helper former_dir (SlurpFile f _ _) = unsafeInterleaveIO $ do
let fn' = former_dir\\\fn2fp f
fn = reverse fn'
efs <- tryNonSignal $ getSymbolicLinkStatus fn
case efs of
Right fs
| isRegularFile fs ->
do let mtime = (Nothing, modificationTime fs, fileSize fs)
ls <- unsafeInterleaveIO $ readFilePS fn
return $ Just $ SlurpFile f mtime ls
_ -> return Nothing
\end{code}
\begin{code}
get_slurp_context_generic :: (Slurpy -> a) -> (a -> [Slurpy]) -> FileName -> Slurpy -> Maybe (a -> a, Slurpy)
get_slurp_context_generic h1 h2 fn0 s0 =
let norm_fn0 = norm_path fn0 in
if norm_fn0 == empty
then Just (id, s0)
else slurp_context_private norm_fn0 id s0
where
slurp_context_private f ctx s@(SlurpFile f' _ _) =
if f == f' then Just (ctx, s)
else Nothing
slurp_context_private f ctx s@(SlurpDir d _ c)
| f == d = Just (ctx, s)
| d == dot =
case break_on_dir f of
Just (dn,fn) | dn == dot ->
descend fn
_ ->
descend f
| otherwise =
case break_on_dir f of
Just (dn,fn) ->
if dn == d
then descend fn
else Nothing
_ -> Nothing
where
descend fname =
let l = [ slurp_context_private
fname
(\x -> ctx (h1 (SlurpDir d Nothing (pre ++ h2 x ++ post))))
this
| (pre, this:post) <- zip (inits' c) (tails c)
]
in
case filter isJust l of
[] -> Nothing
[msf] -> msf
_ -> impossible
-- a lazier implementation of inits
inits' l = [ take i l | i <- [0 .. length l] ]
dot = fp2fn "."
empty = fp2fn ""
\end{code}
\begin{code}
get_slurp_context :: FileName -> Slurpy -> Maybe (Slurpy -> Slurpy, Slurpy)
get_slurp_context = get_slurp_context_generic id return
get_slurp_context_maybe :: FileName -> Slurpy -> Maybe (Maybe Slurpy -> Maybe Slurpy, Slurpy)
get_slurp_context_maybe = get_slurp_context_generic Just maybeToList
get_slurp_context_list :: FileName -> Slurpy -> Maybe ([Slurpy] -> [Slurpy], Slurpy)
get_slurp_context_list = get_slurp_context_generic return id
\end{code}
It is important to be able to readily modify a slurpy.
\begin{code}
slurp_remove :: FileName -> Slurpy -> Maybe Slurpy
slurp_remove fname s@(SlurpDir _ _ _) =
case get_slurp_context_maybe fname s of
Just (ctx, _) -> ctx Nothing
Nothing -> Nothing
slurp_remove _ _ = bug "slurp_remove only acts on SlurpDirs"
slurp_removefile :: FileName -> Slurpy -> Maybe Slurpy
slurp_removefile f s =
if slurp_hasfile f s
then case slurp_remove f s of
Just (SlurpDir d x c) -> Just $ SlurpDir d x c
_ -> impossible
else Nothing
\end{code}
\begin{code}
slurp_move :: FileName -> FileName -> Slurpy -> Maybe Slurpy
slurp_move f f' s =
if not (slurp_has (fn2fp f') s) && slurp_hasdir (super_name f') s
then case get_slurp f s of
Nothing -> Nothing
Just sf ->
case slurp_remove f s of
Nothing -> Nothing
Just (SlurpDir d x c) ->
Just $ addslurp f' (slurp_setname (own_name f') sf)
$ SlurpDir d x c
_ -> impossible
else Nothing
addslurp :: FileName -> Slurpy -> Slurpy -> Slurpy
addslurp fname s s' =
case get_slurp_context (super_name fname) s' of
Just (ctx, SlurpDir d _ c) -> ctx (SlurpDir d Nothing (s:c))
_ -> s'
get_slurp :: FileName -> Slurpy -> Maybe Slurpy
get_slurp f s = fmap snd (get_slurp_context f s)
\end{code}
\begin{code}
slurp_removedir :: FileName -> Slurpy -> Maybe Slurpy
slurp_removedir f s =
case get_slurp f s of
Just (SlurpDir _ _ []) ->
case slurp_remove f s of
Just (SlurpDir d x c) -> Just $ SlurpDir d x c
_ -> impossible
_ -> Nothing
\end{code}
\begin{code}
slurp_adddir :: FileName -> Slurpy -> Maybe Slurpy
slurp_adddir f s =
if slurp_hasfile f s || slurp_hasdir f s || not (slurp_hasdir (super_name f) s)
then Nothing
else Just $ addslurp f (SlurpDir (own_name f) Nothing []) s
\end{code}
Code to modify a given file in a slurpy.
\begin{code}
slurp_modfile :: FileName -> (FileContents -> Maybe FileContents)
-> Slurpy -> Maybe Slurpy
slurp_modfile fname modify sl =
case get_slurp_context fname sl of
Just (ctx, SlurpFile ff _ c) ->
case modify c of
Nothing -> Nothing
Just c' -> Just (ctx (SlurpFile ff undef_time_size c'))
_ ->
Nothing
\end{code}
\begin{code}
slurp_hasfile :: FileName -> Slurpy -> Bool
slurp_hasfile f s =
case get_slurp f s of
Just s' | is_file s' -> True
_ -> False
slurp_has :: FilePath -> Slurpy -> Bool
slurp_has f s = isJust (get_slurp (fp2fn f) s)
slurp_has_anycase :: FilePath -> Slurpy -> Bool
slurp_has_anycase fname (SlurpDir _ _ contents) =
seq normed_name $ or $ map (hasany_private normed_name) contents
where normed_name = norm_path $ fp2fn $ map toLower fname
hasany_private f (SlurpFile f' _ _) = f == tolower f'
hasany_private f (SlurpDir d _ c)
| f == tolower d = True
| otherwise =
case break_on_dir f of
Just (dn,fn) -> if tolower dn == tolower d
then or $ map (hasany_private fn) c
else False
_ -> False
slurp_has_anycase f (SlurpFile f' _ _) =
(norm_path $ fp2fn $ map toLower f) == tolower f'
tolower :: FileName -> FileName
tolower = fp2fn . (map toLower) . fn2fp
slurp_hasdir :: FileName -> Slurpy -> Bool
slurp_hasdir d _ | norm_path d == fp2fn "" = True
slurp_hasdir f (SlurpDir _ _ c) =
seq f $ or $ map (slurp_hasdir_private $ norm_path f) c
slurp_hasdir _ _ = False
slurp_hasdir_private :: FileName -> Slurpy -> Bool
slurp_hasdir_private _ (SlurpFile _ _ _) = False
slurp_hasdir_private f (SlurpDir d _ c)
| f == d = True
| otherwise =
case break_on_dir f of
Just (dn,fn) ->
if dn == d
then or $ map (slurp_hasdir_private fn) c
else False
_ -> False
\end{code}
\begin{code}
get_path_list :: Slurpy -> FilePath -> [FilePath]
get_path_list s fp = get_path_list' s ("./" ++ fp)
get_path_list' :: Slurpy -> FilePath -> [FilePath]
get_path_list' s "" = list_slurpy s
get_path_list' (SlurpFile f _ _) fp
| f' == fp = [f']
where f' = fn2fp f
get_path_list' (SlurpDir d _ ss) fp
| (d' ++ "/") `isPrefixOf` (fp ++ "/")
= let fp' = drop (length d' + 1) fp
in map (d' ///) $ concatMap (\s -> get_path_list' s fp') ss
where d' = fn2fp d
get_path_list' _ _ = []
list_slurpy :: Slurpy -> [FilePath]
list_slurpy (SlurpFile f _ _) = [fn2fp f]
list_slurpy (SlurpDir dd _ ss) = d : map (d ///) (concatMap list_slurpy ss)
where d = fn2fp dd
list_slurpy_files :: Slurpy -> [FilePath]
list_slurpy_files (SlurpFile f _ _) = [fn2fp f]
list_slurpy_files (SlurpDir dd _ ss) =
map ((fn2fp dd) ///) (concatMap list_slurpy_files ss)
list_slurpy_dirs :: Slurpy -> [FilePath]
list_slurpy_dirs (SlurpFile _ _ _) = []
list_slurpy_dirs (SlurpDir dd _ ss) =
d : map (d ///) (concatMap list_slurpy_dirs ss)
where d = fn2fp dd
\end{code}