arbtt 0.11 → 0.11.1
raw patch · 9 files changed
+126/−348 lines, 9 files
Files
- README.md +2/−6
- arbtt.cabal +2/−2
- doc/arbtt.xml +28/−7
- src/Data/Conduit/Attoparsec.hs +10/−13
- src/Data/Conduit/Binary.hs +56/−315
- src/DumpFormat.hs +12/−0
- src/LockFile.hs +1/−1
- src/Stats.hs +12/−1
- tests/small_dump_json.out +3/−3
README.md view
@@ -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-<https://github.com/nomeata/arbtt> or-<https://bitbucket.org/nomeata/arbtt>.+<https://github.com/nomeata/arbtt>. -The issue tracker is hosted on bitbucket:- <https://bitbucket.org/nomeata/arbtt/issues>-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: <https://github.com/nomeata/arbtt/issues> Some of my plans or ideas include:
arbtt.cabal view
@@ -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,
doc/arbtt.xml view
@@ -98,9 +98,9 @@ <title>Installation</title> <sect2>- <title>Obtaining arbtt</title>>+ <title>Obtaining arbtt</title> <para>- See the project website <ulink url="http://arbtt.nomeata.de/#install">for installation instructions</ulink>.+ See the project website <ulink url="https://arbtt.nomeata.de/#install">for installation instructions</ulink>. </para> </sect2> @@ -1073,6 +1073,16 @@ </para> </sect2> <sect2>+ <title>arbtt-chart</title>+ <para>+ Tomáš Janoušek maintains a console-based alternative to arbtt-graph that+ draws charts using Unicode block elements.+ </para>+ <para>+ You can find his tool on <ulink url="https://github.com/liskin/arbtt-chart">https://github.com/liskin/arbtt-chart</ulink>.+ </para>+ </sect2>+ <sect2> <title>arbtt-capture for GNOME Shell</title> <para> 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. </para> + <sect2 id="release-notes-0.11.1">+ <title>Version 0.11.1</title>+ <itemizedlist>+ <listitem>+ <para>+ Support building with GHC-9.0+ </para>+ </listitem>+ </itemizedlist>+ </sect2>+ <sect2 id="release-notes-0.11"> <title>Version 0.11</title> <itemizedlist>@@ -1898,7 +1919,7 @@ <listitem> <para> The syntax now allows for time differences larger than 99:99.- (<ulink url="https://bitbucket.org/nomeata/arbtt/issue/14/improve-time-categorization-directives">issue #14</ulink>)+ (<ulink url="https://github.com/nomeata/arbtt/issue/69">issue #69</ulink>) </para> </listitem> </itemizedlist>@@ -1928,10 +1949,10 @@ <para><command>arbtt-capture</command> now supports the option <option>--dump</option> for development and debugging purposes.</para> </listitem> <listitem>- <para>The name of the current desktop (or workspace) is also recorded, and available as <literal>$desktop</literal> (<ulink url="https://bitbucket.org/nomeata/arbtt/issue/1/track-active-workspace-name">issue #1</ulink>).</para>+ <para>The name of the current desktop (or workspace) is also recorded, and available as <literal>$desktop</literal> (<ulink url="https://github.com/nomeata/arbtt/issue/56">issue #56</ulink>).</para> </listitem> <listitem>- <para>Two bugs in the parser were fixed (<ulink url="https://bitbucket.org/nomeata/arbtt/issue/4/parsing-of-if-then-else-fails">issue #4</ulink> and <ulink url="https://bitbucket.org/nomeata/arbtt/issue/5/parsing-of-fails">issue #5</ulink>).</para>+ <para>Two bugs in the parser were fixed (<ulink url="https://github.com/nomeata/arbtt/issue/59">issue #59</ulink> and <ulink url="https://github.com/nomeata/arbtt/issue/60">issue #60</ulink>).</para> </listitem> <listitem> <para><command>arbtt-stats</command> can print reports split by time interval, using the <option>--for-each</option> option.</para>@@ -1940,10 +1961,10 @@ <para><command>arbtt-stats</command> can print the actual samples selected, with <option>--dump-samples</option>.</para> </listitem> <listitem>- <para>Support for GHC-7.8 was added, with help from Jayesh Kumar Gupta (<ulink url="https://bitbucket.org/nomeata/arbtt/issue/8/update-base-bounds-for-newer-ghc">issue #8</ulink>).</para>+ <para>Support for GHC-7.8 was added, with help from Jayesh Kumar Gupta (<ulink url="https://github.com/nomeata/arbtt/issue/63">issue #63</ulink>).</para> </listitem> <listitem>- <para>Arbtt now has a proper testsuite integrated into Cabal, and an <ulink url="https://travis-ci.org/nomeata/darcs-mirror-arbtt">automated test infrastructure</ulink> on Travis.</para>+ <para>Arbtt now has a proper testsuite integrated into Cabal, and an <ulink url="https://travis-ci.org/nomeata/arbtt">automated test infrastructure</ulink> on Travis.</para> </listitem> <listitem> <para>Waldir Pimenta contributed a new web page, hosted at <ulink url="http://arbtt.nomeata.de/">arbtt.nomeata.de</ulink>.</para>
src/Data/Conduit/Attoparsec.hs view
@@ -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
src/Data/Conduit/Binary.hs view
@@ -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
src/DumpFormat.hs view
@@ -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
src/LockFile.hs view
@@ -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
src/Stats.hs view
@@ -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)
tests/small_dump_json.out view
@@ -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":""}]