diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,9 +1,10 @@ +module Main where + import Path -import qualified Data.ByteString.Lazy as BS 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 ((.|), runConduit) import Data.Conduit.Combinators (stdout) import System.INotify (initINotify, removeWatch, killINotify) import System.File.Follow (follow) @@ -14,9 +15,10 @@ import Control.Concurrent (threadDelay) +main :: IO () main = do - [f] <- getArgs - f <- case parseOnly (eitherP absFilePath relFilePath <* endOfInput) (T.pack f) of + [filePath] <- getArgs + f <- case parseOnly (eitherP absFilePath relFilePath <* endOfInput) (T.pack filePath) of Left e -> error e Right eAR -> case eAR of Left a -> pure a @@ -27,4 +29,7 @@ Right d' -> pure (d' r) i <- initINotify - bracket (follow i f (\source -> runConduit $ source =$= stdout)) (\watch -> removeWatch watch >> killINotify i) $ \_ -> forever $ threadDelay 50000 + let obtain = follow i f $ \source -> runConduit (source .| stdout) + release watch = removeWatch watch >> killINotify i + bracket obtain release $ \_ -> + forever (threadDelay 50000) -- run forever diff --git a/follow-file.cabal b/follow-file.cabal --- a/follow-file.cabal +++ b/follow-file.cabal @@ -1,53 +1,73 @@ -Name: follow-file -Version: 0.0.2 -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 +-- This file has been generated from package.yaml by hpack version 0.21.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 2237e4036e920a20255f1af7b7256b4210fd90eddba2b0938e9df217cf29ccb7 +name: follow-file +version: 0.0.3 +synopsis: Be notified when a file gets appended, solely with what was added. Warning - only works on linux and for files that are strictly appended, like log files. +description: Please see the README on Github at +category: Filesystem +homepage: https://github.com/athanclark/follow-file#readme +bug-reports: https://github.com/athanclark/follow-file/issues +maintainer: Athan Clark +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 -Library - Default-Language: Haskell2010 - HS-Source-Dirs: src - GHC-Options: -Wall - Exposed-Modules: System.File.Follow - Build-Depends: base >= 4.8 && < 5 - , attoparsec - , attoparsec-path - , bytestring - , conduit - , directory - , exceptions - , hinotify - , monad-control - , mtl - , path - , text - , unix - , utf8-string +source-repository head + type: git + location: https://github.com/athanclark/follow-file -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 - , conduit - , conduit-combinators - , directory +library + exposed-modules: + System.File.Follow + other-modules: + Paths_follow_file + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + attoparsec + , attoparsec-path + , base >=4.11 && <5 + , bytestring + , conduit + , directory + , exceptions + , hinotify >=0.4 + , monad-control + , mtl + , path + , text + , unix + , utf8-string + default-language: Haskell2010 -Source-Repository head - Type: git - Location: https://github.com/athanclark/follow-file +executable follow-file + main-is: Main.hs + other-modules: + Paths_follow_file + hs-source-dirs: + app + ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N + build-depends: + attoparsec + , attoparsec-path + , base + , bytestring + , conduit + , conduit-combinators + , directory + , exceptions + , follow-file + , hinotify + , monad-control + , mtl + , path + , text + , unix + , utf8-string + default-language: Haskell2010 diff --git a/src/System/File/Follow.hs b/src/System/File/Follow.hs --- a/src/System/File/Follow.hs +++ b/src/System/File/Follow.hs @@ -12,10 +12,10 @@ 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.Text as T +import qualified Data.Text.Encoding as T import Data.Attoparsec.Text (parseOnly, endOfInput) import Data.Attoparsec.Path (relFilePath) -import Data.Conduit (Producer, yield) +import Data.Conduit (ConduitT, yield) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Catch (MonadMask, bracket) @@ -23,6 +23,7 @@ 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.ByteString.FilePath (RawFilePath) import System.Posix.Files.ByteString (fileSize, getFileStatus) import System.Directory (doesFileExist) import System.INotify (INotify, addWatch, Event (..), EventVariety (..), WatchDescriptor) @@ -38,7 +39,7 @@ ) => INotify -> Path Abs File - -> (Producer m BS.ByteString -> m ()) -- ^ Monadic state of @m@ is thrown away for each invocation, not synchronously interleaved. + -> (ConduitT i BS.ByteString m () -> 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 @@ -67,19 +68,25 @@ stop = do 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) + liftBaseWith $ \runInBase -> addWatch inotify [Modify, Create, Delete] (BS8.fromString $ toFilePath $ parent file) $ \e -> + let isFile :: RawFilePath -> Bool + isFile filePath = parseOnly (relFilePath <* endOfInput) (T.decodeUtf8 filePath) == Right (filename file) in case e of - Created {filePath} | isFile filePath -> void $ runInBase go - | otherwise -> pure () - Deleted {filePath} | isFile filePath -> void $ runInBase stop - | otherwise -> pure () - Modified {maybeFilePath} | (isFile <$> maybeFilePath) == Just True -> void $ runInBase go - | otherwise -> pure () - MovedIn {filePath} | isFile filePath -> void $ runInBase go - | otherwise -> pure () - MovedOut {filePath} | isFile filePath -> void $ runInBase go - | otherwise -> pure () + Created {filePath} + | isFile filePath -> void $ runInBase go + | otherwise -> pure () + Deleted {filePath} + | isFile filePath -> void $ runInBase stop + | otherwise -> pure () + Modified {maybeFilePath} + | (isFile <$> maybeFilePath) == Just True -> void $ runInBase go + | otherwise -> pure () + MovedIn {filePath} + | isFile filePath -> void $ runInBase go + | otherwise -> pure () + MovedOut {filePath} + | isFile filePath -> void $ runInBase go + | otherwise -> pure () DeletedSelf -> error "containing folder deleted" Unmounted -> error "containing folder unmounted" QOverflow -> error "queue overflow"