{-# LANGUAGE Trustworthy #-}

{- arch-tag: HVFS utilities main file
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.IO.HVFS.Utils
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : provisional
   Portability: portable

This module provides various helpful utilities for dealing
filesystems.

Written by John Goerzen, jgoerzen\@complete.org

To operate on your system's main filesystem, just pass SystemFS as the
first parameter to these functions.
-}

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

{- | Obtain a recursive listing of all files\/directories beneath
the specified directory.  The traversal is depth-first
and the original
item is always present in the returned list.

If the passed value is not a directory, the return value
be only that value.

The \".\" and \"..\" entries are removed from the data returned.
-}
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

{- | Like 'recurseDir', but return the stat() (System.Posix.Files.FileStatus)
information with them.  This is an optimization if you will be statting files
yourself later.

The items are returned lazily.

WARNING: do not change your current working directory until you have consumed
all the items.  Doing so could cause strange effects.

Alternatively, you may wish to pass an absolute path to this function.
-}

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

{- | Removes a file or a directory.  If a directory, also removes all its
child files\/directories.
-}
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
                              )

{- | Provide a result similar to the command ls -l over a directory.

Known bug: setuid bit semantics are inexact compared with standard ls.
-}
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