add some utility functions for later
Will need to update the DirMap to add or remove subdirs.
This commit is contained in:
parent
a39b73d118
commit
89fcee03d0
1 changed files with 31 additions and 8 deletions
|
@ -8,8 +8,10 @@
|
||||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||||
|
|
||||||
module Utility.Kqueue (
|
module Utility.Kqueue (
|
||||||
|
scanRecursive,
|
||||||
|
addSubDir,
|
||||||
|
removeSubDir,
|
||||||
waitChange,
|
waitChange,
|
||||||
scanRecursive
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
@ -23,9 +25,37 @@ import qualified Data.Map as M
|
||||||
|
|
||||||
type DirMap = M.Map Fd FilePath
|
type DirMap = M.Map Fd FilePath
|
||||||
|
|
||||||
|
{- Builds a map of directories in a tree, possibly pruning some.
|
||||||
|
- Opens each directory in the tree. -}
|
||||||
|
scanRecursive :: FilePath -> (FilePath -> Bool) -> IO DirMap
|
||||||
|
scanRecursive dir prune = M.fromList <$> (mapM opendir =<< dirTree dir prune)
|
||||||
|
where
|
||||||
|
opendir d = (,)
|
||||||
|
<$> openFd d ReadOnly Nothing defaultFileFlags
|
||||||
|
<*> pure d
|
||||||
|
|
||||||
|
{- Adds a subdirectory (and all its subdirectories, unless pruned) to a
|
||||||
|
- directory map. -}
|
||||||
|
addSubDir :: DirMap -> FilePath -> (FilePath -> Bool) -> IO DirMap
|
||||||
|
addSubDir dirmap dir prune = M.union dirmap <$> scanRecursive dir prune
|
||||||
|
|
||||||
|
{- Removes a subdirectory (and all its subdirectories) from a directory map. -}
|
||||||
|
removeSubDir :: FilePath -> DirMap -> DirMap
|
||||||
|
removeSubDir dir = M.filter (not . dirContains dir)
|
||||||
|
|
||||||
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
|
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
|
||||||
:: Ptr Fd -> IO Fd
|
:: Ptr Fd -> IO Fd
|
||||||
|
|
||||||
|
{- Waits for a change in a map of directories, and returns the directory
|
||||||
|
- where the change took place.
|
||||||
|
-
|
||||||
|
- The kqueue interface does not tell what type of change took place in
|
||||||
|
- the directory; it could be an added file, a deleted file, a renamed
|
||||||
|
- file, a new subdirectory, or a deleted subdirectory, or a moved
|
||||||
|
- subdirectory.
|
||||||
|
-
|
||||||
|
- Note that if subdirectories have changed, the caller will want to
|
||||||
|
- update the map before calling this again. -}
|
||||||
waitChange :: DirMap -> IO (Maybe FilePath)
|
waitChange :: DirMap -> IO (Maybe FilePath)
|
||||||
waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
|
waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
|
||||||
changed <- c_waitchange c_fds
|
changed <- c_waitchange c_fds
|
||||||
|
@ -35,10 +65,3 @@ waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
safeErrno (Errno v) = v == 0
|
safeErrno (Errno v) = v == 0
|
||||||
|
|
||||||
scanRecursive :: FilePath -> (FilePath -> Bool) -> IO DirMap
|
|
||||||
scanRecursive dir prune = M.fromList <$> (mapM opendir =<< dirTree dir prune)
|
|
||||||
where
|
|
||||||
opendir d = (,)
|
|
||||||
<$> openFd d ReadOnly Nothing defaultFileFlags
|
|
||||||
<*> pure d
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue