follow-file 0.0.1.2 → 0.0.2

raw patch · 3 files changed

+60/−44 lines, 3 filesdep +conduitdep +conduit-combinatorsdep +exceptionsdep −vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: conduit, conduit-combinators, exceptions, monad-control, mtl

Dependencies removed: vector

API changes (from Hackage documentation)

Files

• app/Main.hs +3/−1
• follow-file.cabal +19/−14
• src/System/File/Follow.hs +38/−29

@@ -3,6 +3,8 @@ import qualified Data.Text as T import Data.Attoparsec.Text (parseOnly, endOfInput, eitherP) import Data.Attoparsec.Path (absFilePath, relFilePath, absDirPath)+import Data.Conduit ((=$=), runConduit)+import Data.Conduit.Combinators (stdout) import System.INotify (initINotify, removeWatch, killINotify) import System.File.Follow (follow) import System.Directory (getCurrentDirectory)@@ -25,4 +27,4 @@                 Right d' ->                   pure (d' </> r)   i <- initINotify-  bracket (follow i f BS.putStr) (\watch -> removeWatch watch >> killINotify i) $ \_ -> forever $ threadDelay 50000+  bracket (follow i f (\source -> runConduit $ source =$= stdout)) (\watch -> removeWatch watch >> killINotify i) $ \_ -> forever $ threadDelay 50000

@@ -1,5 +1,5 @@ Name:                   follow-file-Version:                0.0.1.2+Version:                0.0.2 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -21,27 +21,32 @@                       , attoparsec                       , attoparsec-path                       , bytestring+                      , conduit                       , directory+                      , exceptions                       , hinotify+                      , monad-control+                      , mtl                       , path                       , text                       , unix                       , utf8-string-                      , vector  Executable follow-file-  Default-Language:    Haskell2010-  Hs-Source-Dirs:      app-  Main-is:             Main.hs-  Build-Depends:       base-                     , bytestring-                     , follow-file-                     , path-                     , text-                     , attoparsec-                     , attoparsec-path-                     , hinotify-                     , directory+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       app+  Main-is:              Main.hs+  Build-Depends:        base+                      , bytestring+                      , follow-file+                      , path+                      , text+                      , attoparsec+                      , attoparsec-path+                      , hinotify+                      , conduit+                      , conduit-combinators+                      , directory  Source-Repository head   Type:                 git

@@ -2,6 +2,8 @@     ScopedTypeVariables   , NamedFieldPuns   , TupleSections+  , Rank2Types+  , FlexibleContexts   #-}  module System.File.Follow where@@ -10,13 +12,15 @@ 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 qualified Data.Text as T import Data.Attoparsec.Text (parseOnly, endOfInput) import Data.Attoparsec.Path (relFilePath)-import Control.Monad (when)-import Control.Exception (bracket)-import Path (Path, Abs, File, filename, parent, toFilePath, parseRelFile)+import Data.Conduit (Producer, yield)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Catch (MonadMask, bracket)+import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith))+import Path (Path, Abs, File, filename, parent, toFilePath) import System.Posix.IO.ByteString (fdReadBuf, openFd, OpenMode (ReadOnly), defaultFileFlags, closeFd, fdSeek) import System.Posix.Types (FileOffset) import System.Posix.Files.ByteString (fileSize, getFileStatus)@@ -28,48 +32,53 @@ -- | '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 :: ( MonadIO m+          , MonadMask m+          , MonadBaseControl IO m+          )+       => INotify+       -> Path Abs File+       -> (Producer m BS.ByteString -> m ()) -- ^ Monadic state of @m@ is thrown away for each invocation, not synchronously interleaved.+       -> m WatchDescriptor follow inotify file f = do   let file' = toFilePath file-  exists <- doesFileExist file'-  (positionRef :: IORef FileOffset) <-+  exists <- liftIO (doesFileExist file')+  (positionRef :: IORef FileOffset) <- liftIO $     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+  let go  = bracket (liftIO $ openFd (BS8.fromString file') ReadOnly Nothing defaultFileFlags)+                    (liftIO . closeFd) $ \fd -> do+              toSeek <- liftIO (readIORef positionRef)+              idx <- liftIO (fdSeek fd AbsoluteSeek toSeek)+              liftIO (writeIORef positionRef idx)+              let loop = do+                    c <- liftIO $ 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))+                      then pure ()+                      else do+                        yield c+                        loop+              f loop       stop = do-        writeIORef positionRef 0-        f mempty-  addWatch inotify [Modify, Create, Delete] (toFilePath $ parent file) $ \e ->+        liftIO (writeIORef positionRef 0)+        f (yield mempty)+  liftBaseWith $ \runInBase -> addWatch inotify [Modify, Create, Delete] (toFilePath $ parent file) $ \e ->     let isFile filePath = parseOnly (relFilePath <* endOfInput) (T.pack filePath) == Right (filename file)     in  case e of-          Created {filePath}  | isFile filePath -> go+          Created {filePath}  | isFile filePath -> void $ runInBase go                               | otherwise -> pure ()-          Deleted {filePath}  | isFile filePath -> stop+          Deleted {filePath}  | isFile filePath -> void $ runInBase stop                               | otherwise -> pure ()-          Modified {maybeFilePath}  | (isFile <$> maybeFilePath) == Just True -> go+          Modified {maybeFilePath}  | (isFile <$> maybeFilePath) == Just True -> void $ runInBase go                                     | otherwise -> pure ()-          MovedIn {filePath}  | isFile filePath -> go+          MovedIn {filePath}  | isFile filePath -> void $ runInBase go                               | otherwise -> pure ()-          MovedOut {filePath}   | isFile filePath -> go+          MovedOut {filePath}   | isFile filePath -> void $ runInBase go                                 | otherwise -> pure ()           DeletedSelf -> error "containing folder deleted"           Unmounted -> error "containing folder unmounted"