packages feed

follow-file (empty) → 0.0.1

raw patch · 5 files changed

+157/−0 lines, 5 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, follow-file, hinotify, path, unix, utf8-string, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Athan Clark++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 Athan Clark 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
+ follow-file.cabal view
@@ -0,0 +1,42 @@+Name:                   follow-file+Version:                0.0.1+Author:                 Athan Clark <athan.clark@gmail.com>+Maintainer:             Athan Clark <athan.clark@gmail.com>+License:                BSD3+License-File:           LICENSE+Synopsis:               Be notified when a file gets appended, solely with what was added.+Description:+    See module for docs+Cabal-Version:          >= 1.10+Build-Type:             Simple+Category:               Filesystem+++Library+  Default-Language:     Haskell2010+  HS-Source-Dirs:       src+  GHC-Options:          -Wall+  Exposed-Modules:      System.File.Follow+  Build-Depends:        base >= 4.8 && < 5+                      , bytestring+                      , directory+                      , hinotify+                      , path+                      , unix+                      , utf8-string+                      , vector++Test-suite filefollow-tests+  Type:                exitcode-stdio-1.0+  Default-Language:    Haskell2010+  Hs-Source-Dirs:      test+  Main-is:             Main.hs+  Build-Depends:       base+                     , follow-file+                     , path+                     , hinotify+                     , directory++Source-Repository head+  Type:                 git+  Location:             https://github.com/athanclark/follow-file
+ src/System/File/Follow.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE+    ScopedTypeVariables+  , NamedFieldPuns+  , TupleSections+  #-}++module System.File.Follow where++import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.ByteString.Lazy.Internal as LBS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.UTF8 as BS8+import qualified Data.Vector as V+import Control.Monad (when)+import Control.Exception (bracket)+import Path (Path, Abs, File, filename, parent, toFilePath, parseRelFile)+import System.Posix.IO.ByteString (fdReadBuf, openFd, OpenMode (ReadOnly), defaultFileFlags, closeFd, fdSeek)+import System.Posix.Types (FileOffset)+import System.Posix.Files.ByteString (fileSize, getFileStatus)+import System.Directory (doesFileExist)+import System.INotify (INotify, addWatch, Event (..), EventVariety (..), WatchDescriptor)+import GHC.IO.Device (SeekMode (AbsoluteSeek))+++-- | 'follow' takes a file, and informs you /only/ when it changes. If it's deleted,+-- | you're notified with an empty 'Data.ByteString.ByteString'. If it doesn't exist yet, you'll be informed+-- | of its entire contents upon it's creation, and will proceed to "follow it" as normal.+follow :: INotify+        -> Path Abs File+        -> (LBS.ByteString -> IO ())+        -> IO WatchDescriptor+follow inotify file f = do+  let file' = toFilePath file+  exists <- doesFileExist file'+  (positionRef :: IORef FileOffset) <-+    if exists+      then getFileStatus (BS8.fromString file') >>= (newIORef . fileSize)+      else newIORef 0+  let go  = bracket (openFd (BS8.fromString file') ReadOnly Nothing defaultFileFlags)+                    closeFd $ \fd -> do+              toSeek <- readIORef positionRef+              idx <- fdSeek fd AbsoluteSeek toSeek+              writeIORef positionRef idx+              let loop acc = do+                    c <- BS.createUptoN LBS.defaultChunkSize $ \ptr -> do+                      seeked <- readIORef positionRef+                      moreRead <- fdReadBuf fd ptr (fromIntegral LBS.defaultChunkSize)+                      writeIORef positionRef (seeked + fromIntegral moreRead)+                      pure (fromIntegral moreRead)+                    if c == mempty+                      then pure acc+                      else loop (acc `V.snoc` c)+              theRest <- loop V.empty+              when (theRest /= V.empty) (f (V.foldr LBS.chunk mempty theRest))+      stop = do+        writeIORef positionRef 0+        f mempty+  addWatch inotify [Modify, Create, Delete] (toFilePath $ parent file) $ \e -> case e of+    Created {filePath} | parseRelFile filePath == Just (filename file) -> go+                       | otherwise -> pure ()+    Deleted {filePath} | parseRelFile filePath == Just (filename file) -> stop+                       | otherwise -> pure ()+    Modified {maybeFilePath} | ( maybeFilePath >>= parseRelFile+                               ) == Just (filename file) -> go+                             | otherwise -> pure ()+    _ -> pure ()
+ test/Main.hs view
@@ -0,0 +1,17 @@+import Path+import System.INotify (initINotify, removeWatch, killINotify)+import System.File.Follow (follow)+import System.Directory (getCurrentDirectory)+import Control.Monad (forever)+import Control.Exception (bracket)+import Control.Concurrent (threadDelay)+++main = do+  i <- initINotify+  d <- getCurrentDirectory+  f <- parseAbsFile $ d ++ "/foo"+  bracket (follow i f print) (\watch -> do+                                removeWatch watch+                                killINotify i+                              ) $ \_ -> forever $ threadDelay 50000