Win32-notify 0.2 → 0.3

raw patch · 3 files changed

+58/−49 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• Win32-notify.cabal +3/−3
• examples/simple/simple.hs +1/−2
• src/System/Win32/Notify.hs +54/−44

@@ -1,5 +1,5 @@ name:           Win32-notify
-version:        0.2
+version:        0.3
 license:        BSD3
 license-file:   LICENSE
 author:         Niklas Broberg
@@ -12,7 +12,7 @@ cabal-version:  >= 1.8
 
 library
-  build-depends:   base >= 4 && < 5, Win32, directory, containers >= 0.4.0.0
+  build-depends:   base >= 4.3.1.0 && < 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
@@ -20,5 +20,5 @@ 
 executable simple
   main-is:       examples/simple/simple.hs
-  build-depends: base >= 4 && < 5, directory, Win32-notify >= 0.1
+  build-depends: base >= 4.3.1.0 && < 5, directory, Win32-notify >= 0.1
   ghc-options:   -Wall -threaded

@@ -1,6 +1,5 @@ module Main where
 
-import System.IO
 import System.Directory
 import System.Win32.Notify
 
@@ -11,7 +10,7 @@   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?
+  _ <- getLine -- TODO: This hangs... why is that?
   killWatchManager watchManager
   putStrLn "Quitting."
   where

@@ -1,13 +1,14 @@ module System.Win32.Notify
-  ( initWatchManager
-  , killWatchManager
-  , watchDirectory
-  , watch
-  , Event(..)
+  ( Event(..)
   , EventVariety(..)
   , Handler
   , WatchId(..)
   , WatchManager(..)
+  , initWatchManager
+  , killWatch
+  , killWatchManager
+  , watch
+  , watchDirectory
     ) where
 
 import Control.Concurrent
@@ -16,6 +17,7 @@ import Data.List (intersect)
 import Data.Map (Map)
 import System.Directory
+import System.Win32 (closeHandle)
 import System.Win32.File
 import System.Win32.FileNotify
 import qualified Data.Map as Map
@@ -31,14 +33,18 @@     -- | A file was modified. @Modified isDirectory file@
     = Modified
         { isDirectory :: Bool
-        , maybeFilePath :: Maybe FilePath
+        , filePath :: FilePath
         }
-    -- | A file was moved within the directory.
+    -- TODO: Problems with receiving (oldName, nil), (nil, newName) events at
+    -- unpredictable times mean that, for now, rename detection is disabled.
+    {-
+    -- A file was moved within the directory.
     | Renamed
         { isDirectory :: Bool
         , oldName     :: Maybe FilePath
-        , newName     :: FilePath
+        , newName     :: Maybe FilePath
         }
+    -}
     -- | A file was created. @Created isDirectory file@
     | Created
         { isDirectory :: Bool
@@ -53,10 +59,13 @@ 
 type Handler = Event -> IO ()
 
-data WatchId = WatchId ThreadId ThreadId deriving (Eq, Ord, Show)
+data WatchId = WatchId ThreadId ThreadId Handle deriving (Eq, Ord, Show)
 type WatchMap = Map WatchId Handler
 data WatchManager = WatchManager (MVar WatchMap)
 
+void :: IO ()
+void = return ()
+
 initWatchManager :: IO WatchManager
 initWatchManager =  do
   mvarMap <- newMVar Map.empty
@@ -65,14 +74,7 @@ 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
+  flip mapM_ (Map.keys watchMap) $ killWatch
 
 varietiesToFnFlags :: [EventVariety] -> FileNotificationFlag
 varietiesToFnFlags = foldl (.|.) 0 . map evToFnFlag'
@@ -94,8 +96,8 @@   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)
+  modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid1 tid2 watchHandle) handler watchMap)
+  return (WatchId tid1 tid2 watchHandle)
   where
     dispatcher :: Chan [Event] -> IO ()
     dispatcher chanEvents = do
@@ -104,43 +106,51 @@       dispatcher chanEvents
     osEventsReader :: Handle -> Chan [Event] -> IO ()
     osEventsReader watchHandle chanEvents = do
-      event <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvent)
-      writeChan chanEvents [event]
+      events <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvents)
+      writeChan chanEvents events
       osEventsReader watchHandle chanEvents
     maybeHandle :: Handler
     maybeHandle event =
-      if not (null ((eventToVarieties event) `intersect` varieties)) then handler event else return ()
+      if (==) (eventToVariety event) `any` varieties then handler event else void
 
 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)
+  modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid tid watchHandle) (\_ -> void) watchMap)
+  return ((WatchId tid tid watchHandle), chanEvents)
   where
     osEventsReader :: Handle -> Chan [Event] -> IO ()
     osEventsReader watchHandle chanEvents = do
-      event <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvent)
-      writeChan chanEvents [event]
+      events <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvents)
+      writeChan chanEvents events
       osEventsReader watchHandle chanEvents
 
-eventToVarieties :: Event -> [EventVariety]
-eventToVarieties event = case event of
-  Created  _ _   -> [Create]
-  Deleted  _ _   -> [Delete]
-  Modified _ _   -> [Modify]
-  Renamed  _ _ _ -> [Move]
+killWatch :: WatchId -> IO ()
+killWatch (WatchId tid1 tid2 handle) = do
+    killThread tid1
+    if tid1 /= tid2 then killThread tid2 else void
+    closeHandle handle
 
-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
+eventToVariety :: Event -> EventVariety
+eventToVariety event = case event of
+  Created  _ _   -> Create
+  Deleted  _ _   -> Delete
+  Modified _ _   -> Modify
+  -- Renamed  _ _ _ -> [Move]
+
+actsToEvents :: [(Action, String)] -> IO [Event]
+actsToEvents = mapM actToEvent
+  where
+    actToEvent (act, fn) = do
+      isDir <- doesDirectoryExist fn
+      case act of
+        FileModified    -> return $ Modified isDir fn
+        FileAdded       -> return $ Created  isDir fn
+        FileRemoved     -> return $ Deleted  isDir fn
+        FileRenamedOld  -> return $ Deleted  isDir fn
+        FileRenamedNew  -> return $ Created  isDir fn
+-- actsToEvent [(FileRenamedOld, fnold),(FileRenamedNew, fnnew)] = do
+--     isDir <- doesDirectoryExist fnnew
+--     return $ Renamed isDir (Just fnold) fnnew