Win32-notify 0.1 → 0.2
raw patch · 6 files changed
+332/−242 lines, 6 filesdep +Win32-notifydep +containersdep ~basenew-component:exe:simplenew-uploader
Dependencies added: Win32-notify, containers
Dependency ranges changed: base
Files
- System/Win32/FileNotify.hsc +0/−133
- System/Win32/Notify.hs +0/−101
- Win32-notify.cabal +14/−8
- examples/simple/simple.hs +21/−0
- src/System/Win32/FileNotify.hsc +151/−0
- src/System/Win32/Notify.hs +146/−0
− System/Win32/FileNotify.hsc
@@ -1,133 +0,0 @@-module System.Win32.FileNotify where - -import System.Win32.File -import System.Win32.Types - -import Foreign -import Foreign.C - -import Data.Bits - - -#include <windows.h> - -getWatchHandle :: FilePath -> IO HANDLE -getWatchHandle dir = - createFile dir - fILE_LIST_DIRECTORY -- Access mode - (fILE_SHARE_READ .|. fILE_SHARE_WRITE) -- Share mode - Nothing -- security attributes - oPEN_EXISTING -- Create mode, we want to look at an existing directory - fILE_FLAG_BACKUP_SEMANTICS -- File attribute, nb NOT using OVERLAPPED since we work synchronously - Nothing -- No template file - - -readDirectoryChanges :: HANDLE -> Bool -> FileNotificationFlag -> IO [(Action, String)] -readDirectoryChanges h wst mask = do - let maxBuf = 16384 - allocaBytes maxBuf $ \buffer -> do - alloca $ \bret -> do - readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret - readChanges buffer - -data Action = FileAdded | FileRemoved | FileModified | FileRenamedOld | FileRenamedNew - deriving (Show, Read, Eq, Ord, Enum) - -readChanges :: Ptr FILE_NOTIFY_INFORMATION -> IO [(Action, String)] -readChanges pfni = do - fni <- peekFNI pfni - let entry = (faToAction $ fniAction fni, fniFileName fni) - nioff = fromEnum $ fniNextEntryOffset fni - entries <- if nioff == 0 then return [] else readChanges $ pfni `plusPtr` nioff - return $ entry:entries - -faToAction :: FileAction -> Action -faToAction fa = toEnum $ fromEnum fa - 1 - -------------------------------------------------------------------- --- Low-level stuff that binds to notifications in the Win32 API - --- Defined in System.Win32.File, but with too few cases: --- type AccessMode = UINT - -#{enum AccessMode, - , fILE_LIST_DIRECTORY = FILE_LIST_DIRECTORY - } --- there are many more cases but I only need this one. - -type FileAction = DWORD - -#{enum FileAction, - , fILE_ACTION_ADDED = FILE_ACTION_ADDED - , fILE_ACTION_REMOVED = FILE_ACTION_REMOVED - , fILE_ACTION_MODIFIED = FILE_ACTION_MODIFIED - , fILE_ACTION_RENAMED_OLD_NAME = FILE_ACTION_RENAMED_OLD_NAME - , fILE_ACTION_RENAMED_NEW_NAME = FILE_ACTION_RENAMED_NEW_NAME - } - -type WCHAR = Word16 --- This is a bit overkill for now, I'll only use nullFunPtr anyway, --- but who knows, maybe someday I'll want asynchronous callbacks on the OS level. -type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ()) - -data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION - { fniNextEntryOffset, fniAction :: DWORD - , fniFileName :: String - } - --- instance Storable FILE_NOTIFY_INFORMATION where --- ... well, we can't write an instance since the struct is not of fix size, --- so we'll have to do it the hard way, and not get anything for free. Sigh. - --- sizeOfFNI :: FILE_NOTIFY_INFORMATION -> Int --- sizeOfFNI fni = (#size FILE_NOTIFY_INFORMATION) + (#size WCHAR) * (length (fniFileName fni) - 1) - -peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION -peekFNI buf = do - neof <- (#peek FILE_NOTIFY_INFORMATION, NextEntryOffset) buf - acti <- (#peek FILE_NOTIFY_INFORMATION, Action) buf - fnle <- (#peek FILE_NOTIFY_INFORMATION, FileNameLength) buf - fnam <- peekCWStringLen - (buf `plusPtr` (#offset FILE_NOTIFY_INFORMATION, FileName), -- start of array - fromEnum (fnle :: DWORD) `div` 2 ) -- fnle is the length in *bytes*, and a WCHAR is 2 bytes - return $ FILE_NOTIFY_INFORMATION neof acti fnam - - -readDirectoryChangesW :: HANDLE -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag -> LPDWORD -> IO () -readDirectoryChangesW h buf bufSize wst f br = - failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f br nullPtr nullFunPtr - -{- -asynchReadDirectoryChangesW :: HANDLE -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag - -> LPOVERLAPPED -> IO () -asynchReadDirectoryChangesW h buf bufSize wst f over = - failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f nullPtr over nullFunPtr - -cbReadDirectoryChangesW :: HANDLE -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag - -> LPOVERLAPPED -> IO BOOL -cbReadDirectoryChanges --} -foreign import stdcall safe "windows.h ReadDirectoryChangesW" - c_ReadDirectoryChangesW :: HANDLE -> LPVOID -> DWORD -> BOOL -> DWORD - -> LPDWORD -> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL - -{- -type CompletionRoutine :: (DWORD, DWORD, LPOVERLAPPED) -> IO () -foreign import ccall "wrapper" - mkCompletionRoutine :: CompletionRoutine -> IO (FunPtr CompletionRoutine) - -type LPOVERLAPPED = Ptr OVERLAPPED -type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr CompletionRoutine - -data OVERLAPPED = OVERLAPPED - { - } - - --- In System.Win32.File, but missing a crucial case: --- type FileNotificationFlag = DWORD --} -#{enum FileNotificationFlag, - , fILE_NOTIFY_CHANGE_CREATION = FILE_NOTIFY_CHANGE_CREATION - , fILE_NOTIFY_CHANGE_LAST_ACCESS = FILE_NOTIFY_CHANGE_LAST_ACCESS - }
− System/Win32/Notify.hs
@@ -1,101 +0,0 @@-module System.Win32.Notify ( - - watchDirectoryOnce -- FilePath -> Bool -> [EventVariety] -> IO Event - , watchDirectory -- FilePath -> Bool -> [EventVariety] -> IO [Event] - - , Event(..) - , EventVariety(..) - - ) where - -import System.Win32.FileNotify -import System.Win32.File - -import Data.Bits -import System.Directory -import Control.Concurrent - -import System.IO.Unsafe (unsafeInterleaveIO) - -import Debug.Trace - -{- -addDirWatch :: FilePath -> Bool -> [EventVariety] -> (Event -> IO ()) -> IO () -addDirWatch dir wst evs cb = trace "addDirWatch" (forkIO loop) >> trace "addDirWatch: forked" (return ()) - where loop = do - trace "addDirWatch: start loop" $ return () - e <- watchDirectory dir wst evs - trace "addDirWatch: watchDirectory returned" $ return () - forkIO $ cb e - trace "addDirWatch: callback forked" $ return () --} - -data EventVariety - = Modify - | Move - | Create - | Delete - deriving Eq - - -evToFnFlag :: [EventVariety] -> FileNotificationFlag -evToFnFlag = foldl (.|.) 0 . map evToFnFlag' - where evToFnFlag' :: EventVariety -> FileNotificationFlag - evToFnFlag' ev = case ev of - Modify -> fILE_NOTIFY_CHANGE_LAST_WRITE - Move -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME - Create -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME - Delete -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME - -watchDirectoryOnce :: FilePath -> Bool -> [EventVariety] -> IO Event -watchDirectoryOnce dir wst evs = do - h <- getWatchHandle dir - readDirectoryChanges h wst (evToFnFlag evs) >>= actsToEvent - -watchDirectory :: FilePath -> Bool -> [EventVariety] -> IO [Event] -watchDirectory dir wst evs = do - h <- getWatchHandle dir - loop h - where loop h = do e <- readDirectoryChanges h wst (evToFnFlag evs) >>= actsToEvent - es <- unsafeInterleaveIO $ loop h - return $ e:es - - - - -actsToEvent :: [(Action, String)] -> IO Event -actsToEvent [] = error "The impossible happened - there was no event!" -actsToEvent [(act, fn)] = do - isDir <- doesDirectoryExist fn - case act of - FileModified -> return $ Modified isDir (Just fn) - FileAdded -> return $ Created isDir fn - FileRemoved -> return $ Deleted isDir fn - FileRenamedOld -> return $ Renamed isDir Nothing fn -actsToEvent [(FileRenamedOld, fnold),(FileRenamedNew, fnnew)] = do - isDir <- doesDirectoryExist fnnew - return $ Renamed isDir (Just fnold) fnnew - -data Event - -- | A file was modified. @Modified isDirectory file@ - = Modified - { isDirectory :: Bool - , maybeFilePath :: Maybe FilePath - } - -- | A file was moved within the directory. - | Renamed - { isDirectory :: Bool - , oldName :: Maybe FilePath - , newName :: FilePath - } - -- | A file was created. @Created isDirectory file@ - | Created - { isDirectory :: Bool - , filePath :: FilePath - } - -- | A file was deleted. @Deleted isDirectory file@ - | Deleted - { isDirectory :: Bool - , filePath :: FilePath - } - deriving (Eq, Show)
Win32-notify.cabal view
@@ -1,18 +1,24 @@ name: Win32-notify -version: 0.1 +version: 0.2 license: BSD3 license-file: LICENSE author: Niklas Broberg -copyright: Niklas Broberg, 2008 -maintainer: Niklas Broberg <nibro@cs.chalmers.se> +copyright: Niklas Broberg, 2008; Mark Dittmer, 2012 +maintainer: Mark Dittmer <mark.s.dittmer@gmail.com> category: System synopsis: A binding to part of the Win32 library for file notification description: A binding to part of the Win32 library for file notification build-type: Simple -build-depends: base, Win32, directory -ghc-options: -Wall -fno-warn-incomplete-patterns -fno-warn-unused-imports -extensions: ForeignFunctionInterface +cabal-version: >= 1.8 -exposed-modules: System.Win32.Notify -other-modules: System.Win32.FileNotify +library + build-depends: base >= 4 && < 5, Win32, directory, containers >= 0.4.0.0 + ghc-options: -Wall -fno-warn-incomplete-patterns -fno-warn-unused-imports -threaded + exposed-modules: System.Win32.Notify + other-modules: System.Win32.FileNotify + hs-source-dirs: src +executable simple + main-is: examples/simple/simple.hs + build-depends: base >= 4 && < 5, directory, Win32-notify >= 0.1 + ghc-options: -Wall -threaded
+ examples/simple/simple.hs view
@@ -0,0 +1,21 @@+module Main where + +import System.IO +import System.Directory +import System.Win32.Notify + +main :: IO () +main = do + watchManager <- initWatchManager + home <- getHomeDirectory + wd <- watchDirectory watchManager home isRecursive varieties handler + print wd + putStrLn "Listens to your home directory. Hit enter to terminate." + getLine -- TODO: This hangs... why is that? + killWatchManager watchManager + putStrLn "Quitting." + where + isRecursive = False + varieties = [Create, Delete, Modify, Move] + handler :: Handler + handler event = putStrLn $ show event
+ src/System/Win32/FileNotify.hsc view
@@ -0,0 +1,151 @@+{-# LANGUAGE ForeignFunctionInterface #-} +#if __GLASGOW_HASKELL__ >= 701 +{-# LANGUAGE InterruptibleFFI #-} +#endif + +module System.Win32.FileNotify + ( Handle + , Action(..) + , getWatchHandle + , readDirectoryChanges + ) where + +import System.Win32.File +import System.Win32.Types + +import Foreign +import Foreign.C + +import Data.Bits + + +#include <windows.h> + +type Handle = HANDLE + +getWatchHandle :: FilePath -> IO Handle +getWatchHandle dir = + createFile dir + fILE_LIST_DIRECTORY -- Access mode + (fILE_SHARE_READ .|. fILE_SHARE_WRITE) -- Share mode + Nothing -- security attributes + oPEN_EXISTING -- Create mode, we want to look at an existing directory + fILE_FLAG_BACKUP_SEMANTICS -- File attribute, nb NOT using OVERLAPPED since we work synchronously + Nothing -- No template file + + +readDirectoryChanges :: Handle -> Bool -> FileNotificationFlag -> IO [(Action, String)] +readDirectoryChanges h wst mask = do + let maxBuf = 16384 + allocaBytes maxBuf $ \buffer -> do + alloca $ \bret -> do + readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret + readChanges buffer + +data Action = FileAdded | FileRemoved | FileModified | FileRenamedOld | FileRenamedNew + deriving (Show, Read, Eq, Ord, Enum) + +readChanges :: Ptr FILE_NOTIFY_INFORMATION -> IO [(Action, String)] +readChanges pfni = do + fni <- peekFNI pfni + let entry = (faToAction $ fniAction fni, fniFileName fni) + nioff = fromEnum $ fniNextEntryOffset fni + entries <- if nioff == 0 then return [] else readChanges $ pfni `plusPtr` nioff + return $ entry:entries + +faToAction :: FileAction -> Action +faToAction fa = toEnum $ fromEnum fa - 1 + +------------------------------------------------------------------- +-- Low-level stuff that binds to notifications in the Win32 API + +-- Defined in System.Win32.File, but with too few cases: +-- type AccessMode = UINT + +#{enum AccessMode, + , fILE_LIST_DIRECTORY = FILE_LIST_DIRECTORY + } +-- there are many more cases but I only need this one. + +type FileAction = DWORD + +#{enum FileAction, + , fILE_ACTION_ADDED = FILE_ACTION_ADDED + , fILE_ACTION_REMOVED = FILE_ACTION_REMOVED + , fILE_ACTION_MODIFIED = FILE_ACTION_MODIFIED + , fILE_ACTION_RENAMED_OLD_NAME = FILE_ACTION_RENAMED_OLD_NAME + , fILE_ACTION_RENAMED_NEW_NAME = FILE_ACTION_RENAMED_NEW_NAME + } + +type WCHAR = Word16 +-- This is a bit overkill for now, I'll only use nullFunPtr anyway, +-- but who knows, maybe someday I'll want asynchronous callbacks on the OS level. +type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ()) + +data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION + { fniNextEntryOffset, fniAction :: DWORD + , fniFileName :: String + } + +-- instance Storable FILE_NOTIFY_INFORMATION where +-- ... well, we can't write an instance since the struct is not of fix size, +-- so we'll have to do it the hard way, and not get anything for free. Sigh. + +-- sizeOfFNI :: FILE_NOTIFY_INFORMATION -> Int +-- sizeOfFNI fni = (#size FILE_NOTIFY_INFORMATION) + (#size WCHAR) * (length (fniFileName fni) - 1) + +peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION +peekFNI buf = do + neof <- (#peek FILE_NOTIFY_INFORMATION, NextEntryOffset) buf + acti <- (#peek FILE_NOTIFY_INFORMATION, Action) buf + fnle <- (#peek FILE_NOTIFY_INFORMATION, FileNameLength) buf + fnam <- peekCWStringLen + (buf `plusPtr` (#offset FILE_NOTIFY_INFORMATION, FileName), -- start of array + fromEnum (fnle :: DWORD) `div` 2 ) -- fnle is the length in *bytes*, and a WCHAR is 2 bytes + return $ FILE_NOTIFY_INFORMATION neof acti fnam + + +readDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag -> LPDWORD -> IO () +readDirectoryChangesW h buf bufSize wst f br = + failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f br nullPtr nullFunPtr + +{- +asynchReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag + -> LPOVERLAPPED -> IO () +asynchReadDirectoryChangesW h buf bufSize wst f over = + failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f nullPtr over nullFunPtr + +cbReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag + -> LPOVERLAPPED -> IO BOOL +cbReadDirectoryChanges +-} + +-- The interruptible qualifier will keep threads listening for events from hanging blocking when killed +#if __GLASGOW_HASKELL__ >= 701 +foreign import stdcall interruptible "windows.h ReadDirectoryChangesW" +#else +foreign import stdcall safe "windows.h ReadDirectoryChangesW" +#endif + c_ReadDirectoryChangesW :: Handle -> LPVOID -> DWORD -> BOOL -> DWORD + -> LPDWORD -> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL + +{- +type CompletionRoutine :: (DWORD, DWORD, LPOVERLAPPED) -> IO () +foreign import ccall "wrapper" + mkCompletionRoutine :: CompletionRoutine -> IO (FunPtr CompletionRoutine) + +type LPOVERLAPPED = Ptr OVERLAPPED +type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr CompletionRoutine + +data OVERLAPPED = OVERLAPPED + { + } + + +-- In System.Win32.File, but missing a crucial case: +-- type FileNotificationFlag = DWORD +-} +#{enum FileNotificationFlag, + , fILE_NOTIFY_CHANGE_CREATION = FILE_NOTIFY_CHANGE_CREATION + , fILE_NOTIFY_CHANGE_LAST_ACCESS = FILE_NOTIFY_CHANGE_LAST_ACCESS + }
+ src/System/Win32/Notify.hs view
@@ -0,0 +1,146 @@+module System.Win32.Notify + ( initWatchManager + , killWatchManager + , watchDirectory + , watch + , Event(..) + , EventVariety(..) + , Handler + , WatchId(..) + , WatchManager(..) + ) where + +import Control.Concurrent +import Control.Concurrent.MVar +import Data.Bits +import Data.List (intersect) +import Data.Map (Map) +import System.Directory +import System.Win32.File +import System.Win32.FileNotify +import qualified Data.Map as Map + +data EventVariety + = Modify + | Move + | Create + | Delete + deriving Eq + +data Event + -- | A file was modified. @Modified isDirectory file@ + = Modified + { isDirectory :: Bool + , maybeFilePath :: Maybe FilePath + } + -- | A file was moved within the directory. + | Renamed + { isDirectory :: Bool + , oldName :: Maybe FilePath + , newName :: FilePath + } + -- | A file was created. @Created isDirectory file@ + | Created + { isDirectory :: Bool + , filePath :: FilePath + } + -- | A file was deleted. @Deleted isDirectory file@ + | Deleted + { isDirectory :: Bool + , filePath :: FilePath + } + deriving (Eq, Show) + +type Handler = Event -> IO () + +data WatchId = WatchId ThreadId ThreadId deriving (Eq, Ord, Show) +type WatchMap = Map WatchId Handler +data WatchManager = WatchManager (MVar WatchMap) + +initWatchManager :: IO WatchManager +initWatchManager = do + mvarMap <- newMVar Map.empty + return (WatchManager mvarMap) + +killWatchManager :: WatchManager -> IO () +killWatchManager (WatchManager mvarMap) = do + watchMap <- readMVar mvarMap + flip mapM_ (Map.keys watchMap) $ killThreads + where + killThreads :: WatchId -> IO () + killThreads (WatchId tid1 tid2) + | tid1 == tid2 = killThread tid1 + | otherwise = do + killThread tid1 + killThread tid2 + +varietiesToFnFlags :: [EventVariety] -> FileNotificationFlag +varietiesToFnFlags = foldl (.|.) 0 . map evToFnFlag' + where evToFnFlag' :: EventVariety -> FileNotificationFlag + evToFnFlag' ev = case ev of + Modify -> fILE_NOTIFY_CHANGE_LAST_WRITE + Move -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME + Create -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME + Delete -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME + +-- watchDirectoryOnce :: FilePath -> Bool -> [EventVariety] -> IO +-- watchDirectoryOnce dir wst evs = do +-- h <- getWatchHandle dir +-- readDirectoryChanges h wst (evToFnFlag evs) >>= actsToEvent + +watchDirectory :: WatchManager -> FilePath -> Bool -> [EventVariety] -> Handler -> IO WatchId +watchDirectory (WatchManager mvarMap) dir watchSubTree varieties handler = do + watchHandle <- getWatchHandle dir + chanEvents <- newChan + tid1 <- forkIO $ dispatcher chanEvents + tid2 <- forkIO $ osEventsReader watchHandle chanEvents + modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid1 tid2) handler watchMap) + return (WatchId tid1 tid2) + where + dispatcher :: Chan [Event] -> IO () + dispatcher chanEvents = do + events <- readChan chanEvents + mapM_ maybeHandle events + dispatcher chanEvents + osEventsReader :: Handle -> Chan [Event] -> IO () + osEventsReader watchHandle chanEvents = do + event <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvent) + writeChan chanEvents [event] + osEventsReader watchHandle chanEvents + maybeHandle :: Handler + maybeHandle event = + if not (null ((eventToVarieties event) `intersect` varieties)) then handler event else return () + +watch :: WatchManager -> FilePath -> Bool -> [EventVariety] -> IO (WatchId, Chan [Event]) +watch (WatchManager mvarMap) dir watchSubTree varieties = do + watchHandle <- getWatchHandle dir + chanEvents <- newChan + tid <- forkIO $ osEventsReader watchHandle chanEvents + modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid tid) (\_ -> return ()) watchMap) + return ((WatchId tid tid), chanEvents) + where + osEventsReader :: Handle -> Chan [Event] -> IO () + osEventsReader watchHandle chanEvents = do + event <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvent) + writeChan chanEvents [event] + osEventsReader watchHandle chanEvents + +eventToVarieties :: Event -> [EventVariety] +eventToVarieties event = case event of + Created _ _ -> [Create] + Deleted _ _ -> [Delete] + Modified _ _ -> [Modify] + Renamed _ _ _ -> [Move] + +actsToEvent :: [(Action, String)] -> IO Event +actsToEvent [] = error "The impossible happened - there was no event!" +actsToEvent [(act, fn)] = do + isDir <- doesDirectoryExist fn + case act of + FileModified -> return $ Modified isDir (Just fn) + FileAdded -> return $ Created isDir fn + FileRemoved -> return $ Deleted isDir fn + FileRenamedOld -> return $ Renamed isDir Nothing fn +actsToEvent [(FileRenamedOld, fnold),(FileRenamedNew, fnnew)] = do + isDir <- doesDirectoryExist fnnew + return $ Renamed isDir (Just fnold) fnnew