arbtt 0.9.0.7 → 0.9.0.8
raw patch · 12 files changed
+84/−32 lines, 12 filesdep ~aesondep ~basebinary-added
Dependency ranges changed: aeson, base
Files
- arbtt.cabal +33/−16
- src/Categorize.hs +4/−1
- src/Graphics/Win32/Window/Extra.hsc +8/−3
- src/LeftFold.hs +2/−2
- src/Stats.hs +10/−3
- src/TermSize.hsc +1/−1
- src/TimeLog.hs +5/−0
- src/stats-main.hs +3/−3
- tests/gap-handling.cfg +1/−0
- tests/gap-handling.log binary
- tests/gap-handling.out +11/−0
- tests/test.hs +6/−3
arbtt.cabal view
@@ -1,5 +1,5 @@ name: arbtt-version: 0.9.0.7+version: 0.9.0.8 license: GPL license-file: LICENSE category: Desktop@@ -40,9 +40,9 @@ main-is: capture-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*,+ base == 4.7.* || == 4.8.*, filepath, directory, transformers, utf8-string,- aeson >= 0.6 && < 0.11,+ aeson >= 0.6 && < 0.12, binary >= 0.5, bytestring, deepseq @@ -63,6 +63,9 @@ ghc-options: -rtsopts + if !os(windows)+ build-depends: unix+ if os(windows) extra-libraries: psapi cpp-options: -DWIN32@@ -80,25 +83,28 @@ Graphics.X11.XScreenSaver System.Locale.SetLocale build-depends:- X11 > 1.4.4, unix+ X11 > 1.4.4 default-language: Haskell98 executable arbtt-stats main-is: stats-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*,+ base == 4.7.* || == 4.8.*, parsec == 3.*, containers == 0.5.*, pcre-light, binary >= 0.5, deepseq, bytestring, utf8-string, strict,- transformers, unix, directory, filepath,- aeson >= 0.6 && < 0.11,+ transformers, directory, filepath,+ aeson >= 0.6 && < 0.12, array == 0.4.* || == 0.5.*, terminal-progress-bar, bytestring-progress + if !os(windows)+ build-depends: unix+ if flag(old-locale) build-depends: time == 1.4.*, old-locale else@@ -128,15 +134,18 @@ main-is: dump-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*,+ base == 4.7.* || == 4.8.*, parsec == 3.*, containers == 0.5.*,- aeson >= 0.6 && < 0.11,+ aeson >= 0.6 && < 0.12, array == 0.4.* || == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string, strict,- transformers, unix, directory, filepath+ transformers, directory, filepath + if !os(windows)+ build-depends: unix+ if flag(old-locale) build-depends: time == 1.4.*, old-locale else@@ -162,13 +171,16 @@ main-is: import-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*,+ base == 4.7.* || == 4.8.*, parsec == 3.*, containers == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string, strict,- transformers, unix, directory, filepath+ transformers, directory, filepath + if !os(windows)+ build-depends: unix+ if flag(old-locale) build-depends: time == 1.4.*, old-locale else@@ -192,12 +204,15 @@ main-is: recover-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*,+ base == 4.7.* || == 4.8.*, containers == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string,- unix, directory, filepath+ directory, filepath + if !os(windows)+ build-depends: unix+ if flag(old-locale) build-depends: time == 1.4.*, old-locale else@@ -226,7 +241,7 @@ Main-is: test.hs Build-depends:- base == 4.5.* || == 4.6.* || == 4.7.* || == 4.8.*+ base == 4.7.* || == 4.8.* , tasty >= 0.7 && < 0.12 , tasty-golden >= 2.2.0.2 && <= 2.4 , tasty-hunit >= 0.2 && < 0.11@@ -235,12 +250,14 @@ , binary >= 0.5 , bytestring , utf8-string- , unix , directory , parsec == 3.* , containers == 0.5.* , pcre-light , transformers++ if !os(windows)+ build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale
src/Categorize.hs view
@@ -20,6 +20,7 @@ import Text.Parsec.Combinator import Text.Parsec.Language import Text.Parsec.ExprFail+import System.IO import System.Exit import Control.Applicative ((<*>),(<$>)) import Control.DeepSeq@@ -77,7 +78,9 @@ readCategorizer :: FilePath -> IO Categorizer readCategorizer filename = do- content <- readFile filename+ h <- openFile filename ReadMode+ hSetEncoding h utf8+ content <- hGetContents h time <- getCurrentTime tz <- getCurrentTimeZone case flip runReader tz $
src/Graphics/Win32/Window/Extra.hsc view
@@ -11,6 +11,8 @@ import System.Win32.Process import System.Win32.File ( closeHandle ) import System.IO+import Control.Exception (tryJust)+import System.IO.Error (isPermissionError) import Control.Exception ( bracket ) import Control.Monad @@ -67,12 +69,15 @@ t <- (#peek LASTINPUTINFO, dwTime) buf return $ LASTINPUTINFO t +ignoreEPerm = tryJust (guard . isPermissionError)+ fetchWindowTitles :: IO [(HWND, String,String)] fetchWindowTitles = do resultRef <- newIORef []- callback <- mkEnumWindowsProc $ \winh _ -> do+ callback <- mkEnumWindowsProc $ \winh _ ->+ do ignoreEPerm $ do v <- c_IsWindowVisible winh -- only consider visible windows- if not v then return True else do+ when v $ do proc <- alloca $ \pid_p -> do c_GetWindowThreadProcessId winh pid_p pid <- peek pid_p@@ -97,7 +102,7 @@ else peekTString c_test unless (str `elem` ["", "Default IME"]) $ do -- Ignore some windows by default modifyIORef resultRef ((winh,str,proc):)- return True+ return True c_EnumWindows callback 0 readIORef resultRef
src/LeftFold.hs view
@@ -73,13 +73,13 @@ runOnGroups eq _ (Pure ox) = Pure ox runOnGroups eq (Pure ix) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sto) go finish where go (S.Nothing :!: so) x = (S.Just x :!: so)- go (S.Just x' :!: so) x | x `eq` x' = (S.Just x :!: so)+ go (S.Just x' :!: so) x | x' `eq` x = (S.Just x :!: so) | otherwise = (S.Just x :!: po so ix) finish (S.Nothing :!: so) = fo so finish (S.Just _ :!: so) = fo (po so ix) runOnGroups eq (LeftFold sti pi fi) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sti :!: sto) go finish where go (S.Nothing :!: si :!: so) x = (S.Just x :!: pi si x :!: so)- go (S.Just x' :!: si :!: so) x | x `eq` x' = (S.Just x :!: pi si x :!: so)+ go (S.Just x' :!: si :!: so) x | x' `eq` x = (S.Just x :!: pi si x :!: so) | otherwise = (S.Just x :!: pi sti x :!: po so (fi si)) finish (S.Nothing :!: si :!: so) = fo so finish (S.Just _ :!: si :!: so) = fo (po so (fi si))
src/Stats.hs view
@@ -36,6 +36,7 @@ import qualified Data.Strict as Strict import Data.Traversable (sequenceA) import Control.Arrow+import Debug.Trace import Data import Categorize@@ -323,22 +324,28 @@ else [] ) +tlRateTimediff :: TimeLogEntry a -> NominalDiffTime+tlRateTimediff tle = fromIntegral (tlRate tle) / 1000+ processIntervalReport :: ReportOptions -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processIntervalReport opts title extr = runOnIntervals go1 go2 where go1 :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Interval] go1 = go3 `mapElems` fmap (extr . snd) go3 :: LeftFold (TimeLogEntry (Maybe String)) [Interval]- go3 = runOnGroups ((==) `on` tlData) go4 (onJusts toList)+ go3 = runOnGroups sameGroup go4 (onJusts toList)+ sameGroup tl1 tl2 =+ tlData tl1 == tlData tl2+ && tlTime tl2 `diffUTCTime` tlTime tl1 < 2 * tlRateTimediff tl1 go4 :: LeftFold (TimeLogEntry (Maybe String)) (Maybe Interval) go4 = pure (\fe le -> case tlData fe of Just str -> Just ( str , showUtcTime (tlTime fe)- , showUtcTime (tlTime le)+ , showUtcTime (tlRateTimediff le `addUTCTime` tlTime le) , showTimeDiff opts $- tlTime le `diffUTCTime` tlTime fe + fromIntegral (tlRate fe)/1000+ tlTime le `diffUTCTime` tlTime fe + tlRateTimediff le ) Nothing -> Nothing) <*> (fromJust <$> lfFirst) <*>
src/TermSize.hsc view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, CPP #-} {- By hammar on http://stackoverflow.com/a/12807521/946226
src/TimeLog.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module TimeLog where import Data@@ -16,7 +17,9 @@ import Control.Exception import Prelude hiding (catch) import Control.DeepSeq+#ifndef mingw32_HOST_OS import System.Posix.Files+#endif import System.IO.Unsafe (unsafeInterleaveIO) import qualified Data.ByteString.Lazy as BS@@ -38,7 +41,9 @@ tle <- mkTimeLogEntry delay entry createTimeLog False filename+#ifndef mingw32_HOST_OS setFileMode filename (ownerReadMode `unionFileModes` ownerWriteMode)+#endif appendTimeLog filename prev tle threadDelay (fromIntegral delay * 1000) loop (Just entry)
src/stats-main.hs view
@@ -14,7 +14,6 @@ import Control.Applicative import qualified Data.ByteString.Lazy as BS import Data.ByteString.Lazy.Progress-import System.Posix.Files import System.ProgressBar import TermSize import qualified Data.MyText as T@@ -178,13 +177,14 @@ exitFailure categorizer <- readCategorizer (optCategorizeFile flags) - timelog <- BS.readFile (optLogFile flags)+ timeloghandle <- openBinaryFile (optLogFile flags) ReadMode+ size <- hFileSize timeloghandle+ timelog <- BS.hGetContents timeloghandle isTerm <- hIsTerminalDevice stderr trackedTimelog <- case isTerm of True -> do hSetBuffering stderr NoBuffering- size <- fileSize <$> getFileStatus (optLogFile flags) trackProgressWithChunkSize (fromIntegral size `div` 100) (\_ b -> do (_height, width) <- getTermSize hPutChar stderr '\r'
+ tests/gap-handling.cfg view
@@ -0,0 +1,1 @@+tag Program:$current.program
+ tests/gap-handling.log view
binary file changed (absent → 5972 bytes)
+ tests/gap-handling.out view
@@ -0,0 +1,11 @@+Intervals for category "Program"+================================+__________________Tag_|______________From_|_____________Until_|_Duration_+gnome-terminal-server | 09/20/15 14:24:03 | 09/20/15 14:25:22 | 1m19s+ Navigator | 09/20/15 14:25:22 | 09/20/15 14:26:22 | 1m00s+ Navigator | 09/20/15 14:49:31 | 09/20/15 14:55:41 | 6m10s+gnome-terminal-server | 09/20/15 14:55:41 | 09/20/15 14:56:31 | 50s+gnome-terminal-server | 09/20/15 18:51:47 | 09/20/15 18:52:17 | 30s+ Navigator | 09/20/15 18:52:17 | 09/20/15 18:52:37 | 20s+ Navigator | 09/20/15 18:53:15 | 09/20/15 18:53:55 | 40s+gnome-terminal-server | 09/20/15 18:53:55 | 09/20/15 18:54:25 | 30s
tests/test.hs view
@@ -10,7 +10,7 @@ import Control.Exception import Data.Typeable import System.Exit-import System.Posix.Env+import System.Environment import Categorize import TimeLog@@ -18,7 +18,7 @@ import Data.Time.Clock main = do- putEnv "TZ=UTC" -- to make tests reproducible+ setEnv "TZ" "UTC" -- to make tests reproducible defaultMain tests tests :: TestTree@@ -71,6 +71,9 @@ , goldenVsString "stats small unicode" "tests/unicode_stats.out" $ run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/unicode.log", "--categorize", "tests/unicode.cfg"] B.empty+ , goldenVsString "stats gap handling"+ "tests/gap-handling.out" $+ run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/gap-handling.log", "--categorize", "tests/gap-handling.cfg", "--intervals", "Program:"] B.empty ] @@ -79,7 +82,7 @@ (ex,stdout,stderr) <- readProcessWithExitCode cmd args stdin unless (B.null stderr) $ throwIO $ StderrException stderr case ex of- ExitSuccess -> return stdout+ ExitSuccess -> return (B.filter (not . (==13)) stdout) -- windows compat ExitFailure r -> throwIO $ ExitCodeException r data StderrException = StderrException B.ByteString