{-# LANGUAGE Trustworthy #-}
module System.IO.HVFS.Utils (recurseDir,
recurseDirStat,
recursiveRemove,
lsl,
SystemFS(..)
)
where
import System.FilePath (pathSeparator, (</>))
import System.IO.HVFS
import System.IO.PlafCompat
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Locale
import System.Time
import System.Time.Utils
import Text.Printf
recurseDir :: HVFS a => a -> FilePath -> IO [FilePath]
recurseDir :: a -> FilePath -> IO [FilePath]
recurseDir fs :: a
fs x :: FilePath
x = a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
fs FilePath
x IO [(FilePath, HVFSStatEncap)]
-> ([(FilePath, HVFSStatEncap)] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> ([(FilePath, HVFSStatEncap)] -> [FilePath])
-> [(FilePath, HVFSStatEncap)]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, HVFSStatEncap) -> FilePath)
-> [(FilePath, HVFSStatEncap)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, HVFSStatEncap) -> FilePath
forall a b. (a, b) -> a
fst
recurseDirStat :: HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat :: a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat h :: a
h fn :: FilePath
fn =
do HVFSStatEncap
fs <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
h FilePath
fn
if HVFSStatEncap -> (forall a. HVFSStat a => a -> Bool) -> Bool
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
fs forall a. HVFSStat a => a -> Bool
vIsDirectory
then do
[FilePath]
dirc <- a -> FilePath -> IO [FilePath]
forall a. HVFS a => a -> FilePath -> IO [FilePath]
vGetDirectoryContents a
h FilePath
fn
let contents :: [FilePath]
contents = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) (FilePath
fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator])) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
(FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: FilePath
x -> FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "." Bool -> Bool -> Bool
&& FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "..") [FilePath]
dirc
[[(FilePath, HVFSStatEncap)]]
subdirs <- IO [[(FilePath, HVFSStatEncap)]]
-> IO [[(FilePath, HVFSStatEncap)]]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [[(FilePath, HVFSStatEncap)]]
-> IO [[(FilePath, HVFSStatEncap)]])
-> IO [[(FilePath, HVFSStatEncap)]]
-> IO [[(FilePath, HVFSStatEncap)]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [(FilePath, HVFSStatEncap)])
-> [FilePath] -> IO [[(FilePath, HVFSStatEncap)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h) [FilePath]
contents
[(FilePath, HVFSStatEncap)] -> IO [(FilePath, HVFSStatEncap)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, HVFSStatEncap)] -> IO [(FilePath, HVFSStatEncap)])
-> [(FilePath, HVFSStatEncap)] -> IO [(FilePath, HVFSStatEncap)]
forall a b. (a -> b) -> a -> b
$ ([[(FilePath, HVFSStatEncap)]] -> [(FilePath, HVFSStatEncap)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FilePath, HVFSStatEncap)]]
subdirs) [(FilePath, HVFSStatEncap)]
-> [(FilePath, HVFSStatEncap)] -> [(FilePath, HVFSStatEncap)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
fn, HVFSStatEncap
fs)]
else [(FilePath, HVFSStatEncap)] -> IO [(FilePath, HVFSStatEncap)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
fn, HVFSStatEncap
fs)]
recursiveRemove :: HVFS a => a -> FilePath -> IO ()
recursiveRemove :: a -> FilePath -> IO ()
recursiveRemove h :: a
h fn :: FilePath
fn =
a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h FilePath
fn IO [(FilePath, HVFSStatEncap)]
-> ([(FilePath, HVFSStatEncap)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (((FilePath, HVFSStatEncap) -> IO ())
-> [(FilePath, HVFSStatEncap)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((FilePath, HVFSStatEncap) -> IO ())
-> [(FilePath, HVFSStatEncap)] -> IO ())
-> ((FilePath, HVFSStatEncap) -> IO ())
-> [(FilePath, HVFSStatEncap)]
-> IO ()
forall a b. (a -> b) -> a -> b
$
\(fn :: FilePath
fn, fs :: HVFSStatEncap
fs) -> if HVFSStatEncap -> (forall a. HVFSStat a => a -> Bool) -> Bool
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
fs forall a. HVFSStat a => a -> Bool
vIsDirectory
then a -> FilePath -> IO ()
forall a. HVFS a => a -> FilePath -> IO ()
vRemoveDirectory a
h FilePath
fn
else a -> FilePath -> IO ()
forall a. HVFS a => a -> FilePath -> IO ()
vRemoveFile a
h FilePath
fn
)
lsl :: HVFS a => a -> FilePath -> IO String
lsl :: a -> FilePath -> IO FilePath
lsl fs :: a
fs fp :: FilePath
fp =
let showmodes :: CMode -> FilePath
showmodes mode :: CMode
mode =
let i :: CMode -> Bool
i m :: CMode
m = (CMode -> CMode -> CMode
intersectFileModes CMode
mode CMode
m CMode -> CMode -> Bool
forall a. Eq a => a -> a -> Bool
/= 0)
in
(if CMode -> Bool
i CMode
ownerReadMode then 'r' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
ownerWriteMode then 'w' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
setUserIDMode then 's' else
if CMode -> Bool
i CMode
ownerExecuteMode then 'x' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
groupReadMode then 'r' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
groupWriteMode then 'w' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
setGroupIDMode then 's' else
if CMode -> Bool
i CMode
groupExecuteMode then 'x' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
otherReadMode then 'r' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
otherWriteMode then 'w' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
(if CMode -> Bool
i CMode
otherExecuteMode then 'x' else '-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: []
showentry :: FilePath -> p -> (HVFSStatEncap, FilePath) -> IO b
showentry origdir :: FilePath
origdir fh :: p
fh (state :: HVFSStatEncap
state, fp :: FilePath
fp) =
case HVFSStatEncap
state of
HVFSStatEncap se :: a
se ->
let typechar :: Char
typechar =
if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsDirectory a
se then 'd'
else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsSymbolicLink a
se then 'l'
else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsBlockDevice a
se then 'b'
else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsCharacterDevice a
se then 'c'
else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsSocket a
se then 's'
else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsNamedPipe a
se then 's'
else '-'
clocktime :: ClockTime
clocktime = EpochTime -> ClockTime
forall a. Real a => a -> ClockTime
epochToClockTime (a -> EpochTime
forall a. HVFSStat a => a -> EpochTime
vModificationTime a
se)
datestr :: CalendarTime -> FilePath
datestr c :: CalendarTime
c= TimeLocale -> FilePath -> CalendarTime -> FilePath
formatCalendarTime TimeLocale
defaultTimeLocale "%b %e %Y"
CalendarTime
c
in do CalendarTime
c <- ClockTime -> IO CalendarTime
toCalendarTime ClockTime
clocktime
FilePath
linkstr <- case a -> Bool
forall a. HVFSStat a => a -> Bool
vIsSymbolicLink a
se of
False -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ""
True -> do FilePath
sl <- p -> FilePath -> IO FilePath
forall a. HVFS a => a -> FilePath -> IO FilePath
vReadSymbolicLink p
fh
(FilePath
origdir FilePath -> FilePath -> FilePath
</> FilePath
fp)
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ " -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sl
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ FilePath
-> Char
-> FilePath
-> Integer
-> Integer
-> Integer
-> FilePath
-> FilePath
-> FilePath
-> b
forall r. PrintfType r => FilePath -> r
printf "%c%s 1 %-8d %-8d %-9d %s %s%s"
Char
typechar
(CMode -> FilePath
showmodes (a -> CMode
forall a. HVFSStat a => a -> CMode
vFileMode a
se))
(UserID -> Integer
forall a. Integral a => a -> Integer
toInteger (UserID -> Integer) -> UserID -> Integer
forall a b. (a -> b) -> a -> b
$ a -> UserID
forall a. HVFSStat a => a -> UserID
vFileOwner a
se)
(GroupID -> Integer
forall a. Integral a => a -> Integer
toInteger (GroupID -> Integer) -> GroupID -> Integer
forall a b. (a -> b) -> a -> b
$ a -> GroupID
forall a. HVFSStat a => a -> GroupID
vFileGroup a
se)
(FileOffset -> Integer
forall a. Integral a => a -> Integer
toInteger (FileOffset -> Integer) -> FileOffset -> Integer
forall a b. (a -> b) -> a -> b
$ a -> FileOffset
forall a. HVFSStat a => a -> FileOffset
vFileSize a
se)
(CalendarTime -> FilePath
datestr CalendarTime
c)
FilePath
fp
FilePath
linkstr
in do [FilePath]
c <- a -> FilePath -> IO [FilePath]
forall a. HVFS a => a -> FilePath -> IO [FilePath]
vGetDirectoryContents a
fs FilePath
fp
[(HVFSStatEncap, FilePath)]
pairs <- (FilePath -> IO (HVFSStatEncap, FilePath))
-> [FilePath] -> IO [(HVFSStatEncap, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\x :: FilePath
x -> do HVFSStatEncap
ss <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
fs (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
x)
(HVFSStatEncap, FilePath) -> IO (HVFSStatEncap, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap
ss, FilePath
x)
) [FilePath]
c
[FilePath]
linedata <- ((HVFSStatEncap, FilePath) -> IO FilePath)
-> [(HVFSStatEncap, FilePath)] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> a -> (HVFSStatEncap, FilePath) -> IO FilePath
forall p b.
(HVFS p, PrintfType b) =>
FilePath -> p -> (HVFSStatEncap, FilePath) -> IO b
showentry FilePath
fp a
fs) [(HVFSStatEncap, FilePath)]
pairs
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ["total 1"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
linedata