{-# 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 = forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
fs FilePath
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 <- forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
h FilePath
fn
       if forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
fs forall a. HVFSStat a => a -> Bool
vIsDirectory
          then do
               [FilePath]
dirc <- forall a. HVFS a => a -> FilePath -> IO [FilePath]
vGetDirectoryContents a
h FilePath
fn
               let contents :: [FilePath]
contents = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
(++) (FilePath
fn forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator])) forall a b. (a -> b) -> a -> b
$
                              forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
x -> FilePath
x forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
x forall a. Eq a => a -> a -> Bool
/= FilePath
"..") [FilePath]
dirc
               [[(FilePath, HVFSStatEncap)]]
subdirs <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h) [FilePath]
contents
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FilePath, HVFSStatEncap)]]
subdirs) forall a. [a] -> [a] -> [a]
++ [(FilePath
fn, HVFSStatEncap
fs)]
          else 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 =
    forall a. HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
recurseDirStat a
h FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$
        \(FilePath
fn, HVFSStatEncap
fs) -> if forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
fs forall a. HVFSStat a => a -> Bool
vIsDirectory
                         then forall a. HVFS a => a -> FilePath -> IO ()
vRemoveDirectory a
h FilePath
fn
                         else 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 :: FileMode -> FilePath
showmodes FileMode
mode =
            let i :: FileMode -> Bool
i FileMode
m = (FileMode -> FileMode -> FileMode
intersectFileModes FileMode
mode FileMode
m forall a. Eq a => a -> a -> Bool
/= FileMode
0)
                in
                (if FileMode -> Bool
i FileMode
ownerReadMode then Char
'r' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
ownerWriteMode then Char
'w' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
setUserIDMode then Char
's' else
                    if FileMode -> Bool
i FileMode
ownerExecuteMode then Char
'x' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
groupReadMode then Char
'r' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
groupWriteMode then Char
'w' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
setGroupIDMode then Char
's' else
                    if FileMode -> Bool
i FileMode
groupExecuteMode then Char
'x' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
otherReadMode then Char
'r' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
otherWriteMode then Char
'w' else Char
'-') forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
otherExecuteMode then Char
'x' else Char
'-') 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 forall a. HVFSStat a => a -> Bool
vIsDirectory a
se then Char
'd'
                       else if forall a. HVFSStat a => a -> Bool
vIsSymbolicLink a
se then Char
'l'
                       else if forall a. HVFSStat a => a -> Bool
vIsBlockDevice a
se then Char
'b'
                       else if forall a. HVFSStat a => a -> Bool
vIsCharacterDevice a
se then Char
'c'
                       else if forall a. HVFSStat a => a -> Bool
vIsSocket a
se then Char
's'
                       else if forall a. HVFSStat a => a -> Bool
vIsNamedPipe a
se then Char
's'
                       else Char
'-'
                   clocktime :: ClockTime
clocktime = forall a. Real a => a -> ClockTime
epochToClockTime (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 forall a. HVFSStat a => a -> Bool
vIsSymbolicLink a
se of
                                       Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
                                       Bool
True -> do FilePath
sl <- forall a. HVFS a => a -> FilePath -> IO FilePath
vReadSymbolicLink p
fh
                                                           (FilePath
origdir FilePath -> FilePath -> FilePath
</> FilePath
fp)
                                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
" -> " forall a. [a] -> [a] -> [a]
++ FilePath
sl
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf FilePath
"%c%s  1 %-8d %-8d %-9d %s %s%s"
                                     Char
typechar
                                     (FileMode -> FilePath
showmodes (forall a. HVFSStat a => a -> FileMode
vFileMode a
se))
                                     (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. HVFSStat a => a -> UserID
vFileOwner a
se)
                                     (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. HVFSStat a => a -> GroupID
vFileGroup a
se)
                                     (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. HVFSStat a => a -> FileOffset
vFileSize a
se)
                                     (CalendarTime -> FilePath
datestr CalendarTime
c)
                                     FilePath
fp
                                     FilePath
linkstr
        in do [FilePath]
c <- forall a. HVFS a => a -> FilePath -> IO [FilePath]
vGetDirectoryContents a
fs FilePath
fp
              [(HVFSStatEncap, FilePath)]
pairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
x -> do HVFSStatEncap
ss <- forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
fs (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
x)
                                      forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap
ss, FilePath
x)
                            ) [FilePath]
c
              [FilePath]
linedata <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {p} {b}.
(HVFS p, PrintfType b) =>
FilePath -> p -> (HVFSStatEncap, FilePath) -> IO b
showentry FilePath
fp a
fs) [(HVFSStatEncap, FilePath)]
pairs
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ [FilePath
"total 1"] forall a. [a] -> [a] -> [a]
++ [FilePath]
linedata