Skip to content

Commit 0349891

Browse files
author
Athan Clark
committed
new version
1 parent 590135f commit 0349891

File tree

6 files changed

+155
-112
lines changed

6 files changed

+155
-112
lines changed

‎app/Main.hs

+10-5
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,10 @@
1+
module Main where
2+
13
import Path
2-
import qualified Data.ByteString.Lazy as BS
34
import qualified Data.Text as T
45
import Data.Attoparsec.Text (parseOnly, endOfInput, eitherP)
56
import Data.Attoparsec.Path (absFilePath, relFilePath, absDirPath)
6-
import Data.Conduit ((=$=), runConduit)
7+
import Data.Conduit ((.|), runConduit)
78
import Data.Conduit.Combinators (stdout)
89
import System.INotify (initINotify, removeWatch, killINotify)
910
import System.File.Follow (follow)
@@ -14,9 +15,10 @@ import Control.Exception (bracket)
1415
import Control.Concurrent (threadDelay)
1516

1617

18+
main :: IO ()
1719
main = do
18-
[f] <- getArgs
19-
f <- case parseOnly (eitherP absFilePath relFilePath <* endOfInput) (T.pack f) of
20+
[filePath] <- getArgs
21+
f <- case parseOnly (eitherP absFilePath relFilePath <* endOfInput) (T.pack filePath) of
2022
Left e -> error e
2123
Right eAR -> case eAR of
2224
Left a -> pure a
@@ -27,4 +29,7 @@ main = do
2729
Right d' ->
2830
pure (d' </> r)
2931
i <- initINotify
30-
bracket (follow i f (\source -> runConduit $ source =$= stdout)) (\watch -> removeWatch watch >> killINotify i) $ \_ -> forever $ threadDelay 50000
32+
let obtain = follow i f $ \source -> runConduit (source .| stdout)
33+
release watch = removeWatch watch >> killINotify i
34+
bracket obtain release $ \_ ->
35+
forever (threadDelay 50000) -- run forever

‎follow-file.cabal

+69-49
Original file line numberDiff line numberDiff line change
@@ -1,53 +1,73 @@
1-
Name: follow-file
2-
Version: 0.0.2
3-
Author: Athan Clark <athan.clark@gmail.com>
4-
Maintainer: Athan Clark <athan.clark@gmail.com>
5-
License: BSD3
6-
License-File: LICENSE
7-
Synopsis: Be notified when a file gets appended, solely with what was added.
8-
Description:
9-
See module for docs
10-
Cabal-Version: >= 1.10
11-
Build-Type: Simple
12-
Category: Filesystem
1+
-- This file has been generated from package.yaml by hpack version 0.21.2.
2+
--
3+
-- see: https://github.com/sol/hpack
4+
--
5+
-- hash: 2237e4036e920a20255f1af7b7256b4210fd90eddba2b0938e9df217cf29ccb7
136

7+
name: follow-file
8+
version: 0.0.3
9+
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.
10+
description: Please see the README on Github at <https://github.com/athanclark/follow-file#readme>
11+
category: Filesystem
12+
homepage: https://github.com/athanclark/follow-file#readme
13+
bug-reports: https://github.com/athanclark/follow-file/issues
14+
maintainer: Athan Clark <athan.clark@gmail.com>
15+
license: BSD3
16+
license-file: LICENSE
17+
build-type: Simple
18+
cabal-version: >= 1.10
1419

15-
Library
16-
Default-Language: Haskell2010
17-
HS-Source-Dirs: src
18-
GHC-Options: -Wall
19-
Exposed-Modules: System.File.Follow
20-
Build-Depends: base >= 4.8 && < 5
21-
, attoparsec
22-
, attoparsec-path
23-
, bytestring
24-
, conduit
25-
, directory
26-
, exceptions
27-
, hinotify
28-
, monad-control
29-
, mtl
30-
, path
31-
, text
32-
, unix
33-
, utf8-string
20+
source-repository head
21+
type: git
22+
location: https://github.com/athanclark/follow-file
3423

35-
Executable follow-file
36-
Default-Language: Haskell2010
37-
Hs-Source-Dirs: app
38-
Main-is: Main.hs
39-
Build-Depends: base
40-
, bytestring
41-
, follow-file
42-
, path
43-
, text
44-
, attoparsec
45-
, attoparsec-path
46-
, hinotify
47-
, conduit
48-
, conduit-combinators
49-
, directory
24+
library
25+
exposed-modules:
26+
System.File.Follow
27+
other-modules:
28+
Paths_follow_file
29+
hs-source-dirs:
30+
src
31+
ghc-options: -Wall
32+
build-depends:
33+
attoparsec
34+
, attoparsec-path
35+
, base >=4.11 && <5
36+
, bytestring
37+
, conduit
38+
, directory
39+
, exceptions
40+
, hinotify >=0.4
41+
, monad-control
42+
, mtl
43+
, path
44+
, text
45+
, unix
46+
, utf8-string
47+
default-language: Haskell2010
5048

51-
Source-Repository head
52-
Type: git
53-
Location: https://github.com/athanclark/follow-file
49+
executable follow-file
50+
main-is: Main.hs
51+
other-modules:
52+
Paths_follow_file
53+
hs-source-dirs:
54+
app
55+
ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N
56+
build-depends:
57+
attoparsec
58+
, attoparsec-path
59+
, base
60+
, bytestring
61+
, conduit
62+
, conduit-combinators
63+
, directory
64+
, exceptions
65+
, follow-file
66+
, hinotify
67+
, monad-control
68+
, mtl
69+
, path
70+
, text
71+
, unix
72+
, utf8-string
73+
default-language: Haskell2010

‎foo

-41
This file was deleted.

‎package.yaml

+52
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
name: follow-file
2+
version: 0.0.3
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.
4+
description: Please see the README on Github at <https://github.com/athanclark/follow-file#readme>
5+
maintainer: Athan Clark <athan.clark@gmail.com>
6+
license: BSD3
7+
github: athanclark/follow-file
8+
category: Filesystem
9+
10+
ghc-options: -Wall
11+
12+
dependencies:
13+
- base >= 4.11 && < 5
14+
- attoparsec
15+
- attoparsec-path
16+
- bytestring
17+
- conduit
18+
- directory
19+
- exceptions
20+
- hinotify >= 0.4
21+
- monad-control
22+
- mtl
23+
- path
24+
- text
25+
- unix
26+
- utf8-string
27+
28+
library:
29+
source-dirs: src
30+
31+
executables:
32+
follow-file:
33+
ghc-options:
34+
- -threaded
35+
- -rtsopts
36+
- -Wall
37+
- -with-rtsopts=-N
38+
main: Main.hs
39+
source-dirs:
40+
- app
41+
dependencies:
42+
- base
43+
- follow-file
44+
- bytestring
45+
- path
46+
- text
47+
- attoparsec
48+
- attoparsec-path
49+
- hinotify
50+
- conduit
51+
- conduit-combinators
52+
- directory

‎src/System/File/Follow.hs

+22-15
Original file line numberDiff line numberDiff line change
@@ -12,17 +12,18 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
1212
import qualified Data.ByteString.Lazy.Internal as LBS
1313
import qualified Data.ByteString.Internal as BS
1414
import qualified Data.ByteString.UTF8 as BS8
15-
import qualified Data.Text as T
15+
import qualified Data.Text.Encoding as T
1616
import Data.Attoparsec.Text (parseOnly, endOfInput)
1717
import Data.Attoparsec.Path (relFilePath)
18-
import Data.Conduit (Producer, yield)
18+
import Data.Conduit (ConduitT, yield)
1919
import Control.Monad (void)
2020
import Control.Monad.IO.Class (MonadIO (liftIO))
2121
import Control.Monad.Catch (MonadMask, bracket)
2222
import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith))
2323
import Path (Path, Abs, File, filename, parent, toFilePath)
2424
import System.Posix.IO.ByteString (fdReadBuf, openFd, OpenMode (ReadOnly), defaultFileFlags, closeFd, fdSeek)
2525
import System.Posix.Types (FileOffset)
26+
import System.Posix.ByteString.FilePath (RawFilePath)
2627
import System.Posix.Files.ByteString (fileSize, getFileStatus)
2728
import System.Directory (doesFileExist)
2829
import System.INotify (INotify, addWatch, Event (..), EventVariety (..), WatchDescriptor)
@@ -38,7 +39,7 @@ follow :: ( MonadIO m
3839
)
3940
=> INotify
4041
-> Path Abs File
41-
-> (Producer m BS.ByteString -> m ()) -- ^ Monadic state of @m@ is thrown away for each invocation, not synchronously interleaved.
42+
-> (ConduitT i BS.ByteString m () -> m ()) -- ^ Monadic state of @m@ is thrown away for each invocation, not synchronously interleaved.
4243
-> m WatchDescriptor
4344
follow inotify file f = do
4445
let file' = toFilePath file
@@ -67,19 +68,25 @@ follow inotify file f = do
6768
stop = do
6869
liftIO (writeIORef positionRef 0)
6970
f (yield mempty)
70-
liftBaseWith $ \runInBase -> addWatch inotify [Modify, Create, Delete] (toFilePath $ parent file) $ \e ->
71-
let isFile filePath = parseOnly (relFilePath <* endOfInput) (T.pack filePath) == Right (filename file)
71+
liftBaseWith $ \runInBase -> addWatch inotify [Modify, Create, Delete] (BS8.fromString $ toFilePath $ parent file) $ \e ->
72+
let isFile :: RawFilePath -> Bool
73+
isFile filePath = parseOnly (relFilePath <* endOfInput) (T.decodeUtf8 filePath) == Right (filename file)
7274
in case e of
73-
Created {filePath} | isFile filePath -> void $ runInBase go
74-
| otherwise -> pure ()
75-
Deleted {filePath} | isFile filePath -> void $ runInBase stop
76-
| otherwise -> pure ()
77-
Modified {maybeFilePath} | (isFile <$> maybeFilePath) == Just True -> void $ runInBase go
78-
| otherwise -> pure ()
79-
MovedIn {filePath} | isFile filePath -> void $ runInBase go
80-
| otherwise -> pure ()
81-
MovedOut {filePath} | isFile filePath -> void $ runInBase go
82-
| otherwise -> pure ()
75+
Created {filePath}
76+
| isFile filePath -> void $ runInBase go
77+
| otherwise -> pure ()
78+
Deleted {filePath}
79+
| isFile filePath -> void $ runInBase stop
80+
| otherwise -> pure ()
81+
Modified {maybeFilePath}
82+
| (isFile <$> maybeFilePath) == Just True -> void $ runInBase go
83+
| otherwise -> pure ()
84+
MovedIn {filePath}
85+
| isFile filePath -> void $ runInBase go
86+
| otherwise -> pure ()
87+
MovedOut {filePath}
88+
| isFile filePath -> void $ runInBase go
89+
| otherwise -> pure ()
8390
DeletedSelf -> error "containing folder deleted"
8491
Unmounted -> error "containing folder unmounted"
8592
QOverflow -> error "queue overflow"

‎stack.yaml

+2-2
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
# resolver:
1616
# name: custom-snapshot
1717
# location: "./custom-snapshot.yaml"
18-
resolver: nightly-2016-06-30
18+
resolver: lts-12.0
1919

2020
# User packages to be built.
2121
# Various formats can be used as shown in the example below.
@@ -40,7 +40,7 @@ packages:
4040
# Dependency packages to be pulled from upstream that are not in the resolver
4141
# (e.g., acme-missiles-0.3)
4242
extra-deps:
43-
- attoparsec-path-0.0.0.1
43+
- hinotify-0.4
4444

4545
# Override default flag values for local packages and extra-deps
4646
flags: {}

0 commit comments

Comments
 (0)