diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -66,13 +66,9 @@ You are very welcome to help the developement of arbtt. You can find the latest source at the git repository at - or -. +. -The issue tracker is hosted on bitbucket: - -Why Bitbucket and not GitHub? Why not, and we need diversitiy even in the -cloud! (Don’t worry, you can use your GitHub account there.) +The issue tracker is hosted on GitHub: Some of my plans or ideas include: diff --git a/arbtt.cabal b/arbtt.cabal --- a/arbtt.cabal +++ b/arbtt.cabal @@ -1,5 +1,5 @@ name: arbtt -version: 0.11 +version: 0.11.1 license: GPL-2 license-file: LICENSE category: Desktop @@ -22,7 +22,7 @@ you understand the consequences of a full-time logger and be careful with this data. homepage: http://arbtt.nomeata.de/ -bug-reports: https://bitbucket.org/nomeata/arbtt/issues +bug-reports: https://github.com/nomeata/arbtt/issues extra-source-files: categorize.cfg, arbtt-capture.desktop, README.md, doc/arbtt.xml, doc/fptools.css, doc/Makefile, diff --git a/doc/arbtt.xml b/doc/arbtt.xml --- a/doc/arbtt.xml +++ b/doc/arbtt.xml @@ -98,9 +98,9 @@ Installation - Obtaining arbtt> + Obtaining arbtt - See the project website for installation instructions. + See the project website for installation instructions. @@ -1073,6 +1073,16 @@ + arbtt-chart + + Tomáš Janoušek maintains a console-based alternative to arbtt-graph that + draws charts using Unicode block elements. + + + You can find his tool on https://github.com/liskin/arbtt-chart. + + + arbtt-capture for GNOME Shell An arbtt-capture implemented as a GNOME Shell extension. Its main value @@ -1779,6 +1789,17 @@ The version history with changes relevant for the user is documented here. + + Version 0.11.1 + + + + Support building with GHC-9.0 + + + + + Version 0.11 @@ -1898,7 +1919,7 @@ The syntax now allows for time differences larger than 99:99. - (issue #14) + (issue #69) @@ -1928,10 +1949,10 @@ arbtt-capture now supports the option for development and debugging purposes. - The name of the current desktop (or workspace) is also recorded, and available as $desktop (issue #1). + The name of the current desktop (or workspace) is also recorded, and available as $desktop (issue #56). - Two bugs in the parser were fixed (issue #4 and issue #5). + Two bugs in the parser were fixed (issue #59 and issue #60). arbtt-stats can print reports split by time interval, using the option. @@ -1940,10 +1961,10 @@ arbtt-stats can print the actual samples selected, with . - Support for GHC-7.8 was added, with help from Jayesh Kumar Gupta (issue #8). + Support for GHC-7.8 was added, with help from Jayesh Kumar Gupta (issue #63). - Arbtt now has a proper testsuite integrated into Cabal, and an automated test infrastructure on Travis. + Arbtt now has a proper testsuite integrated into Cabal, and an automated test infrastructure on Travis. Waldir Pimenta contributed a new web page, hosted at arbtt.nomeata.de. diff --git a/src/Data/Conduit/Attoparsec.hs b/src/Data/Conduit/Attoparsec.hs --- a/src/Data/Conduit/Attoparsec.hs +++ b/src/Data/Conduit/Attoparsec.hs @@ -76,7 +76,6 @@ feedA :: A.IResult a b -> a -> A.IResult a b empty :: a isNull :: a -> Bool - notEmpty :: [a] -> [a] getLinesCols :: a -> Position -- | Return the beginning of the first input with the length of @@ -89,7 +88,6 @@ feedA = Data.Attoparsec.ByteString.feed empty = B.empty isNull = B.null - notEmpty = filter (not . B.null) getLinesCols = B.foldl' f (Position 0 0 0) where f (Position l c o) ch @@ -102,7 +100,6 @@ feedA = Data.Attoparsec.Text.feed empty = T.empty isNull = T.null - notEmpty = filter (not . T.null) getLinesCols = T.foldl' f (Position 0 0 0) where f (Position l c o) ch @@ -117,14 +114,14 @@ -- If parsing fails, a 'ParseError' will be thrown with 'throwM'. -- -- Since 0.5.0 -sinkParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> Consumer a m b +sinkParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> ConduitT a o m b sinkParser = fmap snd . sinkParserPosErr (Position 1 1 0) -- | Same as 'sinkParser', but we return an 'Either' type instead -- of raising an exception. -- -- Since 1.1.5 -sinkParserEither :: (AttoparsecInput a, Monad m) => A.Parser a b -> Consumer a m (Either ParseError b) +sinkParserEither :: (AttoparsecInput a, Monad m) => A.Parser a b -> ConduitT a o m (Either ParseError b) sinkParserEither = (fmap.fmap) snd . sinkParserPos (Position 1 1 0) @@ -133,7 +130,7 @@ -- on bad input. -- -- Since 0.5.0 -conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> Conduit a m (PositionRange, b) +conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> ConduitT a (PositionRange, b) m () conduitParser parser = conduit $ Position 1 1 0 where @@ -147,11 +144,11 @@ {-# SPECIALIZE conduitParser :: MonadThrow m => A.Parser T.Text b - -> Conduit T.Text m (PositionRange, b) #-} + -> ConduitT T.Text (PositionRange, b) m () #-} {-# SPECIALIZE conduitParser :: MonadThrow m => A.Parser B.ByteString b - -> Conduit B.ByteString m (PositionRange, b) #-} + -> ConduitT B.ByteString (PositionRange, b) m () #-} @@ -160,7 +157,7 @@ conduitParserEither :: (Monad m, AttoparsecInput a) => A.Parser a b - -> Conduit a m (Either ParseError (PositionRange, b)) + -> ConduitT a (Either ParseError (PositionRange, b)) m () conduitParserEither parser = conduit $ Position 1 1 0 where @@ -177,11 +174,11 @@ {-# SPECIALIZE conduitParserEither :: Monad m => A.Parser T.Text b - -> Conduit T.Text m (Either ParseError (PositionRange, b)) #-} + -> ConduitT T.Text (Either ParseError (PositionRange, b)) m () #-} {-# SPECIALIZE conduitParserEither :: Monad m => A.Parser B.ByteString b - -> Conduit B.ByteString m (Either ParseError (PositionRange, b)) #-} + -> ConduitT B.ByteString (Either ParseError (PositionRange, b)) m () #-} @@ -190,7 +187,7 @@ :: (AttoparsecInput a, MonadThrow m) => Position -> A.Parser a b - -> Consumer a m (Position, b) + -> ConduitT a o m (Position, b) sinkParserPosErr pos0 p = sinkParserPos pos0 p >>= f where f (Left e) = throwM e @@ -202,7 +199,7 @@ :: (AttoparsecInput a, Monad m) => Position -> A.Parser a b - -> Consumer a m (Either ParseError (Position, b)) + -> ConduitT a o m (Either ParseError (Position, b)) sinkParserPos pos0 p = sink empty pos0 (parseA p) where sink prev pos parser = await >>= maybe close push diff --git a/src/Data/Conduit/Binary.hs b/src/Data/Conduit/Binary.hs --- a/src/Data/Conduit/Binary.hs +++ b/src/Data/Conduit/Binary.hs @@ -1,8 +1,11 @@ {-# LANGUAGE CPP, RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Functions for interacting with bytes. +-- | /NOTE/ It is recommended to start using "Data.Conduit.Combinators" instead +-- of this module. -- +-- Functions for interacting with bytes. +-- -- For many purposes, it's recommended to use the conduit-combinators library, -- which provides a more complete set of functions. module Data.Conduit.Binary @@ -13,26 +16,26 @@ -- order to run such code, you will need to use @runResourceT@. -- ** Sources - sourceFile - , sourceHandle - , sourceHandleUnsafe - , sourceIOHandle + CC.sourceFile + , CC.sourceHandle + , CC.sourceHandleUnsafe + , CC.sourceIOHandle , sourceFileRange , sourceHandleRange , sourceHandleRangeWithBuffer - , withSourceFile + , CC.withSourceFile -- ** Sinks - , sinkFile - , sinkFileCautious - , sinkTempFile - , sinkSystemTempFile - , sinkHandle - , sinkIOHandle - , sinkHandleBuilder - , sinkHandleFlush - , withSinkFile - , withSinkFileBuilder - , withSinkFileCautious + , CC.sinkFile + , CC.sinkFileCautious + , CC.sinkTempFile + , CC.sinkSystemTempFile + , CC.sinkHandle + , CC.sinkIOHandle + , CC.sinkHandleBuilder + , CC.sinkHandleFlush + , CC.withSinkFile + , CC.withSinkFileBuilder + , CC.withSinkFileCautious -- ** Conduits , conduitFile , conduitHandle @@ -56,20 +59,17 @@ , Data.Conduit.Binary.lines ) where -import qualified Data.ByteString.Builder as BB -import qualified Data.Streaming.FileRead as FR +import qualified Data.Conduit.Combinators as CC import Prelude hiding (head, take, drop, takeWhile, dropWhile, mapM_) import qualified Data.ByteString as S import Data.ByteString.Unsafe (unsafeUseAsCString) import qualified Data.ByteString.Lazy as L import Data.Conduit import Data.Conduit.List (sourceList, consume) -import qualified Data.Conduit.List as CL -import Control.Exception (assert, finally, bracket) -import Control.Monad (unless, when) +import Control.Exception (assert, finally) +import Control.Monad (unless) import Control.Monad.IO.Class (liftIO, MonadIO) -import Control.Monad.IO.Unlift -import Control.Monad.Trans.Resource (allocate, release) +import Control.Monad.Trans.Resource (allocate, release, MonadThrow (..)) import Control.Monad.Trans.Class (lift) import qualified System.IO as IO import Data.Word (Word8, Word64) @@ -78,141 +78,19 @@ #endif import System.Directory (getTemporaryDirectory, removeFile) import Data.ByteString.Lazy.Internal (defaultChunkSize) -import Data.ByteString.Internal (ByteString (PS), inlinePerformIO) +import Data.ByteString.Internal (ByteString (PS), accursedUnutterablePerformIO) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.ForeignPtr (touchForeignPtr) import Foreign.Ptr (plusPtr, castPtr) import Foreign.Storable (Storable, peek, sizeOf) -import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import Control.Monad.Trans.Resource (MonadResource) -import Control.Monad.Catch (MonadThrow (..)) import Control.Exception (Exception) import Data.Typeable (Typeable) import Foreign.Ptr (Ptr) #ifndef ALLOW_UNALIGNED_ACCESS import Foreign.Marshal (alloca, copyBytes) #endif -import System.Directory (renameFile) -import System.FilePath (takeDirectory, takeFileName, (<.>)) -import System.IO (hClose, openBinaryTempFile) -import Control.Exception (throwIO, catch) -import System.IO.Error (isDoesNotExistError) -import qualified Data.ByteString.Builder as BB --- | Stream the contents of a file as binary data. --- --- Since 0.3.0 -sourceFile :: MonadResource m - => FilePath - -> Producer m S.ByteString -sourceFile fp = - bracketP - (FR.openFile fp) - FR.closeFile - loop - where - loop h = do - bs <- liftIO $ FR.readChunk h - unless (S.null bs) $ do - yield bs - loop h - --- | Stream the contents of a 'IO.Handle' as binary data. Note that this --- function will /not/ automatically close the @Handle@ when processing --- completes, since it did not acquire the @Handle@ in the first place. --- --- Since 0.3.0 -sourceHandle :: MonadIO m - => IO.Handle - -> Producer m S.ByteString -sourceHandle h = - loop - where - loop = do - bs <- liftIO (S.hGetSome h defaultChunkSize) - if S.null bs - then return () - else yield bs >> loop - --- | Same as @sourceHandle@, but instead of allocating a new buffer for each --- incoming chunk of data, reuses the same buffer. Therefore, the @ByteString@s --- yielded by this function are not referentially transparent between two --- different @yield@s. --- --- This function will be slightly more efficient than @sourceHandle@ by --- avoiding allocations and reducing garbage collections, but should only be --- used if you can guarantee that you do not reuse a @ByteString@ (or any slice --- thereof) between two calls to @await@. --- --- Since 1.0.12 -sourceHandleUnsafe :: MonadIO m => IO.Handle -> Source m ByteString -sourceHandleUnsafe handle = do - fptr <- liftIO $ mallocPlainForeignPtrBytes defaultChunkSize - let ptr = unsafeForeignPtrToPtr fptr - loop = do - count <- liftIO $ IO.hGetBuf handle ptr defaultChunkSize - when (count > 0) $ do - yield (PS fptr 0 count) - loop - - loop - - liftIO $ touchForeignPtr fptr - --- | An alternative to 'sourceHandle'. --- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens --- a 'IO.Handle' (in read mode), so that it can open it only when needed --- and close it as soon as possible. --- --- Since 0.3.0 -sourceIOHandle :: MonadResource m - => IO IO.Handle - -> Producer m S.ByteString -sourceIOHandle alloc = bracketP alloc IO.hClose sourceHandle - --- | Stream all incoming data to the given 'IO.Handle'. Note that this function --- does /not/ flush and will /not/ close the @Handle@ when processing completes. --- --- Since 0.3.0 -sinkHandle :: MonadIO m - => IO.Handle - -> Consumer S.ByteString m () -sinkHandle h = awaitForever (liftIO . S.hPut h) - --- | Stream incoming builders, executing them directly on the buffer of the --- given 'IO.Handle'. Note that this function does /not/ automatically close the --- @Handle@ when processing completes. --- Pass 'Data.ByteString.Builder.Extra.flush' to flush the buffer. --- --- @since 1.2.2 -sinkHandleBuilder :: MonadIO m => IO.Handle -> ConduitM BB.Builder o m () -sinkHandleBuilder h = awaitForever (liftIO . BB.hPutBuilder h) - --- | Stream incoming @Flush@es, executing them on @IO.Handle@ --- Note that this function does /not/ automatically close the @Handle@ when --- processing completes --- --- @since 1.2.2 -sinkHandleFlush :: MonadIO m - => IO.Handle - -> ConduitM (Flush S.ByteString) o m () -sinkHandleFlush h = - awaitForever $ \mbs -> liftIO $ - case mbs of - Chunk bs -> S.hPut h bs - Flush -> IO.hFlush h - --- | An alternative to 'sinkHandle'. --- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens --- a 'IO.Handle' (in write mode), so that it can open it only when needed --- and close it as soon as possible. --- --- Since 0.3.0 -sinkIOHandle :: MonadResource m - => IO IO.Handle - -> Consumer S.ByteString m () -sinkIOHandle alloc = bracketP alloc IO.hClose sinkHandle - -- | Stream the contents of a file as binary data, starting from a certain -- offset and only consuming up to a certain number of bytes. -- @@ -221,7 +99,7 @@ => FilePath -> Maybe Integer -- ^ Offset -> Maybe Integer -- ^ Maximum count - -> Producer m S.ByteString + -> ConduitT i S.ByteString m () sourceFileRange fp offset count = bracketP (IO.openBinaryFile fp IO.ReadMode) IO.hClose @@ -235,7 +113,7 @@ => IO.Handle -> Maybe Integer -- ^ Offset -> Maybe Integer -- ^ Maximum count - -> Producer m S.ByteString + -> ConduitT i S.ByteString m () sourceHandleRange handle offset count = sourceHandleRangeWithBuffer handle offset count defaultChunkSize @@ -249,7 +127,7 @@ -> Maybe Integer -- ^ Offset -> Maybe Integer -- ^ Maximum count -> Int -- ^ Buffer size - -> Producer m S.ByteString + -> ConduitT i S.ByteString m () sourceHandleRangeWithBuffer handle offset count buffer = do case offset of Nothing -> return () @@ -276,79 +154,13 @@ yield bs pullLimited c' --- | Stream all incoming data to the given file. --- --- Since 0.3.0 -sinkFile :: MonadResource m - => FilePath - -> Consumer S.ByteString m () -sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode) - --- | Cautious version of 'sinkFile'. The idea here is to stream the --- values to a temporary file in the same directory of the destination --- file, and only on successfully writing the entire file, moves it --- atomically to the destination path. --- --- In the event of an exception occurring, the temporary file will be --- deleted and no move will be made. If the application shuts down --- without running exception handling (such as machine failure or a --- SIGKILL), the temporary file will remain and the destination file --- will be untouched. --- --- @since 1.1.14 -sinkFileCautious - :: MonadResource m - => FilePath - -> ConduitM S.ByteString o m () -sinkFileCautious fp = - bracketP (cautiousAcquire fp) cautiousCleanup inner - where - inner (tmpFP, h) = do - sinkHandle h - liftIO $ do - hClose h - renameFile tmpFP fp - --- | Stream data into a temporary file in the given directory with the --- given filename pattern, and return the temporary filename. The --- temporary file will be automatically deleted when exiting the --- active 'ResourceT' block, if it still exists. --- --- @since 1.1.15 -sinkTempFile :: MonadResource m - => FilePath -- ^ temp directory - -> String -- ^ filename pattern - -> ConduitM ByteString o m FilePath -sinkTempFile tmpdir pattern = do - (_releaseKey, (fp, h)) <- allocate - (IO.openBinaryTempFile tmpdir pattern) - (\(fp, h) -> IO.hClose h `finally` (removeFile fp `Control.Exception.catch` \e -> - if isDoesNotExistError e - then return () - else throwIO e)) - sinkHandle h - liftIO $ IO.hClose h - return fp - --- | Same as 'sinkTempFile', but will use the default temp file --- directory for the system as the first argument. --- --- @since 1.1.15 -sinkSystemTempFile - :: MonadResource m - => String -- ^ filename pattern - -> ConduitM ByteString o m FilePath -sinkSystemTempFile pattern = do - dir <- liftIO getTemporaryDirectory - sinkTempFile dir pattern - -- | Stream the contents of the input to a file, and also send it along the -- pipeline. Similar in concept to the Unix command @tee@. -- -- Since 0.3.0 conduitFile :: MonadResource m => FilePath - -> Conduit S.ByteString m S.ByteString + -> ConduitT S.ByteString S.ByteString m () conduitFile fp = bracketP (IO.openBinaryFile fp IO.WriteMode) IO.hClose @@ -359,7 +171,7 @@ -- does not close the handle on completion. Related to: @conduitFile@. -- -- Since 1.0.9 -conduitHandle :: MonadIO m => IO.Handle -> Conduit S.ByteString m S.ByteString +conduitHandle :: MonadIO m => IO.Handle -> ConduitT S.ByteString S.ByteString m () conduitHandle h = awaitForever $ \bs -> liftIO (S.hPut h bs) >> yield bs -- | Ensure that only up to the given number of bytes are consumed by the inner @@ -369,7 +181,7 @@ -- Since 0.3.0 isolate :: Monad m => Int - -> Conduit S.ByteString m S.ByteString + -> ConduitT S.ByteString S.ByteString m () isolate = loop where @@ -389,7 +201,7 @@ -- | Return the next byte from the stream, if available. -- -- Since 0.3.0 -head :: Monad m => Consumer S.ByteString m (Maybe Word8) +head :: Monad m => ConduitT S.ByteString o m (Maybe Word8) head = do mbs <- await case mbs of @@ -402,7 +214,7 @@ -- | Return all bytes while the predicate returns @True@. -- -- Since 0.3.0 -takeWhile :: Monad m => (Word8 -> Bool) -> Conduit S.ByteString m S.ByteString +takeWhile :: Monad m => (Word8 -> Bool) -> ConduitT S.ByteString S.ByteString m () takeWhile p = loop where @@ -418,7 +230,7 @@ -- | Ignore all bytes while the predicate returns @True@. -- -- Since 0.3.0 -dropWhile :: Monad m => (Word8 -> Bool) -> Consumer S.ByteString m () +dropWhile :: Monad m => (Word8 -> Bool) -> ConduitT S.ByteString o m () dropWhile p = loop where @@ -433,7 +245,7 @@ -- | Take the given number of bytes, if available. -- -- Since 0.3.0 -take :: Monad m => Int -> Consumer S.ByteString m L.ByteString +take :: Monad m => Int -> ConduitT S.ByteString o m L.ByteString take 0 = return L.empty take n0 = go n0 id where @@ -451,7 +263,7 @@ -- | Drop up to the given number of bytes. -- -- Since 0.5.0 -drop :: Monad m => Int -> Consumer S.ByteString m () +drop :: Monad m => Int -> ConduitT S.ByteString o m () drop 0 = return () drop n0 = go n0 where @@ -470,7 +282,7 @@ -- (10), and strip it from the output. -- -- Since 0.3.0 -lines :: Monad m => Conduit S.ByteString m S.ByteString +lines :: Monad m => ConduitT S.ByteString S.ByteString m () lines = loop [] where @@ -490,7 +302,7 @@ -- | Stream the chunks from a lazy bytestring. -- -- Since 0.5.0 -sourceLbs :: Monad m => L.ByteString -> Producer m S.ByteString +sourceLbs :: Monad m => L.ByteString -> ConduitT i S.ByteString m () sourceLbs = sourceList . L.toChunks -- | Stream the input data into a temp file and count the number of bytes @@ -501,7 +313,7 @@ -- -- Since 1.0.5 sinkCacheLength :: (MonadResource m1, MonadResource m2) - => Sink S.ByteString m1 (Word64, Source m2 S.ByteString) + => ConduitT S.ByteString o m1 (Word64, ConduitT i S.ByteString m2 ()) sinkCacheLength = do tmpdir <- liftIO getTemporaryDirectory (releaseKey, (fp, h)) <- allocate @@ -509,9 +321,9 @@ (\(fp, h) -> IO.hClose h `finally` removeFile fp) len <- sinkHandleLen h liftIO $ IO.hClose h - return (len, sourceFile fp >> release releaseKey) + return (len, CC.sourceFile fp >> release releaseKey) where - sinkHandleLen :: MonadResource m => IO.Handle -> Sink S.ByteString m Word64 + sinkHandleLen :: MonadResource m => IO.Handle -> ConduitT S.ByteString o m Word64 sinkHandleLen h = loop 0 where @@ -526,7 +338,7 @@ -- is performed, but rather all content is read into memory strictly. -- -- Since 1.0.5 -sinkLbs :: Monad m => Sink S.ByteString m L.ByteString +sinkLbs :: Monad m => ConduitT S.ByteString o m L.ByteString sinkLbs = fmap L.fromChunks consume mapM_BS :: Monad m => (Word8 -> m ()) -> S.ByteString -> m () @@ -534,9 +346,9 @@ let start = unsafeForeignPtrToPtr fptr `plusPtr` offset end = start `plusPtr` len loop ptr - | ptr >= end = inlinePerformIO (touchForeignPtr fptr) `seq` return () + | ptr >= end = accursedUnutterablePerformIO (touchForeignPtr fptr) `seq` return () | otherwise = do - f (inlinePerformIO (peek ptr)) + f (accursedUnutterablePerformIO (peek ptr)) loop (ptr `plusPtr` 1) loop start {-# INLINE mapM_BS #-} @@ -544,7 +356,7 @@ -- | Perform a computation on each @Word8@ in a stream. -- -- Since 1.0.10 -mapM_ :: Monad m => (Word8 -> m ()) -> Consumer S.ByteString m () +mapM_ :: Monad m => (Word8 -> m ()) -> ConduitT S.ByteString o m () mapM_ f = awaitForever (lift . mapM_BS f) {-# INLINE mapM_ #-} @@ -553,7 +365,7 @@ -- all unused input as leftovers. -- -- @since 1.1.13 -sinkStorable :: (Monad m, Storable a) => Consumer S.ByteString m (Maybe a) +sinkStorable :: (Monad m, Storable a) => ConduitT S.ByteString o m (Maybe a) sinkStorable = sinkStorableHelper Just (return Nothing) -- | Same as 'sinkStorable', but throws a 'SinkStorableInsufficientBytes' @@ -562,13 +374,13 @@ -- construct/deconstruct a @Maybe@ wrapper in the success case. -- -- @since 1.1.13 -sinkStorableEx :: (MonadThrow m, Storable a) => Consumer S.ByteString m a +sinkStorableEx :: (MonadThrow m, Storable a) => ConduitT S.ByteString o m a sinkStorableEx = sinkStorableHelper id (throwM SinkStorableInsufficientBytes) -sinkStorableHelper :: forall m a b. (Monad m, Storable a) +sinkStorableHelper :: forall m a b o. (Monad m, Storable a) => (a -> b) - -> (Consumer S.ByteString m b) - -> Consumer S.ByteString m b + -> (ConduitT S.ByteString o m b) + -> ConduitT S.ByteString o m b sinkStorableHelper wrap failure = do start where @@ -587,13 +399,13 @@ -- looks like we're stuck concating leftover bs lbs <- take size - let bs = S.concat $ L.toChunks lbs - case compare (S.length bs) size of + let bs' = S.concat $ L.toChunks lbs + case compare (S.length bs') size of LT -> do - leftover bs + leftover bs' failure - EQ -> process bs - GT -> assert False (process bs) + EQ -> process bs' + GT -> assert False (process bs') EQ -> process bs GT -> do let (x, y) = S.splitAt size bs @@ -601,7 +413,7 @@ process x -- Given a bytestring of exactly the correct size, grab the value - process bs = return $! wrap $! inlinePerformIO $! + process bs = return $! wrap $! accursedUnutterablePerformIO $! unsafeUseAsCString bs (safePeek undefined . castPtr) safePeek :: a -> Ptr a -> IO a @@ -615,74 +427,3 @@ data SinkStorableException = SinkStorableInsufficientBytes deriving (Show, Typeable) instance Exception SinkStorableException - --- | Like 'IO.withBinaryFile', but provides a source to read bytes from. --- --- @since 1.2.1 -withSourceFile - :: (MonadUnliftIO m, MonadIO n) - => FilePath - -> (ConduitM i ByteString n () -> m a) - -> m a -withSourceFile fp inner = - withRunInIO $ \run -> - IO.withBinaryFile fp IO.ReadMode $ - run . inner . sourceHandle - --- | Like 'IO.withBinaryFile', but provides a sink to write bytes to. --- --- @since 1.2.1 -withSinkFile - :: (MonadUnliftIO m, MonadIO n) - => FilePath - -> (ConduitM ByteString o n () -> m a) - -> m a -withSinkFile fp inner = - withRunInIO $ \run -> - IO.withBinaryFile fp IO.ReadMode $ - run . inner . sinkHandle - --- | Same as 'withSinkFile', but lets you use a 'BB.Builder'. --- --- @since 1.2.1 -withSinkFileBuilder - :: (MonadUnliftIO m, MonadIO n) - => FilePath - -> (ConduitM BB.Builder o n () -> m a) - -> m a -withSinkFileBuilder fp inner = - withRunInIO $ \run -> - IO.withBinaryFile fp IO.ReadMode $ \h -> - run $ inner $ CL.mapM_ (liftIO . BB.hPutBuilder h) - --- | Like 'sinkFileCautious', but uses the @with@ pattern instead of --- @MonadResource@. --- --- @since 1.2.2 -withSinkFileCautious - :: (MonadUnliftIO m, MonadIO n) - => FilePath - -> (ConduitM S.ByteString o n () -> m a) - -> m a -withSinkFileCautious fp inner = - withRunInIO $ \run -> bracket - (cautiousAcquire fp) - cautiousCleanup - (\(tmpFP, h) -> do - a <- run $ inner $ sinkHandle h - hClose h - renameFile tmpFP fp - return a) - --- | Helper function for Cautious functions above, do not export! -cautiousAcquire :: FilePath -> IO (FilePath, IO.Handle) -cautiousAcquire fp = openBinaryTempFile (takeDirectory fp) (takeFileName fp <.> "tmp") - --- | Helper function for Cautious functions above, do not export! -cautiousCleanup :: (FilePath, IO.Handle) -> IO () -cautiousCleanup (tmpFP, h) = do - hClose h - removeFile tmpFP `Control.Exception.catch` \e -> - if isDoesNotExistError e - then return () - else throwIO e diff --git a/src/DumpFormat.hs b/src/DumpFormat.hs --- a/src/DumpFormat.hs +++ b/src/DumpFormat.hs @@ -44,6 +44,12 @@ "windows" .= cWindows tlData, "desktop" .= cDesktop tlData ] + toEncoding (TimeLogEntry {..}) = pairs + $ "date" .= tlTime + <> "rate" .= tlRate + <> "inactive" .= cLastActivity tlData + <> "windows" .= cWindows tlData + <> "desktop" .= cDesktop tlData instance FromJSON (TimeLogEntry CaptureData) where parseJSON = withObject "TimeLogEntry" $ \v -> do @@ -64,6 +70,12 @@ , "program" .= wProgram , "desktop" .= wDesktop ] + toEncoding WindowData{..} = pairs + $ "active" .= wActive + <> "hidden" .= wHidden + <> "title" .= wTitle + <> "program" .= wProgram + <> "desktop" .= wDesktop instance FromJSON WindowData where parseJSON = withObject "window" $ \v -> do diff --git a/src/LockFile.hs b/src/LockFile.hs --- a/src/LockFile.hs +++ b/src/LockFile.hs @@ -19,7 +19,7 @@ #ifdef WIN32 success <- claimMutex filename unless success $ do - hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") + hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for the path " ++ filename ++ ", possibly because another instance of arbtt is running.") exitFailure #else flip catchIOError (\e -> hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") >> exitFailure) $ do diff --git a/src/Stats.hs b/src/Stats.hs --- a/src/Stats.hs +++ b/src/Stats.hs @@ -100,11 +100,22 @@ mkFilterPredicate :: [Filter] -> IO ApplyCond mkFilterPredicate filters = do - fs <- forM filters $ \flag -> case flag of + fs <- forM (fastFiltersHeuristic filters) $ \flag -> case flag of Exclude act -> return $ excludeTag act Only act -> return $ onlyTag act GeneralCond s-> mkApplyCond s return $ \tl -> all ($ tl) fs + +-- | Reorder filters to first apply the presumably cheaper expressions +-- (e.g. date or sampleage comparisons) given on command-line, hoping that +-- will filter most samples out and we won't need to run the full categorizer +-- on these (which we need for 'Exclude'/'Only'). +fastFiltersHeuristic :: [Filter] -> [Filter] +fastFiltersHeuristic filters = fastFilters ++ slowFilters + where + (fastFilters, slowFilters) = partition isFast filters + isFast (GeneralCond _) = True + isFast _ = False filterActivity :: [ActivityFilter] -> ActivityData -> ActivityData filterActivity fs = filter (applyActivityFilter fs) diff --git a/tests/small_dump_json.out b/tests/small_dump_json.out --- a/tests/small_dump_json.out +++ b/tests/small_dump_json.out @@ -1,4 +1,4 @@ [ -{"desktop":"","inactive":2909,"date":"2010-03-20T13:59:15.075576Z","windows":[{"desktop":"","active":false,"program":"gvim","hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM"},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`ghci' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`irssi' mrtrac@curie:~ "},{"desktop":"","active":true,"program":"urxvt","hidden":false,"title":"mrtrac@curie:~/darcs/arbtt "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`mutt' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"Navigator","hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator"}],"rate":60000}, -{"desktop":"","inactive":557,"date":"2010-03-20T14:00:15.157669Z","windows":[{"desktop":"","active":false,"program":"gvim","hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM"},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`ghci' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`irssi' mrtrac@curie:~ "},{"desktop":"","active":true,"program":"urxvt","hidden":false,"title":"mrtrac@curie:~/darcs/arbtt "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`mutt' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"Navigator","hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator"}],"rate":60000}, -{"desktop":"","inactive":58004,"date":"2010-03-20T14:01:15.220521Z","windows":[{"desktop":"","active":false,"program":"gvim","hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM"},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`ghci' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`irssi' mrtrac@curie:~ "},{"desktop":"","active":true,"program":"urxvt","hidden":false,"title":"mrtrac@curie:~/darcs/arbtt "},{"desktop":"","active":false,"program":"urxvt","hidden":true,"title":"`mutt' mrtrac@curie:~ "},{"desktop":"","active":false,"program":"Navigator","hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator"}],"rate":60000}] +{"date":"2010-03-20T13:59:15.075576Z","rate":60000,"inactive":2909,"windows":[{"active":false,"hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM","program":"gvim","desktop":""},{"active":false,"hidden":true,"title":"`ghci' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`irssi' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":true,"hidden":false,"title":"mrtrac@curie:~/darcs/arbtt ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`mutt' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator","program":"Navigator","desktop":""}],"desktop":""}, +{"date":"2010-03-20T14:00:15.157669Z","rate":60000,"inactive":557,"windows":[{"active":false,"hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM","program":"gvim","desktop":""},{"active":false,"hidden":true,"title":"`ghci' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`irssi' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":true,"hidden":false,"title":"mrtrac@curie:~/darcs/arbtt ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`mutt' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator","program":"Navigator","desktop":""}],"desktop":""}, +{"date":"2010-03-20T14:01:15.220521Z","rate":60000,"inactive":58004,"windows":[{"active":false,"hidden":true,"title":"stats-main.hs (~/darcs/arbtt/src) - GVIM","program":"gvim","desktop":""},{"active":false,"hidden":true,"title":"`ghci' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`irssi' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":true,"hidden":false,"title":"mrtrac@curie:~/darcs/arbtt ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"`mutt' mrtrac@curie:~ ","program":"urxvt","desktop":""},{"active":false,"hidden":true,"title":"HackageDB: network-bytestring-0.1.2.1 - Vimperator","program":"Navigator","desktop":""}],"desktop":""}]