packages feed

hfsevents (empty) → 0.1

raw patch · 5 files changed

+343/−0 lines, 5 filesdep +basedep +bytestringdep +cerealsetup-changed

Dependencies added: base, bytestring, cereal, text, unix

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Luite Stegeman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Luite Stegeman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/OSX/FSEvents.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}++-- | Event-based file and folder watching for OS X++module System.OSX.FSEvents+  ( EventStream+  , eventStreamCreate+  , eventStreamDestroy+  , Event (..)+  -- event callback flags+  , eventFlagMustScanSubDirs, eventFlagUserDropped, eventFlagKernelDropped+  , eventFlagEventIdsWrapped, eventFlagHistoryDone, eventFlagRootChanged+  , eventFlagMount, eventFlagUnmount+  -- item flags: enable file-level events to get these+  , eventFlagItemCreated, eventFlagItemRemoved, eventFlagItemInodeMetaMod+  , eventFlagItemRenamed, eventFlagItemModified, eventFlagItemFinderInfoMod+  , eventFlagItemChangeOwner, eventFlagItemXattrMod+  , eventFlagItemIsFile, eventFlagItemIsDir, eventFlagItemIsSymlink+  ) where++import Control.Concurrent+import Control.Concurrent.MVar+import Control.Exception (bracket)+import Control.Monad+import Data.Bits+import Data.Serialize.Get+import Data.Word+import Foreign.C.String+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import System.IO+import System.Posix.IO+import System.Posix.Types++import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TE++data EventStream = EventStream (Ptr CWatch) (MVar Bool)+data Event = Event+   { eventPath  :: FilePath+   , eventId    :: Word64+   , eventFlags :: Word64+   } deriving (Show, Ord, Eq)+data CWatch++eventFlagMustScanSubDirs :: Word64+eventFlagMustScanSubDirs = 0x00000001+eventFlagUserDropped :: Word64+eventFlagUserDropped = 0x00000002+eventFlagKernelDropped :: Word64+eventFlagKernelDropped = 0x00000004+eventFlagEventIdsWrapped :: Word64+eventFlagEventIdsWrapped = 0x00000008+eventFlagHistoryDone :: Word64+eventFlagHistoryDone = 0x00000010+eventFlagRootChanged :: Word64+eventFlagRootChanged = 0x00000020+eventFlagMount :: Word64+eventFlagMount = 0x00000040+eventFlagUnmount :: Word64+eventFlagUnmount = 0x00000080+-- These flags are only set if you enabled file events when creating the stream+eventFlagItemCreated :: Word64+eventFlagItemCreated = 0x00000100+eventFlagItemRemoved :: Word64+eventFlagItemRemoved = 0x00000200+eventFlagItemInodeMetaMod :: Word64+eventFlagItemInodeMetaMod = 0x00000400+eventFlagItemRenamed :: Word64+eventFlagItemRenamed = 0x00000800+eventFlagItemModified :: Word64+eventFlagItemModified = 0x00001000+eventFlagItemFinderInfoMod :: Word64+eventFlagItemFinderInfoMod = 0x00002000+eventFlagItemChangeOwner :: Word64+eventFlagItemChangeOwner = 0x00004000+eventFlagItemXattrMod :: Word64+eventFlagItemXattrMod = 0x00008000+eventFlagItemIsFile :: Word64+eventFlagItemIsFile = 0x00010000+eventFlagItemIsDir :: Word64+eventFlagItemIsDir = 0x00020000+eventFlagItemIsSymlink :: Word64+eventFlagItemIsSymlink = 0x00040000++withCStrings :: [String] -> (Ptr (Ptr CChar) -> Int -> IO a) -> IO a+withCStrings xss act = bracket alloc release (\p -> act p n)+  where+    n          = length xss+    alloc      = mapM newCString xss >>= newArray+    release pp = peekArray n pp >>= mapM_ free >> free pp+++-- | Create an FSEvents watch for a list of paths.+-- The callback action will be called for each event in the watched paths+-- until the 'EventStream' is destroyed again. All callbacks are from a+-- single thread, so if you take too long to process an event, further+-- events will be delayed.+-- Note: it's relatively expensive to create a watch, since each watch+-- uses an operating system thread for its event loop.+eventStreamCreate :: [FilePath]      -- ^ The paths to watch+                  -> Double          -- ^ Latency+                  -> Bool            -- ^ Process event immediately if no other events received for at least latency+                  -> Bool            -- ^ Ignore events caused by current process+                  -> Bool            -- ^ Get file-level notifications instead of directory level +                  -> (Event -> IO a) -- ^ The action to run when an event has taken place+                  -> IO EventStream  -- ^ The event stream, use this to destroy the stream+eventStreamCreate ps latency nodefer noself filelevel a = withCStrings ps $ \pp n ->+  alloca $ \pfd -> do+  alloca $ \ppw -> do+    when (latency < 0) $ ioError (userError "latency must be nonnegative")+    r <- c_createWatch pp (fromIntegral n) flags 0 (realToFrac latency) pfd ppw+    when (r /= 0) $ ioError (userError "could not create file system event stream")+    h <- fdToHandle . Fd =<< peek pfd+    pw <- peek ppw+    destroyed <- newMVar False+    forkIO $ consumeMsgs h a+    return $ EventStream pw destroyed+        where+          flags = condFlag createFlagNoDefer nodefer .|.+                  condFlag createFlagIgnoreSelf noself .|.+                  condFlag createFlagFileEvents filelevel++condFlag :: Word32 -> Bool -> Word32+condFlag f False = 0+condFlag f True  = f++createFlagNoDefer :: Word32+createFlagNoDefer = 0x00000002++createFlagIgnoreSelf :: Word32+createFlagIgnoreSelf = 0x00000008++createFlagFileEvents :: Word32+createFlagFileEvents = 0x00000010++-- |  Destroy an event stream, the callback action will not be run for new events+-- (but there may be pending events remaining)+eventStreamDestroy :: EventStream -> IO ()+eventStreamDestroy (EventStream ptr d) = do+  destroyed <- takeMVar d+  when (not destroyed) $ c_destroyWatch ptr+  putMVar d True++consumeMsgs :: Handle -> (Event -> IO a) -> IO ()+consumeMsgs h a = readEvents+    where+      readEvents = do+        b <- B.hGet h 24+        if B.length b < 24+          then stop+          else do+            let header = runGet readHeader b+            case header of+              Left _ -> stop+              Right (eventId, flags, pathLen) -> do +                bp <- B.hGet h (fromIntegral pathLen)+                if B.length bp /= fromIntegral pathLen+                  then stop+                  else do+                    let p = TE.decodeUtf8With TE.lenientDecode bp+                    a $ Event (T.unpack p) eventId flags+                    readEvents++      stop = hClose h >> return ()+      readHeader = liftM3 (,,) getWord64host getWord64host getWord64host++foreign import ccall safe "c_fsevents.h createWatch" c_createWatch :: Ptr (Ptr CChar)+                                                                   -> CInt+                                                                   -> Word32+                                                                   -> Word64+                                                                   -> CDouble+                                                                   -> Ptr (CInt)+                                                                   -> Ptr (Ptr CWatch)+                                                                   -> IO CInt++foreign import ccall safe "c_fsevents.h destroyWatch" c_destroyWatch :: Ptr CWatch+                                                                     -> IO ()+
+ cbits/c_fsevents.c view
@@ -0,0 +1,98 @@+#include <CoreServices/CoreServices.h>+#include <pthread.h>+#include <unistd.h>++#include "c_fsevents.h"++void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path) {+  UInt64 buf[3];+  buf[0] = eventId;+  buf[1] = eventFlags;+  buf[2] = (UInt64)strlen(path);+  write(fd, buf, 3*sizeof(UInt64));+  write(fd, path, strlen(path));+}++void watchCallback(ConstFSEventStreamRef streamRef, void *clientCallBackInfo,+                   size_t n, void *eventPaths, const FSEventStreamEventFlags eventFlags[],+                   const FSEventStreamEventId eventIds[]) {+  int i;+  watch *w = clientCallBackInfo;+  char **paths = eventPaths;+  for (i=0; i<n; i++) {+    writeEvent(w->writefd, eventIds[i], eventFlags[i], paths[i]);+  }+}++void *watchRunLoop(void *vw) {+  watch* w = (watch*) vw;+  CFRunLoopRef rl = CFRunLoopGetCurrent();+  CFRetain(rl);+  w->runLoop = rl;+  FSEventStreamScheduleWithRunLoop(w->eventStream, rl, kCFRunLoopDefaultMode);+  FSEventStreamStart(w->eventStream);+  CFRunLoopRun();+  pthread_exit(NULL);+}++#define MAX_WATCH_PATHS 4096++int createWatch( char** folders+               , int n+               , UInt32 createFlags+               , UInt64 since+               , double latency+               , int* fd+               , void** wp+               ) {+  int i;+  int rv;+  int pfds[2];+  if(n>MAX_WATCH_PATHS) return -1;+  if(pipe(pfds)) return -1;+  if(!since) since = kFSEventStreamEventIdSinceNow;+  CFStringRef *cffolders = malloc(n * sizeof(CFStringRef));+  watch *w;+  w  = malloc(sizeof(watch));+  FSEventStreamContext ctx;+  ctx.version = 0;+  ctx.info = (void*)w;+  ctx.retain = NULL;+  ctx.release = NULL;+  ctx.copyDescription = NULL;+  for(i=0;i<n;i++) {+    cffolders[i] = CFStringCreateWithCString(NULL, folders[i], kCFStringEncodingUTF8);+  }+  CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);+  FSEventStreamRef es = FSEventStreamCreate(NULL, &watchCallback, &ctx, paths, since, latency, createFlags);+  pthread_t t;+  if(es != NULL) { /* fixme is this the correct way to check for failure? */+    w->writefd = pfds[1];+    w->eventStream = es;+    w->runLoop = NULL;+    pthread_create(&t, NULL, &watchRunLoop, (void*)w);+    *fd = pfds[0];+    *wp = w;+    rv = 0;+  } else {+    close(pfds[0]);+    close(pfds[1]);+    free(w);+    rv = -1;+  }+  for(i=0;i<n;i++) CFRelease(cffolders[i]);+  free(cffolders);+  CFRelease(paths);+  return rv;+}++int destroyWatch(watch* w) {+  FSEventStreamRelease(w->eventStream);+  if(w->runLoop != NULL) {+    CFRunLoopStop(w->runLoop);+    CFRelease(w->runLoop);+  }+  close(w->writefd);+  free(w);+}+
+ hfsevents.cabal view
@@ -0,0 +1,29 @@+name:                hfsevents+version:             0.1+synopsis:            File/folder watching for OS X+homepage:            http://github.com/luite/hfsevents+license:             BSD3+license-file:        LICENSE+author:              Luite Stegeman+maintainer:          stegeman@gmail.com+category:            System+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules: System.OSX.FSEvents+  if os(darwin)+    buildable: True+  else+    buildable: False+  frameworks: Cocoa+  C-sources: cbits/c_fsevents.c+  include-dirs: cbits+  extra-libraries: pthread+  build-depends:+    base >= 4 && < 5,+    bytestring,+    cereal >= 0.3 && < 0.4,+    unix,+    text+