{-# 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 fs <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
h FilePath
fn
       if withStat fs vIsDirectory
          then do
               dirc <- vGetDirectoryContents h fn
               let 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
               subdirs <- unsafeInterleaveIO $ mapM (recurseDirStat h) contents
               return $ (concat subdirs) ++ [(fn, fs)]
          else return [(fn, 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 :: FileMode -> FilePath
showmodes FileMode
mode =
            let i :: FileMode -> Bool
i FileMode
m = (FileMode -> FileMode -> FileMode
intersectFileModes FileMode
mode FileMode
m FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
0)
                in
                (if FileMode -> Bool
i FileMode
ownerReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
ownerWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
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
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
groupReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
groupWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
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
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
otherReadMode then Char
'r' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
otherWriteMode then Char
'w' else Char
'-') Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:
                (if FileMode -> Bool
i FileMode
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 c <- ClockTime -> IO CalendarTime
toCalendarTime ClockTime
clocktime
                          linkstr <- case vIsSymbolicLink 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 sl <- p -> FilePath -> IO FilePath
forall a. HVFS a => a -> FilePath -> IO FilePath
vReadSymbolicLink p
fh
                                                           (FilePath
origdir FilePath -> FilePath -> FilePath
</> FilePath
fp)
                                                  return $ " -> " ++ sl
                          return $ printf "%c%s  1 %-8d %-8d %-9d %s %s%s"
                                     typechar
                                     (showmodes (vFileMode se))
                                     (toInteger $ vFileOwner se)
                                     (toInteger $ vFileGroup se)
                                     (toInteger $ vFileSize se)
                                     (datestr c)
                                     fp
                                     linkstr
        in do c <- a -> FilePath -> IO [FilePath]
forall a. HVFS a => a -> FilePath -> IO [FilePath]
vGetDirectoryContents a
fs FilePath
fp
              pairs <- mapM (\FilePath
x -> do ss <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
fs (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
x)
                                      return (ss, x)
                            ) c
              linedata <- mapM (showentry fp fs) pairs
              return $ unlines $ ["total 1"] ++ linedata