diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 Sridhar Ratnakumar + +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. diff --git a/src/System/Tail.hs b/src/System/Tail.hs --- a/src/System/Tail.hs +++ b/src/System/Tail.hs @@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {- | File tailing library with multi-subscriber support. This library provides a Haskell API for @tail -f@ style file streaming -using 'STM', 'Control.Concurrent.Async', and system processes. +using 'Control.Concurrent.STM', 'Control.Concurrent.Async', and system processes. Example usage: @@ -14,10 +15,10 @@ main :: IO () main = do - tail <- 'tailFile' \"\/var\/log\/app.log\" - subscriber <- 'tailSubscribe' tail + tail <- tailFile 100 \"\/var\/log\/app.log\" + subscriber <- tailSubscribe tail -- Read from subscriber... - 'tailStop' tail + tailStop tail @ -} module System.Tail ( @@ -37,8 +38,9 @@ import System.Directory (doesFileExist) import System.IO (hGetLine) import System.Process (CreateProcess (..), ProcessHandle, StdStream (..), createProcess, proc, terminateProcess, waitForProcess) +import System.Which (staticWhich) --- | Represent `tail -f`'ing a file in Haskell +-- | Represent running @tail -f@ on a file in Haskell data Tail = Tail { filePath :: FilePath -- ^ The file being tailed @@ -55,9 +57,17 @@ {- | Create a new 'Tail' handle for the given file path with specified buffer size. -The tail process starts immediately and begins reading from the file. +The @tail@ process starts immediately and begins reading from the file. New subscribers will receive a ring buffer containing the last @bufferSize@ lines. -} + +{- | Path to the @tail@ executable + +This should be available in the PATH, thanks to Nix and 'System.Which.staticWhich'. +-} +tailBin :: FilePath +tailBin = $(staticWhich "tail") + tailFile :: (HasCallStack) => Int -> FilePath -> IO Tail tailFile bufferSize filePath = do unlessM (doesFileExist filePath) $ error $ "File does not exist: " <> toText filePath @@ -70,7 +80,7 @@ void $ async $ tailRun t pure t -{- | Signal the tail process to stop reading the file. +{- | Signal the 'Tail' process to stop reading the file. This will terminate the underlying @tail@ process and close all subscriber queues. -} @@ -81,7 +91,7 @@ tailRun :: Tail -> IO () tailRun t = do -- Start the tail -F process (show entire file from beginning) - let createProc = (proc "tail" ["-F", "-n", "+1", t.filePath]) {std_out = CreatePipe} + let createProc = (proc tailBin ["-F", "-n", "+1", t.filePath]) {std_out = CreatePipe} (_, Just hout, _, ph) <- createProcess createProc -- Start async reader that reads from tail process and distributes to queues @@ -125,7 +135,7 @@ readLines readLines -{- | Subscribe to tail output and receive a 'CircularBuffer' for reading lines. +{- | Subscribe to 'Tail' output and receive a 'CircularBuffer' for reading lines. The returned buffer will contain any previously read lines from the ring buffer, plus all new lines as they are read from the file. diff --git a/tail.cabal b/tail.cabal --- a/tail.cabal +++ b/tail.cabal @@ -1,130 +1,147 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack -name: tail -version: 0.1.0.0 -synopsis: Haskell API for tail -f streaming -description: A Haskell library providing an API for tail -f style file streaming using STM, process, and async. -category: System -homepage: https://github.com/juspay/vira -author: Sridhar Ratnakumar -maintainer: srid@srid.ca -copyright: 2025 Sridhar Ratnakumar -license: MIT -build-type: Simple +name: tail +version: 0.2.0.0 +synopsis: Haskell API for tail -f streaming +description: + A Haskell library providing an API for tail -f style file streaming using STM, process, and async. +category: System +homepage: https://github.com/srid/tail-hs +author: Sridhar Ratnakumar +maintainer: srid@srid.ca +copyright: 2025 Sridhar Ratnakumar +license: MIT +license-file: LICENSE +build-type: Simple +data-files: test-fixture.txt + library exposed-modules: - Control.Concurrent.STM.CircularBuffer - System.Tail - other-modules: - Paths_tail - autogen-modules: - Paths_tail - hs-source-dirs: - src + Control.Concurrent.STM.CircularBuffer + System.Tail + + other-modules: Paths_tail + autogen-modules: Paths_tail + hs-source-dirs: src default-extensions: - DataKinds - DeriveDataTypeable - DeriveGeneric - DeriveTraversable - DerivingStrategies - DerivingVia - ExplicitForAll - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NoStarIsType - NumericUnderscores - OverloadedStrings - ScopedTypeVariables - StrictData - TypeApplications - TypeFamilies - TypeOperators - TypeSynonymInstances - ViewPatterns - ghc-options: -Wall -optP-Wno-nonportable-include-path -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wunused-foralls -fprint-explicit-foralls -fprint-explicit-kinds + DataKinds + DeriveDataTypeable + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + ExplicitForAll + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NoStarIsType + NumericUnderscores + OverloadedStrings + ScopedTypeVariables + StrictData + TypeApplications + TypeFamilies + TypeOperators + TypeSynonymInstances + ViewPatterns + + ghc-options: + -Wall -optP-Wno-nonportable-include-path + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Wmissing-deriving-strategies -Wunused-foralls + -fprint-explicit-foralls -fprint-explicit-kinds + build-depends: async - , base ==4.* + , base >=4 && <5 , directory , filepath , process - , relude >=1.0 + , relude >=1.0 , stm , stm-chans , text , which + mixins: - base hiding (Prelude) - , relude (Relude as Prelude, Relude.Container.One) - , relude - default-language: GHC2021 + base hiding (Prelude), + relude (Relude as Prelude, Relude.Container.One), + relude -test-suite tail-test - type: exitcode-stdio-1.0 - main-is: Spec.hs + default-language: GHC2021 + +executable tail-test + main-is: Spec.hs other-modules: - Control.Concurrent.STM.CircularBufferSpec - System.TailSpec - Paths_tail - autogen-modules: - Paths_tail - hs-source-dirs: - test + Control.Concurrent.STM.CircularBufferSpec + Paths_tail + System.TailSpec + + autogen-modules: Paths_tail + hs-source-dirs: test default-extensions: - DataKinds - DeriveDataTypeable - DeriveGeneric - DeriveTraversable - DerivingStrategies - DerivingVia - ExplicitForAll - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NoStarIsType - NumericUnderscores - OverloadedStrings - ScopedTypeVariables - StrictData - TypeApplications - TypeFamilies - TypeOperators - TypeSynonymInstances - ViewPatterns - ghc-options: -Wall -optP-Wno-nonportable-include-path -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wunused-foralls -fprint-explicit-foralls -fprint-explicit-kinds + DataKinds + DeriveDataTypeable + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + ExplicitForAll + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NoStarIsType + NumericUnderscores + OverloadedStrings + ScopedTypeVariables + StrictData + TypeApplications + TypeFamilies + TypeOperators + TypeSynonymInstances + ViewPatterns + + ghc-options: + -Wall -optP-Wno-nonportable-include-path + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Wmissing-deriving-strategies -Wunused-foralls + -fprint-explicit-foralls -fprint-explicit-kinds -threaded -rtsopts + -with-rtsopts=-N + build-depends: async - , base ==4.* + , base >=4 && <5 , directory , filepath , hspec , hspec-discover , process - , relude >=1.0 + , relude >=1.0 , stm , stm-chans , tail , temporary , text , which + mixins: - base hiding (Prelude) - , relude (Relude as Prelude, Relude.Container.One) - , relude - default-language: GHC2021 + base hiding (Prelude), + relude (Relude as Prelude, Relude.Container.One), + relude + + default-language: GHC2021 diff --git a/test-fixture.txt b/test-fixture.txt new file mode 100644 --- /dev/null +++ b/test-fixture.txt @@ -0,0 +1,5 @@ +Line 1: This is a test fixture file +Line 2: Used for testing tail functionality +Line 3: Contains multiple lines +Line 4: For comprehensive testing +Line 5: End of test fixture diff --git a/test/System/TailSpec.hs b/test/System/TailSpec.hs --- a/test/System/TailSpec.hs +++ b/test/System/TailSpec.hs @@ -4,7 +4,7 @@ import Control.Concurrent.STM.CircularBuffer (CircularBuffer) import Control.Concurrent.STM.CircularBuffer qualified as CB import GHC.IO.Handle (hClose) -import System.Directory (doesFileExist) +import Paths_tail (getDataFileName) import System.IO.Temp (withSystemTempFile) import System.Process (system) import System.Tail qualified as Tail @@ -26,16 +26,15 @@ t <- Tail.tailFile 100 "/dev/null" Tail.tailStop t it "streams a static file" $ do - thisFile <- findThisFile - t <- Tail.tailFile 100 thisFile + testFile <- getDataFileName "test-fixture.txt" + t <- Tail.tailFile 100 testFile q <- Tail.tailSubscribe t - threadDelay 1_000_000 -- Wait 1 second for tail to start and read content - Tail.tailStop t + threadDelay 1_000_000 >> Tail.tailStop t ls <- drainAll q - viaNonEmpty head ls `shouldBe` Just "module System.TailSpec where" + viaNonEmpty head ls `shouldBe` Just "Line 1: This is a test fixture file" -- Find the last line from the lines we got let lastLine = viaNonEmpty last ls - lastLine `shouldBe` Just "-- End of file." + lastLine `shouldBe` Just "Line 5: End of test fixture" it "streams a log file being appended to by another process" $ do -- Create a file under a temp directory. Then spawn an external process that writes to it lines over time. withSystemTempFile "tail-spec" $ \tempFile h -> do @@ -44,11 +43,9 @@ t <- Tail.tailFile 100 tempFile q <- Tail.tailSubscribe t void $ forkIO $ do - threadDelay 1_000_000 void $ system $ "echo 'World' >> " <> tempFile - Tail.tailStop t + threadDelay 1_000_000 >> Tail.tailStop t -- Read everything and compare output - threadDelay 3_000_000 ls <- drainAll q ls `shouldBe` ["Hello", "World"] it "ring buffer provides last lines to new subscribers" $ do @@ -56,24 +53,10 @@ hClose h void $ system $ "echo 'Line1' >> " <> tempFile t <- Tail.tailFile 100 tempFile - threadDelay 500_000 -- Let tail read existing lines q <- Tail.tailSubscribe t void $ system $ "echo 'Line2' >> " <> tempFile -- Write *after* subscribing - Tail.tailStop t + threadDelay 1_000_000 >> Tail.tailStop t ls <- drainAll q ls `shouldBe` ["Line1", "Line2"] - --- | Find this test file by trying common paths -findThisFile :: IO FilePath -findThisFile = do - let paths = - [ "test/System/TailSpec.hs" -- cabal test / nix build - , "packages/tail/test/System/TailSpec.hs" -- ghcid from root - ] - let findFirst [] = error "TailSpec.hs not found" - findFirst (p : ps) = do - exists <- doesFileExist p - if exists then pure p else findFirst ps - findFirst paths -- End of file.