Initial check-in
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 13 Sep 2009 09:15:11 +0000 (09:15 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 13 Sep 2009 09:15:11 +0000 (09:15 +0000)
14 files changed:
LICENSE [new file with mode: 0644]
README [new file with mode: 0644]
Setup.hs [new file with mode: 0644]
arbtt-capture.desktop [new file with mode: 0644]
arbtt.cabal [new file with mode: 0644]
categorize.cfg [new file with mode: 0644]
src/Capture.hs [new file with mode: 0644]
src/Categorize.hs [new file with mode: 0644]
src/Data.hs [new file with mode: 0644]
src/Graphics/X11/XScreenSaver.hsc [new file with mode: 0644]
src/Stats.hs [new file with mode: 0644]
src/TimeLog.hs [new file with mode: 0644]
src/capture.hs [new file with mode: 0644]
src/stats.hs [new file with mode: 0644]

diff --git a/LICENSE b/LICENSE
new file mode 100644 (file)
index 0000000..d60c31a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,340 @@
+                   GNU GENERAL PUBLIC LICENSE
+                      Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                           Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+                   GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+                           NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+                    END OF TERMS AND CONDITIONS
+\f
+           How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year  name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..2dd1ed7
--- /dev/null
+++ b/README
@@ -0,0 +1,128 @@
+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.
+
+Configuration
+=============
+
+Once arbtt-capture is running, it will start recording, without further
+configuration. The configuration is only needed to do an analysis of the
+recorded data. Thus, if you improve your categorization there, it will
+apply even to previous data samples!
+
+The configuration file needs to be placed in ~/.arbtt/categorize.cfg. An
+example file is included, which should be more enlighting than this rather
+formal description.
+
+Whitespace is non-significant and Haskell-style comments are allowed.
+
+Here is grammar of the file:
+
+Rules := [ "aliases" AliasSpec ] Rule ( ("," Rule)* | (";" Rule)* )
+
+Rule := "{" Rules "}" | Cond "==>" Rule | "if" Cond "then" Rule "else" Rule
+      | "tag" Tag
+
+Cond := "(" Cond ")" | "!" Cond | Cond "&&" Cond | Cond "||" Cond 
+      | "$" SVar "==" String | "$" SVar "/=" String
+      | "$" SVar "=~" "/" Regex "/" |
+      | "$" NVar NOp Number
+      | "$" BVar
+      | "current window" $cond
+      | "any window" $cond
+
+SVar := "title" | "program"
+NVar := "idle"
+BVar := "active"
+
+The variables $title, $program, $active refer to the "window in scope". At
+first, no window is in scope. Only when evaluating the condition passed to
+"current window" or "any window", this changes.
+
+For "current window", the currently active window is in scopre. If there is
+no such window, the condition is false.
+
+For "any window", the condition is applied to each window, and if any
+window matches the condition, the result is true. If it matches more than
+one window, of which match the variables $1,.. (see below) will be taken.
+
+Tags are not enclosed in quotation marks, and contain only letters, dashes
+or underscores (e.g. work).
+
+They may be prepended with a category,
+separated by a colon (e.g. Project:arbtt). This category can later be used
+for pie chart like statistics. For each category, no more than one tags can
+be matched per sample. If multiple tags with the same category are
+generated by the rules, only the first one will be taken.
+
+A tag can also interpolate variables, including in the category part.
+Available variables are:
+ $1, $2,..  Matches from the last successfully applied regular expression
+            in the enclosing condition
+ $current.title
+ $current.program
+           The title or the name of the currently active program. If no
+           program happens to be active, this tag will be ignored.
+
+Statistics
+==========
+
+Run the statistics program arbtt-stats with the parameter --help to get an
+overview of the options.
+
+By default, any sample with the tag "inactive" are excluded from the
+statistics, and tags with a percentage lower than one will not be shown.
+
+The tags that affect the selection (-x, -o, --also-inactive) of samples can
+be mixed with the report options (-m) and the reports (-i, -t, -c), but
+will apply to all reports.
+
+Some useful examples:
+
+  # Only consider the time when I was programming in Haskell 
+  arbtt-stats -o Editing-Haskell
+
+  # Tell me what evolution folders I spend my time in when I actually do
+  # work with e-Mail
+ are arbtt-stats -o Program:evolution -c Evo-Folder
+
+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
+
+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.
+ * A better representation of the data in the log, to keep the size and 
+   parsing speed down. 
+ * Possibly more data sources?
+
+Any help cleaning, documenting or testing the current code is appreciated
+as well.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644 (file)
index 0000000..e8efd11
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+module Main where
+import Distribution.Simple
+main = defaultMain
diff --git a/arbtt-capture.desktop b/arbtt-capture.desktop
new file mode 100644 (file)
index 0000000..7783f51
--- /dev/null
@@ -0,0 +1,10 @@
+[Desktop Entry]
+Encoding=UTF-8
+Name=arbtt Data Capture Program
+#Icon=
+Comment=Records information about the user’s application usage
+Type=Application
+#Categories=
+Exec=arbtt-capture
+Terminal=false
+StartupNotify=false
diff --git a/arbtt.cabal b/arbtt.cabal
new file mode 100644 (file)
index 0000000..b8abb2d
--- /dev/null
@@ -0,0 +1,50 @@
+cabal-version:      >= 1.6
+build-type:         Simple
+name:               arbtt
+version:            0.1
+license:            GPL
+license-file:       LICENSE
+category:           Development
+author:             Joachim Breitner <mail@joachim-breitner.de>
+maintainer:         Joachim Breitner <mail@joachim-breitner.de>
+copyright:          Joachim Breitner 2009
+synopsis:           Automatic Rule-Based Time Tracker
+description:
+    arbtt is a background daemon that stores which windows are open, which one
+    has the focus and how long since your last action (and possbly more sources
+    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.
+--    Aditionally, it is a program that lets you graphically expore the log file.
+    .
+    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://darcs.nomeata.de/arbtt
+
+extra-source-files:
+    categorize.cfg, arbtt-capture.desktop, README
+
+executable arbtt-capture
+    main-is:            capture.hs
+    hs-source-dirs:     src
+    build-depends:
+        base == 4.*, filepath, directory, mtl, time, unix,
+        X11 > 1.4.4
+    extra-libraries: Xss
+    other-modules:
+        Data
+        Capture
+        TimeLog
+        Graphics.X11.XScreenSaver
+
+executable arbtt-stats
+    main-is:            stats.hs
+    hs-source-dirs:     src
+    build-depends:
+        base == 4.*, parsec == 2.*, containers, pcre-light, tabular
+    other-modules:
+        Data
+        Categorize
+        TimeLog
+        Stats
+
diff --git a/categorize.cfg b/categorize.cfg
new file mode 100644 (file)
index 0000000..cdd28c9
--- /dev/null
@@ -0,0 +1,30 @@
+-- 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"
+       )
+
+-- 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,
+
+-- 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 the folder
+current window $program == "evolution" &&
+any window ($program == "evolution" && $title =~ /^(.*) \([0-9]+/)
+  ==> tag Evo-Folder:$1,
+
+-- A general rule that works well with gvim and gnome-terminal and tells me what
+-- project I'm currently working on
+current window $title =~ m!(?:~|home/jojo)/projekte/(?:programming/(?:haskell/)?)?([^/)]*)!
+  ==> tag Project:$1,
+
+-- Out of curiosity: what percentage of my time am I actually coding Haskell?
+current window ($program == "gvim" && $title =~ /^[^ ]+\.hs \(/ )
+  ==> tag Editing-Haskell,
diff --git a/src/Capture.hs b/src/Capture.hs
new file mode 100644 (file)
index 0000000..9f21cc6
--- /dev/null
@@ -0,0 +1,46 @@
+module Capture where
+
+import Data
+import Graphics.X11
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.XScreenSaver (getXIdleTime)
+import Control.Monad
+import Data.Maybe
+import Control.Applicative
+import Data.Time.Clock
+
+captureData :: IO CaptureData
+captureData = do
+       dpy <- openDisplay ":0"
+        xSetErrorHandler
+       let rwin = defaultRootWindow dpy
+       (_,_,cwins) <- queryTree dpy rwin
+
+       cwins <- filterM (isInterestingWindow dpy) cwins
+       (fwin,_) <- getInputFocus dpy
+       winData <- mapM (\w -> (,,) (w == fwin) <$> getWindowTitle dpy w <*> getProgramName dpy w) cwins
+
+       it <- fromIntegral `fmap` getXIdleTime dpy
+
+       closeDisplay dpy
+       return $ CaptureData winData it
+
+-- copied from XMonad/Main.hs, where function "ok" from "scan"
+isInterestingWindow :: Display -> Window -> IO Bool
+isInterestingWindow dpy w = do
+       wa <- getWindowAttributes dpy w
+       a  <- internAtom dpy "WM_STATE" False
+       p  <- getWindowProperty32 dpy a w
+       let ic = case p of
+                 Just (3:_) -> True -- 3 for iconified
+                 _          -> False
+       return $ not (wa_override_redirect wa)
+                && (wa_map_state wa == waIsViewable || ic)
+
+
+getWindowTitle :: Display -> Window -> IO String
+getWindowTitle dpy w = fmap (fromMaybe "") $ fetchName dpy w
+
+getProgramName :: Display -> Window -> IO String
+getProgramName dpy w = fmap resName $ getClassHint dpy w
+
diff --git a/src/Categorize.hs b/src/Categorize.hs
new file mode 100644 (file)
index 0000000..93ebb88
--- /dev/null
@@ -0,0 +1,281 @@
+module Categorize where
+
+import Data
+
+import Data.Maybe
+-- import Text.Regex
+import qualified Text.Regex.PCRE.Light.Char8 as RE
+import qualified Data.Map as M
+import Control.Monad
+import Control.Monad.Instances
+
+import Text.ParserCombinators.Parsec hiding (Parser)
+import Text.ParserCombinators.Parsec.Token
+import Text.ParserCombinators.Parsec.Language
+import Text.ParserCombinators.Parsec.Expr
+import System.Exit
+import Control.Applicative ((<*>),(<$>))
+import Data.List
+import Data.Maybe
+import Data.Char
+import Debug.Trace
+
+type Categorizer = TimeLog CaptureData -> TimeLog ActivityData
+type Rule = Ctx -> ActivityData
+
+type Parser a = CharParser () a
+
+data Ctx = Ctx
+       { cNow :: CaptureData
+       , cPast :: [CaptureData]
+       , cFuture :: [CaptureData]
+       , cWindowInScope :: Maybe (Bool, String, String)
+       , cSubsts :: [String]
+       }
+  deriving (Show)
+
+type Cond = Ctx -> Maybe [String]
+
+readCategorizer :: FilePath -> IO Categorizer
+readCategorizer filename = do
+       content <- readFile filename
+       case parse (do {r <- parseRules; eof ; return r}) filename content of
+         Left err -> do
+               putStrLn "Parser error:"
+               putStrLn (show err)
+               exitFailure
+         Right cat -> return ((fmap . fmap) (postpare . cat) . prepare)
+
+prepare :: TimeLog CaptureData -> TimeLog Ctx
+prepare tl = go' [] (map tlData tl) tl
+  where go' past [] []
+               = []
+        go' past (this:future) (now:rest)
+               = now {tlData = Ctx this past future Nothing [] } :
+                 go' (this:past) future rest
+
+-- | Here, we filter out tags appearing twice, and make sure that only one of
+--   each category survives
+postpare :: ActivityData -> ActivityData
+postpare = nubBy $ go
+  where go (Activity (Just c1) _) (Activity (Just c2) _) = c1 == c2
+        go a1                     a2                     = a1 == a2
+
+lang :: TokenParser ()
+lang = haskell
+
+parseRules :: Parser Rule
+parseRules = do 
+       whiteSpace lang
+       a <- option id (reserved lang "aliases" >> parens lang parseAliasSpecs)
+       rb <- parseRulesBody
+       return (a . rb)
+
+parseAliasSpecs :: Parser (ActivityData -> ActivityData)
+parseAliasSpecs = do as <- sepEndBy1 parseAliasSpec (comma lang)
+                    return $ \ad -> foldr doAlias ad as
+
+doAlias :: (String, String) -> ActivityData -> ActivityData
+doAlias (s1,s2) = map go
+  where go (Activity cat tag) = Activity (if cat == Just s1 then Just s2 else cat)
+                                         (if tag == s1 then s2 else tag)
+
+parseAliasSpec :: Parser (String, String)
+parseAliasSpec = do s1 <- stringLiteral lang
+                    reservedOp lang "->"
+                   s2 <- stringLiteral lang
+                   return (s1,s2)
+
+parseRulesBody :: Parser (Ctx -> ActivityData)
+parseRulesBody = do 
+       x <- parseRule
+       choice [ do comma lang
+                   xs <- sepEndBy1 parseRule (comma lang)
+                   return (matchAny (x:xs))
+              , do semi lang
+                   xs <- many1 (semi lang >> parseRule)
+                   return (matchFirst (x:xs))
+              ,    return x
+              ]
+
+parseRule :: Parser Rule
+parseRule = choice
+       [    braces lang parseRules
+       , do cond <- parseCond
+            reservedOp lang "==>"
+            rule <- parseRule
+            return (ifThenElse cond rule matchNone)
+       , do reserved lang "if"
+            cond <- parseCond
+            reserved lang "then"
+            rule1 <- parseRule
+            reserved lang "else"
+            rule2 <- parseRule
+            return (ifThenElse cond rule1 rule2)
+       , do reserved lang "tag"
+            parseSetTag
+       ]
+
+parseCond :: Parser Cond
+parseCond = buildExpressionParser [
+               [ Prefix (reservedOp lang "!" >> return checkNot) ],
+               [ Infix (reservedOp lang "&&" >> return checkAnd) AssocLeft ],
+               [ Infix (reservedOp lang "||" >> return checkOr) AssocLeft ]
+           ] parseCondPrim
+
+checkAnd :: Cond -> Cond -> Cond           
+checkAnd c1 c2 = do res1 <- c1
+                    res2 <- c2
+                   return $ res1 >> res2
+
+
+checkOr :: Cond -> Cond -> Cond            
+checkOr c1 c2 = do res1 <- c1
+                   res2 <- c2
+                  return $ res1 `mplus` res2
+
+checkNot :: Cond -> Cond
+checkNot = liftM (maybe (Just []) (const Nothing))
+
+parseCondPrim :: Parser Cond
+parseCondPrim = choice
+       [    parens lang parseCond
+       , do char '$'
+            varname <- show `liftM` natural lang <|> identifier lang
+            choice
+               [ do guard $ varname `elem` ["title","program"]
+                    choice
+                       [ do reservedOp lang "=~"
+                            regex <- parseRegex
+                            return $ checkRegex varname (RE.compile regex [])
+                       , do reservedOp lang "==" <|> reservedOp lang "="
+                            str <- stringLiteral lang
+                            return $ checkEq varname str
+                       , do reservedOp lang "/=" <|> reservedOp lang "!="
+                            str <- stringLiteral lang
+                            return $ checkNot (checkEq varname str)
+                       ]
+               , do guard $ varname == "idle"
+                    op <- choice $ map (\(s,o) -> reservedOp lang s >> return o)
+                       [(">=",(>=)),
+                        (">", (>)),
+                        ("=", (==)),
+                        ("==",(==)),
+                        ("<",(<)),
+                        ("<=",(<=))]
+                    num <- natural lang
+                    return $ checkNumCmp op varname num
+               , do guard $ varname == "active"
+                    return $ checkActive
+               ]
+       , do reserved lang "current window"
+            cond <- parseCond
+            return $ checkCurrentwindow cond
+       , do reserved lang "any window"
+            cond <- parseCond
+            return $ checkAnyWindow cond
+       ]
+
+parseRegex :: Parser String
+parseRegex = lexeme lang $ choice
+       [ between (char '/') (char '/') (many1 (noneOf "/"))
+       , do char 'm'
+            c <- anyChar
+            str <- many1 (noneOf [c])
+            char c
+            return str
+       ]
+            
+
+parseSetTag :: Parser Rule
+parseSetTag = lexeme lang $ do
+                 firstPart <- parseTagPart 
+                choice [ do char ':'
+                            secondPart <- parseTagPart
+                            return $ do cat <- firstPart
+                                        tag <- secondPart
+                                        return $ maybeToList $ do
+                                           cat <- cat
+                                           tag <- tag
+                                           return $ Activity (Just cat) tag
+                       ,    return $ do tag <- firstPart
+                                        return $ maybeToList $ do
+                                           tag <- tag
+                                           return $ Activity Nothing tag
+                       ]
+
+parseTagPart :: Parser (Ctx -> Maybe String)
+parseTagPart = do parts <- many1 (choice 
+                       [ do char '$'
+                            varname <- many1 (letter <|> oneOf ".") <|> many1 digit
+                            return $ getVar varname
+                       , do s <- many1 (letter <|> oneOf "-_")
+                            return $ const (Just s)
+                       ])
+                 return $ (fmap concat . sequence) <$> sequence parts
+
+ifThenElse :: Cond -> Rule -> Rule -> Rule
+ifThenElse cond r1 r2 = do res <- cond
+                           case res of 
+                           Just substs -> r1 . setSubsts substs
+                           Nothing -> r2
+  where setSubsts :: [String] -> Ctx -> Ctx
+        setSubsts substs ctx = ctx { cSubsts = substs }
+       
+
+matchAny :: [Rule] -> Rule
+matchAny rules = concat <$> sequence rules
+matchFirst :: [Rule] -> Rule
+matchFirst rules = takeFirst <$> sequence rules
+  where takeFirst [] = []
+        takeFirst ([]:xs) = takeFirst xs
+       takeFirst (x:xs) = x
+
+getVar :: String -> Ctx -> Maybe String
+getVar v ctx | all isNumber  v = 
+               let n = read v in
+               listToMaybe (drop (n-1) (cSubsts ctx))
+getVar v ctx | "current" `isPrefixOf` v = do
+               let var = drop (length "current.") v
+               win <- findActive $ cWindows (cNow ctx)
+               getVar var (ctx { cWindowInScope = Just win })
+getVar "title"   ctx = do
+               (_,t,_) <- cWindowInScope ctx
+                return t
+getVar "program" ctx = do
+               (_,_,p) <- cWindowInScope ctx
+                return p
+
+checkRegex :: String -> RE.Regex -> Cond
+checkRegex varname regex ctx = do s <- getVar varname ctx
+                                 matches <- RE.match regex s []
+                                 return (tail matches)
+
+checkEq :: String -> String -> Cond
+checkEq varname str ctx = do s <- getVar varname ctx
+                            [] `justIf` (s == str)
+
+findActive :: [(Bool, t, t1)] -> Maybe (Bool, t, t1)
+findActive = find (\(a,_,_) -> a)                                
+
+checkCurrentwindow :: Cond -> Cond
+checkCurrentwindow cond ctx = cond (ctx { cWindowInScope = findActive (cWindows (cNow ctx)) })
+
+checkAnyWindow :: Cond -> Cond
+checkAnyWindow cond ctx = msum $ map (\w -> cond (ctx { cWindowInScope = Just w }))
+                                     (cWindows (cNow ctx))
+
+checkActive :: Cond
+checkActive ctx = do (a,_,_) <- cWindowInScope ctx
+                     guard a
+                    return []
+
+checkNumCmp ::  (Integer -> Integer -> Bool) -> String -> Integer -> Cond
+checkNumCmp op "idle" num ctx = [] `justIf` op (cLastActivity (cNow ctx)) (num*1000)
+
+matchNone :: Rule
+matchNone = const []
+
+justIf :: a -> Bool -> Maybe a
+justIf x True = Just x
+justIf x False = Nothing
diff --git a/src/Data.hs b/src/Data.hs
new file mode 100644 (file)
index 0000000..36b8e01
--- /dev/null
@@ -0,0 +1,54 @@
+module Data where
+
+import Data.Time
+import Text.ParserCombinators.ReadPrec (readP_to_Prec)
+import Text.ParserCombinators.ReadP
+import Text.Read (readPrec)
+
+type TimeLog a = [TimeLogEntry a]
+
+data TimeLogEntry a = TimeLogEntry
+       { tlTime :: UTCTime
+       , tlRate :: Integer -- ^ in milli-seconds
+       , tlData :: a }
+  deriving (Show, Read)
+
+instance Functor TimeLogEntry where
+       fmap f tl = tl { tlData = f (tlData tl) }
+       
+data CaptureData = CaptureData
+       { cWindows :: [ (Bool, String, String) ]
+               -- ^ Active window, window title, programm name
+       , cLastActivity :: Integer -- ^ in milli-seconds
+       }
+  deriving (Show, Read)
+
+type ActivityData = [Activity]
+
+data Activity = Activity 
+       { activityCategory :: Maybe Category
+       , activityName :: String
+       }
+  deriving (Ord, Eq)
+
+-- < An activity with special meaning: ignored by default (i.e. for idle times)
+inactiveActivity = Activity Nothing "inactive"
+
+
+instance Show Activity where
+ show (Activity mbC t) = maybe "" (++":") mbC ++ t
+
+instance Read Activity where
+ readPrec = readP_to_Prec $ \_ ->
+                  (do cat <- munch1 (/= ':')
+                      char ':'
+                      tag <- many1 get
+                      return $ Activity (Just cat) tag)
+                  <++ (Activity Nothing `fmap` many1 get)
+
+type Category = String
+
+isCategory :: Category -> Activity -> Bool
+isCategory cat (Activity (Just cat') _) = cat == cat'
+isCategory _   _                        = False
+
diff --git a/src/Graphics/X11/XScreenSaver.hsc b/src/Graphics/X11/XScreenSaver.hsc
new file mode 100644 (file)
index 0000000..f98643e
--- /dev/null
@@ -0,0 +1,187 @@
+{-# LANGUAGE  ForeignFunctionInterface #-}
+--------------------------------------------------------------------
+-- |
+-- Module    : Graphics.X11.XScreenSaver
+-- Copyright : (c) Haskell.org, 2009
+-- License   : BSD3
+--
+-- Maintainer: Joachim Breitner <mail@joachim-breitner.de>
+-- Stability : provisional
+-- Portability: portable
+--
+--------------------------------------------------------------------
+--
+-- Interface to XScreenSaver API
+--
+
+module Graphics.X11.XScreenSaver (
+    getXIdleTime,
+    XScreenSaverState(..),
+    XScreenSaverKind(..),
+    XScreenSaverInfo(..),
+    xScreenSaverQueryExtension,
+    xScreenSaverQueryVersion,
+    xScreenSaverQueryInfo,
+    compiledWithXScreenSaver
+ ) where
+
+import Foreign
+import Foreign.C.Types
+import Graphics.X11.Xlib
+import Control.Monad
+
+data XScreenSaverState = ScreenSaverOff | ScreenSaverOn | ScreenSaverDisabled deriving Show
+data XScreenSaverKind = ScreenSaverBlanked | ScreenSaverInternal | ScreenSaverExternal deriving Show
+
+-- | Representation of the XScreenSaverInfo struct.
+data XScreenSaverInfo = XScreenSaverInfo
+                          { xssi_window        :: !Window,
+                            xssi_state         :: !XScreenSaverState,
+-- ^ The state field specified whether or not the screen saver is currently
+-- active and how the til-or-since value should be interpreted:
+--
+-- ['ScreenSaverOff'] The  screen is not currently being saved; til-or-since specifies the
+-- number of milliseconds until the screen saver is expected to activate.
+--
+-- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies the number
+-- of milliseconds since the screen saver activated.
+--
+-- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since is zero.
+                            xssi_kind          :: !XScreenSaverKind,
+-- ^ The kind field specifies the mechanism that either is currently being used
+-- or would have been were the screen being saved:
+--
+-- ['ScreenSaverBlanked'] The video signal to the display monitor was disabled.
+--
+-- ['ScreenSaverInternal'] A server-dependent, built-in screen saver image was displayed;
+-- either no client had set the screen saver window attributes or a different
+-- client had the server grabbed when the screen saver activated.  
+--
+-- ['ScreenSaverExternal'] The screen saver window was mapped with attributes set by a client
+-- using the ScreenSaverSetAttributes request.  
+                            xssi_til_or_since  :: !CULong,
+                            xssi_idle          :: !CULong,
+-- ^ The idle field specifies the number of milliseconds since the last input
+-- was received from the user on any of the input devices.
+                            xssi_event_mask    :: !CULong
+-- ^ The event-mask field specifies which, if any, screen saver events this
+-- client has requested using ScreenSaverSelectInput.
+                            } deriving (Show)
+
+-- | Simple wrapper around 'xScreenSaverQueryInfo' if you are only interested in
+-- the idle time, in milliseconds. Returns 0 if the XScreenSaver extension is
+-- not available
+getXIdleTime :: Display -> IO Int
+getXIdleTime dpy = maybe 0 (fromIntegral . xssi_idle) `fmap` xScreenSaverQueryInfo dpy
+
+-- We have XScreenSaver, so the library will actually work
+compiledWithXScreenSaver :: Bool
+compiledWithXScreenSaver = True
+
+-- for XFree() (already included from scrnsaver.h, but I don't know if I can count on that.)
+#include <X11/Xlib.h>
+#include <X11/extensions/scrnsaver.h>
+
+xScreenSaverState2CInt :: XScreenSaverState -> CInt
+xScreenSaverState2CInt ScreenSaverOn = #const ScreenSaverOn
+xScreenSaverState2CInt ScreenSaverOff = #const ScreenSaverOff
+xScreenSaverState2CInt ScreenSaverDisabled = #const ScreenSaverDisabled
+
+cInt2XScreenSaverState :: CInt -> XScreenSaverState
+cInt2XScreenSaverState (#const ScreenSaverOn) = ScreenSaverOn
+cInt2XScreenSaverState (#const ScreenSaverOff) = ScreenSaverOff
+cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled
+cInt2XScreenSaverState _ = error "Unknown state in xScreenSaverQueryInfo"
+
+instance Storable XScreenSaverState where
+  sizeOf    _ = sizeOf (undefined :: CInt)
+  alignment _ = alignment (undefined :: CInt)
+  poke p xsss = poke (castPtr p) (xScreenSaverState2CInt xsss)
+  peek p = cInt2XScreenSaverState `fmap` peek (castPtr p)
+
+xScreenSaverKind2CInt :: XScreenSaverKind -> CInt
+xScreenSaverKind2CInt ScreenSaverBlanked = #const ScreenSaverBlanked
+xScreenSaverKind2CInt ScreenSaverInternal = #const ScreenSaverInternal
+xScreenSaverKind2CInt ScreenSaverExternal = #const ScreenSaverExternal
+
+cInt2XScreenSaverKind :: CInt -> XScreenSaverKind
+cInt2XScreenSaverKind (#const ScreenSaverBlanked) = ScreenSaverBlanked
+cInt2XScreenSaverKind (#const ScreenSaverInternal) = ScreenSaverInternal
+cInt2XScreenSaverKind (#const ScreenSaverExternal) = ScreenSaverExternal
+cInt2XScreenSaverKind _ = error "Unknown kind in xScreenSaverQueryInfo"
+
+instance Storable XScreenSaverKind where
+  sizeOf    _ = sizeOf (undefined :: CInt)
+  alignment _ = alignment (undefined :: CInt)
+  poke p xsss = poke (castPtr p) (xScreenSaverKind2CInt xsss)
+  peek p = cInt2XScreenSaverKind `fmap` peek (castPtr p)
+
+instance Storable XScreenSaverInfo where
+  sizeOf _ = #{size XScreenSaverInfo}
+  -- FIXME: Is this right?
+  alignment _ = alignment (undefined :: CInt)
+
+  poke p xssi = do
+    #{poke XScreenSaverInfo, window       } p $ xssi_window xssi
+    #{poke XScreenSaverInfo, state        } p $ xssi_state xssi
+    #{poke XScreenSaverInfo, kind         } p $ xssi_kind xssi
+    #{poke XScreenSaverInfo, til_or_since } p $ xssi_til_or_since xssi
+    #{poke XScreenSaverInfo, idle         } p $ xssi_idle xssi
+    #{poke XScreenSaverInfo, eventMask    } p $ xssi_event_mask xssi
+
+  peek p = return XScreenSaverInfo
+              `ap` (#{peek XScreenSaverInfo, window} p)
+              `ap` (#{peek XScreenSaverInfo, state} p)
+              `ap` (#{peek XScreenSaverInfo, kind} p)
+              `ap` (#{peek XScreenSaverInfo, til_or_since} p)
+              `ap` (#{peek XScreenSaverInfo, idle} p)
+              `ap` (#{peek XScreenSaverInfo, eventMask} p)
+
+
+xScreenSaverQueryExtension :: Display -> IO (Maybe (CInt, CInt))
+xScreenSaverQueryExtension dpy = wrapPtr2 (cXScreenSaverQueryExtension dpy) go
+  where go False _ _                = Nothing
+        go True eventbase errorbase = Just (fromIntegral eventbase, fromIntegral errorbase)
+
+xScreenSaverQueryVersion :: Display -> IO (Maybe (CInt, CInt))
+xScreenSaverQueryVersion dpy = wrapPtr2 (cXScreenSaverQueryVersion dpy) go
+  where go False _ _        = Nothing
+        go True major minor = Just (fromIntegral major, fromIntegral minor)
+
+wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
+wrapPtr2 cfun f =
+  withPool $ \pool -> do aptr <- pooledMalloc pool
+                         bptr <- pooledMalloc pool
+                         ret <- cfun aptr bptr
+                         a <- peek aptr
+                         b <- peek bptr
+                         return (f ret a b)
+
+-- | xScreenSaverQueryInfo returns information about the current state of the
+-- screen server. If the xScreenSaver extension is not available, it returns Nothing
+xScreenSaverQueryInfo :: Display -> IO (Maybe XScreenSaverInfo)
+xScreenSaverQueryInfo dpy = do
+  p <- cXScreenSaverAllocInfo
+  if p == nullPtr then return Nothing else do
+  s <- cXScreenSaverQueryInfo dpy (defaultRootWindow dpy) p
+  if s == 0 then return Nothing else do
+  xssi <- peek p
+  cXFree p
+  return (Just xssi)
+
+foreign import ccall "XScreenSaverQueryExtension"
+  cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool
+
+foreign import ccall "XScreenSaverQueryVersion"
+  cXScreenSaverQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool
+
+foreign import ccall "XScreenSaverAllocInfo"
+ cXScreenSaverAllocInfo :: IO (Ptr XScreenSaverInfo)
+
+foreign import ccall "XScreenSaverQueryInfo"
+ cXScreenSaverQueryInfo :: Display -> Drawable -> Ptr XScreenSaverInfo -> IO Status
+
+foreign import ccall "XFree"
+  cXFree :: Ptr a -> IO CInt
diff --git a/src/Stats.hs b/src/Stats.hs
new file mode 100644 (file)
index 0000000..94f874d
--- /dev/null
@@ -0,0 +1,159 @@
+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
+module Stats where
+
+import Data.Time
+import Data.Maybe
+import Data.List
+import Data.Ord
+import Text.Tabular
+import Text.Printf
+import qualified Data.Map as M
+
+import Data
+
+
+data Report = GeneralInfos | TotalTime | Category String
+        deriving Eq
+
+data Filter = Exclude Activity | Only Activity | AlsoInactive
+        deriving Eq
+
+data ReportOption = MinPercentage Double
+        deriving Eq
+
+applyFilters :: [Filter] -> TimeLog ActivityData -> TimeLog ActivityData
+applyFilters filters tle = 
+        foldr (\flag -> case flag of 
+                                Exclude act  -> excludeTag act
+                                Only act     -> onlyTag act
+                                AlsoInactive -> id
+        ) (if AlsoInactive `elem` filters then tle else defaultFilter tle) filters
+
+
+excludeTag act = filter (notElem act . tlData)
+onlyTag act = filter (elem act . tlData)
+defaultFilter = excludeTag inactiveActivity
+
+-- | to be used lazily, to re-use computation when generating more than one
+-- report at a time
+data Calculations = Calculations
+       { firstDate :: UTCTime
+       , lastDate  :: UTCTime
+       , timeDiff :: NominalDiffTime
+       , totalTimeRec :: Integer
+       , totalTimeSel :: Integer
+       , fractionRec :: Double
+       , fractionSel :: Double
+       , fractionSelRec :: Double
+       , sums :: M.Map Activity Integer
+       , tags :: TimeLog ActivityData
+       }
+
+prepareCalculations :: TimeLog ActivityData -> TimeLog ActivityData -> Calculations
+prepareCalculations allTags tags =
+  let c = Calculations
+         { firstDate = tlTime (head allTags)
+         , lastDate = tlTime (last allTags)
+         , timeDiff = diffUTCTime (lastDate c) (firstDate c)
+         , totalTimeRec = sum (map tlRate allTags)
+         , totalTimeSel = sum (map tlRate tags)
+         , fractionRec = fromIntegral (totalTimeRec c) / (realToFrac (timeDiff c) * 1000)
+         , fractionSel = fromIntegral (totalTimeSel c) / (realToFrac (timeDiff c) * 1000)
+         , fractionSelRec = fromIntegral (totalTimeSel c) / fromIntegral (totalTimeRec c)
+         , sums = sumUp tags
+         , tags
+         } in c
+
+-- | Sums up each occurence of an 'Activity', weighted by the sampling rate
+sumUp :: TimeLog ActivityData -> M.Map Activity Integer
+sumUp = foldr go (M.empty) 
+  where go tl m = foldr go' m (tlData tl)
+          where go' act = M.insertWith (+) act (tlRate tl)
+
+
+renderReport :: [ReportOption] -> Calculations -> Report -> (String, Table String String String)
+renderReport opts (Calculations {..}) r = case r of
+       GeneralInfos -> ("General Information",
+               empty ^..^ colH "Value"
+               +.+ row "FirstRecord"
+                       [show firstDate]
+               +.+ row "LastRecord"
+                       [show lastDate]
+               +.+ row "Number of records"
+                       [show (length tags)]
+               +.+ row "Total time recorded"
+                       [formatSeconds (fromIntegral totalTimeRec / 1000)]
+               +.+ row "Total time selected"
+                       [formatSeconds (fromIntegral totalTimeSel / 1000)]
+               +.+ row "Fraction of total time recorded"
+                       [printf "%3.0f%%" (fractionRec * 100) ]
+               +.+ row "Fraction of total time selected"
+                       [printf "%3.0f%%" (fractionSel * 100) ]
+               +.+ row "Fraction of recorded time selected"
+                       [printf "%3.0f%%" (fractionSelRec * 100) ]
+               )
+
+       TotalTime -> ("Total time per tag",
+               foldr (\(tag,time) ->
+                     let perc = fromIntegral time/fromIntegral totalTimeSel*100 in
+                     if perc >= minPercentage
+                     then (+.+ row (show tag) [
+                               formatSeconds (fromIntegral time/100),
+                               printf "%.1f%%" perc])
+                     else id
+                     )
+               (empty ^..^ colH "Time" ^..^ colH "Percentage")
+               (sortBy (comparing snd) $ M.toList sums)
+               )
+       
+       Category cat -> ("Statistics for category " ++ cat,
+               let filteredSums = M.filterWithKey (\a _ -> isCategory cat a) sums
+                   uncategorizedTime = totalTimeSel - M.fold (+) 0 filteredSums
+                   tooSmallSums = M.filter (\t -> fromIntegral t / fromIntegral totalTimeSel * 100 < minPercentage) filteredSums
+                   tooSmallTimes = M.fold (+) 0 tooSmallSums
+               in
+
+               (if uncategorizedTime > 0
+               then (+.+ row "(unmatched time)" [
+                        formatSeconds (fromIntegral uncategorizedTime/1000),
+                        printf "%.1f%%" (fromIntegral uncategorizedTime/fromIntegral totalTimeSel*100::Double)])
+               else id
+               )
+               .       
+               (
+               if tooSmallTimes > 0
+               then (+.+ row (printf "(%d entries omitted)" (M.size tooSmallSums)) [
+                        formatSeconds (fromIntegral tooSmallTimes/1000),
+                        printf "%.1f%%" (fromIntegral tooSmallTimes/fromIntegral totalTimeSel*100::Double) ])
+               else id
+               )
+               $       
+               foldr (\(tag,time) ->
+                     let perc = fromIntegral time/fromIntegral totalTimeSel*100 in
+                     if perc >= minPercentage
+                     then (+.+ row (show tag) [
+                               formatSeconds (fromIntegral time/100),
+                               printf "%.1f%%" perc])
+                     else id
+                     )
+
+               (empty ^..^ colH "Time" ^..^ colH "Percentage")
+
+               (sortBy (comparing snd) $ M.toList filteredSums)
+               )
+
+  where minPercentage = last $ mapMaybe (\f -> case f of {MinPercentage m -> Just m {- ; _ -> Nothing -} }) opts
+
+
+formatSeconds :: Double -> String
+formatSeconds s' = go $ zip [days,hours,mins,secs] ["d","h","m","s"]
+  where s = round s' :: Integer
+        days  =  s `div` (24*60*60)
+        hours = (s `div` (60*60)) `mod` 24
+        mins  = (s `div` (60)) `mod` 60
+       secs  = (s `mod` (60))
+       go | s == 0    = const "0s"
+          | otherwise = concat . snd . mapAccumL go' False 
+       go' True  (a,u)             = (True, printf "%02d%s" a u)
+       go' False (a,u) | a > 0     = (True, printf "%2d%s" a u)
+                       | otherwise = (False, "")
diff --git a/src/TimeLog.hs b/src/TimeLog.hs
new file mode 100644 (file)
index 0000000..2a45804
--- /dev/null
@@ -0,0 +1,25 @@
+module TimeLog where
+
+import Control.Applicative
+import System.IO
+import Data
+import Control.Concurrent
+import Control.Monad
+import Data.Time
+
+-- | Runs the given action each delay milliseconds and appends the TimeLog to the
+-- given file.
+runLogger :: (Show a) => FilePath -> Integer -> IO a -> IO ()
+runLogger filename delay action = forever $ do
+       entry <- action
+       date <- getCurrentTime
+       appendTimeLog filename (TimeLogEntry date delay entry)
+       threadDelay (fromIntegral delay * 1000)
+       
+
+appendTimeLog :: Show a => FilePath -> TimeLogEntry a -> IO ()
+-- Double show to ensure it is one string on one line
+appendTimeLog filename tl = appendFile filename $ (++"\n") $ show $ show $ tl
+
+readTimeLog :: Read a => FilePath -> IO (TimeLog a)
+readTimeLog filename = (map (read.read) . lines) <$> (openFile filename ReadMode >>= hGetContents)
diff --git a/src/capture.hs b/src/capture.hs
new file mode 100644 (file)
index 0000000..ee509b1
--- /dev/null
@@ -0,0 +1,32 @@
+module Main where
+
+import Control.Monad
+import Control.Concurrent
+
+import Capture
+import TimeLog
+import System.Directory
+import System.FilePath
+import Graphics.X11.XScreenSaver (compiledWithXScreenSaver)
+import System.IO
+import System.Posix.IO
+import System.IO.Error
+import System.Exit
+
+
+-- | sampleRate in seconds
+sampleRate = 60 
+
+-- | This is very raw, someone ought to improve this
+lockFile filename = flip catch (\e -> hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") >> exitFailure) $ do
+    fd <- openFd (filename  ++ ".lck") WriteOnly (Just 0644) defaultFileFlags
+    setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+
+main = do
+    unless compiledWithXScreenSaver $
+       hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver"
+    dir <- getAppUserDataDirectory "arbtt"
+    createDirectoryIfMissing False dir
+    let captureFile = dir </> "capture.log"
+    lockFile captureFile
+    runLogger captureFile (sampleRate * 1000) captureData
diff --git a/src/stats.hs b/src/stats.hs
new file mode 100644 (file)
index 0000000..7e36853
--- /dev/null
@@ -0,0 +1,137 @@
+module Main where
+import System.Directory
+import System.FilePath
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.IO
+import Control.Monad
+import qualified Data.Map as M
+import Data.List
+import Data.Ord
+import Data.Time
+import Text.Printf
+import Data.Maybe
+import Data.Version (showVersion)
+import qualified Text.Tabular.AsciiArt as TA
+
+import TimeLog
+import Data
+import Categorize
+import Stats
+
+import Paths_arbtt (version)
+
+data Flag = Help | Version |
+        Report Report |
+        Filter Filter |
+       ReportOption ReportOption
+        deriving Eq
+
+getReports = mapMaybe (\f -> case f of {Report r -> Just r; _ -> Nothing})
+getFilters = mapMaybe (\f -> case f of {Filter f -> Just f; _ -> Nothing})
+getRepOpts = mapMaybe (\f -> case f of {ReportOption o -> Just o; _ -> Nothing})
+
+versionStr = "arbtt-stats " ++ showVersion version
+header = "Usage: arbtt-stats [OPTIONS...]"
+
+options :: [OptDescr Flag]
+options =
+     [ Option "h?"     ["help"]
+              (NoArg Help)
+             "show this help"
+     , Option ['V']     ["version"]
+              (NoArg Version)
+             "show the version number"
+--     , Option ['g']     ["graphical"] (NoArg Graphical)    "render the reports as graphical charts"
+     , Option ['x']     ["exclude"]
+              (ReqArg (Filter . Exclude . Activity Nothing) "TAG")
+             "ignore samples containing this tag"
+     , Option ['o']     ["only"]
+              (ReqArg (Filter . Only . read) "TAG")
+             "only consider samples containing this tag"
+     , Option []        ["also-inactive"]
+              (NoArg (Filter AlsoInactive))
+             "include samples with the tag \"inactive\""
+     , Option ['m']     ["min-percentage"]
+              (ReqArg (ReportOption . MinPercentage . read) "PERC")
+             "do not show tags with a percentage lower than PERC% (default: 1)"
+     , Option ['i']     ["information"]
+              (NoArg (Report GeneralInfos))
+             "show general statistics about the data"
+     , Option ['t']     ["total-time"]
+              (NoArg (Report TotalTime))
+             "show total time for each tag"
+     , Option ['c']     ["category"]
+              (ReqArg (Report . Category) "CATEGORY")
+             "show statistics about category CATEGORY"
+     ]
+
+
+main = do
+  args <- getArgs
+  flags <- case getOpt Permute options args of
+          (o,[],[]) | Help `notElem` o  && Version `notElem` o -> return o
+          (o,_,_) | Version `elem` o -> do
+                hPutStrLn stderr versionStr
+                exitSuccess
+          (o,_,_) | Help `elem` o -> do
+                hPutStr stderr (usageInfo header options)
+                exitSuccess
+          (_,_,errs) -> do
+                hPutStr stderr (concat errs ++ usageInfo header options)
+                exitFailure
+
+  dir <- getAppUserDataDirectory "arbtt"
+
+  let categorizeFilename = dir </> "categorize.cfg"
+  fileEx <- doesFileExist categorizeFilename
+  unless (fileEx) $ do
+     putStrLn $ printf "Configuration file %s does not exist." categorizeFilename
+     putStrLn $ "Please see the example file and the README for more details"
+     exitFailure
+  categorizer <- readCategorizer categorizeFilename
+
+  let captureFilename = dir </> "capture.log"
+  captures <- readTimeLog captureFilename
+  let allTags = categorizer captures
+  when (null allTags) $ do
+     putStrLn "Nothing recorded yet"
+     exitFailure
+      
+  let tags = applyFilters (getFilters flags) allTags
+  let opts = case getRepOpts flags of {[] -> [MinPercentage 1]; ropts -> ropts }
+  let reps = case getReports flags of {[] -> [TotalTime]; reps -> reps }
+
+  -- 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 c = prepareCalculations allTags tags
+  
+  sequence_ $ intersperse (putStrLn "")
+            $ map (\r -> let (h,t) = renderReport opts c r in do
+                       putStrLnUnderlined h
+                       putStr (TA.render id id id t)
+                       )
+           $ reps
+
+putStrLnUnderlined str = do
+        putStrLn str
+        putStrLn $ map (const '=') str
+
+
+{-
+import Data.Accessor
+import Graphics.Rendering.Chart
+import Graphics.Rendering.Chart.Gtk
+
+        graphicalReport TotalTime = do
+          let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..]
+          let plot = plot_bars_values ^= values $ defaultPlotBars
+          let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList  sums)) $
+                           defaultLayoutAxis
+          let layout = layout1_plots ^= [Right (plotBars plot)] $
+                       layout1_bottom_axis ^= layoutaxis $
+                       defaultLayout1
+          do renderableToWindow (toRenderable layout) 800 600
+-}