    {-# 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