arbtt 0.7 → 0.8
raw patch · 38 files changed
+936/−251 lines, 38 filesdep +HUnitdep +aesondep +arraydep ~basedep ~binarydep ~containersbinary-added
Dependencies added: HUnit, aeson, array, process-extras, tasty, tasty-golden, tasty-hunit
Dependency ranges changed: base, binary, containers, time
Files
- README +0/−95
- README.md +112/−0
- arbtt.cabal +79/−14
- categorize.cfg +11/−2
- doc/arbtt.xml +164/−14
- src/Capture/Win32.hs +1/−1
- src/Capture/X11.hs +29/−2
- src/Categorize.hs +8/−4
- src/Data.hs +8/−4
- src/Data/List/TakeR.hs +33/−0
- src/Data/MyText.hs +6/−3
- src/DumpFormat.hs +94/−0
- src/LeftFold.hs +16/−3
- src/Stats.hs +114/−68
- src/System/Locale/SetLocale.hsc +2/−4
- src/TermSize.hsc +1/−1
- src/TimeLog.hs +19/−9
- src/UpgradeLog1.hs +1/−1
- src/capture-main.hs +17/−5
- src/dump-main.hs +33/−1
- src/recover-main.hs +1/−0
- src/stats-main.hs +47/−20
- tests/categorize.cfg +25/−0
- tests/issue4.cfg +5/−0
- tests/issue5.cfg +3/−0
- tests/small.cfg +4/−0
- tests/small.log binary
- tests/small_borked.log binary
- tests/small_borked_recover.out binary
- tests/small_dump.out +3/−0
- tests/small_import.in +3/−0
- tests/small_import.out binary
- tests/small_stats.out +5/−0
- tests/small_stats_csv.out +3/−0
- tests/test.hs +82/−0
- tests/unicode.cfg +3/−0
- tests/unicode.log binary
- tests/unicode_stats.out +4/−0
− README
@@ -1,95 +0,0 @@-arbtt, the Automatic Rule-Based Time Tracker--© 2009 Joachim Breitner <mail@joachim-breitner.de>--The Automatic Rule-Based Time Tracker is a desktop daemon that runs in the-background and, every minute, records what windows are open on your-desktop, what their titles are, which one is active. The accompanied-statistics program lets you derive information from this log file, i.e.-what how much of your time have you been spending with e-Mail, or what-projects are your largest time wasters. The mapping from the raw window-titles to sensible „tags“ is done by a configuration file with an powerful-syntax.--Installation-============--You can build and install this program as any other Cabalized program:- $ runhaskell Setup.hs configure- $ runhaskell Setup.hs build- $ runhaskell Setup.hs install--You also need to make sure that arbtt-capture is started with your X-session. If you use GNOME or KDE, you can copy the file-"arbtt-capture.desktop" to ~/.config/autostart/. You might need to put the-full path to arbtt-capture in the Exec line there, if you did not do a-system wide installation.--If you want to record samples at a different rate than one per minute, you-will have to pass the "--sample-rate" parameter to arbtt-capture. --Documentation-============--Full documentation is now provided in the user manual in the doc/-directory. If you have the docbook xsl toolchain installed, you can-generate the HTML documentation by entering "make" in that directory.-Otherwise, you can use the online version at-http://darcs.nomeata.de/arbtt/doc/users_guide/-Beware that this will also reflect the latest version.--Creating the Windows Installer-==============================--The file setup.iss contains an installer script for Inno Setup and can be used-to create the windows installer for arbtt. It can be used under wine. To build-arbtt under Windows, you need to install the Haskell Platform. Because the-Haskell Platform ships an older version of the w32api package from mingw, you-also need to download w32api-3.14-mingw32-dev.tar.gz and copy at least the files-include/psapi.h and lib/libpsapi.a over the files installed by the Haskell-Platform. For the pcre-light package, you need to install the pcre library.-Unless you run a German version of Windows, you’ll need to adjust the path to-the pcre3.dll file in setup.iss. Install Inno Setup. Create the documentation-(make -C doc) and configure arbtt with the --with-ISCC-flag:-$ wine runhaskell Setup.hs configure --with-ISCC='C:\Programme\Inno Setup 5\ISCC.exe'-again adjusting the path if you do not have a German version of Windows. This-will put the version name into setup.iss and create the output file as-dist/arbtt-setup-<version>.exe.--Download links:- * http://hackage.haskell.org/platform/2009.2.0.2/HaskellPlatform-2009.2.0.2-setup.exe- * http://sourceforge.net/projects/mingw/files/MinGW%20API%20for%20MS-Windows/- * http://gnuwin32.sourceforge.net/downlinks/pcre.php- * http://www.jrsoftware.org/download.php/is-unicode.exe--Development-===========--You are very welcome to help the developement of arbtt. You can find the-latest source at the darcs repository at- http://darcs.nomeata.de/arbtt--User and Developer discussion happens on the arbtt mailing list:- arbtt@lists.nomeata.de-To subscribe to the list, visit:- http://lists.nomeata.de/mailman/listinfo/arbtt--Some of my plans or ideas include:-- * A graphical viewer that allows you to expore the tags in an appealing,- interactive way. Possibly based on the Charts haskell library.- * Looking forward and backwards in time when writing rules. (Information- is already passed to the categorizing function, but not exposed to the- syntax).- * $total_idle time, which is the maximum idle time until it is reset. This- would allow the user to catch the idle times more exactly.- * Rules based on day of time, to create tags for worktime, weekend, late- at night. (Partially done)- * Storing the current timezone in the tags, for the prevoius entry to be- more to be more useful.- * Storing the hostname, in case a user has several. - * Statistics based on time, to visualize trends.- * Possibly more data sources?--Any help cleaning, documenting or testing the current code is appreciated-as well.
+ README.md view
@@ -0,0 +1,112 @@+arbtt, the Automatic Rule-Based Time Tracker+============================================++© 2009 Joachim Breitner <mail@joachim-breitner.de>++The Automatic Rule-Based Time Tracker is a desktop daemon that runs in the+background and, every minute, records what windows are open on your+desktop, what their titles are, which one is active. The accompanied+statistics program lets you derive information from this log file, i.e.+what how much of your time have you been spending with e-Mail, or what+projects are your largest time wasters. The mapping from the raw window+titles to sensible „tags“ is done by a configuration file with an powerful+syntax.++Installation+------------++You can build and install this program as any other Cabalized program:++ $ runhaskell Setup.hs configure+ $ runhaskell Setup.hs build+ $ runhaskell Setup.hs install++You also need to make sure that arbtt-capture is started with your X+session. If you use GNOME or KDE, you can copy the file+`arbtt-capture.desktop` to `~/.config/autostart/`. You might need to put the+full path to arbtt-capture in the `Exec` line there, if you did not do a+system wide installation.++If you want to record samples at a different rate than one per minute, you+will have to pass the `--sample-rate` parameter to arbtt-capture.++Documentation+------------++Full documentation is now provided in the user manual in the doc/+directory. If you have the docbook xsl toolchain installed, you can+generate the HTML documentation by entering "make" in that directory.+Otherwise, you can use the+[online version of the User’s Guide](http://darcs.nomeata.de/arbtt/doc/users_guide/)+Beware that this will also reflect the latest development version.++Development+-----------++You are very welcome to help the developement of arbtt. You can find the+latest source at the darcs repository at+ http://darcs.nomeata.de/arbtt++Git mirrors are available at++ * http://git.nomeata.de/?p=darcs-mirror-arbtt.git+ * https://github.com/nomeata/darcs-mirror-arbtt+ * https://bitbucket.org/nomeata/arbtt++User and Developer discussion happens on the arbtt mailing list:+ arbtt@lists.nomeata.de+To subscribe to the list, visit:+ http://lists.nomeata.de/mailman/listinfo/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.)++Some of my plans or ideas include:++ * A graphical viewer that allows you to expore the tags in an appealing,+ interactive way. Possibly based on the Charts haskell library.+ * Looking forward and backwards in time when writing rules. (Information+ is already passed to the categorizing function, but not exposed to the+ syntax).+ * `$total_idle` time, which is the maximum idle time until it is reset. This+ would allow the user to catch the idle times more exactly.+ * Rules based on time of day, to create tags for worktime, weekend, late+ at night. (Partially done)+ * Storing the current timezone in the tags, for the prevoius entry to be+ more to be more useful.+ * Storing the hostname, in case a user has several. + * Statistics based on time, to visualize trends.+ * Possibly more data sources?++Any help cleaning, documenting or testing the current code is appreciated+as well.++Creating the Windows Installer+------------------------------++The file `setup.iss` contains an installer script for Inno Setup and can be used+to create the windows installer for arbtt. It can be used under wine. To build+arbtt under Windows, you need to install the Haskell Platform. Because the+Haskell Platform ships an older version of the w32api package from mingw, you+also need to download `w32api-3.14-mingw32-dev.tar.gz` and copy at least the files+`include/psapi.h` and `lib/libpsapi.a` over the files installed by the Haskell+Platform. For the `pcre-light` package, you need to install the `pcre` library.+Unless you run a German version of Windows, you’ll need to adjust the path to+the `pcre3.dll` file in `setup.iss`. Install `Inno Setup`. Create the documentation+(`make -C doc`) and configure arbtt with the `--with-ISCC-flag`:++ $ wine runhaskell Setup.hs configure --with-ISCC='C:\Programme\Inno Setup 5\ISCC.exe'++again adjusting the path if you do not have a German version of Windows. This+will put the version name into `setup.iss` and create the output file as+`dist/arbtt-setup-<version>.exe.`++Download links:++ * http://hackage.haskell.org/platform/2009.2.0.2/HaskellPlatform-2009.2.0.2-setup.exe+ * http://sourceforge.net/projects/mingw/files/MinGW%20API%20for%20MS-Windows/+ * http://gnuwin32.sourceforge.net/downlinks/pcre.php+ * http://www.jrsoftware.org/download.php/is-unicode.exe+
arbtt.cabal view
@@ -1,9 +1,9 @@ name: arbtt-version: 0.7+version: 0.8 license: GPL license-file: LICENSE category: Desktop-cabal-version: >= 1.6+cabal-version: >= 1.10 build-type: Simple author: Joachim Breitner <mail@joachim-breitner.de> maintainer: Joachim Breitner <mail@joachim-breitner.de>@@ -15,26 +15,30 @@ later), and stores this. It is also a program that will, based on expressive rules you specify, derive what you were doing, and what for. .+ The documentation, which includes the changelog, can also be found at+ http://arbtt.nomeata.de/doc/users_guide/.+ . WARNING: The log file might contain very sensitive private data. Make sure you understand the consequences of a full-time logger and be careful with this data.-homepage: http://www.joachim-breitner.de/projects#arbtt-+homepage: http://arbtt.nomeata.de/ extra-source-files:- categorize.cfg, arbtt-capture.desktop, README,+ categorize.cfg, arbtt-capture.desktop, README.md, doc/arbtt.xml, doc/fptools.css, doc/Makefile,- setup.iss, modpath.iss+ setup.iss, modpath.iss,+ tests/*.log, tests/*.out, tests/*.in, tests/*.cfg executable arbtt-capture main-is: capture-main.hs hs-source-dirs: src build-depends:- base == 4.5.* || == 4.6.*,+ base == 4.5.* || == 4.6.* || == 4.7.*, filepath, directory, transformers, time >= 1.4, utf8-string,- bytestring, binary, deepseq, strict,- terminal-progress-bar,- bytestring-progress+ aeson == 0.6.* || == 0.7.*,+ array == 0.4.* || == 0.5.*,+ binary >= 0.5,+ bytestring, deepseq, strict, old-locale other-modules: Data Data.MyText@@ -65,12 +69,22 @@ System.Locale.SetLocale build-depends: X11 > 1.4.4, unix+ default-language: Haskell98 executable arbtt-stats main-is: stats-main.hs hs-source-dirs: src build-depends:- base == 4.*, parsec == 3.*, containers, pcre-light, old-locale+ base == 4.5.* || == 4.6.* || == 4.7.*,+ parsec == 3.*,+ containers == 0.5.*,+ pcre-light, old-locale,+ binary >= 0.5,+ deepseq, bytestring, utf8-string, time >= 1.4, strict,+ transformers, unix, directory, filepath,+ aeson == 0.6.* || == 0.7.*,+ array == 0.4.* || == 0.5.*,+ terminal-progress-bar, bytestring-progress other-modules: Data Data.MyText@@ -89,30 +103,47 @@ else other-modules: System.Locale.SetLocale+ default-language: Haskell98 executable arbtt-dump main-is: dump-main.hs hs-source-dirs: src build-depends:- base == 4.*, parsec == 3.*, containers+ base == 4.5.* || == 4.6.* || == 4.7.*,+ parsec == 3.*,+ containers == 0.5.*,+ aeson == 0.6.* || == 0.7.*,+ array == 0.4.* || == 0.5.*,+ binary >= 0.5,+ deepseq, bytestring, utf8-string, time >= 1.4, strict,+ transformers, unix, directory, filepath,+ old-locale other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup TimeLog+ DumpFormat+ Data.List.TakeR ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale+ default-language: Haskell98 executable arbtt-import main-is: import-main.hs hs-source-dirs: src build-depends:- base == 4.*, parsec == 3.*, containers+ base == 4.5.* || == 4.6.* || == 4.7.*,+ parsec == 3.*,+ containers == 0.5.*,+ binary >= 0.5,+ deepseq, bytestring, utf8-string, time >= 1.4, strict,+ transformers, unix, directory, filepath other-modules: Data Data.MyText@@ -125,12 +156,17 @@ else other-modules: System.Locale.SetLocale+ default-language: Haskell98 executable arbtt-recover main-is: recover-main.hs hs-source-dirs: src build-depends:- base == 4.*, parsec == 3.*, containers+ base == 4.5.* || == 4.6.* || == 4.7.*,+ parsec == 3.*, containers == 0.5.*,+ binary >= 0.5,+ deepseq, bytestring, utf8-string, time >= 1.4, strict,+ transformers, unix, directory, filepath other-modules: Data Data.MyText@@ -143,6 +179,35 @@ else other-modules: System.Locale.SetLocale+ default-language: Haskell98++test-suite test+ Type:+ exitcode-stdio-1.0+ Hs-source-dirs:+ tests+ src+ Main-is:+ test.hs+ Build-depends:+ base == 4.5.* || == 4.6.* || == 4.7.*+ , tasty == 0.7.*+ , tasty-golden == 2.2.0.2+ , tasty-hunit == 0.2.* || == 0.4.*+ , HUnit == 1.2.*+ , process-extras == 0.2.*+ , deepseq+ , binary >= 0.5+ , bytestring+ , utf8-string+ , time+ , unix+ , directory+ , parsec == 3.*+ , containers == 0.5.*+ , pcre-light, old-locale+ , transformers+ default-language: Haskell98 source-repository head type: darcs
categorize.cfg view
@@ -1,11 +1,15 @@+-- Comments in this file use the Haskell syntax:+-- A "--" comments the rest of the line.+-- A set of {- ... -} comments out a group of lines.+ -- This defines some aliases, to make the reports look nicer: aliases ( "sun-awt-X11-XFramePeer" -> "java", "sun-awt-X11-XDialogPeer" -> "java", "sun-awt-X11-XWindowPeer" -> "java",- "gramps.py" -> "gramps",+ "gramps.py" -> "gramps", "___nforschung" -> "ahnenforschung",- "Pidgin" -> "pidgin"+ "Pidgin" -> "pidgin" ) -- A rule that probably everybody wants. Being inactive for over a minute@@ -27,6 +31,9 @@ -- Simple rule that just tags the current program tag Program:$current.program, +-- Another simple rule, just tags the current desktop (a.k.a. workspace)+tag Desktop:$desktop,+ -- I'd like to know what evolution folders I'm working in. But when sending a -- mail, the window title only contains the (not very helpful) subject. So I do -- not tag necessarily by the active window title, but the title that contains@@ -118,3 +125,5 @@ month $date == 2 ==> tag month:February, year $date == 2010 ==> tag year:2010, -}++}
doc/arbtt.xml view
@@ -33,6 +33,12 @@ <contrib>Contributor</contrib> <email>muharem@linux.com</email> </author>+ <author id="waldir">+ <firstname>Waldir</firstname>+ <surname>Pimenta</surname>+ <contrib>Documentation writer</contrib>+ <email>waldir@email.com</email>+ </author> </authorgroup> </articleinfo> <abstract>@@ -150,8 +156,8 @@ <title>The semantics (informal)</title> <para> A data sample consists of the time of recording, the time passed since the- user’s last action and the list of windows. For each window this- information is available:+ user’s last action, the name of the current workspace and the list of+ windows. For each window this information is available: <itemizedlist> <listitem><simpara>the window title</simpara></listitem> <listitem><simpara>the program name</simpara></listitem>@@ -214,6 +220,11 @@ </para> <para>+ The name of the current desktop (or workspace) is available as+ <literal>$desktop</literal>.+ </para>++ <para> For <literal>current window</literal>, the currently active window is in scope. If there is no such window, the condition is false. </para>@@ -372,6 +383,8 @@ <nonterminal def="#g-number"/> </rhs> <rhs> <nonterminal def="#g-timediff"/> <nonterminal def="#g-cmpop"/> <nonterminal def="#g-timediff"/> </rhs>+ <rhs> <nonterminal def="#g-date"/> <nonterminal def="#g-cmpop"/>+ <nonterminal def="#g-date"/> </rhs> <rhs> <quote>current window</quote> <nonterminal def="#g-cond"/> </rhs> <rhs> <quote>any window</quote> <nonterminal def="#g-cond"/> </rhs> </production>@@ -380,6 +393,7 @@ <lhs>String</lhs> <rhs> <quote>$title</quote> </rhs> <rhs> <quote>$program</quote> </rhs>+ <rhs> <quote>$desktop</quote> </rhs> <rhs> <quote>format</quote> <nonterminal def="#g-date" /> </rhs> <rhs> <quote>"</quote> string literal <quote>"</quote> </rhs> </production>@@ -513,7 +527,7 @@ --> <para>Because the data log file is binary, a tool names <command>arbtt-dump</command> can bee used to dump the data in- textual form. Its command line reference is given in <xref+ various textual formats. Its command line reference is given in <xref linkend="arbtt-dump"/>.</para> <para>If <command>arbtt-capture</command> crashes it might be that the log@@ -597,7 +611,7 @@ </varlistentry> <varlistentry> <term><option>-o</option> <replaceable>TAG</replaceable></term>- <term><option>--only</option> <replaceable>TAB</replaceable></term>+ <term><option>--only</option> <replaceable>TAG</replaceable></term> <listitem><simpara>Ignore any data samples that have not been assigned this tag. To distinguish tags and categories, the latter have to be entered followed by a colon. Can be given more than once.</simpara></listitem>@@ -714,6 +728,22 @@ </listitem> </varlistentry>+ <varlistentry>+ <term><option>--for-each</option> <replaceable>PERIOD</replaceable></term>+ <listitem><para>This is not a report of its own, but causes the selected+ report to be executed for each of the given PERIOD (which can be+ day, month or year) where there exist selected samples. All the reports + will then be printed one after another or, in the case of CSV output,+ with an additional column.</para>+ + <para>Note that if this option is enabled, samples that are filtered out+ are completely ignored (to avoid empty reports for periods with+ only filtered samples). Therefore, the+ <option>--information</option> report will print the numbers for+ the samples selected also for the totals.</para>++ </listitem>+ </varlistentry> </variablelist> </refsect2> </refsect1>@@ -748,7 +778,7 @@ <refsect1><title>See also</title> <para>See the arbtt manual for more information and the <ulink- url="http://www.hackage.org/package/arbtt">arbtt hackage page</ulink> for+ url="http://hackage.haskell.org/package/arbtt">arbtt hackage page</ulink> for newer versions of arbtt.</para> </refsect1> </refentry>@@ -804,6 +834,11 @@ <term><option>--logfile</option> <replaceable>FILE</replaceable></term> <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem> </varlistentry>+ <varlistentry>+ <term><option>-d</option></term>+ <term><option>--dump</option></term>+ <listitem><simpara>dump one current sample instead of modifying the logfile</simpara></listitem>+ </varlistentry> </variablelist> </refsect1> <refsect1><title>Files</title>@@ -818,7 +853,7 @@ <refsect1><title>See also</title> <para>See the arbtt manual for more information and the <ulink- url="http://www.hackage.org/package/arbtt">arbtt hackage page</ulink> for+ url="http://hackage.haskell.org/package/arbtt">arbtt hackage page</ulink> for newer versions of arbtt.</para> </refsect1> </refentry>@@ -869,8 +904,19 @@ <term><option>--logfile</option> <replaceable>FILE</replaceable></term> <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem> </varlistentry>+ <varlistentry>+ <term><option>-t</option> <replaceable>FORMAT</replaceable></term>+ <term><option>--format</option> <replaceable>FORMAT</replaceable></term>+ <listitem><simpara>dumping format to use, where <replaceable>FORMAT</replaceable> is one of <literal>human</literal> (the default), <literal>show</literal> or <literal>JSON</literal>. Case in-sensitive.</simpara></listitem>+ </varlistentry>+ <varlistentry>+ <term><option>-l</option> <replaceable>NUMBER</replaceable></term>+ <term><option>--last</option> <replaceable>NUMBER</replaceable></term>+ <listitem><simpara>dump only the last <replaceable>NUMBER</replaceable> of samples.</simpara></listitem>+ </varlistentry> </variablelist> </refsect1>+ <refsect1><title>Files</title> <variablelist> <varlistentry>@@ -880,9 +926,66 @@ </variablelist> </refsect1> + <refsect1><title>Formats</title>+ <refsect2><title>Human</title>+ <para>This format is intended for human inspection, but not for further+ processing. Hence, it may change in new versions of arbtt without notice.+ Example output:</para>+ <screen>2013-06-20 14:53:50 (48ms inactive):+ ( ) Navigator: arbtt-dump - Iceweasel+ ( ) gnome-terminal-server: jojo@kirk:~/projekte/programming/arbtt/doc+ (*) gvim: arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2+</screen>+ <para>The line with a star indicates the currently active window.</para>+ </refsect2>++ <refsect2><title>Show</title>+ <para>This is the default serialization format of Haskell's+ <literal>Show</literal> type class, one entry per line. This can be+ useful if the data is to be processed by further Haskell code. Example+ output, with indentation added manually:</para>+ <screen>TimeLogEntry+ { tlTime = 2013-06-20 14:53:50.957763 UTC+ , tlRate = 60000+ , tlData = CaptureData+ { cWindows =+ [ (False,"arbtt-dump - Iceweasel","Navigator")+ , (False,"jojo@kirk:~/projekte/programming/arbtt/doc","gnome-terminal-server")+ , (True,"arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2","gvim")+ ]+ , cLastActivity = 48+ }+ }</screen>+ </refsect2>++ <refsect2><title>JSON</title>+ <para>For interoperability, arbtt supports dumping its data to JSON, which can+ easily be parsed by many different programming languages. Some level of+ backward-compatibility will be provided, as far as possible. Default+ output, again with indentation and spacing added manually:</para>+ <screen>[ ...,+ { "windows": [+ { "program": "arbtt-dump - Iceweasel",+ "title": "Navigator",+ "active": false},+ { "program": "jojo@kirk:~/projekte/programming/arbtt/doc",+ "title":" gnome-terminal-server",+ "active": false},+ { "program": "arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2",+ "title": "gvim",+ "active":true+ }],+ "inactive": 48,+ "date": "2013-06-20T14:53:50.957Z",+ "rate": 60000},+ ...+]</screen>+ </refsect2>+ </refsect1>+ <refsect1><title>See also</title> <para>See the arbtt manual for more information and the <ulink- url="http://www.hackage.org/package/arbtt">arbtt hackage page</ulink> for+ url="http://hackage.haskell.org/package/arbtt">arbtt hackage page</ulink> for newer versions of arbtt.</para> </refsect1> </refentry>@@ -946,7 +1049,7 @@ <refsect1><title>See also</title> <para>See the arbtt manual for more information and the <ulink- url="http://www.hackage.org/package/arbtt">arbtt hackage page</ulink> for+ url="http://hackage.haskell.org/package/arbtt">arbtt hackage page</ulink> for newer versions of arbtt.</para> </refsect1> </refentry>@@ -972,11 +1075,11 @@ <refsect1><title>Description</title> <para>- <command>arbtt-recover</command> tries to readsthe data samples recorded- by <xref linkend="arbtt-capture"/>, skipping over possible broken entries. A fixed log file is written to <file>~/.arbtt/capture.log.recovered</file>. If the recovery was successful, you should stop <command>arbtt-capture</command> and move the file to <file>~/.arbtt/capture.log</file>.+ <command>arbtt-recover</command> tries to read the data samples recorded+ by <xref linkend="arbtt-capture"/>, skipping over possible broken entries. A fixed log file is written to <filename>~/.arbtt/capture.log.recovered</filename>. If the recovery was successful, you should stop <command>arbtt-capture</command> and move the file to <filename>~/.arbtt/capture.log</filename>. </para> <para>- As a sid effect, <command>arbtt-recover</command> applies the log compression method implemented in version 0.4.5 to the samples created by an earlier version. If you have a large logfile written by older versions, running <command>arbtt-recover</command> is recommended.+ As a side effect, <command>arbtt-recover</command> applies the log compression method implemented in version 0.4.5 to the samples created by an earlier version. If you have a large logfile written by older versions, running <command>arbtt-recover</command> is recommended. </para> </refsect1> @@ -1002,7 +1105,7 @@ <varlistentry> <term><option>-o</option></term> <term><option>--outfile</option></term>- <listitem><simpara>where to save the recovered file, instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem>+ <listitem><simpara>where to save the recovered file, instead of <filename>~/.arbtt/capture.log.recovered</filename></simpara></listitem> </varlistentry> </variablelist> </refsect1>@@ -1021,7 +1124,7 @@ <refsect1><title>See also</title> <para>See the arbtt manual for more information and the <ulink- url="http://www.hackage.org/package/arbtt">arbtt hackage page</ulink> for+ url="http://hackage.haskell.org/package/arbtt">arbtt hackage page</ulink> for newer versions of arbtt.</para> </refsect1> </refentry>@@ -1073,8 +1176,55 @@ <sect1 id="release-notes"> <title>Release Notes</title> <para>- The version history with changes relevant for the user are documented here.+ The version history with changes relevant for the user is documented here. </para>+ + <sect2>+ <title>Version 0.8 (unreleased)</title>+ <itemizedlist>+ <listitem>+ <para>+ <command>arbtt-dump</command> can now show the data in other formats+ as well, as suggested by Waldir Pimenta (option+ <option>--format</option>). This includes a human-readale output and+ JSON.+ </para>+ </listitem>+ <listitem>+ <para>New option <option>--last</option> of <command>arbtt-dump</command>.</para>+ </listitem>+ <listitem>+ <para><command>arbtt-recover</command> can handle larger datasets with a reasonable amount of memory.</para>+ </listitem>+ <listitem>+ <para>When dumping samples with <command>arbtt-stats</command> or <command>arbtt-dump</command> (in human-readable mode), times are printed in the local time zone, as suggested by Oren Gampel.</para>+ </listitem>+ <listitem>+ <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>+ </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>+ </listitem>+ <listitem>+ <para><command>arbtt-stats</command> can print reports split by time interval, using the <option>--for-each</option> option.</para>+ </listitem>+ <listitem>+ <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>+ </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>+ </listitem>+ <listitem>+ <para>Waldir Pimenta contributed a new web page, hosted at <ulink url="http://arbtt.nomeata.de/">arbtt.nomeata.de</ulink>.</para>+ </listitem>+ </itemizedlist>+ </sect2> <sect2> <title>Version 0.7</title>
src/Capture/Win32.hs view
@@ -26,4 +26,4 @@ it <- fromIntegral `fmap` getIdleTime - return $ CaptureData winData it+ return $ CaptureData winData it (T.pack "")
src/Capture/X11.hs view
@@ -36,11 +36,27 @@ xSetErrorHandler let rwin = defaultRootWindow dpy + -- Desktops+ current_desktop <- flip catchIOError (\_ -> return "") $ do+ a <- internAtom dpy "_NET_CURRENT_DESKTOP" False+ p <- getWindowProperty32 dpy a rwin+ let desk_index = do {[d] <- p; return (fromIntegral d)}++ a <- internAtom dpy "_NET_DESKTOP_NAMES" False+ tp <- getTextProperty dpy rwin a+ names <- wcTextPropertyToTextList dpy tp++ return $ case desk_index of+ Nothing -> ""+ Just n -> if 0 <= n && n < length names+ then names !! n+ else show n+ -- Windows a <- internAtom dpy "_NET_CLIENT_LIST" False p <- getWindowProperty32 dpy a rwin wins <- case p of- Just wins -> return (map fromIntegral wins)+ Just wins -> filterM (isInteresting dpy) (map fromIntegral wins) Nothing -> return [] (fsubwin,_) <- getInputFocus dpy@@ -54,7 +70,7 @@ it <- fromIntegral `fmap` getXIdleTime dpy closeDisplay dpy- return $ CaptureData winData it+ return $ CaptureData winData it (T.pack current_desktop) getWindowTitle :: Display -> Window -> IO String getWindowTitle dpy = myFetchName dpy@@ -70,6 +86,17 @@ | otherwise = do (r,p,_) <- queryTree dpy w if p == 0 then return w else go p ++-- | Ignore, for example, Desktop and Docks windows+isInteresting :: Display -> Window -> IO Bool+isInteresting d w = do+ a <- internAtom d "_NET_WM_WINDOW_TYPE" False+ dock <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False+ desk <- internAtom d "_NET_WM_WINDOW_TYPE_DESKTOP" False+ mbr <- getWindowProperty32 d a w+ case mbr of+ Just [r] -> return $ fromIntegral r `notElem` [dock, desk]+ _ -> return True -- | better than fetchName from X11, as it supports _NET_WM_NAME and unicode --
src/Categorize.hs view
@@ -143,10 +143,10 @@ parseRulesBody = do x <- parseRule choice [ do comma lang- xs <- sepEndBy1 parseRule (comma lang)+ xs <- parseRule `sepEndBy1` comma lang return (matchAny (x:xs)) , do semi lang- xs <- many1 (semi lang >> parseRule)+ xs <- parseRule `sepEndBy1` semi lang return (matchFirst (x:xs)) , return x ]@@ -355,7 +355,7 @@ ) <?> "list of regular expressions" ]) , char '$' >> choice - [ do backref <- natural lang+ [ do backref <- read <$> many1 digit return $ CondString (getBackref backref) , do varname <- identifier lang choice @@ -373,6 +373,8 @@ return $ CondTime (getTimeVar "sampleage") , do guard $ varname == "date" return $ CondDate (getDateVar "date")+ , do guard $ varname == "desktop"+ return $ CondString (getVar "desktop") ] ] <?> "variable" , do regex <- parseRegex <?> "regular expression"@@ -480,7 +482,7 @@ parseTagPart = do parts <- many1 (choice [ do char '$' (replaceForbidden . ) <$> choice- [ do num <- natural lang+ [ do num <- read <$> many1 digit return $ getBackref num , do varname <- many1 (letter <|> oneOf ".") return $ getVar varname@@ -522,6 +524,8 @@ getVar "program" ctx = do (_,_,p) <- cWindowInScope ctx return p+getVar "desktop" ctx = do+ return $ cDesktop (tlData (cNow ctx)) getVar v ctx = error $ "Unknown variable " ++ v getNumVar :: String -> CtxFun Integer
src/Data.hs view
@@ -34,11 +34,13 @@ { cWindows :: [ (Bool, Text, Text) ] -- ^ Active window, window title, programm name , cLastActivity :: Integer -- ^ in milli-seconds+ , cDesktop :: Text+ -- ^ Current desktop name } deriving (Show, Read) instance NFData CaptureData where- rnf (CaptureData a b) = a `deepseq` b `deepseq` ()+ rnf (CaptureData a b c) = a `deepseq` b `deepseq` c `deepseq` () type ActivityData = [Activity] @@ -105,14 +107,16 @@ -- 2 Using ListOfStringable ls_put strs cd = do -- A version tag- putWord8 2+ putWord8 3 ls_put strs (cWindows cd) ls_put strs (cLastActivity cd)+ ls_put strs (cDesktop cd) ls_get strs = do v <- getWord8 case v of- 1 -> CaptureData <$> get <*> get- 2 -> CaptureData <$> ls_get strs <*> ls_get strs+ 1 -> CaptureData <$> get <*> get <*> pure ""+ 2 -> CaptureData <$> ls_get strs <*> ls_get strs <*> pure ""+ 3 -> CaptureData <$> ls_get strs <*> ls_get strs <*> ls_get strs _ -> error $ "Unsupported CaptureData version tag " ++ show v -- | 'getMany n' get 'n' elements in order, without blowing the stack.
+ src/Data/List/TakeR.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.List.TakeR where++import Control.Monad.ST+import Debug.Trace+import Data.Array.MArray+import Data.Array.ST++-- Efficient taking of last r values+takeR n l = go (drop n l) l+ where+ go [] r = r+ go (x:xs) (y:ys) = go xs ys++-- Much faster and better evaluation properties than:+{-+takeR :: forall a. Int -> [a] -> [a]+takeR n l | n <= 0 = []+takeR n l = runST stAction+ where+ stAction :: forall s. ST s [a]+ stAction = do+ buffer <- newArray_ (0, n-1)+ i <- go (buffer :: STArray s Int a) 0 l+ let s = min i n+ sequence $ [ readArray buffer (j `mod` n) | j <- [i-s..i-1] ]+ go buffer i [] = return i+ go buffer i (x:xs) = writeArray buffer (i `mod` n) x >> go buffer (i+1) xs+-}++ +-- Correctness asserted by+-- quickCheck (\n l -> n <= 100000 ==> takeR n l == reverse (take n (reverse (l::[Int]) )))
src/Data/MyText.hs view
@@ -7,7 +7,7 @@ import Data.Binary import Control.Applicative ((<$>)) import Control.Arrow (first)-import Prelude hiding (length, map)+import Prelude hiding (length, map, null) import qualified Prelude import GHC.Exts( IsString(..) ) import Control.DeepSeq@@ -31,8 +31,8 @@ -- The downside is that it quietly suceeds for broken input get = do n <- get :: Get Int- lbs <- lookAhead (getLazyByteString (4*fromIntegral n)) -- safe approximation- let bs = BS.concat $ LBS.toChunks $ lbs+ r <- remaining+ bs <- lookAhead (getByteString (min (fromIntegral r) (4*n))) -- safe approximation let utf8bs = BSU.take n bs unless (BSU.length utf8bs == n) $ fail $ "Coult not parse the expected " ++ show n ++ " utf8 characters."@@ -78,3 +78,6 @@ concat :: [Text] -> Text concat = Text . BS.concat . Prelude.map toBytestring++null :: Text -> Bool+null = BS.null . toBytestring
+ src/DumpFormat.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}+module DumpFormat+ ( DumpFormat(..)+ , readDumpFormat+ , dumpActivity+ , dumpSample+ , dumpSamples+ ) where++import Data.MyText (unpack, null, Text)+import Data.Aeson+import qualified Data.ByteString.Lazy as LBS+import Data.Time+import System.Locale+import Data.Char++import Data+import Text.Printf+import Data.List hiding (null)+import Prelude hiding (null)++data DumpFormat+ = DFShow+ | DFHuman+ | DFJSON + deriving (Show, Eq)++instance ToJSON Text where+ toJSON = toJSON . unpack++instance ToJSON (TimeLogEntry CaptureData) where+ toJSON (TimeLogEntry {..}) = object [+ "date" .= tlTime,+ "rate" .= tlRate,+ "inactive" .= cLastActivity tlData,+ "windows" .= map (\(a,p,t) -> object ["active" .= a, "program" .= p, "title" .= t]) (cWindows tlData),+ "desktop" .= cDesktop tlData+ ]++readDumpFormat :: String -> Maybe DumpFormat+readDumpFormat arg =+ case map toLower arg of+ "human" -> return DFHuman+ "show" -> return DFShow+ "json" -> return DFJSON+ _ -> Nothing++dumpActivity :: TimeLog (CaptureData, TimeZone, ActivityData) -> IO ()+dumpActivity = mapM_ go+ where+ go tle = do+ dumpHeader tz (tlTime tle) (cLastActivity cd)+ dumpDesktop (cDesktop cd)+ mapM_ dumpWindow (cWindows cd)+ dumpTags ad+ where+ (cd, tz, ad) = tlData tle++dumpTags :: ActivityData -> IO ()+dumpTags = mapM_ go+ where go act = printf " %s\n" (show act)++dumpHeader :: TimeZone -> UTCTime -> Integer -> IO ()+dumpHeader tz time lastActivity = do+ printf "%s (%dms inactive):\n"+ (formatTime defaultTimeLocale "%F %X" (utcToLocalTime tz time))+ lastActivity++dumpWindow :: (Bool, Text, Text) -> IO ()+dumpWindow (active, title, program) = do+ printf " %s %-15s %s\n"+ (if active then ("(*)"::String) else "( )")+ (unpack program ++ ":")+ (unpack title)++dumpDesktop :: Text -> IO ()+dumpDesktop d+ | null d = return ()+ | otherwise = printf " Current Desktop: %s\n" (unpack d)++dumpSample :: TimeZone -> TimeLogEntry CaptureData -> IO ()+dumpSample tz tle = do+ dumpHeader tz (tlTime tle) (cLastActivity (tlData tle))+ dumpDesktop (cDesktop (tlData tle))+ mapM_ dumpWindow (cWindows (tlData tle))++dumpSamples :: TimeZone -> DumpFormat -> TimeLog CaptureData -> IO ()+dumpSamples _ DFShow = mapM_ print++dumpSamples tz DFHuman = mapM_ (dumpSample tz)++dumpSamples _ DFJSON = enclose . sequence_ . intersperse (putStrLn ",") . map (LBS.putStr . encode)+ where+ enclose m = putStrLn "[" >> m >> putStrLn "]"
src/LeftFold.hs view
@@ -7,6 +7,8 @@ import Data.Monoid import Data.Strict ((:!:), Pair((:!:))) import qualified Data.Strict as S+import qualified Data.Map.Strict as M+import Data.Maybe data LeftFold x a = forall s. LeftFold {@@ -38,7 +40,7 @@ runLeftFold :: LeftFold x a -> [x] -> a runLeftFold (Pure x) _ = x-runLeftFold (LeftFold st1 p1 f1) xs = f1 (foldl' p1 st1 xs)+runLeftFold (LeftFold st1 p1 f1) xs = f1 $! foldl' p1 st1 xs monoidFold :: Monoid m => LeftFold m m monoidFold = leftFold mempty mappend@@ -47,9 +49,14 @@ mapElems (Pure x) _ = (Pure x) mapElems (LeftFold s p f) t = LeftFold s (\s x -> p s $! t x) f -filterWith :: (x -> Bool) -> LeftFold (Bool :!: x) a -> LeftFold x a-filterWith p f = f `mapElems` (\x -> (p x :!: x))+filterElems :: (x -> Bool) -> LeftFold x a -> LeftFold x a +filterElems _ (Pure x) = (Pure x)+filterElems pred (LeftFold s p f) = LeftFold s (\s x -> if pred x then p s x else s) f +adjoin :: (x -> Bool) -> LeftFold (Bool :!: x) a -> LeftFold x a+adjoin p f = f `mapElems` (\x -> (p x :!: x))++ onSelected :: LeftFold x a -> LeftFold (Bool :!: x) a onSelected (Pure x) = Pure x onSelected (LeftFold s p f) = LeftFold s (\s (b :!: x) -> if b then p s x else s) f@@ -99,6 +106,12 @@ finish (S.Nothing :!: S.Nothing) = fo so finish (S.Just si :!: S.Just so) = fo (po so (fi si)) finish (S.Just si :!: S.Nothing) = fo (po so (fi si))++multiplex :: Ord k => (a -> k) -> LeftFold a b -> LeftFold a (M.Map k b)+multiplex key (LeftFold si pi fi) = LeftFold M.empty go finish+ where go m x = M.alter go' (key x) m+ where go' mbOld = Just $ pi (fromMaybe si mbOld) x+ finish = M.map fi lfLength :: LeftFold x Int lfLength = leftFold 0 (\c _ -> c + 1)
src/Stats.hs view
@@ -6,12 +6,14 @@ ReportResults(..), ActivityFilter(..), Filter(..),+ Repeater(..), defaultFilter, defaultReportOptions, parseActivityMatcher, filterPredicate, prepareCalculations,- processReports,+ processReport,+ processRepeater, renderReport ) where @@ -26,12 +28,15 @@ import Data.Function (on) import System.Locale (defaultTimeLocale) import Control.Applicative-import Data.Strict ((:!:))+import Data.Strict ((:!:), Pair(..))+import qualified Data.Strict as Strict import Data.Traversable (sequenceA)+import Control.Arrow import Data import Categorize import LeftFold+import DumpFormat data Report = GeneralInfos@@ -40,6 +45,7 @@ | EachCategory | IntervalCategory Category | IntervalTag Activity+ | DumpSamples deriving (Show, Eq) data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String@@ -51,6 +57,9 @@ data ActivityFilter = ExcludeActivity ActivityMatcher | OnlyActivity ActivityMatcher deriving (Show, Eq) +data Repeater = ByDay | ByMonth | ByYear+ deriving (Show, Eq)+ -- Supported report output formats: text, comma-separated values and -- tab-separated values data ReportFormat = RFText | RFCSV | RFTSV@@ -78,7 +87,9 @@ | ListOfTimePercValues String [(String, String, Double)] | PieChartOfTimePercValues String [(String, String, Double)] | ListOfIntervals String [Interval]- | MultpleReportResults [ReportResults]+ | MultipleReportResults [ReportResults]+ | RepeatedReportResults String [(String, ReportResults)]+ | DumpResult (TimeLog (CaptureData, TimeZone, ActivityData)) filterPredicate :: [Filter] -> TimeLogEntry (Ctx, ActivityData) -> Bool@@ -88,6 +99,9 @@ Only act -> onlyTag act tl GeneralCond s-> applyCond s (cTimeZone (fst (tlData tl))) tl) filters +filterActivity :: [ActivityFilter] -> ActivityData -> ActivityData+filterActivity fs = filter (applyActivityFilter fs)+ applyActivityFilter :: [ActivityFilter] -> Activity -> Bool applyActivityFilter fs act = all go fs where go (ExcludeActivity matcher) = not (matchActivityMatcher matcher act)@@ -160,59 +174,88 @@ let go' m act = M.insertWith' (+) act (fromInteger (tlRate tl)/1000) m in foldl' go' m (snd (tlData tl))) id -processReports :: ReportOptions -> Calculations -> [Report] -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) [ReportResults]-processReports opts c = sequenceA . map (processReport opts c)+processRepeater :: Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults+processRepeater ByDay rep =+ filterElems (\(b :!: _) -> b) $+ pure (RepeatedReportResults "Day" . map (\(d,rr) -> (showGregorian d, rr)) . M.toList) <*>+ multiplex (utctDay . tlTime . Strict.snd) rep+processRepeater ByMonth rep =+ filterElems (\(b :!: _) -> b) $+ pure (RepeatedReportResults "Month" . map (\((y,m),rr) -> (show y ++ "-" ++ show m, rr)) . M.toList) <*>+ multiplex ((\(y,m,_) -> (y, m)). toGregorian . utctDay . tlTime . Strict.snd) rep+processRepeater ByYear rep =+ filterElems (\(b :!: _) -> b) $+ pure (RepeatedReportResults "Year" . map (\(y,rr) -> (show y, rr)) . M.toList) <*>+ multiplex ((\(y,_,_) -> y). toGregorian . utctDay . tlTime . Strict.snd) rep -processReport :: ReportOptions -> Calculations -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults-processReport opts ~(Calculations {..}) GeneralInfos =- pure (\n ->- ListOfFields "General Information"+processReport :: ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults+processReport opts GeneralInfos =+ pure (\n firstDate lastDate ttr tts ->+ let timeDiff = diffUTCTime lastDate firstDate+ fractionRec = realToFrac ttr / (realToFrac timeDiff) :: Double+ fractionSel = realToFrac tts / (realToFrac timeDiff) :: Double+ fractionSelRec = realToFrac tts / realToFrac ttr :: Double+ in ListOfFields "General Information" [ ("FirstRecord", show firstDate) , ("LastRecord", show lastDate) , ("Number of records", show n)- , ("Total time recorded", showTimeDiff totalTimeRec)- , ("Total time selected", showTimeDiff totalTimeSel)+ , ("Total time recorded", showTimeDiff opts ttr)+ , ("Total time selected", showTimeDiff opts tts) , ("Fraction of total time recorded", printf "%3.0f%%" (fractionRec * 100)) , ("Fraction of total time selected", printf "%3.0f%%" (fractionSel * 100)) , ("Fraction of recorded time selected", printf "%3.0f%%" (fractionSelRec * 100)) ]) <*>- onAll lfLength+ onAll lfLength <*>+ onAll calcFirstDate <*>+ onAll calcLastDate <*>+ onAll calcTotalTime <*>+ onSelected calcTotalTime -processReport opts ~(Calculations {..}) TotalTime =- pure $ +processReport opts TotalTime =+ onSelected $+ pure (\totalTimeSel sums -> ListOfTimePercValues "Total time per tag" . mapMaybe (\(tag,time) -> let perc = realToFrac time/realToFrac totalTimeSel pick = applyActivityFilter (roActivityFilter opts) tag in if pick && perc*100 >= roMinPercentage opts then Just $ ( show tag- , showTimeDiff time+ , showTimeDiff opts time , perc) else Nothing ) . reverse . sortBy (comparing snd) $ M.toList $- sums+ sums) <*>+ calcTotalTime <*>+ calcSums -processReport opts c (Category cat) = pure (processCategoryReport opts c cat)+processReport opts (Category cat) = pure (\c -> processCategoryReport opts c cat) <*>+ prepareCalculations -processReport opts c EachCategory = - pure (\cats -> MultpleReportResults $ map (processCategoryReport opts c) cats) <*>+processReport opts EachCategory = + pure (\c cats -> MultipleReportResults $ map (processCategoryReport opts c) cats) <*>+ prepareCalculations <*> onSelected calcCategories -processReport opts c (IntervalCategory cat) =- processIntervalReport opts c ("Intervals for category " ++ show cat) (extractCat cat) +processReport opts (IntervalCategory cat) =+ processIntervalReport opts ("Intervals for category " ++ show cat) (extractCat cat) where extractCat :: Category -> ActivityData -> Maybe String extractCat cat = fmap (unpack . activityName) . listToMaybe . filter ( (==Just cat) . activityCategory ) -processReport opts c (IntervalTag tag) =- processIntervalReport opts c ("Intervals for category " ++ show tag) (extractTag tag) +processReport opts (IntervalTag tag) =+ processIntervalReport opts ("Intervals for category " ++ show tag) (extractTag tag) where extractTag :: Activity -> ActivityData -> Maybe String extractTag tag = fmap show . listToMaybe . filter ( (==tag) ) +processReport opts DumpSamples =+ DumpResult <$> onSelected (mapElems toList $ fmap $+ \(cd,ad) -> (tlData (cNow cd), cTimeZone cd, filterActivity (roActivityFilter opts) ad)+ )+ calcCategories :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Category] calcCategories = fmap S.toList $ leftFold S.empty $ \s tl -> foldl' go' s (snd (tlData tl))@@ -232,7 +275,7 @@ pick = applyActivityFilter (roActivityFilter opts) tag in if pick && perc*100 >= roMinPercentage opts then Just ( show tag- , showTimeDiff time+ , showTimeDiff opts time , perc) else Nothing )@@ -241,7 +284,7 @@ ( if tooSmallTimes > 0 then [( printf "(%d entries omitted)" (M.size tooSmallSums)- , showTimeDiff tooSmallTimes+ , showTimeDiff opts tooSmallTimes , realToFrac tooSmallTimes/realToFrac totalTimeSel )] else []@@ -249,14 +292,14 @@ ++ (if uncategorizedTime > 0 then [( "(unmatched time)"- , showTimeDiff uncategorizedTime+ , showTimeDiff opts uncategorizedTime , realToFrac uncategorizedTime/realToFrac totalTimeSel )] else [] ) -processIntervalReport :: ReportOptions -> Calculations -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults-processIntervalReport _opts _c title extr = runOnIntervals go1 go2+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) @@ -269,7 +312,7 @@ ( str , showUtcTime (tlTime fe) , showUtcTime (tlTime le)- , showTimeDiff $+ , showTimeDiff opts $ tlTime le `diffUTCTime` tlTime fe + fromIntegral (tlRate fe)/1000 ) Nothing -> Nothing) <*>@@ -305,30 +348,36 @@ -} renderReport :: ReportOptions -> ReportResults -> IO ()-renderReport opts (MultpleReportResults reports) =+renderReport opts (DumpResult samples) =+ dumpActivity samples+renderReport opts (MultipleReportResults reports) = sequence_ . intersperse (putStrLn "") . map (renderReport opts) $ reports renderReport opts reportdata = putStr $ doRender opts reportdata doRender :: ReportOptions -> ReportResults -> String doRender opts reportdata = case roReportFormat opts of- RFText -> renderReportText reportdata- RFCSV -> renderReportCSV reportdata- RFTSV -> renderReportTSV reportdata+ RFText -> renderReportText id reportdata+ RFCSV -> renderWithDelimiter "," $ renderXSV reportdata+ RFTSV -> renderWithDelimiter "\t" $ renderXSV reportdata -renderReportText (ListOfFields title dats) = - underline title +++renderReportText titleMod (ListOfFields title dats) = + underline (titleMod title) ++ (tabulate False $ map (\(f,v) -> [f,v]) dats) -renderReportText (ListOfTimePercValues title dats) = - underline title ++ (tabulate True $ listOfValues dats)+renderReportText titleMod (ListOfTimePercValues title dats) = + underline (titleMod title) ++ (tabulate True $ listOfValues dats) -renderReportText (PieChartOfTimePercValues title dats) = - underline title ++ (tabulate True $ piechartOfValues dats)+renderReportText titleMod (PieChartOfTimePercValues title dats) = + underline (titleMod title) ++ (tabulate True $ piechartOfValues dats) -renderReportText (ListOfIntervals title dats) = - underline title ++ (tabulate True $ listOfIntervals dats)+renderReportText titleMod (ListOfIntervals title dats) = + underline (titleMod title) ++ (tabulate True $ listOfIntervals dats) +renderReportText titleMod (RepeatedReportResults cat reps) = + intercalate "\n" $ map (\(v,rr) -> renderReportText (titleMod . mod v) rr) reps+ where mod v s = s ++ " (" ++ cat ++ " " ++ v ++ ")"+ listOfValues dats = ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats@@ -343,38 +392,24 @@ -- The reporting of "General Information" is not supported for the -- comma-separated output format.-renderReportCSV (ListOfFields title dats) = - error ("\"" ++ title ++ "\"" ++ " not supported for comma-separated output format")--renderReportCSV (ListOfTimePercValues _ dats) = - renderWithDelimiter "," (listOfValues dats)--renderReportCSV (PieChartOfTimePercValues _ dats) = - renderWithDelimiter "," (piechartOfValues dats)--renderReportCSV (ListOfIntervals title dats) = - renderWithDelimiter "," (listOfIntervals dats)+renderXSV (ListOfFields title dats) = + error ("\"" ++ title ++ "\"" ++ " not supported for this output format") --- The reporting of "General Information" is not supported for the--- TAB-separated output format.-renderReportTSV (ListOfFields title dats) = - error ("\"" ++ title ++ "\"" ++ " not supported for TAB-separated output format")+renderXSV (ListOfTimePercValues _ dats) = listOfValues dats -renderReportTSV (ListOfTimePercValues _ dats) = - renderWithDelimiter "\t" (listOfValues dats)+renderXSV (PieChartOfTimePercValues _ dats) = piechartOfValues dats -renderReportTSV (PieChartOfTimePercValues _ dats) = - renderWithDelimiter "\t" (piechartOfValues dats)+renderXSV (ListOfIntervals title dats) = listOfIntervals dats -renderReportTSV (ListOfIntervals title dats) = - renderWithDelimiter "\t" (listOfIntervals dats)+-- A bit code-smelly here.+renderXSV (RepeatedReportResults cat reps) = title : fields+ where+ title = cat : head (renderXSV (snd (head reps)))+ fields = concatMap (\(v,rr) -> map (v:) (tail (renderXSV rr))) reps renderWithDelimiter :: String -> [[String]] -> String renderWithDelimiter delim datasource =- unlines $ map (injectDelimiter delim) datasource--injectDelimiter :: [a] -> [[a]] -> [a]-injectDelimiter d = concat . intersperse d+ unlines $ map (intercalate delim) datasource tabulate :: Bool -> [[String]] -> String tabulate titlerow rows = unlines $ addTitleRow $ map (intercalate " | " . zipWith (\l s -> take (l - length s) (repeat ' ') ++ s) colwidths) rows@@ -385,8 +420,12 @@ -- | titlerow = \(l:ls) -> l : (take (length l) (repeat '-')) : ls | otherwise = id -showTimeDiff :: NominalDiffTime -> String-showTimeDiff t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"]+showTimeDiff :: ReportOptions -> NominalDiffTime -> String+showTimeDiff (ReportOptions { roReportFormat = RFText }) = showTimeDiffHuman+showTimeDiff _ = showTimeDiffMachine++showTimeDiffHuman :: NominalDiffTime -> String+showTimeDiffHuman t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"] where s = round t :: Integer days = s `div` (24*60*60) hours = (s `div` (60*60)) `mod` 24@@ -398,6 +437,13 @@ go True ((a,u):vs) = printf "%02d%s" a u ++ go True vs go False ((a,u):vs) | a > 0 = printf "%2d%s" a u ++ go True vs | otherwise = go False vs++showTimeDiffMachine :: NominalDiffTime -> String+showTimeDiffMachine t = printf "%d:%02d:%02d" hours mins secs+ where s = round t :: Integer+ hours = s `div` (60*60)+ mins = (s `div` 60) `mod` 60+ secs = s `mod` 60 showUtcTime :: UTCTime -> String showUtcTime = formatTime defaultTimeLocale "%x %X"
src/System/Locale/SetLocale.hsc view
@@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DeriveDataTypeable #-} {- This file is copied from the setlocale-0.0.3 package. Its author is Lukas Mai@@ -26,10 +27,7 @@ | LC_MONETARY | LC_NUMERIC | LC_TIME- deriving (Eq, Ord, Read, Show, Enum, Bounded)--instance Typeable Category where- typeOf _ = mkTyConApp (mkTyCon "System.Locale.SetLocale.Category") []+ deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable) #include <locale.h>
src/TermSize.hsc view
@@ -44,7 +44,7 @@ getTermSize = with (WinSize 0 0) $ \ws -> do throwErrnoIfMinus1 "ioctl" $- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) ws+ ioctl (#const STDERR_FILENO) (#const TIOCGWINSZ) ws WinSize row col <- peek ws return (fromIntegral row, fromIntegral col) #endif
src/TimeLog.hs view
@@ -17,21 +17,29 @@ import Prelude hiding (catch) import Control.DeepSeq import System.Posix.Files+import System.IO.Unsafe (unsafeInterleaveIO) import qualified Data.ByteString.Lazy as BS import Data.Maybe magic = BS.pack $ map (fromIntegral.ord) "arbtt-timelog-v1\n" +mkTimeLogEntry :: Integer -> a -> IO (TimeLogEntry a)+mkTimeLogEntry delay entry = do+ date <- getCurrentTime+ return $ TimeLogEntry date delay entry++ -- | Runs the given action each delay milliseconds and appends the TimeLog to the -- given file. runLogger :: ListOfStringable a => FilePath -> Integer -> IO a -> IO () runLogger filename delay action = flip fix Nothing $ \loop prev -> do entry <- action- date <- getCurrentTime+ tle <- mkTimeLogEntry delay entry+ createTimeLog False filename setFileMode filename (ownerReadMode `unionFileModes` ownerWriteMode)- appendTimeLog filename prev (TimeLogEntry date delay entry)+ appendTimeLog filename prev tle threadDelay (fromIntegral delay * 1000) loop (Just entry) @@ -53,6 +61,7 @@ return (Just (tlData v)) -- | This might be very bad style, and it hogs memory, but it might help in some situations...+-- Use of unsafeInterleaveIO should be replaced by conduit, pipe or something the like recoverTimeLog :: ListOfStringable a => FilePath -> IO (TimeLog a) recoverTimeLog filename = do content <- BS.readFile filename@@ -64,18 +73,20 @@ show (map (chr.fromIntegral) (BS.unpack startString)) else do putStrLn $ "Found header, continuing... (" ++ show (BS.length rest) ++ " bytes to go)" go Nothing rest off+ go prev input off = do- mb <- tryGet prev False input off+ mb <- tryGet prev input off off flip (maybe (return [])) mb $ \(v,rest,off') -> if BS.null rest then return [v]- else (v :) <$> go (Just (tlData v)) rest off'- tryGet prev retrying input off = catch (+ else (v:) <$> (unsafeInterleaveIO $ go (Just (tlData v)) rest off')++ tryGet prev input off orig_off = catch ( do -- putStrLn $ "Trying value at offset " ++ show off let (v,rest,off') = runGetState (ls_get strs) input off evaluate rest- when retrying $- putStrLn $ "Succesfully read value at position " ++ show off+ when (off /= orig_off) $+ putStrLn $ "Skipped from " ++ show orig_off ++ ", succesful read at position " ++ show off ++ ", lost " ++ show (off - orig_off) ++ " bytes." return (Just (v,rest,off')) ) ( \e -> do@@ -84,8 +95,7 @@ if BS.length input <= 1 then do putStrLn $ "End of file reached" return Nothing- else do putStrLn $ "Trying at position " ++ show (off+1) ++ "."- tryGet prev True (BS.tail input) (off+1)+ else do tryGet prev (BS.tail input) (off+1) orig_off ) where strs = maybe [] listOfStrings prev
src/UpgradeLog1.hs view
@@ -57,6 +57,6 @@ upgrade = map $ \(TimeLogEntry a b c) -> D.TimeLogEntry a b (upgradeCD c) upgradeCD :: CaptureData -> D.CaptureData-upgradeCD (CaptureData a b) = D.CaptureData (map (\(b,s1,s2) -> (b, T.pack s1, T.pack s2)) a) b+upgradeCD (CaptureData a b) = D.CaptureData (map (\(b,s1,s2) -> (b, T.pack s1, T.pack s2)) a) b (T.pack "")
src/capture-main.hs view
@@ -17,11 +17,13 @@ import System.Environment import Data.Maybe import Data.Version (showVersion)+import Data.Time.LocalTime import Capture import TimeLog import UpgradeLog1 import CommonStartup+import DumpFormat import Paths_arbtt (version) @@ -29,12 +31,14 @@ data Options = Options { optSampleRate :: Integer , optLogFile :: String+ , optDump :: Bool } defaultOptions :: FilePath -> Options defaultOptions dir = Options { optSampleRate = 60 , optLogFile = dir </> "capture.log"+ , optDump = False } versionStr = "arbtt-capture " ++ showVersion version@@ -60,6 +64,9 @@ , Option "r" ["sample-rate"] (ReqArg (\arg opt -> return opt { optSampleRate = read arg }) "RATE") "set the sample rate in seconds (default: 60)"+ , Option "d" ["dump"]+ (NoArg (\opt -> return opt { optDump = True }))+ "dump one sample to standard out, instead of modifying the log file" ] -- | This is very raw, someone ought to improve this@@ -88,8 +95,13 @@ dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions - createDirectoryIfMissing False dir- lockFile (optLogFile flags)- upgradeLogFile1 (optLogFile flags)- setupCapture- runLogger (optLogFile flags) (optSampleRate flags * 1000) captureData+ if optDump flags then do+ setupCapture+ tz <- getCurrentTimeZone+ captureData >>= mkTimeLogEntry (optSampleRate flags * 1000) >>= dumpSample tz+ else do+ createDirectoryIfMissing False dir+ lockFile (optLogFile flags)+ upgradeLogFile1 (optLogFile flags)+ setupCapture+ runLogger (optLogFile flags) (optSampleRate flags * 1000) captureData
src/dump-main.hs view
@@ -9,19 +9,27 @@ import Data.Version (showVersion) import Data.Maybe import Control.Monad+import Data.Char+import Data.List.TakeR+import Data.Time.LocalTime import TimeLog import Data import CommonStartup+import DumpFormat import Paths_arbtt (version) data Options = Options { optLogFile :: String+ , optFormat :: DumpFormat+ , optLast :: Maybe Int } defaultOptions dir = Options { optLogFile = dir </> "capture.log"+ , optFormat = DFHuman+ , optLast = Nothing } @@ -45,6 +53,24 @@ , Option "f" ["logfile"] (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log"+ , Option "t" ["format"]+ (ReqArg (\arg opt ->+ case readDumpFormat arg of+ Just fm -> return $ opt { optFormat = fm}+ Nothing -> do+ hPutStrLn stderr ("Invalid format \"" ++ arg ++ "\".")+ hPutStr stderr (usageInfo header options)+ exitFailure) "FORMAT")+ "output format, one of Human (default), Show or JSON "+ , Option "l" ["last"]+ (ReqArg (\arg opt ->+ case reads arg of+ [(n, "")] | n >= 0 -> return $ opt { optLast = Just n }+ _ -> do+ hPutStrLn stderr ("Invalid number \"" ++ arg ++ "\".")+ hPutStr stderr (usageInfo header options)+ exitFailure) "NUMBER")+ "only dump the last NUMBER of samples." ] main = do@@ -60,4 +86,10 @@ flags <- foldl (>>=) (return (defaultOptions dir)) actions captures <- readTimeLog (optLogFile flags) :: IO (TimeLog CaptureData)- mapM_ print captures++ captures <- case optLast flags of + Nothing -> return captures+ Just n -> return $ takeR n captures++ tz <- getCurrentTimeZone+ dumpSamples tz (optFormat flags) captures
src/recover-main.hs view
@@ -66,3 +66,4 @@ captures <- recoverTimeLog (optInFile flags) :: IO (TimeLog CaptureData) writeTimeLog (optOutFile flags) captures+ putStrLn $ "Wrote data recovered from " ++ optInFile flags ++ " to " ++ optOutFile flags
src/stats-main.hs view
@@ -6,7 +6,7 @@ import System.Exit import System.IO import Control.Monad-import qualified Data.MyText as T+import Data.Maybe import Data.Char (toLower) import Text.Printf import Data.Version (showVersion)@@ -17,18 +17,21 @@ import System.Posix.Files import System.ProgressBar import TermSize+import qualified Data.MyText as T import TimeLog import Categorize import Stats import CommonStartup import LeftFold+import DumpFormat import Paths_arbtt (version) data Options = Options { optReports :: [Report] , optFilters :: [Filter]+ , optRepeater :: [Repeater] , optAlsoInactive :: Bool , optReportOptions :: ReportOptions , optLogFile :: String@@ -39,6 +42,7 @@ defaultOptions dir = Options { optReports = [] , optFilters = []+ , optRepeater = [] , optAlsoInactive = False , optReportOptions = defaultReportOptions , optLogFile = dir </> "capture.log"@@ -120,21 +124,35 @@ reports = report : optReports opt in return opt { optReports = reports }) "TAG") "list intervals of tag or category TAG"+ , Option "" ["dump-samples"]+ (NoArg (\opt -> let reports = DumpSamples : optReports opt+ in return opt { optReports = reports }))+ "Dump the raw samples and tags." , Option "" ["output-format"] (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roReportFormat = readReportFormat arg } in return opt { optReportOptions = ro }) "FORMAT") "one of: text, csv (comma-separated values), tsv (TAB-separated values) (default: Text)"+ , Option "" ["for-each"]+ (ReqArg (\arg opt -> let repeater = readRepeater arg : optRepeater opt+ in return opt { optRepeater = repeater }) "PERIOD")+ "one of: day, month, year" ] +readRepeater :: String -> Repeater+readRepeater arg =+ case map toLower arg of+ "day" -> ByDay+ "month" -> ByMonth+ "year" -> ByYear+ _ -> error ("Unsupported parameter to --for-each: '" ++ arg ++ "'")+ readReportFormat :: String -> ReportFormat readReportFormat arg =- case (tolower arg) of+ case map toLower arg of "text" -> RFText "csv" -> RFCSV "tsv" -> RFTSV _ -> error ("Unsupported report output format: '" ++ arg ++ "'")- where- tolower = map toLower main :: IO () main = do@@ -158,18 +176,22 @@ timelog <- BS.readFile (optLogFile flags) size <- fileSize <$> getFileStatus (optLogFile flags)+ isTerm <- hIsTerminalDevice stderr - hSetBuffering stderr NoBuffering- trackedTimelog <- trackProgressWithChunkSize (fromIntegral size `div` 100) (\_ b -> do- (_height, width) <- getTermSize- hPutChar stderr '\r'- hPutStr stderr $- mkProgressBar (msg "Processing data") percentage (fromIntegral width) (fromIntegral b) (fromIntegral size)- when (fromIntegral b >= fromIntegral size) $ do- hPutChar stderr '\r'- hPutStr stderr (replicate width ' ')+ trackedTimelog <- case isTerm of+ True -> do+ hSetBuffering stderr NoBuffering+ trackProgressWithChunkSize (fromIntegral size `div` 100) (\_ b -> do+ (_height, width) <- getTermSize hPutChar stderr '\r'- ) timelog+ hPutStr stderr $+ mkProgressBar (msg "Processing data") percentage (fromIntegral width) (fromIntegral b) (fromIntegral size)+ when (fromIntegral b >= fromIntegral size) $ do+ hPutChar stderr '\r'+ hPutStr stderr (replicate width ' ')+ hPutChar stderr '\r'+ ) timelog+ False -> return timelog let captures = parseTimeLog trackedTimelog let allTags = categorizer captures@@ -178,19 +200,24 @@ exitFailure let filters = (if optAlsoInactive flags then id else (defaultFilter:)) $ optFilters flags- let reps = case optReports flags of {[] -> [TotalTime]; reps -> reverse reps } + let rep = case optReports flags of+ [] -> TotalTime+ [x] -> x+ _ -> error "Please specify exactly one report to generate"+ let repeater = foldr (.) id $ map processRepeater (optRepeater flags)+ -- These are defined here, but of course only evaluated when any report -- refers to them. Some are needed by more than one report, which is then -- advantageous. let opts = optReportOptions flags- let (c,results) = runLeftFold (filterPredicate filters `filterWith` - (pure (,) <*> prepareCalculations <*> processReports opts c reps)) allTags+ let fold = filterPredicate filters `adjoin` repeater (processReport opts rep)+ let result = runLeftFold fold allTags - -- Force the results a bit, to ensure the progress bar to be shown before the titel- c `seq` return ()+ -- Force the results a bit, to ensure the progress bar to be shown before the title+ result `seq` return () - renderReport opts (MultpleReportResults results)+ renderReport opts result {- import Data.Accessor
+ tests/categorize.cfg view
@@ -0,0 +1,25 @@+-- This defines some aliases, to make the reports look nicer:+aliases (+ "sun-awt-X11-XFramePeer" -> "java",+ "sun-awt-X11-XDialogPeer" -> "java",+ "sun-awt-X11-XWindowPeer" -> "java",+ )++-- A rule that probably everybody wants. Being inactive for over a minute+-- causes this sample to be ignored by default.+$idle > 60 ==> tag inactive,++-- Simple rule that just tags the current program+tag Program:$current.program,++-- To be able to match on the time of day, I introduce tags for that as well+$time >= 2:00 && $time < 8:00 ==> tag time-of-day:night,+$time >= 8:00 && $time < 12:00 ==> tag time-of-day:morning,+$time >= 12:00 && $time < 14:00 ==> tag time-of-day:lunchtime,+$time >= 14:00 && $time < 18:00 ==> tag time-of-day:afternoon,+$time >= 18:00 && $time < 22:00 ==> tag time-of-day:evening,+$time >= 22:00 || $time < 2:00 ==> tag time-of-day:late-evening,++-- This tag always refers to the last 24h+$sampleage <= 24:00 ==> tag last-day,+
+ tests/issue4.cfg view
@@ -0,0 +1,5 @@+-- Firefox+current window $program == "program" ==>+if current window $title =~ /^(aaa)/ then tag Cat:$1 else+if current window $title =~ /^(aa)/ then tag Cat:$1 else+if current window $title =~ /^(a)/ then tag Cat:$1 else tag None
+ tests/issue5.cfg view
@@ -0,0 +1,3 @@+current window $title =~ /^aaa/ ==> tag A3;+current window $title =~ /^aa/ ==> tag A2;+current window $title =~ /^a/ ==> tag A1
+ tests/small.cfg view
@@ -0,0 +1,4 @@+current window $title =~ m/arbtt/ ==> tag arbtt,++$time < 14:00 ==> tag before_14+
+ tests/small.log view
binary file changed (absent → 519 bytes)
+ tests/small_borked.log view
binary file changed (absent → 519 bytes)
+ tests/small_borked_recover.out view
binary file changed (absent → 546 bytes)
+ tests/small_dump.out view
@@ -0,0 +1,3 @@+TimeLogEntry {tlTime = 2010-03-20 13:59:15.075576 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 2909, cDesktop = ""}}+TimeLogEntry {tlTime = 2010-03-20 14:00:15.157669 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 557, cDesktop = ""}}+TimeLogEntry {tlTime = 2010-03-20 14:01:15.220521 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 58004, cDesktop = ""}}
+ tests/small_import.in view
@@ -0,0 +1,3 @@+TimeLogEntry {tlTime = 2010-03-20 13:59:15.075576 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 2909, cDesktop = ""}}+TimeLogEntry {tlTime = 2010-03-20 14:00:15.157669 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 557, cDesktop = ""}}+TimeLogEntry {tlTime = 2010-03-20 14:01:15.220521 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 58004, cDesktop = ""}}
+ tests/small_import.out view
binary file changed (absent → 546 bytes)
+ tests/small_stats.out view
@@ -0,0 +1,5 @@+Total time per tag+==================+______Tag_|___Time_|_Percentage_+ arbtt | 3m00s | 100.00+before_14 | 1m00s | 33.33
+ tests/small_stats_csv.out view
@@ -0,0 +1,3 @@+Tag,Time,Percentage+arbtt,0:03:00,100.00+before_14,0:01:00,33.33
+ tests/test.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}++import Test.Tasty hiding (defaultMain)+import Test.Tasty.Golden.Manage+import Test.Tasty.Golden+import Test.Tasty.HUnit+import Test.HUnit+import System.Process.ByteString.Lazy+import qualified Data.ByteString.Lazy as B+import Control.Monad+import Control.Exception+import Data.Typeable+import System.Exit+import System.Posix.Env++import Categorize+import TimeLog+import Data++main = do+ putEnv "TZ=UTC" -- to make tests reproducible+ defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [goldenTests, regressionTests]++regressionTests :: TestTree+regressionTests = testGroup "Regression tests"+ [ testCase "Issue #4" $ do+ cat <- readCategorizer "tests/issue4.cfg"+ let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "")+ let [TimeLogEntry _ _ (_,acts)] = cat [sample]+ [Activity (Just "Cat") "aa"] @=? acts+ return ()+ , testCase "Issue #5" $ do+ cat <- readCategorizer "tests/issue5.cfg"+ let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "")+ let [TimeLogEntry _ _ (_,acts)] = cat [sample]+ [Activity Nothing "A2"] @=? acts+ return ()+ ]+++goldenTests :: TestTree+goldenTests = testGroup "Golden tests"+ [ goldenVsString "dump small"+ "tests/small_dump.out" $+ run "dist/build/arbtt-dump/arbtt-dump" ["-f","tests/small.log", "-t", "Show"] B.empty+ , goldenVsFile "import small"+ "tests/small_import.out" "tests/small_import.out.actual" $ void $+ B.readFile "tests/small_import.in" >>=+ run "dist/build/arbtt-import/arbtt-import" ["-f","tests/small_import.out.actual"]+ , goldenVsFile "recover small"+ "tests/small_borked_recover.out" "tests/small_borked_recover.out.actual" $ void $+ run "dist/build/arbtt-recover/arbtt-recover" ["-i","tests/small_borked_recover.out", "-o", "tests/small_borked_recover.out.actual"] B.empty+ , goldenVsString "stats small"+ "tests/small_stats.out" $+ run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg"] B.empty+ , goldenVsString "stats small csv"+ "tests/small_stats_csv.out" $+ run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg", "--output-format", "csv"] B.empty+ , 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+ ]+++run :: FilePath -> [FilePath] -> B.ByteString -> IO B.ByteString+run cmd args stdin = do+ (ex,stdout,stderr) <- readProcessWithExitCode cmd args stdin+ unless (B.null stderr) $ throwIO $ StderrException stderr+ case ex of+ ExitSuccess -> return stdout+ ExitFailure r -> throwIO $ ExitCodeException r++data StderrException = StderrException B.ByteString+ deriving (Show, Typeable)+data ExitCodeException = ExitCodeException Int+ deriving (Show, Typeable)++instance Exception StderrException+instance Exception ExitCodeException
+ tests/unicode.cfg view
@@ -0,0 +1,3 @@+any window $title =~ /aäα/ ==> tag ok,+any window $title =~ /aäƱ/ ==> tag notok,+
+ tests/unicode.log view
binary file changed (absent → 93 bytes)
+ tests/unicode_stats.out view
@@ -0,0 +1,4 @@+Total time per tag+==================+Tag_|___Time_|_Percentage_+ ok | 1m00s | 100.00