{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module System.FSNotify.Linux.Util (
  canonicalizePath
  , canonicalizeRawDirPath
  , (<//>)
  , traverseAllDirs

  , boolToIsDirectory

  , fromRawFilePath
  , toRawFilePath

  , fromHinotifyPath

  , rawToHinotifyPath
  , rawFromHinotifyPath
  ) where

import Control.Exception.Safe as E
import Control.Monad
import qualified Data.ByteString as BS
import Data.Function
import Data.Monoid
import qualified GHC.Foreign as F
import GHC.IO.Encoding (getFileSystemEncoding)
import Prelude hiding (FilePath)
import System.Directory (canonicalizePath)
import System.FSNotify.Types
import System.FilePath (FilePath)
import System.Posix.ByteString (RawFilePath)
import System.Posix.Directory.ByteString (openDirStream, readDirStream, closeDirStream)
import System.Posix.Files (getFileStatus, isDirectory)


canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath
canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath
canonicalizeRawDirPath RawFilePath
p = RawFilePath -> IO FilePath
fromRawFilePath RawFilePath
p IO FilePath -> (FilePath -> 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
canonicalizePath IO FilePath -> (FilePath -> IO RawFilePath) -> IO RawFilePath
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 RawFilePath
toRawFilePath

-- | Same as </> but for RawFilePath
-- TODO: make sure this is correct or find in a library
(<//>) :: RawFilePath -> RawFilePath -> RawFilePath
RawFilePath
x <//> :: RawFilePath -> RawFilePath -> RawFilePath
<//> RawFilePath
y = RawFilePath
x RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
"/" RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
y

traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO ()
traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO ()
traverseAllDirs RawFilePath
dir RawFilePath -> IO ()
cb = RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
dir ((RawFilePath -> IO Bool) -> IO ())
-> (RawFilePath -> IO Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RawFilePath
subPath ->
  -- TODO: wish we didn't need fromRawFilePath here
  -- TODO: make sure this does the right thing with symlinks
  RawFilePath -> IO FilePath
fromRawFilePath RawFilePath
subPath IO FilePath -> (FilePath -> IO FileStatus) -> IO FileStatus
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 FileStatus
getFileStatus IO FileStatus -> (FileStatus -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FileStatus -> Bool
isDirectory -> Bool
True) -> RawFilePath -> IO ()
cb RawFilePath
subPath IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    FileStatus
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
dir RawFilePath -> IO Bool
cb = IO DirStream
-> (DirStream -> IO ()) -> (DirStream -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m) =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (RawFilePath -> IO DirStream
openDirStream RawFilePath
dir) DirStream -> IO ()
closeDirStream ((DirStream -> IO ()) -> IO ()) -> (DirStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DirStream
dirStream ->
  (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
loop -> do
    DirStream -> IO RawFilePath
readDirStream DirStream
dirStream IO RawFilePath -> (RawFilePath -> 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
>>= \case
      RawFilePath
x | RawFilePath -> Bool
BS.null RawFilePath
x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RawFilePath
"." -> IO ()
loop
      RawFilePath
".." -> IO ()
loop
      RawFilePath
subDir -> (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally IO ()
loop (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- TODO: canonicalize?
        let fullSubDir :: RawFilePath
fullSubDir = RawFilePath
dir RawFilePath -> RawFilePath -> RawFilePath
<//> RawFilePath
subDir
        Bool
shouldRecurse <- RawFilePath -> IO Bool
cb RawFilePath
fullSubDir
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldRecurse (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
fullSubDir RawFilePath -> IO Bool
cb

boolToIsDirectory :: Bool -> EventIsDirectory
boolToIsDirectory :: Bool -> EventIsDirectory
boolToIsDirectory Bool
False = EventIsDirectory
IsFile
boolToIsDirectory Bool
True = EventIsDirectory
IsDirectory

toRawFilePath :: FilePath -> IO BS.ByteString
toRawFilePath :: FilePath -> IO RawFilePath
toRawFilePath FilePath
fp = do
  TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
  TextEncoding
-> FilePath -> (CString -> IO RawFilePath) -> IO RawFilePath
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
F.withCString TextEncoding
enc FilePath
fp CString -> IO RawFilePath
BS.packCString

fromRawFilePath :: BS.ByteString -> IO FilePath
fromRawFilePath :: RawFilePath -> IO FilePath
fromRawFilePath RawFilePath
bs = do
  TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
  RawFilePath -> (CString -> IO FilePath) -> IO FilePath
forall a. RawFilePath -> (CString -> IO a) -> IO a
BS.useAsCString RawFilePath
bs (TextEncoding -> CString -> IO FilePath
F.peekCString TextEncoding
enc)

#if MIN_VERSION_hinotify(0, 3, 10)
fromHinotifyPath :: BS.ByteString -> IO FilePath
fromHinotifyPath :: RawFilePath -> IO FilePath
fromHinotifyPath = RawFilePath -> IO FilePath
fromRawFilePath

rawToHinotifyPath :: BS.ByteString -> IO BS.ByteString
rawToHinotifyPath :: RawFilePath -> IO RawFilePath
rawToHinotifyPath = RawFilePath -> IO RawFilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

rawFromHinotifyPath :: BS.ByteString -> IO BS.ByteString
rawFromHinotifyPath :: RawFilePath -> IO RawFilePath
rawFromHinotifyPath = RawFilePath -> IO RawFilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
#else
fromHinotifyPath :: FilePath -> IO FilePath
fromHinotifyPath = return

rawToHinotifyPath :: BS.ByteString -> IO FilePath
rawToHinotifyPath = fromRawFilePath

rawFromHinotifyPath :: FilePath -> IO BS.ByteString
rawFromHinotifyPath = toRawFilePath
#endif