diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/follow-file.cabal b/follow-file.cabal new file mode 100644 --- /dev/null +++ b/follow-file.cabal @@ -0,0 +1,42 @@ +Name: follow-file +Version: 0.0.1 +Author: Athan Clark +Maintainer: Athan Clark +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 diff --git a/src/System/File/Follow.hs b/src/System/File/Follow.hs new file mode 100644 --- /dev/null +++ b/src/System/File/Follow.hs @@ -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 () diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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