diff --git a/arbtt.cabal b/arbtt.cabal --- a/arbtt.cabal +++ b/arbtt.cabal @@ -1,5 +1,5 @@ name: arbtt -version: 0.6 +version: 0.6.1 license: GPL license-file: LICENSE category: Desktop @@ -31,7 +31,7 @@ hs-source-dirs: src build-depends: base == 4.*, filepath, directory, mtl, time, utf8-string, - bytestring, binary + bytestring, binary, deepseq other-modules: Data Data.MyText @@ -64,7 +64,7 @@ main-is: stats-main.hs hs-source-dirs: src build-depends: - base == 4.*, parsec == 2.*, containers, pcre-light, old-locale + base == 4.*, parsec == 3.*, containers, pcre-light, old-locale other-modules: Data Data.MyText @@ -85,7 +85,7 @@ main-is: dump-main.hs hs-source-dirs: src build-depends: - base == 4.*, parsec == 2.*, containers + base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText @@ -102,7 +102,7 @@ main-is: import-main.hs hs-source-dirs: src build-depends: - base == 4.*, parsec == 2.*, containers + base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText @@ -119,7 +119,7 @@ main-is: recover-main.hs hs-source-dirs: src build-depends: - base == 4.*, parsec == 2.*, containers + base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText diff --git a/categorize.cfg b/categorize.cfg --- a/categorize.cfg +++ b/categorize.cfg @@ -4,13 +4,24 @@ "sun-awt-X11-XDialogPeer" -> "java", "sun-awt-X11-XWindowPeer" -> "java", "gramps.py" -> "gramps", - "___nforschung" -> "ahnenforschung" + "___nforschung" -> "ahnenforschung", + "Pidgin" -> "pidgin" ) -- A rule that probably everybody wants. Being inactive for over a minute -- causes this sample to be ignored by default. $idle > 60 ==> tag inactive, + +current window $program == "sun-awt-X11-XFramePeer" && +current window $title == "I3P" + ==> tag Program:I3P, + +current window $program == "sun-awt-X11-XDialogPeer" && +current window $title == " " && +any window $title == "I3P" + ==> tag Program:I3P, + -- Simple rule that just tags the current program tag Program:$current.program, @@ -43,10 +54,29 @@ current window $title =~ m!LoopSubgroupPaper.pdf! ==> tag Project:DA, +( format $date >= "2010-08-01" && + format $date <= "2010-12-01" && + ( current window $program == "sun-awt-X11-XFramePeer" && + current window $title == "I3P" || + current window $program == "sun-awt-X11-XDialogPeer" && + current window $title == " " && + any window $title == "I3P" || + current window $title =~ m!(?:~|home/jojo)/dokumente/Uni/SA! || + current window $title =~ m!Isabelle200! || + current window $title =~ m!isar-ref.pdf! || + current window $title =~ m!document.pdf! || + current window $title =~ m!outline.pdf! || + current window $title =~ m!Studienarbeit.pdf! ) +) ==> tag Project:SA, + + -- Out of curiosity: what percentage of my time am I actually coding Haskell? current window ($program == "gvim" && $title =~ /^[^ ]+\.hs \(/ ) ==> tag Editing-Haskell, +{- +-- Example of time-related rules. I do not use these myself. + -- To be able to match on the time of day, I introduce tags for that as well. -- $time evaluates to local time. $time >= 2:00 && $time < 8:00 ==> tag time-of-day:night, @@ -78,3 +108,4 @@ month $date == 1 ==> tag month:January, month $date == 2 ==> tag month:February, year $date == 2010 ==> tag year:2010, +-} diff --git a/src/Categorize.hs b/src/Categorize.hs --- a/src/Categorize.hs +++ b/src/Categorize.hs @@ -64,7 +64,7 @@ content <- readFile filename time <- getCurrentTime tz <- getCurrentTimeZone - case parse (do {r <- parseRules; eof ; return r}) filename content of + case parse (between (return ()) eof parseRules) filename content of Left err -> do putStrLn "Parser error:" print err @@ -184,7 +184,7 @@ checkRegex (CondString getStr) (CondRegex getRegex) = Right $ CondCond $ \ctx -> do str <- getStr ctx regex <- getRegex ctx - tail <$> RE.match regex str [] + tail <$> RE.match regex str [RE.exec_no_utf8_check] checkRegex cp1 cp2 = Left $ printf "Cannot apply =~ to an expression of type %s and type %s" (cpType cp1) (cpType cp2) diff --git a/src/Data.hs b/src/Data.hs --- a/src/Data.hs +++ b/src/Data.hs @@ -14,6 +14,7 @@ import Data.MyText (Text) import Control.Applicative import Control.Monad +import Control.DeepSeq type TimeLog a = [TimeLogEntry a] @@ -25,6 +26,19 @@ instance Functor TimeLogEntry where fmap f tl = tl { tlData = f (tlData tl) } + +instance NFData a => NFData (TimeLogEntry a) where + rnf (TimeLogEntry a b c) = a `deepseq` b `deepseq` c `deepseq` () + +instance NFData UTCTime where + rnf (UTCTime a b) = a `deepseq` b `deepseq` () + +instance NFData Day where + rnf d = rnf (toModifiedJulianDay d) + +instance NFData DiffTime where + rnf d = rnf (toRational d) + data CaptureData = CaptureData { cWindows :: [ (Bool, Text, Text) ] @@ -32,6 +46,9 @@ , cLastActivity :: Integer -- ^ in milli-seconds } deriving (Show, Read) + +instance NFData CaptureData where + rnf (CaptureData a b) = a `deepseq` b `deepseq` () type ActivityData = [Activity] diff --git a/src/Data/MyText.hs b/src/Data/MyText.hs --- a/src/Data/MyText.hs +++ b/src/Data/MyText.hs @@ -8,6 +8,7 @@ import Prelude hiding (length, map) import qualified Prelude import GHC.Exts( IsString(..) ) +import Control.DeepSeq newtype Text = Text { toBytestring :: BSU.ByteString } deriving (Eq, Ord) @@ -24,6 +25,9 @@ instance Binary Text where put = put . unpack get = pack <$> get + +instance NFData Text where + rnf (Text a) = a `seq` () length :: Text -> Int length (Text bs) = BSU.length bs diff --git a/src/stats-main.hs b/src/stats-main.hs --- a/src/stats-main.hs +++ b/src/stats-main.hs @@ -10,6 +10,7 @@ import Data.Char (toLower) import Text.Printf import Data.Version (showVersion) +import Control.DeepSeq import TimeLog import Categorize @@ -149,6 +150,7 @@ categorizer <- readCategorizer (optCategorizeFile flags) captures <- readTimeLog (optLogFile flags) + captures `deepseq` return () let allTags = categorizer captures when (null allTags) $ do putStrLn "Nothing recorded yet"