{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

{- 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  : stable
   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
    ( SystemFS(..),
      HVFS(vGetSymbolicLinkStatus, vRemoveDirectory, vRemoveFile,
           vReadSymbolicLink, vGetDirectoryContents),
      HVFSStat(vFileSize, vIsDirectory, vIsBlockDevice,
               vIsCharacterDevice, vIsSocket, vIsNamedPipe, vModificationTime,
               vIsSymbolicLink, vFileMode, vFileOwner, vFileGroup),
      HVFSStatEncap(..),
      withStat )
import System.IO.PlafCompat
    ( groupExecuteMode,
      groupReadMode,
      groupWriteMode,
      intersectFileModes,
      otherExecuteMode,
      otherReadMode,
      otherWriteMode,
      ownerExecuteMode,
      ownerReadMode,
      ownerWriteMode,
      setGroupIDMode,
      setUserIDMode )
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Locale ( defaultTimeLocale )
import System.Time ( formatCalendarTime, toCalendarTime )
import System.Time.Utils ( epochToClockTime )
import Text.Printf ( 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 :: forall a. HVFS a => a -> FilePath -> IO [FilePath]
recurseDir a
fs 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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall a. a -> IO a
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 :: forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h 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 a -> Bool
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 (\FilePath
x -> FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"..") [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
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 a. a -> IO a
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 :: forall a. HVFS a => a -> FilePath -> IO ()
recursiveRemove a
h FilePath
path =
    a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h FilePath
path IO [(FilePath, HVFSStatEncap)]
-> ([(FilePath, HVFSStatEncap)] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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
$
        \(FilePath
fn, HVFSStatEncap
fs) -> if HVFSStatEncap -> (forall a. HVFSStat a => a -> Bool) -> Bool
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
fs a -> Bool
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 :: forall a. HVFS a => a -> FilePath -> IO FilePath
lsl a
fs FilePath
fp =
    let showmodes :: CMode -> FilePath
showmodes CMode
mode =
            let i :: CMode -> Bool
i CMode
m = (CMode -> CMode -> CMode
intersectFileModes CMode
mode CMode
m CMode -> CMode -> Bool
forall a. Eq a => a -> a -> Bool
/= CMode
0)
                in
                (if CMode -> Bool
i CMode
ownerReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
ownerWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
setUserIDMode then Char
's' else
                    if CMode -> Bool
i CMode
ownerExecuteMode then Char
'x' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
groupReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
groupWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
setGroupIDMode then Char
's' else
                    if CMode -> Bool
i CMode
groupExecuteMode then Char
'x' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
otherReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
otherWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if CMode -> Bool
i CMode
otherExecuteMode then Char
'x' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: []
        showentry :: FilePath -> p -> (HVFSStatEncap, FilePath) -> IO b
showentry FilePath
origdir p
fh (HVFSStatEncap
state, FilePath
fp) =
            case HVFSStatEncap
state of
              HVFSStatEncap a
se ->
               let typechar :: Char
typechar =
                    if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsDirectory a
se then Char
'd'
                       else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsSymbolicLink a
se then Char
'l'
                       else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsBlockDevice a
se then Char
'b'
                       else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsCharacterDevice a
se then Char
'c'
                       else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsSocket a
se then Char
's'
                       else if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsNamedPipe a
se then Char
's'
                       else Char
'-'
                   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 CalendarTime
c= TimeLocale -> FilePath -> CalendarTime -> FilePath
formatCalendarTime TimeLocale
defaultTimeLocale FilePath
"%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
                                       Bool
False -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
                                       Bool
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 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
" -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sl
                          b -> IO b
forall a. a -> IO a
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 FilePath
"%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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\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 a. a -> IO a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 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] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
"total 1"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
linedata