tailfile-hinotify (empty) → 1.0.0.0
raw patch · 11 files changed
+383/−0 lines, 11 filesdep +asyncdep +basedep +bytestringsetup-changed
Dependencies added: async, base, bytestring, conceit, directory, foldl, hinotify, pipes, process-streaming, streaming, streaming-eversion, tasty, tasty-hunit
Files
- ChangeLog.md +0/−0
- LICENSE +21/−0
- NOTES.md +5/−0
- README.md +9/−0
- Setup.hs +2/−0
- lib/System/IO/TailFile.hs +88/−0
- lib/System/IO/TailFile/Foldl.hs +15/−0
- lib/System/IO/TailFile/Pipes.hs +18/−0
- lib/System/IO/TailFile/Streaming.hs +17/−0
- tailfile-hinotify.cabal +64/−0
- tests/tests.hs +144/−0
+ ChangeLog.md view
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 Daniel Díaz Carrete++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ NOTES.md view
@@ -0,0 +1,5 @@+http://stackoverflow.com/questions/41230293/how-to-efficiently-follow-tail-a-file-with-haskell-including-detecting-file/41231899#41231899++http://unix.stackexchange.com/questions/41668/what-happens-when-you-read-a-file-while-it-is-overwritten++http://unix.stackexchange.com/questions/33447/why-we-should-use-create-and-copytruncate-together/39509#39509
+ README.md view
@@ -0,0 +1,9 @@+# tailfile-hinotify++Tail files in Unix. Based on [hinotify](http://hackage.haskell.org/package/hinotify).++Files can be tailed with types from+[foldl](http://hackage.haskell.org/package/foldl),+[pipes](http://hackage.haskell.org/package/pipes) and+[streaming](http://hackage.haskell.org/package/streaming), or with simple+update functions.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/System/IO/TailFile.hs view
@@ -0,0 +1,88 @@+{-| Tail files in Unix. ++ The functions in this module do not use any particular streaming library.+ They just accept an initial state and a monadic update function.+ -}+++{-# language NumDecimals #-}+module System.IO.TailFile (tailFile) where++import Data.Foldable+import Data.Monoid+import qualified Data.ByteString+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import Control.Concurrent (threadDelay)+import Control.Concurrent.MVar+import Control.Monad+import Control.Exception+import System.INotify+import System.IO (withFile+ ,IOMode(ReadMode)+ ,hSeek+ ,SeekMode(AbsoluteSeek,SeekFromEnd)+ ,hFileSize)+import System.IO.Error (isDoesNotExistError)++{-| Tail a file, while keeping an internal state.+ + If the file doesn't exist, `tailFile` will poll for it until it is found.++ If `tailFile` detects the file has been moved or renamed, it goes back to+ watching a file with the original name.++ `tailFile` also detects file truncations, in which case it starts reading+ again from the beginning.++ Data already existing in the file before `tailFile` is invoked is ignored.+ -}+tailFile :: FilePath + -> (a -> Data.ByteString.ByteString -> IO a) -- ^ State update function.+ -> IO a -- ^ Monadic action for getting the initial state.+ -> IO void -- ^ The result action never returns!+tailFile filepath callback initial = withINotify (\i -> + do state <- initial+ loop i state)+ where+ loop i =+ let go pristine a = do ea' <- tryJust (guard . isDoesNotExistError)+ (watchFile pristine i a)+ case ea' of + Left () -> do threadDelay 5e5+ go False a -- reuse the state+ Right a' -> go False a'+ in go True+ watchFile pristine i a = + do sem <- newMVar mempty+ bracket (addWatch i + [Modify,MoveSelf,DeleteSelf] + filepath + (\event -> let stop = Any (case event of+ MovedSelf {} -> True+ Deleted {} -> True+ _ -> False)+ in do old <- fold <$> tryTakeMVar sem+ new <- evaluate $ old <> stop+ putMVar sem new))+ removeWatch+ (\_ -> withFile filepath ReadMode (\h -> + do if pristine then hSeek h SeekFromEnd 0+ else return ()+ sleeper sem h a))+ sleeper sem h =+ let go ms a = do event <- takeMVar sem+ size' <- hFileSize h + for_ ms (\size -> if size' < size -- truncation + then hSeek h AbsoluteSeek 0+ else return ())+ a' <- drainBytes h a+ if getAny event then return a'+ else go (Just size') a'+ in go Nothing+ drainBytes h = + let go a = do c <- Data.ByteString.hGetSome h defaultChunkSize+ if Data.ByteString.null c+ then do return a+ else do a' <- callback a c+ drainBytes h a'+ in go
+ lib/System/IO/TailFile/Foldl.hs view
@@ -0,0 +1,15 @@+{-| Tail files in Unix, using folds form the @foldl@ package. ++ -}+module System.IO.TailFile.Foldl where++import qualified Data.ByteString+import qualified Control.Foldl as L+import qualified System.IO.TailFile++{-| Like 'System.IO.TailFile.tailFile', but it takes a 'L.FoldM'.+ + The @done@ part of the fold is never invoked.+ -}+tailFile :: FilePath -> L.FoldM IO Data.ByteString.ByteString void -> IO void+tailFile path = L.impurely (\step initial _ -> System.IO.TailFile.tailFile path step initial)
+ lib/System/IO/TailFile/Pipes.hs view
@@ -0,0 +1,18 @@+{-| Tail files in Unix, using types from the @pipes@ package. ++ -}++{-# language RankNTypes #-}+module System.IO.TailFile.Pipes where++import qualified Data.ByteString+import Pipes+import Streaming.Eversion.Pipes+import qualified System.IO.TailFile.Foldl++{-| Tail a file with a function that consumes a 'Producer'.+-}+tailFile :: FilePath -- ^ + -> (forall t r. (MonadTrans t, MonadIO (t IO)) => Producer Data.ByteString.ByteString (t IO) r -> t IO (void, r)) -- ^ Scary type, but any resonably polymorphic (say, over 'MonadIO') function that consumes a 'Producer' can go here.+ -> IO void+tailFile path consumer = System.IO.TailFile.Foldl.tailFile path (evertMIO consumer)
+ lib/System/IO/TailFile/Streaming.hs view
@@ -0,0 +1,17 @@+{-| Tail files in Unix, using types from the @streraming@ package. ++ -}+{-# language RankNTypes #-}+module System.IO.TailFile.Streaming where++import qualified Data.ByteString+import Streaming+import Streaming.Eversion+import qualified System.IO.TailFile.Foldl++{-| Tail a file with a function that consumes a 'Stream'.+-}+tailFile :: FilePath -- ^ + -> (forall t r. (MonadTrans t, MonadIO (t IO)) => Stream (Of Data.ByteString.ByteString) (t IO) r -> t IO (Of void r)) -- ^ Scary type, but any resonably polymorphic (say, over 'MonadIO') function that consumes a 'Stream' can go here.+ -> IO void+tailFile path consumer = System.IO.TailFile.Foldl.tailFile path (evertMIO consumer)
+ tailfile-hinotify.cabal view
@@ -0,0 +1,64 @@+name: tailfile-hinotify+version: 1.0.0.0+synopsis: Tail files in Unix, using hinotify. +description: Tail files in Unix, using hinotify. +license: MIT+license-file: LICENSE+author: Daniel Diaz+maintainer: diaz.carrete@facebook.com+category: System+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++Extra-Source-Files:+ README.md+ NOTES.md++source-repository head+ type: git+ location: https://github.com/danidiaz/tailfile-hinotify.git++library+ exposed-modules: + System.IO.TailFile+ System.IO.TailFile.Foldl+ System.IO.TailFile.Streaming+ System.IO.TailFile.Pipes+ build-depends:+ base >= 4.6 && < 5,+ hinotify >= 0.3.9 && < 0.4,+ bytestring >= 0.9.2.1 && <0.11,+ async >= 2.0 && < 2.2,+ foldl >= 1.1 && < 1.3,+ streaming >= 0.1.4 && < 0.2,+ pipes >= 4.3.0 && < 4.4,+ streaming-eversion >= 0.3.1.0 && < 0.4+ hs-source-dirs: lib+ default-language: Haskell2010+ ghc-options: -Wall++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests, lib+ main-is: tests.hs+ other-modules: + System.IO.TailFile+ System.IO.TailFile.Foldl+ System.IO.TailFile.Streaming+ System.IO.TailFile.Pipes+ build-depends:+ base >= 4.6 && < 5,+ hinotify >= 0.3.9 && < 0.4,+ bytestring >= 0.9.2.1 && <0.11,+ async >= 2.0 && < 2.2,+ foldl >= 1.1 && < 1.3,+ streaming >= 0.1.4 && < 0.2,+ pipes >= 4.3.0 && < 4.4,+ streaming-eversion >= 0.3.1.0 && < 0.4,+ directory >= 1.3.0.0, + conceit >= 0.4.0.0,+ process-streaming >= 0.9.1.2,+ tasty >= 0.10.1.1,+ tasty-hunit >= 0.9.2+ default-language: Haskell2010
+ tests/tests.hs view
@@ -0,0 +1,144 @@+{-# language NumDecimals #-}+{-# language OverloadedStrings #-}+module Main where++import Data.Foldable+import Data.Monoid+import Data.ByteString(ByteString)+import Data.ByteString.Char8(unpack)+import qualified Data.ByteString as Bytes+import Control.Concurrent (threadDelay)+import Control.Monad+import Control.Exception+import Data.IORef+import Control.Concurrent.Conceit++import Test.Tasty+import Test.Tasty.HUnit++import System.Directory+import System.IO+import System.IO.Error+import System.Process.Streaming+import System.IO.TailFile++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [ testCase "simple" testSimple+ , testCase "preexisting" testPreexisting+ , testCase "truncation" testTruncation+ , testCase "move" testMove+ , testCase "notExistingAtFirst" testMove+ ]++testSimple :: IO ()+testSimple = + do deleteFiles+ let content1 = "1 new content"+ content2 = "2 new content"+ bytes <- tailToIORef (\filepath -> + do catToFile filepath content1+ halfsec+ catToFile filepath content2)+ filename1+ assertEqual "" (newlines [content1,content2]) bytes++testPreexisting :: IO ()+testPreexisting = + do deleteFiles+ Bytes.writeFile filename1 "previous content\n"+ let content1 = "1 new content"+ content2 = "2 new content"+ bytes <- tailToIORef (\filepath -> + do catToFile filepath content1+ halfsec+ catToFile filepath content2)+ filename1+ assertEqual "" (newlines [content1,content2]) bytes++testTruncation :: IO ()+testTruncation = + do deleteFiles+ Bytes.writeFile filename1 "previous content\n"+ let content1 = "1 new content"+ content2 = "2 new content"+ bytes <- tailToIORef (\filepath -> + do catToFile filepath content1+ halfsec+ truncateFile filepath+ halfsec+ catToFile filepath content2)+ filename1+ assertEqual "" (newlines [content1,content2]) bytes++testMove :: IO ()+testMove = + do deleteFiles+ let content1 = "1 new content"+ content2 = "2 new content"+ bytes <- tailToIORef (\filepath -> + do catToFile filepath content1+ halfsec+ renameFile filepath filename2+ halfsec+ catToFile filepath content2+ halfsec+ halfsec+ halfsec)+ filename1+ assertEqual "" (newlines [content1,content2]) bytes++testNotExistingAtFirst :: IO ()+testNotExistingAtFirst = + do deleteFiles+ let content1 = "1 new content"+ content2 = "2 new content"+ bytes <- tailToIORef (\filepath -> + do halfsec+ halfsec+ catToFile filepath content1+ halfsec+ catToFile filepath content2+ halfsec+ halfsec)+ filename1+ assertEqual "" (newlines [content1,content2]) bytes++truncateFile :: FilePath -> IO ()+truncateFile filepath =+ execute (piped (shell ("truncate -s 0 "<> filepath))) + (pure ())++catToFile :: FilePath -> ByteString -> IO ()+catToFile filepath content =+ execute (piped (shell ("echo \"" <> unpack content <> "\" >> " <> filepath))) + (pure ())+ +halfsec :: IO ()+halfsec = threadDelay 5e5++filename1 :: FilePath+filename1 = "/tmp/haskell_tailfile_test_1_387493423492347.txt"++filename2 :: FilePath+filename2 = "/tmp/haskell_tailfile_test_2_387493423492347.txt"++newlines :: [ByteString] -> ByteString+newlines bs = mconcat . map (\b -> b <> "\n") $ bs++deleteFiles :: IO ()+deleteFiles = for_ [filename1,filename2]+ (\filepath -> do _ <- tryJust (guard . isDoesNotExistError) + (removeFile filepath)+ pure ())++tailToIORef :: (FilePath -> IO ()) -> FilePath -> IO Data.ByteString.ByteString+tailToIORef writer filepath =+ do ref <- newIORef mempty+ let addToRef _ bytes = modifyIORef' ref (\b -> b <> bytes) + runConceit (Conceit (Left <$> writer filepath) + *> + _Conceit (tailFile filepath addToRef (pure ())))+ readIORef ref