Notify.hs

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)