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