arbtt-0.7/0000755000000000000000000000000012076570560010672 5ustar0000000000000000arbtt-0.7/modpath.iss0000644000000000000000000001172212076570560013051 0ustar0000000000000000// ---------------------------------------------------------------------------- // // Inno Setup Ver: 5.2.1 // Script Version: 1.3.1 // Author: Jared Breland // Homepage: http://www.legroom.net/software // // Script Function: // Enable modification of system path directly from Inno Setup installers // // Instructions: // Copy modpath.iss to the same directory as your setup script // // Add this statement to your [Setup] section // ChangesEnvironment=yes // // Add this statement to your [Tasks] section // You can change the Description or Flags, but the Name must be modifypath // Name: modifypath; Description: &Add application directory to your system path; Flags: unchecked // // Add the following to the end of your [Code] section // setArrayLength must specify the total number of dirs to be added // Dir[0] contains first directory, Dir[1] contains second, etc. // function ModPathDir(): TArrayOfString; // var // Dir: TArrayOfString; // begin // setArrayLength(Dir, 1) // Dir[0] := ExpandConstant('{app}'); // Result := Dir; // end; // #include "modpath.iss" // ---------------------------------------------------------------------------- procedure ModPath(); var oldpath: String; newpath: String; pathArr: TArrayOfString; aExecFile: String; aExecArr: TArrayOfString; i, d: Integer; pathdir: TArrayOfString; begin // Get array of new directories and act on each individually pathdir := ModPathDir(); for d := 0 to GetArrayLength(pathdir)-1 do begin // Modify WinNT path if UsingWinNT() = true then begin // Get current path, split into an array RegQueryStringValue(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment', 'Path', oldpath); oldpath := oldpath + ';'; i := 0; while (Pos(';', oldpath) > 0) do begin SetArrayLength(pathArr, i+1); pathArr[i] := Copy(oldpath, 0, Pos(';', oldpath)-1); oldpath := Copy(oldpath, Pos(';', oldpath)+1, Length(oldpath)); i := i + 1; // Check if current directory matches app dir if pathdir[d] = pathArr[i-1] then begin // if uninstalling, remove dir from path if IsUninstaller() = true then begin continue; // if installing, abort because dir was already in path end else begin abort; end; end; // Add current directory to new path if i = 1 then begin newpath := pathArr[i-1]; end else begin newpath := newpath + ';' + pathArr[i-1]; end; end; // Append app dir to path if not already included if IsUninstaller() = false then newpath := newpath + ';' + pathdir[d]; // Write new path RegWriteStringValue(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment', 'Path', newpath); // Modify Win9x path end else begin // Convert to shortened dirname pathdir[d] := GetShortName(pathdir[d]); // If autoexec.bat exists, check if app dir already exists in path aExecFile := 'C:\AUTOEXEC.BAT'; if FileExists(aExecFile) then begin LoadStringsFromFile(aExecFile, aExecArr); for i := 0 to GetArrayLength(aExecArr)-1 do begin if IsUninstaller() = false then begin // If app dir already exists while installing, abort add if (Pos(pathdir[d], aExecArr[i]) > 0) then abort; end else begin // If app dir exists and = what we originally set, then delete at uninstall if aExecArr[i] = 'SET PATH=%PATH%;' + pathdir[d] then aExecArr[i] := ''; end; end; end; // If app dir not found, or autoexec.bat didn't exist, then (create and) append to current path if IsUninstaller() = false then begin SaveStringToFile(aExecFile, #13#10 + 'SET PATH=%PATH%;' + pathdir[d], True); // If uninstalling, write the full autoexec out end else begin SaveStringsToFile(aExecFile, aExecArr, False); end; end; // Write file to flag modifypath was selected // Workaround since IsTaskSelected() cannot be called at uninstall and AppName and AppId cannot be "read" in Code section if IsUninstaller() = false then SaveStringToFile(ExpandConstant('{app}') + '\uninsTasks.txt', WizardSelectedTasks(False), False); end; end; procedure CurStepChanged(CurStep: TSetupStep); begin if CurStep = ssPostInstall then if IsTaskSelected('modifypath') then ModPath(); end; procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep); var appdir: String; selectedTasks: AnsiString; begin appdir := ExpandConstant('{app}') if CurUninstallStep = usUninstall then begin if LoadStringFromFile(appdir + '\uninsTasks.txt', selectedTasks) then if Pos('modifypath', selectedTasks) > 0 then ModPath(); DeleteFile(appdir + '\uninsTasks.txt') end; end; function NeedRestart(): Boolean; begin if IsTaskSelected('modifypath') and not UsingWinNT() then begin Result := True; end else begin Result := False; end; end; arbtt-0.7/categorize.cfg0000644000000000000000000001112512076570560013507 0ustar0000000000000000-- 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", "___nforschung" -> "ahnenforschung", "Pidgin" -> "pidgin" ) -- A rule that probably everybody wants. Being inactive for over a minute -- causes this sample to be ignored by default. $idle > 60 ==> tag inactive, -- A rule that matches on a list of strings current window $program == ["Navigator","galeon"] ==> tag Web, current window $program == "sun-awt-X11-XFramePeer" && current window $title == "I3P" ==> tag Program:I3P, current window $program == "sun-awt-X11-XDialogPeer" && current window $title == " " && any window $title == "I3P" ==> tag Program:I3P, -- Simple rule that just tags the current program tag Program:$current.program, -- 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, current window $title =~ m!(?:~|home/jojo)/debian! ==> tag Project:Debian, -- This was a frequently looked-at pdf-File current window $title =~ m!output.pdf! && any window ($title =~ /nforschung/) ==> tag Project:ahnenforschung, -- My diploma thesis is in a different directory current window $title =~ [ m!(?:~|home/jojo)/dokumente/Uni/DA! , m!Diplomarbeit.pdf! , m!LoopSubgroupPaper.pdf! ] ==> tag Project:DA, current window $title =~ m!TDM! ==> tag Project:TDM, ( $date >= 2010-08-01 && $date <= 2010-12-01 && ( current window $program == "sun-awt-X11-XFramePeer" && current window $title == "I3P" || current window $program == "sun-awt-X11-XDialogPeer" && current window $title == " " && any window $title == "I3P" || current window $title =~ m!(?:~|home/jojo)/dokumente/Uni/SA! || current window $title =~ m!Isabelle200! || current window $title =~ m!isar-ref.pdf! || current window $title =~ m!document.pdf! || current window $title =~ m!outline.pdf! || current window $title =~ m!Studienarbeit.pdf! ) ) ==> tag Project:SA, -- Out of curiosity: what percentage of my time am I actually coding Haskell? current window ($program == "gvim" && $title =~ /^[^ ]+\.hs \(/ ) ==> tag Editing-Haskell, {- -- Example of time-related rules. I do not use these myself. -- To be able to match on the time of day, I introduce tags for that as well. -- $time evaluates to local time. $time >= 2:00 && $time < 8:00 ==> tag time-of-day:night, $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, -- To categorize by calendar periods (months, weeks, or arbitrary periods), -- I use $date variable, and some auxiliary functions. All these functions -- evaluate dates in local time. Set TZ environment variable if you need -- statistics in a different time zone. -- You can compare dates: $date >= 2001-01-01 ==> tag this_century, -- You have to write them in YYYY-MM-DD format, else they will not be recognized. -- “format $date” produces a string with the date in ISO 8601 format -- (YYYY-MM-DD), it may be compared with strings. For example, to match -- everything on and after a particular date I can use format $date =~ ".*-03-19" ==> tag period:on_a_special_day, -- but note that this is a rather expensive operation and will slow down your -- data processing considerably. -- “day of month $date” gives the day of month (1..31), -- “day of week $date” gives a sequence number of the day of week -- (1..7, Monday is 1): (day of month $date == 13) && (day of week $date == 5) ==> tag day:friday_13, -- “month $date” gives a month number (1..12), “year $date” gives a year: month $date == 1 ==> tag month:January, month $date == 2 ==> tag month:February, year $date == 2010 ==> tag year:2010, -} arbtt-0.7/Setup.hs0000644000000000000000000000241312076570560012326 0ustar0000000000000000module Main where import Distribution.Simple import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Utils import Distribution.PackageDescription import Distribution.Text import System.FilePath import System.Directory main = defaultMainWithHooks simpleUserHooks { hookedPrograms = [isccProgram] , postBuild = myPostBuild } isccProgram = simpleProgram "ISCC" myPostBuild _ flags pd lbi = do case lookupProgram isccProgram (withPrograms lbi) of Nothing -> warn verb $ "The INNO Setup compile ISCC was not found, skipping the " ++ "creation of the windows setup executable." Just configuredProg -> do writeFile includeFilename $ "AppVerName=" ++ display (package pd) ++ "\n" rawSystemProgram verb configuredProg ["/Odist","/F"++setupFilename,"setup.iss"] removeFile includeFilename where verb = fromFlag (buildVerbosity flags) setupFilename = display (pkgName (package pd)) ++ "-setup-" ++ display (pkgVersion (package pd)) includeFilename = "dist" "setup-app-ver-name.iss" arbtt-0.7/LICENSE0000644000000000000000000004311012076570560011676 0ustar0000000000000000 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. 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.) 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. 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. 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 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. Copyright (C) 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. , 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. arbtt-0.7/README0000644000000000000000000001024112076570560011550 0ustar0000000000000000arbtt, the Automatic Rule-Based Time Tracker © 2009 Joachim Breitner 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-.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. arbtt-0.7/arbtt-capture.desktop0000644000000000000000000000033312076570560015041 0ustar0000000000000000[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 arbtt-0.7/arbtt.cabal0000644000000000000000000001002012076570560012763 0ustar0000000000000000name: arbtt version: 0.7 license: GPL license-file: LICENSE category: Desktop cabal-version: >= 1.6 build-type: Simple author: Joachim Breitner maintainer: Joachim Breitner copyright: Joachim Breitner 2009-2013 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. . 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 extra-source-files: categorize.cfg, arbtt-capture.desktop, README, doc/arbtt.xml, doc/fptools.css, doc/Makefile, setup.iss, modpath.iss executable arbtt-capture main-is: capture-main.hs hs-source-dirs: src build-depends: base == 4.5.* || == 4.6.*, filepath, directory, transformers, time >= 1.4, utf8-string, bytestring, binary, deepseq, strict, terminal-progress-bar, bytestring-progress other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup Capture TimeLog UpgradeLog1 LeftFold ghc-options: -rtsopts if os(windows) extra-libraries: psapi cpp-options: -DWIN32 ghc-options: -optl-mwindows other-modules: Capture.Win32 Graphics.Win32.Window.Extra System.Win32.Mutex build-depends: Win32 else extra-libraries: Xss other-modules: Capture.X11 Graphics.X11.XScreenSaver System.Locale.SetLocale build-depends: X11 > 1.4.4, unix executable arbtt-stats main-is: stats-main.hs hs-source-dirs: src build-depends: base == 4.*, parsec == 3.*, containers, pcre-light, old-locale other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup Categorize TimeLog Stats Text.Parsec.ExprFail Text.ParserCombinators.Parsec.ExprFail Text.Regex.PCRE.Light.Text TermSize ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale executable arbtt-dump main-is: dump-main.hs hs-source-dirs: src build-depends: base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup TimeLog ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale executable arbtt-import main-is: import-main.hs hs-source-dirs: src build-depends: base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup TimeLog ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale executable arbtt-recover main-is: recover-main.hs hs-source-dirs: src build-depends: base == 4.*, parsec == 3.*, containers other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup TimeLog ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale source-repository head type: darcs location: http://darcs.nomeata.de/arbtt arbtt-0.7/setup.iss0000644000000000000000000000471112076570560012555 0ustar0000000000000000[Setup] ; NOTE: The value of AppId uniquely identifies this application. ; Do not use the same AppId value in installers for other applications. ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.) AppId={{1DB6EA4F-D387-432D-A739-283E0E916AF6} AppName=arbtt ;AppVerName=arbtt-0.4.4 #include "dist\setup-app-ver-name.iss" AppPublisher=Joachim Breitner AppPublisherURL=http://www.joachim-breitner.de/projects#arbtt AppSupportURL=http://www.joachim-breitner.de/projects#arbtt AppUpdatesURL=http://www.joachim-breitner.de/projects#arbtt DefaultDirName={pf}\arbtt DefaultGroupName=arbtt AllowNoIcons=yes OutputBaseFilename=arbtt-setup Compression=lzma SolidCompression=yes ; Is there a point in displaying the LICENSE file? ; LicenseFile=LICENSE InfoBeforeFile=README.Win32 ChangesEnvironment=yes [Tasks] Name: modifypath; Description: "Add arbtt binaries to the system path" Name: autorun; Description: "Start to capture data upon system start" Name: runcapture; Description: "Start to capture data after the installation" [Files] Source: "dist\build\arbtt-dump\arbtt-dump.exe"; DestDir: "{app}\bin" Source: "dist\build\arbtt-stats\arbtt-stats.exe"; DestDir: "{app}\bin" Source: "dist\build\arbtt-capture\arbtt-capture.exe"; DestDir: "{app}\bin" Source: "dist\build\arbtt-recover\arbtt-recover.exe"; DestDir: "{app}\bin" Source: "C:\Programme\GnuWin32\bin\pcre3.dll"; DestDir: "{app}\bin" Source: "categorize.cfg"; DestDir: "{userappdata}\arbtt"; Flags: onlyifdoesntexist uninsneveruninstall Source: "doc\users_guide\*.*"; DestDir: "{app}\doc"; [Icons] Name: "{group}\Edit categorize.cfg"; Filename: "wordpad.exe"; Parameters: """{userappdata}\arbtt\categorize.cfg"""; Flags: useapppaths Name: "{group}\{cm:UninstallProgram,arbtt}"; Filename: "{uninstallexe}" Name: "{group}\arbtt documentation"; Filename: "{app}\doc\index.html" Name: "{commonstartup}\arbtt-capture"; Filename: "{app}\bin\arbtt-capture.exe"; Comment: "Collects data for computer useage statistics"; Tasks: autorun [Run] Filename: "{app}\bin\arbtt-capture.exe"; Description: "Start collecting usage data"; Flags: nowait; Tasks: runcapture [Languages] Name: "english"; MessagesFile: "compiler:Default.isl" Name: "german"; MessagesFile: "compiler:Languages\German.isl" [Code] function ModPathDir(): TArrayOfString; var Dir: TArrayOfString; begin setArrayLength(Dir, 1) Dir[0] := ExpandConstant('{app}\bin'); Result := Dir; end; #include "modpath.iss" arbtt-0.7/src/0000755000000000000000000000000012076570560011461 5ustar0000000000000000arbtt-0.7/src/TimeLog.hs0000644000000000000000000001113312076570560013354 0ustar0000000000000000module TimeLog where import Data import Control.Applicative import System.IO import Control.Concurrent import Control.Monad import Data.Time import Data.Binary import Data.Binary.StringRef import Data.Binary.Get import Data.Function import Data.Char import System.Directory import Control.Exception import Prelude hiding (catch) import Control.DeepSeq import System.Posix.Files import qualified Data.ByteString.Lazy as BS import Data.Maybe magic = BS.pack $ map (fromIntegral.ord) "arbtt-timelog-v1\n" -- | 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 createTimeLog False filename setFileMode filename (ownerReadMode `unionFileModes` ownerWriteMode) appendTimeLog filename prev (TimeLogEntry date delay entry) threadDelay (fromIntegral delay * 1000) loop (Just entry) createTimeLog :: Bool -> FilePath -> IO () createTimeLog force filename = do ex <- doesFileExist filename when (not ex || force) $ BS.writeFile filename magic appendTimeLog :: ListOfStringable a => FilePath -> Maybe a -> TimeLogEntry a -> IO () appendTimeLog filename prev = BS.appendFile filename . ls_encode strs where strs = maybe [] listOfStrings prev writeTimeLog :: ListOfStringable a => FilePath -> TimeLog a -> IO () writeTimeLog filename tl = do createTimeLog True filename foldM_ go Nothing tl where go prev v = do appendTimeLog filename prev v return (Just (tlData v)) -- | This might be very bad style, and it hogs memory, but it might help in some situations... recoverTimeLog :: ListOfStringable a => FilePath -> IO (TimeLog a) recoverTimeLog filename = do content <- BS.readFile filename start content where start content = do let (startString, rest, off) = runGetState (getLazyByteString (BS.length magic)) content 0 if startString /= magic then do putStrLn $ "WARNING: Timelog starts with unknown marker " ++ 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 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 ( 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 return (Just (v,rest,off')) ) ( \e -> do putStrLn $ "Failed to read value at position " ++ show off ++ ":" putStrLn $ " " ++ show (e :: SomeException) 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) ) where strs = maybe [] listOfStrings prev readTimeLog :: (NFData a, ListOfStringable a) => FilePath -> IO (TimeLog a) readTimeLog filename = do content <- BS.readFile filename return $ parseTimeLog content parseTimeLog :: (NFData a, ListOfStringable a) => BS.ByteString -> TimeLog a parseTimeLog input = if startString == magic then go Nothing rest off else error $ "Timelog starts with unknown marker " ++ show (map (chr.fromIntegral) (BS.unpack startString)) where (startString, rest, off) = runGetState (getLazyByteString (BS.length magic)) input 0 go prev input off = let (v, rest, off') = runGetState (ls_get strs) input off in v `deepseq` if (BS.null rest) then [v] else v : go (Just (tlData v)) rest off' where strs = maybe [] listOfStrings prev arbtt-0.7/src/Stats.hs0000644000000000000000000003710112076570560013115 0ustar0000000000000000{-# LANGUAGE RecordWildCards, NamedFieldPuns, TypeOperators, TupleSections #-} module Stats ( Report(..), ReportOptions(..), ReportFormat(..), ReportResults(..), ActivityFilter(..), Filter(..), defaultFilter, defaultReportOptions, parseActivityMatcher, filterPredicate, prepareCalculations, processReports, renderReport ) where import Data.Time import Data.Maybe import Data.List import Data.Ord import Text.Printf import qualified Data.Map as M import qualified Data.Set as S import Data.MyText (Text,pack,unpack) import Data.Function (on) import System.Locale (defaultTimeLocale) import Control.Applicative import Data.Strict ((:!:)) import Data.Traversable (sequenceA) import Data import Categorize import LeftFold data Report = GeneralInfos | TotalTime | Category Category | EachCategory | IntervalCategory Category | IntervalTag Activity deriving (Show, Eq) data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String deriving (Show, Eq) data ActivityMatcher = MatchActivity Activity | MatchCategory Category deriving (Show, Eq) data ActivityFilter = ExcludeActivity ActivityMatcher | OnlyActivity ActivityMatcher deriving (Show, Eq) -- Supported report output formats: text, comma-separated values and -- tab-separated values data ReportFormat = RFText | RFCSV | RFTSV deriving (Show, Eq) data ReportOptions = ReportOptions { roMinPercentage :: Double , roReportFormat :: ReportFormat , roActivityFilter :: [ActivityFilter] } deriving (Show, Eq) defaultReportOptions :: ReportOptions defaultReportOptions = ReportOptions { roMinPercentage = 1 , roReportFormat = RFText , roActivityFilter = [] } -- Data format semantically representing the result of a report, including the -- title type Interval = (String,String,String,String) data ReportResults = ListOfFields String [(String, String)] | ListOfTimePercValues String [(String, String, Double)] | PieChartOfTimePercValues String [(String, String, Double)] | ListOfIntervals String [Interval] | MultpleReportResults [ReportResults] filterPredicate :: [Filter] -> TimeLogEntry (Ctx, ActivityData) -> Bool filterPredicate filters tl = all (\flag -> case flag of Exclude act -> excludeTag act tl Only act -> onlyTag act tl GeneralCond s-> applyCond s (cTimeZone (fst (tlData tl))) tl) filters applyActivityFilter :: [ActivityFilter] -> Activity -> Bool applyActivityFilter fs act = all go fs where go (ExcludeActivity matcher) = not (matchActivityMatcher matcher act) go (OnlyActivity matcher) = matchActivityMatcher matcher act excludeTag matcher = not . any (matchActivityMatcher matcher) . snd . tlData onlyTag matcher = any (matchActivityMatcher matcher) . snd . tlData defaultFilter :: Filter defaultFilter = Exclude (MatchActivity inactiveActivity) matchActivityMatcher :: ActivityMatcher -> Activity -> Bool matchActivityMatcher (MatchActivity act1) act2 = act1 == act2 matchActivityMatcher (MatchCategory cat) act2 = Just cat == activityCategory act2 parseActivityMatcher :: String -> ActivityMatcher parseActivityMatcher str | last str == ':' = MatchCategory (pack (init str)) | otherwise = MatchActivity (read str) -- | 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 :: NominalDiffTime , totalTimeSel :: NominalDiffTime , fractionRec :: Double , fractionSel :: Double , fractionSelRec :: Double , sums :: M.Map Activity NominalDiffTime -- , allTags :: TimeLog (Ctx, ActivityData) -- tags is a list of uninterrupted entries -- , tags :: [TimeLog (Ctx, ActivityData)] } prepareCalculations :: LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) Calculations prepareCalculations = pure (\fd ld ttr tts s -> let c = Calculations { firstDate = fd , lastDate = ld , timeDiff = diffUTCTime (lastDate c) (firstDate c) , totalTimeRec = ttr , totalTimeSel = tts , fractionRec = realToFrac (totalTimeRec c) / (realToFrac (timeDiff c)) , fractionSel = realToFrac (totalTimeSel c) / (realToFrac (timeDiff c)) , fractionSelRec = realToFrac (totalTimeSel c) / realToFrac (totalTimeRec c) , sums = s } in c) <*> onAll calcFirstDate <*> onAll calcLastDate <*> onAll calcTotalTime <*> onSelected calcTotalTime <*> onSelected calcSums where calcFirstDate :: LeftFold (TimeLogEntry a) UTCTime calcFirstDate = fromJust <$> lfFirst `mapElems` tlTime calcLastDate :: LeftFold (TimeLogEntry a) UTCTime calcLastDate = fromJust <$> lfLast `mapElems` tlTime calcTotalTime :: LeftFold (TimeLogEntry a) NominalDiffTime calcTotalTime = (/1000) <$> LeftFold 0 (+) fromInteger `mapElems` tlRate calcSums :: LeftFold (TimeLogEntry (a, [Activity])) (M.Map Activity NominalDiffTime) calcSums = LeftFold M.empty (\m tl -> 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) processReport :: ReportOptions -> Calculations -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processReport opts ~(Calculations {..}) GeneralInfos = pure (\n -> ListOfFields "General Information" [ ("FirstRecord", show firstDate) , ("LastRecord", show lastDate) , ("Number of records", show n) , ("Total time recorded", showTimeDiff totalTimeRec) , ("Total time selected", showTimeDiff totalTimeSel) , ("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 processReport opts ~(Calculations {..}) TotalTime = pure $ 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 , perc) else Nothing ) . reverse . sortBy (comparing snd) $ M.toList $ sums processReport opts c (Category cat) = pure (processCategoryReport opts c cat) processReport opts c EachCategory = pure (\cats -> MultpleReportResults $ map (processCategoryReport opts c) cats) <*> onSelected calcCategories processReport opts c (IntervalCategory cat) = processIntervalReport opts c ("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) where extractTag :: Activity -> ActivityData -> Maybe String extractTag tag = fmap show . listToMaybe . filter ( (==tag) ) calcCategories :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Category] calcCategories = fmap S.toList $ leftFold S.empty $ \s tl -> foldl' go' s (snd (tlData tl)) where go' s (Activity (Just cat) _) = S.insert cat s go' s _ = s processCategoryReport opts ~(Calculations {..}) cat = PieChartOfTimePercValues ("Statistics for category " ++ show cat) $ let filteredSums = M.filterWithKey (\a _ -> isCategory cat a) sums uncategorizedTime = totalTimeSel - M.fold (+) 0 filteredSums tooSmallSums = M.filter (\t -> realToFrac t / realToFrac totalTimeSel * 100 < roMinPercentage opts) filteredSums tooSmallTimes = M.fold (+) 0 tooSmallSums in 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 , perc) else Nothing ) (reverse $ sortBy (comparing snd) $ M.toList filteredSums) ++ ( if tooSmallTimes > 0 then [( printf "(%d entries omitted)" (M.size tooSmallSums) , showTimeDiff tooSmallTimes , realToFrac tooSmallTimes/realToFrac totalTimeSel )] else [] ) ++ (if uncategorizedTime > 0 then [( "(unmatched time)" , showTimeDiff 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 where go1 :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Interval] go1 = go3 `mapElems` fmap (extr . snd) go3 :: LeftFold (TimeLogEntry (Maybe String)) [Interval] go3 = runOnGroups ((==) `on` tlData) go4 (onJusts toList) go4 :: LeftFold (TimeLogEntry (Maybe String)) (Maybe Interval) go4 = pure (\fe le -> case tlData fe of Just str -> Just ( str , showUtcTime (tlTime fe) , showUtcTime (tlTime le) , showTimeDiff $ tlTime le `diffUTCTime` tlTime fe + fromIntegral (tlRate fe)/1000 ) Nothing -> Nothing) <*> (fromJust <$> lfFirst) <*> (fromJust <$> lfLast) go2 :: LeftFold [Interval] ReportResults go2 = ListOfIntervals title <$> concatFold {- ((extr. snd) `filterWith` runOnIntervals (runOnGroups ((==) `on` tlData) -} {- intervalReportToTable :: String -> (ActivityData -> Maybe String) -> ReportResults intervalReportToTable title extr = ListOfIntervals title $ map (\tles -> let str = fromJust (tlData (head tles)) firstE = showUtcTime (tlTime (head tles)) lastE = showUtcTime (tlTime (last tles)) timeLength = showTimeDiff $ tlTime (last tles) `diffUTCTime` tlTime (head tles) + fromIntegral (tlRate (last tles))/1000 in (str, firstE, lastE, timeLength)) $ filter (isJust . tlData . head ) $ concat $ fmap (groupBy ((==) `on` tlData) . (fmap.fmap) (extr . snd)) $ tags -} renderReport :: ReportOptions -> ReportResults -> IO () renderReport opts (MultpleReportResults 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 renderReportText (ListOfFields title dats) = underline title ++ (tabulate False $ map (\(f,v) -> [f,v]) dats) renderReportText (ListOfTimePercValues title dats) = underline title ++ (tabulate True $ listOfValues dats) renderReportText (PieChartOfTimePercValues title dats) = underline title ++ (tabulate True $ piechartOfValues dats) renderReportText (ListOfIntervals title dats) = underline title ++ (tabulate True $ listOfIntervals dats) listOfValues dats = ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats piechartOfValues dats = ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats listOfIntervals dats = ["Tag","From","Until","Duration"] : map (\(t,f,u,d) -> [t,f,u,d]) dats -- 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) -- 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") renderReportTSV (ListOfTimePercValues _ dats) = renderWithDelimiter "\t" (listOfValues dats) renderReportTSV (PieChartOfTimePercValues _ dats) = renderWithDelimiter "\t" (piechartOfValues dats) renderReportTSV (ListOfIntervals title dats) = renderWithDelimiter "\t" (listOfIntervals dats) renderWithDelimiter :: String -> [[String]] -> String renderWithDelimiter delim datasource = unlines $ map (injectDelimiter delim) datasource injectDelimiter :: [a] -> [[a]] -> [a] injectDelimiter d = concat . intersperse d tabulate :: Bool -> [[String]] -> String tabulate titlerow rows = unlines $ addTitleRow $ map (intercalate " | " . zipWith (\l s -> take (l - length s) (repeat ' ') ++ s) colwidths) rows where cols = transpose rows colwidths = map (maximum . map length) cols addTitleRow | titlerow = \(l:ls) -> (map (\c -> if c == ' ' then '_' else c) l ++ "_") : ls -- | 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"] where s = round t :: 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 False [] = "0s" go True [] = "" -- go True vs | all (==0) (map fst vs) = concat (replicate (length vs) " ") 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 showUtcTime :: UTCTime -> String showUtcTime = formatTime defaultTimeLocale "%x %X" underline :: String -> String underline str = unlines [ str , map (const '=') str ] arbtt-0.7/src/capture-main.hs0000644000000000000000000000530012076570560014400 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main where import Control.Monad import Control.Concurrent import System.Directory import System.FilePath import System.IO import System.IO.Error #ifdef WIN32 import System.Win32.Mutex #else import System.Posix.IO #endif import System.Exit import System.Console.GetOpt import System.Environment import Data.Maybe import Data.Version (showVersion) import Capture import TimeLog import UpgradeLog1 import CommonStartup import Paths_arbtt (version) data Options = Options { optSampleRate :: Integer , optLogFile :: String } defaultOptions :: FilePath -> Options defaultOptions dir = Options { optSampleRate = 60 , optLogFile = dir "capture.log" } versionStr = "arbtt-capture " ++ showVersion version header = "Usage: arbtt-capture [OPTIONS...]" options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"] (NoArg $ \_ -> do hPutStr stderr (usageInfo header options) exitSuccess ) "show this help" , Option "V" ["version"] (NoArg $ \_ -> do hPutStrLn stderr versionStr exitSuccess ) "show the version number" , Option "f" ["logfile"] (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" , Option "r" ["sample-rate"] (ReqArg (\arg opt -> return opt { optSampleRate = read arg }) "RATE") "set the sample rate in seconds (default: 60)" ] -- | This is very raw, someone ought to improve this lockFile filename = do #ifdef WIN32 success <- claimMutex filename unless success $ do hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") exitFailure #else flip catchIOError (\e -> hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") >> exitFailure) $ do fd <- openFd (filename ++ ".lck") WriteOnly (Just 0o644) defaultFileFlags setLock fd (WriteLock, AbsoluteSeek, 0, 0) #endif main = do commonStartup args <- getArgs actions <- case getOpt Permute options args of (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure 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 arbtt-0.7/src/Categorize.hs0000644000000000000000000005160112076570560014114 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} module Categorize where import Data import qualified Text.Regex.PCRE.Light.Text as RE import qualified Data.Map as M import qualified Data.MyText as T import Data.MyText (Text) import Control.Monad import Control.Monad.Instances import Control.Monad.Trans.Reader import Control.Monad.Trans.Class import Data.Functor.Identity import Text.Parsec import Text.Parsec.Char import Text.Parsec.Token import Text.Parsec.Combinator import Text.Parsec.Language import Text.Parsec.ExprFail import System.Exit import Control.Applicative ((<*>),(<$>)) import Control.DeepSeq import Data.List import Data.Maybe import Data.Char import Data.Time.Clock import Data.Time.LocalTime import Data.Time.Calendar (toGregorian, fromGregorian) import Data.Time.Calendar.WeekDate (toWeekDate) import Data.Time.Format (formatTime) import System.Locale (defaultTimeLocale, iso8601DateFormat) import Debug.Trace import Control.Arrow (second) import Text.Printf type Categorizer = TimeLog CaptureData -> TimeLog (Ctx, ActivityData) type Rule = Ctx -> ActivityData type Parser = ParsecT String () (ReaderT TimeZone Identity) data Ctx = Ctx { cNow :: TimeLogEntry CaptureData , cCurrentWindow :: Maybe (Bool, Text, Text) , cWindowInScope :: Maybe (Bool, Text, Text) , cSubsts :: [Text] , cCurrentTime :: UTCTime , cTimeZone :: TimeZone } deriving (Show) instance NFData Ctx where rnf (Ctx a b c d e f) = a `deepseq` b `deepseq` c `deepseq` e `deepseq` e `deepseq` f `deepseq` () type Cond = CtxFun [Text] type CtxFun a = Ctx -> Maybe a data CondPrim = CondString (CtxFun Text) | CondRegex (CtxFun RE.Regex) | CondInteger (CtxFun Integer) | CondTime (CtxFun NominalDiffTime) | CondDate (CtxFun UTCTime) | CondCond (CtxFun [Text]) | CondStringList (CtxFun [Text]) | CondRegexList (CtxFun [RE.Regex]) newtype Cmp = Cmp (forall a. Ord a => a -> a -> Bool) readCategorizer :: FilePath -> IO Categorizer readCategorizer filename = do content <- readFile filename time <- getCurrentTime tz <- getCurrentTimeZone case flip runReader tz $ runParserT (between (return ()) eof parseRules) () filename content of Left err -> do putStrLn "Parser error:" print err exitFailure Right cat -> return $ (map (fmap (mkSecond (postpare . cat))) . prepare time tz) applyCond :: String -> TimeZone -> TimeLogEntry (Ctx, ActivityData) -> Bool applyCond s tz = case flip runReader tz $ runParserT (do {c <- parseCond; eof ; return c}) () "commad line parameter" s of Left err -> error (show err) Right c -> isJust . c . fst . tlData prepare :: UTCTime -> TimeZone -> TimeLog CaptureData -> TimeLog Ctx prepare time tz = map go where go now = now {tlData = Ctx now (findActive (cWindows (tlData now))) Nothing [] time tz } -- | 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 :: GenTokenParser String () (ReaderT TimeZone Identity) lang = makeTokenParser $ LanguageDef { commentStart = "{-" , commentEnd = "-}" , commentLine = "--" , nestedComments = True , identStart = letter , identLetter = alphaNum <|> oneOf "_'" , opStart = oneOf ":!#$%&*+./<=>?@\\^|-~" , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" , reservedOpNames= [] , reservedNames = [] , caseSensitive = True } 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 :: (Text, Text) -> 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 (Text, Text) parseAliasSpec = do s1 <- T.pack <$> stringLiteral lang reservedOp lang "->" s2 <- T.pack <$> stringLiteral lang return (s1,s2) parseRulesBody :: Parser Rule 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 = do cp <- parseCondExpr case cp of CondCond c -> return c cp -> fail $ printf "Expression of type %s" (cpType cp) parseCondExpr :: Parser CondPrim parseCondExpr = buildExpressionParser [ [ Prefix (reservedOp lang "!" >> return checkNot) ], [ Prefix (reserved lang "day of week" >> return evalDayOfWeek) , Prefix (reserved lang "day of month" >> return evalDayOfMonth) , Prefix (reserved lang "month" >> return evalMonth) , Prefix (reserved lang "year" >> return evalYear) , Prefix (reserved lang "format" >> return formatDate) ], [ Infix (reservedOp lang "=~" >> return checkRegex) AssocNone , Infix (checkCmp <$> parseCmp) AssocNone ], [ Prefix (reserved lang "current window" >> return checkCurrentwindow) , Prefix (reserved lang "any window" >> return checkAnyWindow) ], [ Infix (reservedOp lang "&&" >> return checkAnd) AssocRight ], [ Infix (reservedOp lang "||" >> return checkOr) AssocRight ] ] parseCondPrim cpType :: CondPrim -> String cpType (CondString _) = "String" cpType (CondRegex _) = "Regex" cpType (CondInteger _) = "Integer" cpType (CondTime _) = "Time" cpType (CondDate _) = "Date" cpType (CondCond _) = "Condition" cpType (CondStringList _) = "List of Strings" cpType (CondRegexList _) = "List of regular expressions" checkRegex :: CondPrim -> CondPrim -> Erring CondPrim checkRegex (CondString getStr) (CondRegex getRegex) = Right $ CondCond $ \ctx -> do str <- getStr ctx regex <- getRegex ctx tail <$> RE.match regex str [RE.exec_no_utf8_check] checkRegex (CondString getStr) (CondRegexList getRegexList) = Right $ CondCond $ \ctx -> do str <- getStr ctx regexes <- getRegexList ctx tail <$> msum (map (\regex -> RE.match regex str [RE.exec_no_utf8_check]) regexes) checkRegex cp1 cp2 = Left $ printf "Cannot apply =~ to an expression of type %s and type %s" (cpType cp1) (cpType cp2) checkAnd :: CondPrim-> CondPrim -> Erring CondPrim checkAnd (CondCond c1) (CondCond c2) = Right $ CondCond $ do res1 <- c1 res2 <- c2 return $ res1 >> res2 checkAnd cp1 cp2 = Left $ printf "Cannot apply && to an expression of type %s and type %s" (cpType cp1) (cpType cp2) checkOr :: CondPrim-> CondPrim -> Erring CondPrim checkOr (CondCond c1) (CondCond c2) = Right $ CondCond $ do res1 <- c1 res2 <- c2 return $ res1 `mplus` res2 checkOr cp1 cp2 = Left $ printf "Cannot apply && to an expression of type %s and type %s" (cpType cp1) (cpType cp2) checkNot :: CondPrim -> Erring CondPrim checkNot (CondCond getCnd) = Right $ CondCond $ do liftM (maybe (Just []) (const Nothing)) getCnd checkNot cp = Left $ printf "Cannot apply ! to an expression of type %s" (cpType cp) checkCmp :: Cmp -> CondPrim -> CondPrim -> Erring CondPrim checkCmp (Cmp (?)) (CondInteger getN1) (CondInteger getN2) = Right $ CondCond $ \ctx -> do n1 <- getN1 ctx n2 <- getN2 ctx guard (n1 ? n2) return [] checkCmp (Cmp (?)) (CondTime getT1) (CondTime getT2) = Right $ CondCond $ \ctx -> do t1 <- getT1 ctx t2 <- getT2 ctx guard (t1 ? t2) return [] checkCmp (Cmp (?)) (CondDate getT1) (CondDate getT2) = Right $ CondCond $ \ctx -> do t1 <- getT1 ctx t2 <- getT2 ctx guard (t1 ? t2) return [] checkCmp (Cmp (?)) (CondString getS1) (CondString getS2) = Right $ CondCond $ \ctx -> do s1 <- getS1 ctx s2 <- getS2 ctx guard (s1 ? s2) return [] checkCmp (Cmp (?)) (CondString getS1) (CondStringList getS2) = Right $ CondCond $ \ctx -> do s1 <- getS1 ctx sl <- getS2 ctx guard (any (s1 ?) sl) return [] checkCmp _ cp1 cp2 = Left $ printf "Cannot compare expressions of type %s and type %s" (cpType cp1) (cpType cp2) checkCurrentwindow :: CondPrim -> Erring CondPrim checkCurrentwindow (CondCond cond) = Right $ CondCond $ \ctx -> cond (ctx { cWindowInScope = cCurrentWindow ctx }) checkCurrentwindow cp = Left $ printf "Cannot apply current window to an expression of type %s" (cpType cp) checkAnyWindow :: CondPrim -> Erring CondPrim checkAnyWindow (CondCond cond) = Right $ CondCond $ \ctx -> msum $ map (\w -> cond (ctx { cWindowInScope = Just w })) (cWindows (tlData (cNow ctx))) checkAnyWindow cp = Left $ printf "Cannot apply current window to an expression of type %s" (cpType cp) fst3 (a,_,_) = a snd3 (_,b,_) = b trd3 (_,_,c) = c -- Day of week is an integer in [1..7]. evalDayOfWeek :: CondPrim -> Erring CondPrim evalDayOfWeek (CondDate df) = Right $ CondInteger $ \ctx -> let tz = cTimeZone ctx in (toInteger . trd3 . toWeekDate . localDay . utcToLocalTime tz) `liftM` df ctx evalDayOfWeek cp = Left $ printf "Cannot apply day of week to an expression of type %s, only to $date." (cpType cp) -- Day of month is an integer in [1..31]. evalDayOfMonth :: CondPrim -> Erring CondPrim evalDayOfMonth (CondDate df) = Right $ CondInteger $ \ctx -> let tz = cTimeZone ctx in (toInteger . trd3 . toGregorian . localDay . utcToLocalTime tz) `liftM` df ctx evalDayOfMonth cp = Left $ printf "Cannot apply day of month to an expression of type %s, only to $date." (cpType cp) -- Month is an integer in [1..12]. evalMonth :: CondPrim -> Erring CondPrim evalMonth (CondDate df) = Right $ CondInteger $ \ctx -> let tz = cTimeZone ctx in (toInteger . snd3 . toGregorian . localDay . utcToLocalTime tz) `liftM` df ctx evalMonth cp = Left $ printf "Cannot apply month to an expression of type %s, only to $date." (cpType cp) evalYear :: CondPrim -> Erring CondPrim evalYear (CondDate df) = Right $ CondInteger $ \ctx -> let tz = cTimeZone ctx in (fst3 . toGregorian . localDay . utcToLocalTime tz) `liftM` df ctx evalYear cp = Left $ printf "Cannot apply year to an expression of type %s, only to $date." (cpType cp) -- format date according to ISO 8601 (YYYY-MM-DD) formatDate :: CondPrim -> Erring CondPrim formatDate (CondDate df) = Right $ CondString $ \ctx -> let tz = cTimeZone ctx local = utcToLocalTime tz `liftM` df ctx in T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing) <$> local formatDate cp = Left $ printf "Cannot format an expression of type %s, only $date." (cpType cp) parseCmp :: Parser Cmp parseCmp = choice $ map (\(s,o) -> reservedOp lang s >> return o) [(">=",Cmp (>=)), (">", Cmp (>)), ("==",Cmp (==)), ("=", Cmp (==)), ("<", Cmp (<)), ("<=",Cmp (<=))] parseCondPrim :: Parser CondPrim parseCondPrim = choice [ parens lang parseCondExpr , brackets lang (choice [ (do list <- commaSep1 lang (stringLiteral lang) return $ CondStringList (const (Just (map T.pack list))) ) "list of strings", (do list <- commaSep1 lang parseRegex return $ CondRegexList (const (Just list)) ) "list of regular expressions" ]) , char '$' >> choice [ do backref <- natural lang return $ CondString (getBackref backref) , do varname <- identifier lang choice [ do guard $ varname == "title" return $ CondString (getVar "title") , do guard $ varname == "program" return $ CondString (getVar "program") , do guard $ varname == "active" return $ CondCond checkActive , do guard $ varname == "idle" return $ CondInteger (getNumVar "idle") , do guard $ varname == "time" return $ CondTime (getTimeVar "time") , do guard $ varname == "sampleage" return $ CondTime (getTimeVar "sampleage") , do guard $ varname == "date" return $ CondDate (getDateVar "date") ] ] "variable" , do regex <- parseRegex "regular expression" return $ CondRegex (const (Just regex)) , do str <- T.pack <$> stringLiteral lang "string" return $ CondString (const (Just str)) , try $ do time <- parseTime "time" -- backtrack here, it might have been a number return $ CondTime (const (Just time)) , try $ do date <- parseDate "date" -- backtrack here, it might have been a number return $ CondDate (const (Just date)) , do num <- natural lang "number" return $ CondInteger (const (Just num)) ] {- 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 <- parseCmp num <- natural lang return $ checkNumCmp op varname num , do guard $ varname `elem` ["time","sampleage"] op <- parseCmp time <- parseTime return $ checkTimeCmp op varname time , 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 RE.Regex parseRegex = fmap (flip RE.compile [] . T.pack) $ lexeme lang $ choice [ between (char '/') (char '/') (many1 (noneOf "/")) , do char 'm' c <- anyChar str <- many1 (noneOf [c]) char c return str ] -- | Parses a day-of-time specification (hh:mm) parseTime :: Parser NominalDiffTime parseTime = fmap fromIntegral $ lexeme lang $ do h <- digitToInt <$> digit mh <- optionMaybe (digitToInt <$> digit) char ':' m1 <- digitToInt <$> digit m2 <- digitToInt <$> digit let hour = maybe h ((10*h)+) mh return $ (hour * 60 + m1 * 10 + m2) * 60 parseDate :: Parser UTCTime parseDate = lexeme lang $ do tz <- lift ask year <- read <$> count 4 digit char '-' month <- read <$> count 2 digit char '-' day <- read <$> count 2 digit time <- option 0 parseTime let date = LocalTime (fromGregorian year month day) (TimeOfDay 0 0 0) return $ addUTCTime time $ localTimeToUTC tz date 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 ] replaceForbidden :: Maybe Text -> Maybe Text replaceForbidden = liftM $ T.map go where go c | isAlphaNum c = c | c `elem` "-_" = c | otherwise = '_' parseTagPart :: Parser (Ctx -> Maybe Text) parseTagPart = do parts <- many1 (choice [ do char '$' (replaceForbidden . ) <$> choice [ do num <- natural lang return $ getBackref num , do varname <- many1 (letter <|> oneOf ".") return $ getVar varname ] "variable" , do s <- many1 (alphaNum <|> oneOf "-_") return $ const (Just (T.pack s)) ]) return $ (fmap T.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 :: [Text] -> 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 getBackref :: Integer -> CtxFun Text getBackref n ctx = listToMaybe (drop (fromIntegral n-1) (cSubsts ctx)) getVar :: String -> CtxFun Text getVar v ctx | "current" `isPrefixOf` v = do let var = drop (length "current.") v win <- cCurrentWindow 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 getVar v ctx = error $ "Unknown variable " ++ v getNumVar :: String -> CtxFun Integer getNumVar "idle" ctx = Just $ cLastActivity (tlData (cNow ctx)) `div` 1000 getTimeVar :: String -> CtxFun NominalDiffTime getTimeVar "time" ctx = Just $ let utc = tlTime . cNow $ ctx tz = cTimeZone ctx local = utcToLocalTime tz utc midnightUTC = localTimeToUTC tz $ local { localTimeOfDay = midnight } in utc `diffUTCTime` midnightUTC getTimeVar "sampleage" ctx = Just $ cCurrentTime ctx `diffUTCTime` tlTime (cNow ctx) getDateVar :: String -> CtxFun UTCTime getDateVar "date" ctx = Just $ tlTime (cNow ctx) findActive :: [(Bool, t, t1)] -> Maybe (Bool, t, t1) findActive = find (\(a,_,_) -> a) checkActive :: Cond checkActive ctx = do (a,_,_) <- cWindowInScope ctx guard a return [] matchNone :: Rule matchNone = const [] justIf :: a -> Bool -> Maybe a justIf x True = Just x justIf x False = Nothing mkSecond :: (a -> b) -> a -> (a, b) mkSecond f a = (a, f a) arbtt-0.7/src/stats-main.hs0000644000000000000000000002166612076570560014110 0ustar0000000000000000module 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.MyText as T import Data.Char (toLower) import Text.Printf import Data.Version (showVersion) import Control.DeepSeq import Control.Applicative import qualified Data.ByteString.Lazy as BS import Data.ByteString.Lazy.Progress import System.Posix.Files import System.ProgressBar import TermSize import TimeLog import Categorize import Stats import CommonStartup import LeftFold import Paths_arbtt (version) data Options = Options { optReports :: [Report] , optFilters :: [Filter] , optAlsoInactive :: Bool , optReportOptions :: ReportOptions , optLogFile :: String , optCategorizeFile :: String } defaultOptions :: FilePath -> Options defaultOptions dir = Options { optReports = [] , optFilters = [] , optAlsoInactive = False , optReportOptions = defaultReportOptions , optLogFile = dir "capture.log" , optCategorizeFile = dir "categorize.cfg" } versionStr, header :: String versionStr = "arbtt-stats " ++ showVersion version header = "Usage: arbtt-stats [OPTIONS...]" options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"] (NoArg $ \_ -> do hPutStr stderr (usageInfo header options) exitSuccess ) "show this help" , Option "V" ["version"] (NoArg $ \_ -> do hPutStrLn stderr versionStr exitSuccess ) "show the version number" -- , Option ['g'] ["graphical"] (NoArg Graphical) "render the reports as graphical charts" , Option "" ["logfile"] (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" , Option "" ["categorizefile"] (ReqArg (\arg opt -> return opt { optCategorizeFile = arg }) "FILE") "use this file instead of ~/.arbtt/categorize.cfg" , Option "x" ["exclude"] (ReqArg (\arg opt -> let filters = Exclude (parseActivityMatcher arg) : optFilters opt in return opt { optFilters = filters }) "TAG") "ignore samples containing this tag or category" , Option "o" ["only"] (ReqArg (\arg opt -> let filters = Only (parseActivityMatcher arg) : optFilters opt in return opt { optFilters = filters }) "TAG") "only consider samples containing this tag or category" , Option "" ["also-inactive"] (NoArg (\opt -> return opt { optAlsoInactive = True })) "include samples with the tag \"inactive\"" , Option "f" ["filter"] (ReqArg (\arg opt -> let filters = GeneralCond arg : optFilters opt in return opt { optFilters = filters }) "COND") "only consider samples matching the condition" , Option "m" ["min-percentage"] (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roMinPercentage = read arg} in return opt { optReportOptions = ro }) "COND") "do not show tags with a percentage lower than PERC% (default: 1)" , Option "" ["output-exclude"] (ReqArg (\arg opt -> let filters = ExcludeActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt) in return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG") "remove these tags from the output" , Option "" ["output-only"] (ReqArg (\arg opt -> let filters = OnlyActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt) in return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG") "only include these tags in the output" , Option "i" ["information"] (NoArg (\opt -> let reports = GeneralInfos : optReports opt in return opt { optReports = reports })) "show general statistics about the data" , Option "t" ["total-time"] (NoArg (\opt -> let reports = TotalTime : optReports opt in return opt { optReports = reports })) "show total time for each tag" , Option "c" ["category"] (ReqArg (\arg opt -> let reports = Category (T.pack arg) : optReports opt in return opt { optReports = reports }) "CATEGORY") "show statistics about category CATEGORY" , Option "" ["each-category"] (NoArg (\opt -> let reports = EachCategory : optReports opt in return opt { optReports = reports })) "show statistics about each category found" , Option "" ["intervals"] (ReqArg (\arg opt -> let report = if last arg == ':' then IntervalCategory (T.pack (init arg)) else IntervalTag (read arg) reports = report : optReports opt in return opt { optReports = reports }) "TAG") "list intervals of tag or category TAG" , 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)" ] readReportFormat :: String -> ReportFormat readReportFormat arg = case (tolower arg) of "text" -> RFText "csv" -> RFCSV "tsv" -> RFTSV _ -> error ("Unsupported report output format: '" ++ arg ++ "'") where tolower = map toLower main :: IO () main = do commonStartup args <- getArgs actions <- case getOpt Permute options args of (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions fileEx <- doesFileExist (optCategorizeFile flags) unless fileEx $ do putStrLn $ printf "Configuration file %s does not exist." (optCategorizeFile flags) putStrLn "Please see the example file and the README for more details" exitFailure categorizer <- readCategorizer (optCategorizeFile flags) timelog <- BS.readFile (optLogFile flags) size <- fileSize <$> getFileStatus (optLogFile flags) 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 ' ') hPutChar stderr '\r' ) timelog let captures = parseTimeLog trackedTimelog let allTags = categorizer captures when (null allTags) $ do putStrLn "Nothing recorded yet" exitFailure let filters = (if optAlsoInactive flags then id else (defaultFilter:)) $ optFilters flags let reps = case optReports flags of {[] -> [TotalTime]; reps -> reverse 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 opts = optReportOptions flags let (c,results) = runLeftFold (filterPredicate filters `filterWith` (pure (,) <*> prepareCalculations <*> processReports opts c reps)) allTags -- Force the results a bit, to ensure the progress bar to be shown before the titel c `seq` return () renderReport opts (MultpleReportResults results) {- 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 -} arbtt-0.7/src/import-main.hs0000644000000000000000000000363712076570560014262 0ustar0000000000000000module Main where import System.Directory import System.FilePath import System.Console.GetOpt import System.Environment import System.Exit import System.IO import qualified Data.Map as M import Data.Version (showVersion) import Data.Maybe import Control.Monad import Control.Applicative import TimeLog import Data import CommonStartup import Paths_arbtt (version) data Options = Options { optLogFile :: String } defaultOptions dir = Options { optLogFile = dir "capture.log" } versionStr = "arbtt-import " ++ showVersion version header = "Usage: arbtt-import [OPTIONS...]" options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"] (NoArg $ \_ -> do hPutStr stderr (usageInfo header options) exitSuccess ) "show this help" , Option "V" ["version"] (NoArg $ \_ -> do hPutStrLn stderr versionStr exitSuccess ) "show the version number" , Option "f" ["logfile"] (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" ] main = do commonStartup args <- getArgs actions <- case getOpt Permute options args of (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions ex <- doesFileExist (optLogFile flags) if ex then do putStrLn $ "File at " ++ (optLogFile flags) ++ " does already exist. Please delete this" putStrLn $ "file before running arbtt-import." else do captures <- map read . lines <$> getContents :: IO (TimeLog CaptureData) writeTimeLog (optLogFile flags) captures arbtt-0.7/src/LeftFold.hs0000644000000000000000000001145412076570560013521 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, TypeOperators #-} module LeftFold where import Control.Applicative import Data.List import Data.Monoid import Data.Strict ((:!:), Pair((:!:))) import qualified Data.Strict as S data LeftFold x a = forall s. LeftFold { start :: s, process :: s -> x -> s, finish :: s -> a } -- We keep things pure for as long as possible, to avoid constructing pairs -- in <*> when not needed. Some of the more advanced code below (e.g. -- intervals) is not properly tested with pure LeftFolds. | Pure a leftFold :: a -> (a -> x -> a) -> LeftFold x a leftFold s p = LeftFold s p id instance Functor (LeftFold x) where fmap f (Pure x) = Pure (f x) fmap f (LeftFold st1 p1 f2) = LeftFold st1 p1 (f . f2) instance Applicative (LeftFold x) where pure x = Pure x Pure f <*> c = f <$> c LeftFold st1 p1 f1 <*> Pure x = LeftFold st1 p1 (\s -> f1 s x) LeftFold st1 p1 f1 <*> LeftFold st2 p2 f2 = LeftFold { start = st1 :!: st2, process = \(s1 :!: s2) x -> p1 s1 x :!: p2 s2 x, finish = \(s1 :!: s2) -> f1 s1 (f2 s2) } runLeftFold :: LeftFold x a -> [x] -> a runLeftFold (Pure x) _ = x runLeftFold (LeftFold st1 p1 f1) xs = f1 (foldl' p1 st1 xs) monoidFold :: Monoid m => LeftFold m m monoidFold = leftFold mempty mappend mapElems :: LeftFold y a -> (x -> y) -> LeftFold x a 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)) 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 onJusts :: LeftFold x a -> LeftFold (Maybe x) a onJusts (Pure x) = Pure x onJusts (LeftFold s p f) = LeftFold s (\s mx -> maybe s (p s) mx) f onAll :: LeftFold x a -> LeftFold (Bool :!: x) a onAll (Pure x) = Pure x onAll lf = lf `mapElems` S.snd runOnGroups :: (x -> x -> Bool) -> LeftFold x y -> LeftFold y z -> LeftFold x z runOnGroups eq _ (Pure ox) = Pure ox runOnGroups eq (Pure ix) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sto) go finish where go (S.Nothing :!: so) x = (S.Just x :!: so) go (S.Just x' :!: so) x | x `eq` x' = (S.Just x :!: so) | otherwise = (S.Just x :!: po so ix) finish (S.Nothing :!: so) = fo so finish (S.Just _ :!: so) = fo (po so ix) runOnGroups eq (LeftFold sti pi fi) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sti :!: sto) go finish where go (S.Nothing :!: si :!: so) x = (S.Just x :!: pi si x :!: so) go (S.Just x' :!: si :!: so) x | x `eq` x' = (S.Just x :!: pi si x :!: so) | otherwise = (S.Just x :!: pi sti x :!: po so (fi si)) finish (S.Nothing :!: si :!: so) = fo so finish (S.Just _ :!: si :!: so) = fo (po so (fi si)) runOnIntervals :: LeftFold x y -> LeftFold y z -> LeftFold (Bool :!: x) z runOnIntervals _ (Pure ox) = (Pure ox) runOnIntervals (Pure ix) (LeftFold so po fo) = LeftFold (False :!: S.Nothing) go finish where go (True :!: so) (True :!: x) = (True :!: so) go (True :!: S.Just so) (False :!: x) = (False :!: S.Just (po so ix)) go (True :!: S.Nothing) (False :!: x) = (False :!: S.Just (po so ix)) go (False :!: so) (True :!: x) = (True :!: so) go (False :!: so) (False :!: x) = (False :!: so) finish (False :!: S.Just so) = fo so finish (False :!: S.Nothing) = fo so finish (True :!: S.Just so) = fo (po so ix) finish (True :!: S.Nothing) = fo (po so ix) runOnIntervals (LeftFold si pi fi) (LeftFold so po fo) = LeftFold (S.Nothing :!: S.Nothing) go finish where go (S.Just si :!: so) (True :!: x) = (S.Just (pi si x) :!: so) go (S.Just si :!: S.Just so) (False :!: x) = (S.Nothing :!: S.Just (po so $! fi si)) go (S.Just si :!: S.Nothing) (False :!: x) = (S.Nothing :!: S.Just (po so $! fi si)) go (S.Nothing :!: so) (True :!: x) = (S.Just (pi si x) :!: so) go (S.Nothing :!: so) (False :!: x) = (S.Nothing :!: so) finish (S.Nothing :!: S.Just so) = fo so 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)) lfLength :: LeftFold x Int lfLength = leftFold 0 (\c _ -> c + 1) lfFirst :: LeftFold x (Maybe x) lfFirst = getFirst <$> monoidFold `mapElems` (First . Just) lfLast :: LeftFold x (Maybe x) lfLast = getLast <$> monoidFold `mapElems` (Last . Just) toList :: LeftFold x [x] toList = LeftFold [] (flip (:)) reverse concatFold :: LeftFold [x] [x] concatFold = concat <$> toList arbtt-0.7/src/CommonStartup.hs0000644000000000000000000000033412076570560014630 0ustar0000000000000000{-# LANGUAGE CPP #-} module CommonStartup where #ifndef WIN32 import System.Locale.SetLocale #endif commonStartup :: IO () commonStartup = do #ifndef WIN32 setLocale LC_ALL (Just "") #endif return () arbtt-0.7/src/Capture.hs0000644000000000000000000000031412076570560013416 0ustar0000000000000000{-# LANGUAGE CPP #-} module Capture ( #ifdef WIN32 module Capture.Win32 #else module Capture.X11 #endif ) where #ifdef WIN32 import Capture.Win32 #else import Capture.X11 #endif arbtt-0.7/src/TermSize.hsc0000644000000000000000000000265212076570560013727 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {- By hammar on http://stackoverflow.com/a/12807521/946226 -} module TermSize (getTermSize) where #ifdef WIN32 getTermSize :: IO (Int, Int) getTermSize = return (25,80) #else import Foreign import Foreign.C.Error import Foreign.C.Types #include #include -- Trick for calculating alignment of a type, taken from -- http://www.haskell.org/haskellwiki/FFICookBook#Working_with_structs #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -- The ws_xpixel and ws_ypixel fields are unused, so I've omitted them here. data WinSize = WinSize { wsRow, wsCol :: CUShort } instance Storable WinSize where sizeOf _ = (#size struct winsize) alignment _ = (#alignment struct winsize) peek ptr = do row <- (#peek struct winsize, ws_row) ptr col <- (#peek struct winsize, ws_col) ptr return $ WinSize row col poke ptr (WinSize row col) = do (#poke struct winsize, ws_row) ptr row (#poke struct winsize, ws_col) ptr col foreign import ccall "sys/ioctl.h ioctl" ioctl :: CInt -> CInt -> Ptr WinSize -> IO CInt -- | Return current number of (rows, columns) of the terminal. getTermSize :: IO (Int, Int) getTermSize = with (WinSize 0 0) $ \ws -> do throwErrnoIfMinus1 "ioctl" $ ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) ws WinSize row col <- peek ws return (fromIntegral row, fromIntegral col) #endif arbtt-0.7/src/Data.hs0000644000000000000000000000744512076570560012700 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data where import Data.Time import Text.ParserCombinators.ReadPrec (readP_to_Prec) import Text.ParserCombinators.ReadP hiding (get) import qualified Text.ParserCombinators.ReadP as ReadP import Text.Read (readPrec) import Data.Binary import Data.Binary.Put import Data.Binary.Get import Data.Binary.StringRef import qualified Data.MyText as T import Data.MyText (Text) import Control.Applicative import Control.Monad import Control.DeepSeq 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) } instance NFData a => NFData (TimeLogEntry a) where rnf (TimeLogEntry a b c) = a `deepseq` b `deepseq` c `deepseq` () data CaptureData = CaptureData { cWindows :: [ (Bool, Text, Text) ] -- ^ Active window, window title, programm name , cLastActivity :: Integer -- ^ in milli-seconds } deriving (Show, Read) instance NFData CaptureData where rnf (CaptureData a b) = a `deepseq` b `deepseq` () type ActivityData = [Activity] data Activity = Activity { activityCategory :: Maybe Category , activityName :: Text } deriving (Ord, Eq) instance NFData Activity where rnf (Activity a b) = a `deepseq` b `deepseq` () -- | 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 "" ((++":").T.unpack) mbC ++ (T.unpack t) instance Read Activity where readPrec = readP_to_Prec $ \_ -> (do cat <- munch1 (/= ':') char ':' tag <- many1 ReadP.get return $ Activity (Just (T.pack cat)) (T.pack tag)) <++ (Activity Nothing . T.pack <$> many1 ReadP.get) type Category = Text isCategory :: Category -> Activity -> Bool isCategory cat (Activity (Just cat') _) = cat == cat' isCategory _ _ = False -- Data.Binary instances instance StringReferencingBinary a => StringReferencingBinary (TimeLogEntry a) where ls_put strs tle = do -- A version tag putWord8 1 put (tlTime tle) put (tlRate tle) ls_put strs (tlData tle) ls_get strs = do v <- getWord8 case v of 1 -> TimeLogEntry <$> get <*> get <*> ls_get strs _ -> error $ "Unsupported TimeLogEntry version tag " ++ show v instance Binary UTCTime where put (UTCTime (ModifiedJulianDay d) t) = do put d put (toRational t) get = do d <- get t <- get return $ UTCTime (ModifiedJulianDay d) ({-# SCC diffTimeFromRational #-} fromRational t) instance ListOfStringable CaptureData where listOfStrings = concatMap (\(b,t,p) -> [t,p]) . cWindows instance StringReferencingBinary CaptureData where -- Versions: -- 1 First version -- 2 Using ListOfStringable ls_put strs cd = do -- A version tag putWord8 2 ls_put strs (cWindows cd) ls_put strs (cLastActivity cd) ls_get strs = do v <- getWord8 case v of 1 -> CaptureData <$> get <*> get 2 -> CaptureData <$> ls_get strs <*> ls_get strs _ -> error $ "Unsupported CaptureData version tag " ++ show v -- | 'getMany n' get 'n' elements in order, without blowing the stack. -- From Data.Binary getMany :: Binary a => Int -> Get [a] getMany n = go [] n where go xs 0 = return $! reverse xs go xs i = do x <- get -- we must seq x to avoid stack overflows due to laziness in -- (>>=) x `seq` go (x:xs) (i-1) {-# INLINE getMany #-} arbtt-0.7/src/recover-main.hs0000644000000000000000000000365312076570560014413 0ustar0000000000000000module Main where import System.Directory import System.FilePath import System.Console.GetOpt import System.Environment import System.Exit import System.IO import qualified Data.Map as M import Data.Version (showVersion) import Data.Maybe import Control.Monad import TimeLog import Data import CommonStartup import Paths_arbtt (version) data Options = Options { optInFile :: String , optOutFile :: String } defaultOptions dir = Options { optInFile = dir "capture.log" , optOutFile = dir "capture.log.recovered" } versionStr = "arbtt-recover " ++ showVersion version header = "Usage: arbtt-recover [OPTIONS...]" options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"] (NoArg $ \_ -> do hPutStr stderr (usageInfo header options) exitSuccess ) "show this help" , Option "V" ["version"] (NoArg $ \_ -> do hPutStrLn stderr versionStr exitSuccess ) "show the version number" , Option "i" ["infile"] (ReqArg (\arg opt -> return opt { optInFile = arg }) "FILE") "read from this file instead of ~/.arbtt/capture.log" , Option "o" ["outfile"] (ReqArg (\arg opt -> return opt { optOutFile = arg }) "FILE") "write to this file instead of ~/.arbtt/capture.log.recovered" ] main = do commonStartup args <- getArgs actions <- case getOpt Permute options args of (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions captures <- recoverTimeLog (optInFile flags) :: IO (TimeLog CaptureData) writeTimeLog (optOutFile flags) captures arbtt-0.7/src/UpgradeLog1.hs0000644000000000000000000000414512076570560014133 0ustar0000000000000000module UpgradeLog1 (upgradeLogFile1) where import qualified Data.ByteString.Char8 as BS import System.IO import Data.Time import Control.Applicative import Control.Monad import System.Directory import qualified Data.MyText as T import TimeLog (writeTimeLog) import qualified Data as D -- | A copy of the data definitions as they were on 2009-10-03, to be able to -- change them in the main code later, and still be able to read old log files. 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) readTimeLog :: Read a => FilePath -> IO (TimeLog a) readTimeLog filename = (map (read.read) . lines) <$> (openFile filename ReadMode >>= hGetContents) magicStart = BS.pack "\"TimeLogEntry" upgradeLogFile1 captureFile = do ex <- doesFileExist captureFile when ex $ do h <- openFile captureFile ReadMode start <- BS.hGet h (BS.length magicStart) hClose h when (start == magicStart) $ do putStrLn $ "Detected old text file format. Creating backup at " ++ oldFile ++ " and converting to new format..." renameFile captureFile oldFile captures <- readTimeLog oldFile writeTimeLog captureFile (upgrade captures) putStrLn "done." where oldFile = captureFile ++ ".old" upgrade :: TimeLog CaptureData -> D.TimeLog D.CaptureData 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 arbtt-0.7/src/dump-main.hs0000644000000000000000000000320612076570560013705 0ustar0000000000000000module Main where import System.Directory import System.FilePath import System.Console.GetOpt import System.Environment import System.Exit import System.IO import qualified Data.Map as M import Data.Version (showVersion) import Data.Maybe import Control.Monad import TimeLog import Data import CommonStartup import Paths_arbtt (version) data Options = Options { optLogFile :: String } defaultOptions dir = Options { optLogFile = dir "capture.log" } versionStr = "arbtt-dump " ++ showVersion version header = "Usage: arbtt-dump [OPTIONS...]" options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"] (NoArg $ \_ -> do hPutStr stderr (usageInfo header options) exitSuccess ) "show this help" , Option "V" ["version"] (NoArg $ \_ -> do hPutStrLn stderr versionStr exitSuccess ) "show the version number" , Option "f" ["logfile"] (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" ] main = do commonStartup args <- getArgs actions <- case getOpt Permute options args of (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions captures <- readTimeLog (optLogFile flags) :: IO (TimeLog CaptureData) mapM_ print captures arbtt-0.7/src/Data/0000755000000000000000000000000012076570560012332 5ustar0000000000000000arbtt-0.7/src/Data/MyText.hs0000644000000000000000000000443612076570560014127 0ustar0000000000000000module Data.MyText where import qualified Data.ByteString.UTF8 as BSU import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS import Data.Binary.Get import Data.Binary import Control.Applicative ((<$>)) import Control.Arrow (first) import Prelude hiding (length, map) import qualified Prelude import GHC.Exts( IsString(..) ) import Control.DeepSeq import Control.Monad newtype Text = Text { toBytestring :: BSU.ByteString } deriving (Eq, Ord) instance Show Text where showsPrec i t = showsPrec i (toBytestring t) instance Read Text where readsPrec i s = Prelude.map (first Text) $ readsPrec i s instance IsString Text where fromString = pack -- Binary instance compatible with Binary String instance Binary Text where put = put . unpack -- The following code exploits that the Binary Char instance uses UTF8 as well -- 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 let utf8bs = BSU.take n bs unless (BSU.length utf8bs == n) $ fail $ "Coult not parse the expected " ++ show n ++ " utf8 characters." skip (BS.length utf8bs) return $ Text utf8bs {- Possible speedup with a version of binary that provides access to the internals, as the Char instance is actually UTF8, but the length bit is chars, not bytes. instance Binary Text where put = put . unpack get = do n <- get :: Get Int let go = do s <- GI.get let utf8s = BSU.take n s if BSU.length utf8s == n then GI.skip (B.length utf8s) >> return utf8s else GI.demandInput >> go go -} instance NFData Text where rnf (Text a) = a `seq` () length :: Text -> Int length (Text bs) = BSU.length bs decodeUtf8 :: BS.ByteString -> Text decodeUtf8 = Text encodeUtf8 :: Text -> BS.ByteString encodeUtf8 = toBytestring unpack :: Text -> String unpack = BSU.toString . toBytestring pack :: String -> Text pack = Text . BSU.fromString map :: (Char -> Char) -> Text -> Text map f = pack . Prelude.map f . unpack concat :: [Text] -> Text concat = Text . BS.concat . Prelude.map toBytestring arbtt-0.7/src/Data/Binary/0000755000000000000000000000000012076570560013556 5ustar0000000000000000arbtt-0.7/src/Data/Binary/StringRef.hs0000644000000000000000000001003712076570560016016 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, UndecidableInstances, TypeSynonymInstances, OverlappingInstances#-} module Data.Binary.StringRef ( ListOfStringable(..) , StringReferencingBinary(..) , ls_encode , ls_decode ) where import Data.Binary import Data.Binary.Put import Data.Binary.Get import Control.Monad import Control.Applicative ((<$>)) import Data.List import Data.ByteString.Lazy (ByteString) import qualified Data.MyText as T import Data.MyText (Text, decodeUtf8, encodeUtf8) import Debug.Trace class StringReferencingBinary a => ListOfStringable a where listOfStrings :: a -> [Text] -- | An extended version of Binary that passes the list of strings of the -- previous sample class StringReferencingBinary a where ls_put :: [Text] -> a -> Put ls_get :: [Text] -> Get a ------------------------------------------------------------------------ -- Instances for the first few tuples instance (StringReferencingBinary a, StringReferencingBinary b) => StringReferencingBinary (a,b) where ls_put strs (a,b) = ls_put strs a >> ls_put strs b ls_get strs = liftM2 (,) (ls_get strs) (ls_get strs) instance (StringReferencingBinary a, StringReferencingBinary b, StringReferencingBinary c) => StringReferencingBinary (a,b,c) where ls_put strs (a,b,c) = ls_put strs a >> ls_put strs b >> ls_put strs c ls_get strs = liftM3 (,,) (ls_get strs) (ls_get strs) (ls_get strs) instance (StringReferencingBinary a, StringReferencingBinary b, StringReferencingBinary c, StringReferencingBinary d) => StringReferencingBinary (a,b,c,d) where ls_put strs (a,b,c,d) = ls_put strs a >> ls_put strs b >> ls_put strs c >> ls_put strs d ls_get strs = liftM4 (,,,) (ls_get strs) (ls_get strs) (ls_get strs) (ls_get strs) instance (StringReferencingBinary a, StringReferencingBinary b, StringReferencingBinary c, StringReferencingBinary d, StringReferencingBinary e) => StringReferencingBinary (a,b,c,d,e) where ls_put strs (a,b,c,d,e) = ls_put strs a >> ls_put strs b >> ls_put strs c >> ls_put strs d >> ls_put strs e ls_get strs = liftM5 (,,,,) (ls_get strs) (ls_get strs) (ls_get strs) (ls_get strs) (ls_get strs) instance StringReferencingBinary a => StringReferencingBinary [a] where ls_put strs l = ls_put strs (length l) >> mapM_ (ls_put strs) l ls_get strs = do n <- (ls_get strs) :: Get Int ls_getMany strs n -- | 'ls_get strsMany n' ls_get strs 'n' elements in order, without blowing the stack. ls_getMany :: StringReferencingBinary a => [Text] -> Int -> Get [a] ls_getMany strs n = go [] n where go xs 0 = return $! reverse xs go xs i = do x <- ls_get strs -- we must seq x to avoid stack overflows due to laziness in -- (>>=) x `seq` go (x:xs) (i-1) {-# INLINE ls_getMany #-} instance StringReferencingBinary Text where ls_put strs s = case elemIndex s strs of Just i | 0 <= i && i < 255 - 2 -> put (fromIntegral (succ i) :: Word8) _ -> put (0 :: Word8) >> put s ls_get strs = do tag <- get case tag :: Word8 of 0 -> get i -> return $! strs !! fromIntegral (pred i) {- instance Binary a => StringReferencingBinary a where ls_put _ = put ls_get _ = get -} instance StringReferencingBinary Char where { ls_put _ = put; ls_get _ = get } instance StringReferencingBinary Int where { ls_put _ = put; ls_get _ = get } instance StringReferencingBinary Integer where { ls_put _ = put; ls_get _ = get } instance StringReferencingBinary Bool where { ls_put _ = put; ls_get _ = get } ls_encode :: StringReferencingBinary a => [Text] -> a -> ByteString ls_encode strs = runPut . ls_put strs {-# INLINE ls_encode #-} -- | Decode a value from a lazy ByteString, reconstructing the original structure. -- ls_decode :: StringReferencingBinary a => [Text] -> ByteString -> a ls_decode strs = runGet (ls_get strs) arbtt-0.7/src/System/0000755000000000000000000000000012076570560012745 5ustar0000000000000000arbtt-0.7/src/System/Locale/0000755000000000000000000000000012076570560014144 5ustar0000000000000000arbtt-0.7/src/System/Locale/SetLocale.hsc0000644000000000000000000000334612076570560016524 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {- This file is copied from the setlocale-0.0.3 package. Its author is Lukas Mai and it is placed in the Public Domain. -} module System.Locale.SetLocale ( Category(..), categoryToCInt, setLocale ) where import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Data.Typeable -- | A type representing the various locale categories. See @man 7 locale@. data Category = LC_ALL | LC_COLLATE | LC_CTYPE | LC_MESSAGES | LC_MONETARY | LC_NUMERIC | LC_TIME deriving (Eq, Ord, Read, Show, Enum, Bounded) instance Typeable Category where typeOf _ = mkTyConApp (mkTyCon "System.Locale.SetLocale.Category") [] #include -- | Convert a 'Category' to the corresponding system-specific @LC_*@ code. -- You probably don't need this function. categoryToCInt :: Category -> CInt categoryToCInt LC_ALL = #const LC_ALL categoryToCInt LC_COLLATE = #const LC_COLLATE categoryToCInt LC_CTYPE = #const LC_CTYPE categoryToCInt LC_MESSAGES = #const LC_MESSAGES categoryToCInt LC_MONETARY = #const LC_MONETARY categoryToCInt LC_NUMERIC = #const LC_NUMERIC categoryToCInt LC_TIME = #const LC_TIME ptr2str :: Ptr CChar -> IO (Maybe String) ptr2str p | p == nullPtr = return Nothing | otherwise = fmap Just $ peekCString p str2ptr :: Maybe String -> (Ptr CChar -> IO a) -> IO a str2ptr Nothing f = f nullPtr str2ptr (Just s) f = withCString s f foreign import ccall unsafe "locale.h setlocale" c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar) -- | A Haskell version of @setlocale()@. See @man 3 setlocale@. setLocale :: Category -> Maybe String -> IO (Maybe String) setLocale cat str = str2ptr str $ \p -> c_setlocale (categoryToCInt cat) p >>= ptr2str arbtt-0.7/src/System/Win32/0000755000000000000000000000000012076570560013647 5ustar0000000000000000arbtt-0.7/src/System/Win32/Mutex.hsc0000644000000000000000000000164712076570560015460 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module System.Win32.Mutex ( claimMutex ) where import System.Win32.Types import Foreign #include type LPSECURITY_ATTRIBUTES = Ptr () foreign import stdcall unsafe "windows.h CreateMutexW" c_CreateMutex :: LPSECURITY_ATTRIBUTES -> Bool -> LPCTSTR -> IO HANDLE foreign import stdcall unsafe "windows.h SetLastError" c_SetLastError :: DWORD -> IO () -- | Given a unique identifier in the string, this function tries to create -- and claim a mutex based on that name. Returns 'True' if the mutex was claimed. claimMutex :: String -> IO Bool claimMutex lockfilename = do let name = "Local\\" ++ filter (/='\\') lockfilename withTString name $ \c_str -> do c_SetLastError (#const ERROR_SUCCESS) handle <- c_CreateMutex nullPtr True c_str err <- getLastError if handle == nullPtr then errorWin "CreateMutex" else return (err /= (#const ERROR_ALREADY_EXISTS)) arbtt-0.7/src/Text/0000755000000000000000000000000012076570560012405 5ustar0000000000000000arbtt-0.7/src/Text/Parsec/0000755000000000000000000000000012076570560013622 5ustar0000000000000000arbtt-0.7/src/Text/Parsec/ExprFail.hs0000644000000000000000000001507612076570560015701 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Text.Parsec.Expr -- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 -- License : BSD-style (see the LICENSE file) -- -- Maintainer : derek.a.elkins@gmail.com -- Stability : provisional -- Portability : non-portable -- -- A helper module to parse \"expressions\". -- Builds a parser given a table of operators and associativities. -- ----------------------------------------------------------------------------- module Text.Parsec.ExprFail ( Assoc(..), Operator(..), OperatorTable , Erring , buildExpressionParser ) where import Text.Parsec.Prim import Text.Parsec.Combinator import Control.Applicative ((<*>),(<$>)) ----------------------------------------------------------- -- Assoc and OperatorTable ----------------------------------------------------------- -- | This data type specifies the associativity of operators: left, right -- or none. data Assoc = AssocNone | AssocLeft | AssocRight type Erring a = Either String a -- | This data type specifies operators that work on values of type @a@. -- An operator is either binary infix or unary prefix or postfix. A -- binary operator has also an associated associativity. data Operator s u m a = Infix (ParsecT s u m (a -> a -> Erring a)) Assoc | Prefix (ParsecT s u m (a -> Erring a)) | Postfix (ParsecT s u m (a -> Erring a)) erringToParsec :: Erring a -> ParsecT s u m a erringToParsec = either fail return -- | An @OperatorTable s u m a@ is a list of @Operator s u m a@ -- lists. The list is ordered in descending -- precedence. All operators in one list have the same precedence (but -- may have a different associativity). type OperatorTable s u m a = [[Operator s u m a]] ----------------------------------------------------------- -- Convert an OperatorTable and basic term parser into -- a full fledged expression parser ----------------------------------------------------------- -- | @buildExpressionParser table term@ builds an expression parser for -- terms @term@ with operators from @table@, taking the associativity -- and precedence specified in @table@ into account. Prefix and postfix -- operators of the same precedence can only occur once (i.e. @--2@ is -- not allowed if @-@ is prefix negate). Prefix and postfix operators -- of the same precedence associate to the left (i.e. if @++@ is -- postfix increment, than @-2++@ equals @-1@, not @-3@). -- -- The @buildExpressionParser@ takes care of all the complexity -- involved in building expression parser. Here is an example of an -- expression parser that handles prefix signs, postfix increment and -- basic arithmetic. -- -- > expr = buildExpressionParser table term -- > "expression" -- > -- > term = parens expr -- > <|> natural -- > "simple expression" -- > -- > table = [ [prefix "-" negate, prefix "+" id ] -- > , [postfix "++" (+1)] -- > , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ] -- > , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] -- > ] -- > -- > binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc -- > prefix name fun = Prefix (do{ reservedOp name; return fun }) -- > postfix name fun = Postfix (do{ reservedOp name; return fun }) buildExpressionParser :: (Stream s m t) => OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a buildExpressionParser operators simpleExpr = foldl (makeParser) simpleExpr operators where makeParser term ops = let (rassoc,lassoc,nassoc ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops rassocOp = choice rassoc lassocOp = choice lassoc nassocOp = choice nassoc prefixOp = choice prefix "" postfixOp = choice postfix "" ambigious assoc op= try $ do{ op; fail ("ambiguous use of a " ++ assoc ++ " associative operator") } ambigiousRight = ambigious "right" rassocOp ambigiousLeft = ambigious "left" lassocOp ambigiousNon = ambigious "non" nassocOp termP = do{ pre <- prefixP ; x <- term ; post <- postfixP ; erringToParsec (pre x) >>= erringToParsec . post } postfixP = postfixOp <|> return Right prefixP = prefixOp <|> return Right rassocP x = do{ f <- rassocOp ; y <- do{ z <- termP; rassocP1 z } ; erringToParsec (f x y) } <|> ambigiousLeft <|> ambigiousNon -- <|> return x rassocP1 x = rassocP x <|> return x lassocP x = do{ f <- lassocOp ; y <- termP ; erringToParsec (f x y) >>= lassocP1 } <|> ambigiousRight <|> ambigiousNon -- <|> return x lassocP1 x = lassocP x <|> return x nassocP x = do{ f <- nassocOp ; y <- termP ; ambigiousRight <|> ambigiousLeft <|> ambigiousNon <|> erringToParsec (f x y) } -- <|> return x in do{ x <- termP ; rassocP x <|> lassocP x <|> nassocP x <|> return x "operator" } splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix) = case assoc of AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix) AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix) AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix) splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,op:prefix,postfix) splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,prefix,op:postfix) arbtt-0.7/src/Text/Regex/0000755000000000000000000000000012076570560013457 5ustar0000000000000000arbtt-0.7/src/Text/Regex/PCRE/0000755000000000000000000000000012076570560014210 5ustar0000000000000000arbtt-0.7/src/Text/Regex/PCRE/Light/0000755000000000000000000000000012076570560015257 5ustar0000000000000000arbtt-0.7/src/Text/Regex/PCRE/Light/Text.hs0000644000000000000000000001425112076570560016542 0ustar0000000000000000-------------------------------------------------------------------- -- | -- Module : Text.Regex.PCRE.Light.Text -- Copyright: Copyright (c) 2007-2008, Don Stewart -- License : BSD3 -- -- Maintainer: Don Stewart -- Stability : experimental -- Portability: H98 + FFI -- -------------------------------------------------------------------- -- -- A simple, portable binding to perl-compatible regular expressions -- (PCRE) via 8-bit latin1 Strings. -- module Text.Regex.PCRE.Light.Text ( -- * The abstract PCRE Regex type Regex -- * String interface , compile, compileM , match -- * Regex types and constructors externally visible -- ** PCRE compile-time bit flags , PCREOption , anchored , auto_callout {-, bsr_anycrlf-} {-, bsr_unicode-} , caseless , dollar_endonly , dotall , dupnames , extended , extra , firstline , multiline {-, newline_any-} {-, newline_anycrlf-} , newline_cr , newline_crlf , newline_lf , no_auto_capture , ungreedy , utf8 , no_utf8_check -- ** PCRE exec-time bit flags , PCREExecOption , exec_anchored {-, exec_newline_any -} {-, exec_newline_anycrlf -} , exec_newline_cr , exec_newline_crlf , exec_newline_lf , exec_notbol , exec_noteol , exec_notempty , exec_no_utf8_check , exec_partial ) where import qualified Data.MyText as T import Data.MyText (Text, decodeUtf8, encodeUtf8) import qualified Text.Regex.PCRE.Light as S import Text.Regex.PCRE.Light hiding (match, compile, compileM) -- | 'compile' -- -- Compile a perl-compatible regular expression, in a strict bytestring. -- The arguments are: -- -- * 'pat': A ByteString, which may or may not be zero-terminated, -- containing the regular expression to be compiled. -- -- * 'flags', optional bit flags. If 'Nothing' is provided, defaults are used. -- -- Valid compile-time flags are: -- -- * 'anchored' - Force pattern anchoring -- -- * 'auto_callout' - Compile automatic callouts -- -- * 'bsr_anycrlf' - \\R matches only CR, LF, or CRLF -- -- * 'bsr_unicode' - \\R matches all Unicode line endings -- -- * 'caseless' - Do caseless matching -- -- * 'dollar_endonly' - '$' not to match newline at end -- -- * 'dotall' - matches anything including NL -- -- * 'dupnames' - Allow duplicate names for subpatterns -- -- * 'extended' - Ignore whitespace and # comments -- -- * 'extra' - PCRE extra features (not much use currently) -- -- * 'firstline' - Force matching to be before newline -- -- * 'multiline' - '^' and '$' match newlines within data -- -- * 'newline_any' - Recognize any Unicode newline sequence -- -- * 'newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'newline_cr' - Set CR as the newline sequence -- -- * 'newline_crlf' - Set CRLF as the newline sequence -- -- * 'newline_lf' - Set LF as the newline sequence -- -- * 'no_auto_capture' - Disable numbered capturing parentheses (named ones available) -- -- * 'ungreedy' - Invert greediness of quantifiers -- -- * 'utf8' - Run in UTF-8 mode (always enabled in this module) -- -- * 'no_utf8_check' - Do not check the pattern for UTF-8 validity (always enabled in this module) -- -- If compilation of the pattern fails, the 'Left' constructor is -- returned with the error string. Otherwise an abstract type -- representing the compiled regular expression is returned. -- The regex is allocated via malloc on the C side, and will be -- deallocated by the runtime when the Haskell value representing it -- goes out of scope. -- -- As regexes are often defined statically, GHC will compile them -- to null-terminated, strict C strings, enabling compilation of the -- pattern without copying. This may be useful for very large patterns. -- -- See man pcreapi for more details. -- compile :: Text -> [PCREOption] -> Regex compile str os = S.compile (encodeUtf8 str) (no_utf8_check:utf8:os) {-# INLINE compile #-} -- | 'compileM' -- A safe version of 'compile' with failure lifted into an Either compileM :: Text -> [PCREOption] -> Either String Regex compileM str os = S.compileM (encodeUtf8 str) (no_utf8_check:utf8:os) {-# INLINE compileM #-} -- | 'match' -- -- Matches a compiled regular expression against a given subject string, -- using a matching algorithm that is similar to Perl's. If the subject -- string doesn't match the regular expression, 'Nothing' is returned, -- otherwise the portion of the string that matched is returned, along -- with any captured subpatterns. -- -- The arguments are: -- -- * 'regex', a PCRE regular expression value produced by compile -- -- * 'subject', the subject string to match against -- -- * 'options', an optional set of exec-time flags to exec. -- -- Available runtime options are: -- -- * 'anchored' - Match only at the first position -- -- * 'bsr_anycrlf' - '\\R' matches only CR, LF, or CRLF -- -- * 'bsr_unicode' - '\\R' matches all Unicode line endings -- -- * 'newline_any' - Recognize any Unicode newline sequence -- -- * 'newline_anycrlf' - Recognize CR, LF, and CRLF as newline sequences -- -- * 'newline_cr' - Set CR as the newline sequence -- -- * 'newline_crlf' - Set CRLF as the newline sequence -- -- * 'newline_lf' - Set LF as the newline sequence -- -- * 'notbol' - Subject is not the beginning of a line -- -- * 'noteol' - Subject is not the end of a line -- -- * 'notempty' - An empty string is not a valid match -- -- * 'no_utf8_check' - Do not check the subject for UTF-8 -- -- * 'partial' - Return PCRE_ERROR_PARTIAL for a partial match -- -- The result value, and any captured subpatterns, are returned. -- If the regex is invalid, or the subject string is empty, Nothing -- is returned. -- match :: Regex -> Text -> [PCREExecOption] -> Maybe [Text] match r subject os = case S.match r (encodeUtf8 subject) os of Nothing -> Nothing Just x -> Just (map decodeUtf8 x) {-# INLINE match #-} arbtt-0.7/src/Text/ParserCombinators/0000755000000000000000000000000012076570560016042 5ustar0000000000000000arbtt-0.7/src/Text/ParserCombinators/Parsec/0000755000000000000000000000000012076570560017257 5ustar0000000000000000arbtt-0.7/src/Text/ParserCombinators/Parsec/ExprFail.hs0000644000000000000000000001231112076570560021323 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.Parsec.Expr -- Copyright : (c) Daan Leijen 1999-2001 -- License : BSD-style (see the file libraries/parsec/LICENSE) -- -- Maintainer : daan@cs.uu.nl -- Stability : provisional -- Portability : portable -- -- A helper module to parse \"expressions\". -- Builds a parser given a table of operators and associativities. -- ----------------------------------------------------------------------------- module Text.ParserCombinators.Parsec.ExprFail ( Erring , Assoc(..), Operator(..), OperatorTable , buildExpressionParser ) where import Text.ParserCombinators.Parsec.Prim import Text.ParserCombinators.Parsec.Combinator import Control.Applicative ((<*>),(<$>)) type Erring a = Either String a ----------------------------------------------------------- -- Assoc and OperatorTable ----------------------------------------------------------- data Assoc = AssocNone | AssocLeft | AssocRight data Operator t st a = Infix (GenParser t st (a -> a -> Erring a)) Assoc | Prefix (GenParser t st (a -> Erring a)) | Postfix (GenParser t st (a -> Erring a)) type OperatorTable t st a = [[Operator t st a]] erringToParsec :: Erring a -> GenParser t st a erringToParsec = either fail return ----------------------------------------------------------- -- Convert an OperatorTable and basic term parser into -- a full fledged expression parser ----------------------------------------------------------- buildExpressionParser :: OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a buildExpressionParser operators simpleExpr = foldl (makeParser) simpleExpr operators where makeParser term ops = let (rassoc,lassoc,nassoc ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops rassocOp = choice rassoc lassocOp = choice lassoc nassocOp = choice nassoc prefixOp = choice prefix "" postfixOp = choice postfix "" ambigious assoc op= try $ do{ op; fail ("ambiguous use of a " ++ assoc ++ " associative operator") } ambigiousRight = ambigious "right" rassocOp ambigiousLeft = ambigious "left" lassocOp ambigiousNon = ambigious "non" nassocOp termP = do{ pre <- prefixP ; x <- term ; post <- postfixP ; erringToParsec (pre x) >>= erringToParsec . post } postfixP = postfixOp <|> return Right prefixP = prefixOp <|> return Right rassocP x = do{ f <- rassocOp ; y <- do{ z <- termP; rassocP1 z } ; erringToParsec (f x y) } <|> ambigiousLeft <|> ambigiousNon -- <|> return x rassocP1 x = rassocP x <|> return x lassocP x = do{ f <- lassocOp ; y <- termP ; erringToParsec (f x y) >>= rassocP1 } <|> ambigiousRight <|> ambigiousNon -- <|> return x lassocP1 x = lassocP x <|> return x nassocP x = do{ f <- nassocOp ; y <- termP ; ambigiousRight <|> ambigiousLeft <|> ambigiousNon <|> erringToParsec (f x y) } -- <|> return x in do{ x <- termP ; rassocP x <|> lassocP x <|> nassocP x <|> return x "operator" } splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix) = case assoc of AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix) AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix) AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix) splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,op:prefix,postfix) splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix) = (rassoc,lassoc,nassoc,prefix,op:postfix) arbtt-0.7/src/Graphics/0000755000000000000000000000000012076570560013221 5ustar0000000000000000arbtt-0.7/src/Graphics/Win32/0000755000000000000000000000000012076570560014123 5ustar0000000000000000arbtt-0.7/src/Graphics/Win32/Window/0000755000000000000000000000000012076570560015372 5ustar0000000000000000arbtt-0.7/src/Graphics/Win32/Window/Extra.hsc0000644000000000000000000001030112076570560017147 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Graphics.Win32.Window.Extra ( fetchWindowTitles , getForegroundWindow , getIdleTime ) where import Graphics.Win32.GDI.Types import System.Win32.Types import System.Win32.Process import System.Win32.File ( closeHandle ) import System.IO import Control.Exception ( bracket ) import Control.Monad import Foreign import Data.IORef #include type EnumWindowsProc = HWND -> LPARAM -> IO Bool foreign import ccall "wrapper" mkEnumWindowsProc :: EnumWindowsProc -> IO (FunPtr EnumWindowsProc) foreign import stdcall safe "windows.h EnumWindows" c_EnumWindows :: (FunPtr EnumWindowsProc) -> LPARAM -> IO Bool foreign import stdcall unsafe "windows.h GetWindowTextW" c_GetWindowText :: HWND -> LPWSTR -> Int -> IO Int foreign import stdcall unsafe "windows.h GetWindowTextLengthW" c_GetWindowTextLength :: HWND -> IO Int foreign import stdcall unsafe "windows.h GetForegroundWindow" c_GetForegroundWindow :: IO HWND foreign import stdcall unsafe "windows.h GetLastInputInfo" c_GetLastInputInfo :: Ptr LASTINPUTINFO -> IO Bool foreign import stdcall unsafe "windows.h GetTickCount" c_GetTickCount :: IO DWORD foreign import stdcall unsafe "windows.h GetWindowThreadProcessId" c_GetWindowThreadProcessId :: HWND -> LPDWORD -> IO DWORD foreign import stdcall unsafe "psapi.h GetProcessImageFileNameW" c_GetProcessImageFileName :: HANDLE -> LPTSTR -> DWORD -> IO DWORD foreign import stdcall unsafe "windows.h SetLastError" c_SetLastError :: DWORD -> IO () foreign import stdcall unsafe "windows.h IsWindowVisible" c_IsWindowVisible :: HWND -> IO Bool data LASTINPUTINFO = LASTINPUTINFO DWORD deriving (Show) instance Storable LASTINPUTINFO where sizeOf = const (#size LASTINPUTINFO) alignment = sizeOf poke buf (LASTINPUTINFO t) = do (#poke LASTINPUTINFO, cbSize) buf ((#size LASTINPUTINFO) :: UINT) (#poke LASTINPUTINFO, dwTime) buf t peek buf = do t <- (#peek LASTINPUTINFO, dwTime) buf return $ LASTINPUTINFO t fetchWindowTitles :: IO [(HWND, String,String)] fetchWindowTitles = do resultRef <- newIORef [] callback <- mkEnumWindowsProc $ \winh _ -> do v <- c_IsWindowVisible winh -- only consider visible windows if not v then return True else do proc <- alloca $ \pid_p -> do c_GetWindowThreadProcessId winh pid_p pid <- peek pid_p bracket (openProcess pROCESS_QUERY_INFORMATION False pid) closeHandle $ \ph -> allocaArray0 (#const MAX_PATH) $ \c_test -> do c_SetLastError (#const ERROR_SUCCESS) r <- c_GetProcessImageFileName ph c_test ((#const MAX_PATH)+1) err <- getLastError if r == 0 && err /= (#const ERROR_SUCCESS) then do hPutStrLn stderr $ "GetProcessImageFileName returned error " ++ show err ++ "." return "" else peekTString c_test len <- c_GetWindowTextLength winh str <- allocaArray0 len $ \c_test -> do c_SetLastError (#const ERROR_SUCCESS) r <- c_GetWindowText winh c_test (len+1) err <- getLastError if r == 0 && err /= (#const ERROR_SUCCESS) then do hPutStrLn stderr $ "GetWindowText returned error " ++ show err ++ "." return "" else peekTString c_test unless (str `elem` ["", "Default IME"]) $ do -- Ignore some windows by default modifyIORef resultRef ((winh,str,proc):) return True c_EnumWindows callback 0 readIORef resultRef getForegroundWindow :: IO HWND getForegroundWindow = c_GetForegroundWindow -- | Idle time in milliseconds getIdleTime :: IO Integer getIdleTime = with (LASTINPUTINFO 0) $ \lii_p -> do failIfFalse_ "GetLastInputInfo" $ c_GetLastInputInfo lii_p LASTINPUTINFO lii <- peek lii_p now <- c_GetTickCount return (fromIntegral (now - lii)) arbtt-0.7/src/Graphics/X11/0000755000000000000000000000000012076570560013572 5ustar0000000000000000arbtt-0.7/src/Graphics/X11/XScreenSaver.hsc0000644000000000000000000001757012076570560016653 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -------------------------------------------------------------------- -- | -- Module : Graphics.X11.XScreenSaver -- Copyright : (c) Joachim Breitner -- License : GPL2 -- -- Maintainer: Joachim Breitner -- 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 #include 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 arbtt-0.7/src/Capture/0000755000000000000000000000000012076570560013064 5ustar0000000000000000arbtt-0.7/src/Capture/Win32.hs0000644000000000000000000000120412076570560014317 0ustar0000000000000000module Capture.Win32 where import Data import qualified Data.MyText as T import Control.Monad import Control.Exception (bracket) import Control.Applicative import Data.Maybe import Data.Time.Clock import System.IO import Graphics.Win32.Window.Extra setupCapture :: IO () setupCapture = do return () captureData :: IO CaptureData captureData = do titles <- fetchWindowTitles foreground <- getForegroundWindow let winData = map ( \(h,t,p) -> (h == foreground, T.pack t, T.pack p) ) titles it <- fromIntegral `fmap` getIdleTime return $ CaptureData winData it arbtt-0.7/src/Capture/X11.hs0000644000000000000000000000565512076570560014004 0ustar0000000000000000module Capture.X11 where import Data import Graphics.X11 import Graphics.X11.Xlib.Extras import Control.Monad import Control.Exception (bracket) import System.IO.Error (catchIOError) import Control.Applicative import Data.Maybe import Data.Time.Clock import System.IO import qualified Data.MyText as T import System.Locale.SetLocale import Graphics.X11.XScreenSaver (getXIdleTime, compiledWithXScreenSaver) setupCapture :: IO () setupCapture = do unless compiledWithXScreenSaver $ hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver" loc <- supportsLocale unless loc $ hPutStrLn stderr "arbtt [Warning]: locale unsupported" dpy <- openDisplay "" xSetErrorHandler let rwin = defaultRootWindow dpy a <- internAtom dpy "_NET_CLIENT_LIST" False p <- getWindowProperty32 dpy a rwin when (isNothing p) $ do hPutStrLn stderr "arbtt: ERROR: No _NET_CLIENT_LIST set for the root window" closeDisplay dpy captureData :: IO CaptureData captureData = do dpy <- openDisplay "" xSetErrorHandler let rwin = defaultRootWindow dpy a <- internAtom dpy "_NET_CLIENT_LIST" False p <- getWindowProperty32 dpy a rwin wins <- case p of Just wins -> return (map fromIntegral wins) Nothing -> return [] (fsubwin,_) <- getInputFocus dpy fwin <- followTreeUntil dpy (`elem` wins) fsubwin winData <- forM wins $ \w -> (,,) (w == fwin) <$> (T.pack <$> getWindowTitle dpy w) <*> (T.pack <$> getProgramName dpy w) it <- fromIntegral `fmap` getXIdleTime dpy closeDisplay dpy return $ CaptureData winData it getWindowTitle :: Display -> Window -> IO String getWindowTitle dpy = myFetchName dpy getProgramName :: Display -> Window -> IO String getProgramName dpy = fmap resName . getClassHint dpy -- | Follows the tree of windows up until the condition is met or the root -- window is reached. followTreeUntil :: Display -> (Window -> Bool) -> Window -> IO Window followTreeUntil dpy cond = go where go w | cond w = return w | otherwise = do (r,p,_) <- queryTree dpy w if p == 0 then return w else go p -- | better than fetchName from X11, as it supports _NET_WM_NAME and unicode -- -- Code taken from XMonad.Managehook.title myFetchName :: Display -> Window -> IO String myFetchName d w = do let getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) `catchIOError` (\_ -> getTextProperty d w wM_NAME) extract prop = do l <- wcTextPropertyToTextList d prop return $ if null l then "" else head l bracket getProp (xFree . tp_value) extract `catchIOError` \_ -> return "" arbtt-0.7/doc/0000755000000000000000000000000012076570560011437 5ustar0000000000000000arbtt-0.7/doc/arbtt.xml0000644000000000000000000015126012076570560013302 0ustar0000000000000000
arbtt – The Automatic Rule-Base Time Tracker Joachim Breitner Main author of arbtt mail@joachim-breitner.de Sergey Astanin Contributor s.astanin@gmail.com Martin Kiefel Contributor mk@nopw.de Muharem Hrnjadovic Contributor muharem@linux.com arbtt is a background daemon that stores which windows are open, which one has the focus and how long since your last action (and possibly 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. 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. Installation Building with <command>cabal-install</command> arbtt comes in the form of a CabalizedCabal is the common software packaging for Haskell programs and libraries, see . package, and is available from hackage. The easiest way of obtaining and installing arbtt is via cabal-install. If you have cabal-install available, just run $ cabal install arbtt to download, build and install arbtt. Building without <command>cabal-install</command> You can fetch the latest arbtt source tarball from hackage, at . Extract the tarball and run the following commands to build and install the arbtt binaries: $ runhaskell Setup.hs configure $ runhaskell Setup.hs build $ runhaskell Setup.hs install Setting up the capture program To have arbtt gather useful data, you 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. By default, arbtt-capture will save one data sample per minute. If you want to change that, you can pass to arbtt-capture, where RATE specifies the sample rate in seconds. Building the documentation Obviously, you can already read the documentation. If you still want to build it yourself, enter the directory doc/ and run make for the documentation in HTML and PDF format. Development version If you want to try the latest unreleased state of the code, or want to contribute to arbtt, you can fetch the code with darcs get Configuring the arbtt categorizer (<command>arbtt-stats</command>) Once arbtt-capture is running, it will record data without any configuration. And only to analyze the recorded data, one needs to configure the categorizer. Everytime the categorizer (arbtt-stats) runs, it applies categorization rules to all recorded data and tags it accordingly. Thus, if you improve your categorization rules later, they will apply also to all previous data samples! Configuration example The configuration file needs to be placed in ~/.arbtt/categorize.cfg. An example is included in the source distribution, and it is reproduced here: see . It should be more enlightening than a formal description. <filename>categorize.cfg</filename> The semantics (informal) 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: the window title the program name whether the window was the active window Based on this information and on the rules in categorize.cfg, the categorizer (arbtt-stats) assigns tags to each sample. A simple rule consists of a condition followed by an arrow (==>) and a tag expression (tag keyword followed by tag name). The rule ends with a coma (,). The keyword tag, usually preceded with a condition, assigns a tag to the sample; tag keyword is followed by a tag name (any sequence of alphanumeric symbols, underscores and hyphens). If tag name contains a colon (:), the first part of the name before the colon, is considered to be tag category. For example, this rule month $date == 1 ==> tag month:January, if it succeeds, assigns a the tag January in the category month. If the tag has a category, it will only be assigned if no other tag of that category has been assigned. This means that for each sample and each category, there can be at most only one tag in that category. Tags can contain references to group matches in the regular expressions used in conditions ($1, $2)...). Tags can also reference some variables such as window title ($current.title) or program name ($current.program). The variable $idle contains the idle time of the user, measured in seconds. Usually, it is used to assign the tag inactive, which is handled specially by arbtt-stats, as can be seen in . When applying the rules, the categorizer has a notion of the window in scope, and the variables $title, $program and $active always refer to the window in scope. By default, there is no window is in scope. Condition should be prefixed with either current window or any window, to define scope of these variables. For current window, the currently active window is in scope. If there is no such window, the condition is false. For any window, the condition is applied to each window, in turn, and if any of the windows matches, the result is true. If more than one window matches it is not defined from which match the variables $1... are taken from (see more about regular expressions below). The variable $time refers to the time-of-day of the sample (i.e. the time since 00:00 that day, local time), while $sampleage refers to the time span from when the sample was recored until now, the time of evaluating the statistics. The latter variable is especially useful when passed to the option of arbtt-stats. They can be compared with expressions like "hh:mm", for example $time >= 8:00 && $time < 12:00 ==> tag time-of-day:morning The variable $date referes to the date and time of the recorded sample. It can be compared with date literals in the form YYYY-MM-DD (which stand for midnight, so $date == 2001-01-01 will not do what you want, but $date >= 2001-01-01 && $date <= 2001-01-02 would). All dates are evaluated in local time. Expression format $date evaluates to a string with a date formatted according to ISO 8601, i.e. like "YYYY-MM-DD". The 19th of March 2010 is formatted as "2010-03-19". Formatted date can be compared to strings. Formatted dates may be useful to tag particular date ranges. But also note that this is a rather expensive operation that can slow down your data processing. Expression month $date evaluates to an integer, from 1 to 12, corresponding to the month number. Expression year $date evaluates to an integer which is a year number. Expression day of month $date evaluates to an integer, from 1 to 31, corresponding to the day of month. Expression day of week $date evaluates to an integer, from 1 to 7, corresponding to the day of week, Monday is 1, Sunday is 7. These expressions can be compared to integers. Expressions can be compared to literal values with == (equal), /= (not equal), <, <=, >=, > operators. String expressions ($program, $title) can be matched against regular expressions with =~ operator. With these operatorions, the right hand side can be a comma-separated list of literals enclosed in square brackets ([ ..., ..., ]), which succeeds if any of them succeeds. Regular expressions are written either between slashes (/ regular expression /), or after a letter m followed by any symbol (m c regular expression c, where c is any symbol). The second appearance of that symbol ends the expression. You can find both variants in . Complex conditions may be constructed from the simpler ones, using Boolean AND (&&), OR (||), and NOT (!) functions and parentheses. The syntax categorize.cfg is a plain text file. Whitespace is insignificant and Haskell-style comments are allowed. A formal grammar is provided in .
The formal grammar of <filename>categorize.cfg</filename> Rules [ ] ( (, )* | ( ; )* ) AliasSpec aliases ( (, )* ) Alias Literal -> Literal Rule { } ==> | if then else tag Cond ( ) ! | && | || $active [ ] =~ =~ [ ] current window any window String $title $program format " string literal " ListOfString " string literal " " string literal " , Number $idle day of week day of month month year number literal Date $date TimeDiff $time $sampleage [ Digit ] Digit : Digit Digit Tag [ Literal : ] Literal RegEx / Literal / | m c Literal cWhere c can be any character. ListOfRegex " " " " , CmpOp <= | < | == | > | >=
A String refers to a double-quoted string of characters, while a Literal is not quoted. Tags may only consist of letters, dashes and underscores, or variable interpolations. A Tag maybe be optionally prepended with a category, separated by a colon. The category itself follows he same lexical rules as the tag. A variable interpolation can be one of the following: $1, $2,... will be replaced by the respective group in the last successfully applied regular expression in the conditions enclosing the current rule. $current.title $current.program will be replaced by title the currently active window, resp. by the name of the currently active program. If no window happens to be active, this tag will be ignored. A regular expression is, like in perl, either enclosed in forward slashes or, alternatively, in any character of your choice with an m (for match) in front. This is handy if you need to use regular expressions that match directory names. Otherwise, the syntax of the regular expressions is that of perl-compatible regular expressions. Program references arbtt consists of a few command line tools, the most important one is arbtt-stats. This overview is followed by their manual pages. To generate statistics about the data that arbtt-capture has gathered, use the program arbtt-stats. A detailed description of the possible options is given in . The collection of data is done by arbtt-capture. Usually, you only set it up once to run automatically, as described in , and do not have to worry about it again. Its command line reference is given in . Because the data log file is binary, a tool names arbtt-dump can bee used to dump the data in textual form. Its command line reference is given in . If arbtt-capture crashes it might be that the log file is not readable any more. In some cases, this can be fixed using the (relatively raw) arbtt-recover tool. Its command line reference is given in . arbtt-stats 1 arbtt manual arbtt-stats generate statistics from the arbtt data samples arbtt-stats OPTION Description arbtt-stats reads the samples that were recorded so far by arbtt-capture from the log file, filters them according to the users specifications and generates one or more reports from the data. When run without any options, is assumed. The order in which filters (, , and ) and reports are passed to the program is irrelevant: All filters given on the command line are active for all reports. Options shows a short summary of the available options, and exists. shows the version number, and exists. FILE logfile to use instead of ~/.arbtt/capture.log categorize file to use instead of ~/.arbtt/categorize.cfg Filtering options TAG TAG Ignore any data samples that have been assigned this tag or category. To distinguish tags and categories, the latter have to be entered followed by a colon. Can be given more than once. TAG TAB 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. by default, arbtt-stats ignores any samples which have been assigned the tag inactive. This flag disables this behaviour. CONDITION CONDITION Only consider samples matching the given condition, which follows the same syntax as in categorize.cfg (Nonterminal in the formal grammar specification found in the user guide). Report options PERCENTAGE PERCENTAGE Ignore tags whose percentage is less than the value specified here. Default percentage: 1%. TAG Skip this tag or category when printing statistics. Only affects the reports and . To distinguish tags and categories, the latter have to be entered followed by a colon. Can be given more than once. TAG Prints statistics only for the specified tag or category. Only affects the reports and . To distinguish tags and categories, the latter have to be entered followed by a colon. Can be given more than once. FORMAT Specify the report output format, may be one of: text, csv (comma-separated values), tsv (TAB-separated values). Default format: text. Reports Various bits of information about the recorded data, such as total time recorded, number of records etc. In this report, time recorded is the sum of all samples, including inactive and those that are disabled by the filter, while time selected is the sum of the samples that are matched by the given filters. For all tags, print the part of the selected time with this tag applied to, both as an absolute value and a percentage of the selected time. CATEGORY CATEGORY For the given category, give the textual equivalent of a pie chart: For each possible value of the category, including one for no tag of this category present, give the absolute time and fraction. Entries which are not displayed because of the option are aggregated. This is just a shortcut for a series of options, one for each category found in the data. [TAG|CATEGORY:] This report lists all periods of consecutive time intervals where the given tag has been applied to, or where the given category has the same value. To distinguish tags and categories, the latter have to be entered followed by a colon. This report will give wrong results if an activity has been carried out at the end of a session and right at the beginning, as the intermediate time is thought to be part of the interval. Inactive times while arbtt-capture is running will separate the results as expected. Examples Some useful examples of what you can do with arbtt-stats are provided here: # 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 arbtt-stats -o Program:evolution -c Evo-Folder # Generate statistics about the last hour arbtt-stats -f '$sampleage < 1:00' Files ~/.arbtt/capture.log binary file, storing the arbtt data samples ~/.arbtt/categorize.cfg specification of the arbtt categorizer syntax. A detailed description is given in See also See the arbtt manual for more information and the arbtt hackage page for newer versions of arbtt. arbtt-capture 1 arbtt manual arbtt-capture collect data samples for arbtt arbtt-capture OPTION Description arbtt-capture runs continuously and saves at the given sample rate, usually once per minute, the collected data to ~/.arbtt/capture.log. Options shows a short summary of the available options, and exists. shows the version number, and exists. RATE RATE sets the sample rate in seconds (default: 60) FILE FILE logfile to use instead of ~/.arbtt/capture.log Files ~/.arbtt/capture.log binary file, storing the arbtt data samples See also See the arbtt manual for more information and the arbtt hackage page for newer versions of arbtt. arbtt-dump 1 arbtt manual arbtt-dump dumps arbtt data samples arbtt-dump OPTION Description arbtt-dump reads the data samples recorded by and writes them so the standard output in an ascii based format. Options shows a short summary of the available options, and exists. shows the version number, and exists. FILE FILE logfile to use instead of ~/.arbtt/capture.log Files ~/.arbtt/capture.log binary file, storing the arbtt data samples See also See the arbtt manual for more information and the arbtt hackage page for newer versions of arbtt. arbtt-import imports dumped arbtt data samples arbtt-import OPTION Description arbtt-import expects the output of arbtt-dump on the standard input and saves them as the logfile or the specified file. This program would completely override the existing file, therefore it will refuse to work if the log file already exists. If you want to overwrite a file, please delete it before running arbtt-import. Options shows a short summary of the available options, and exists. shows the version number, and exists. FILE FILE logfile to use instead of ~/.arbtt/capture.log Files ~/.arbtt/capture.log binary file, storing the arbtt data samples See also See the arbtt manual for more information and the arbtt hackage page for newer versions of arbtt. arbtt-recover 1 arbtt manual arbtt-recover tries to recover a broken arbtt data log arbtt-recover OPTION Description arbtt-recover tries to readsthe data samples recorded by , skipping over possible broken entries. A fixed log file is written to ~/.arbtt/capture.log.recovered. If the recovery was successful, you should stop arbtt-capture and move the file to ~/.arbtt/capture.log. As a sid effect, arbtt-recover 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 arbtt-recover is recommended. Options shows a short summary of the available options, and exists. shows the version number, and exists. logfile to use instead of ~/.arbtt/capture.log where to save the recovered file, instead of ~/.arbtt/capture.log Files ~/.arbtt/capture.log binary file, storing the arbtt data samples ~/.arbtt/capture.log.recovered binary file, storing the fixed arbtt data samples See also See the arbtt manual for more information and the arbtt hackage page for newer versions of arbtt. Troubleshooting arbtt and xmonad If you are using the xmonad window manager and arbtt does ont record any windows, ensure that your xmonad configuration includes the EWMH-Hints extensions in the module XMonad.Hooks.EwmhDesktops. Copyright and Contact arbtt is Copyright © 2009-2010 Joachim Breitner arbtt does not have a bug tracker yet. If you have bug reports, suggestions or questions, please send an email to the arbtt mailing list at arbtt@lists.nomeata.de, which you can subscribe at http://lists.nomeata.de/mailman/listinfo/arbtt. arbtt License 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., 675 Mass Ave, Cambridge, MA 02139, USA. Release Notes The version history with changes relevant for the user are documented here. Version 0.7 Make sure that the log file is only readable by the current user. Thanks to Joey Hess for pointing that out. Show a progress bar in arbtt-stats. GHC-7.6 compatibility, thanks to Isaac Dupree. Version 0.6.4.1 Added missing module to the packages. Version 0.6.4 Massive memory footprint reduction, due to processing the data in one run. See my blog post for technical information. Version 0.6.3 Performance improvements. Support comparing a string to a list of strings, or matching it against a list ofregular expressions. Version 0.6.2 Add a warning whtn the system locale is not supported. Allwo RTS options to be passed to the arbtt binaries. GHC 7.4 compatibility. Version 0.6.1 Performance improvements. Version 0.6 The command arbtt-capture now supports the . New report “intervals”, available using arbtt-stats . The paramters and of arbtt-stats can match categories as well as tags. Bugfix: Numbers in tag names are no longer replaced by an underscore. New paramters and of arbtt-stats. Version 0.5 (The ZuriHac-Release) New command arbtt-import, which imports the output from arbtt-dump. The command arbtt-stats now supports the and as well. () The command arbtt-stats now supports the csv (comma-separated values) and tsv (TAB-separated values) report output formats in addition to text. () Unicode is handled correctly in regular expressions. Improved date-handling functions for categorize.cfg. () Version 0.4.5.1 Bugfix: Added missing modules to the cabal file. Version 0.4.5 Implement a custom compression method greatly reduce the file size of the log file. Run arbtt-capture to compress the previous samples as well. Version 0.4.4 Bugfix: Correctly parse a tag name containing a colon when passed to arbtt-stats . Bugfix: Only warn once when the _NET_CLIENT_LIST X property is not set for the root window. Version 0.4.3 Use fetchName from xmonad instead of xFetchName, as it works with unicode characters in window titles. Version 0.4.2 Implement option to arbtt-dump. New command arbtt-recover to rescue data from a proken data log file. Actually include this documentation in the released tarball. Version 0.4.1 Write this documentation Drop dependency on setlocale: Copy the SetLocale module. Drop dependency on tabular: Implement custom table rendering code. In the absence of _NET_CLIENT_LIST, look for application windows as children of the root windows. This should work for users of window managers like i3 without EWHM support. Version 0.4 Implement option to arbtt-stats Eliminate one possible cause for crashes of arbtt-capture. Version 0.3.0 Switch to binary log file format, for greatly increased speed arbtt-capture will automatically detect and convert log files in the old format. Version 0.2.0 Add option to arbtt-stats Add option to arbtt-capture Introduce time-base variables $time and $sampleage Version 0.1.5 Use setlocale to get umlauts in window titles correctly Version 0.1.4 Be smarter when figuring out what window is active. Thanks to CJ van den Berg for investigating the issue. Version 0.1.3 Read _NET_CLIENT_LIST for the list of applications, for compatibility with window managers such as metacity Version 0.1.2 Off-By-Ten error in the time display Correctly show total number of records in Version 0.1.1 Rename files to allow building on MacOS. Version 0.1 Initial release of arbtt
arbtt-0.7/doc/fptools.css0000644000000000000000000000147212076570560013643 0ustar0000000000000000div { font-family: sans-serif; color: black; background: white } h1, h2, h3, h4, h5, h6, p.title { color: #005A9C } h1 { font: 170% sans-serif } h2 { font: 140% sans-serif } h3 { font: 120% sans-serif } h4 { font: bold 100% sans-serif } h5 { font: italic 100% sans-serif } h6 { font: small-caps 100% sans-serif } pre { font-family: monospace; border-width: 1px; border-style: solid; padding: 0.3em } pre.screen { color: #006400 } pre.programlisting { color: maroon } div.example { margin: 1ex 0em; border: solid #412e25 1px; padding: 0ex 0.4em } div.example, div.example-contents { background-color: #fffcf5 } a:link { color: #0000C8 } a:hover { background: #FFFFA8 } a:active { color: #D00000 } a:visited { color: #680098 } arbtt-0.7/doc/Makefile0000644000000000000000000000217612076570560013105 0ustar0000000000000000all: html man XSLTPROC=xsltproc XSLTPROC_HTML_OUTDIR=users_guide/ XSLTPROC_HTML_CSS=fptools.css XSLTPROC_HTML_PARAMS=\ --stringparam use.id.as.filename 1 \ --stringparam base.dir $(XSLTPROC_HTML_OUTDIR) \ --stringparam html.stylesheet $(XSLTPROC_HTML_CSS) XSLTPROC_HTML_STYLESHEET=/usr/share/xml/docbook/stylesheet/nwalsh/xhtml/profile-chunk.xsl XSLTPROC_MAN_STYLESHEET=/usr/share/xml/docbook/stylesheet/nwalsh/manpages/profile-docbook.xsl XSLTPROC_MAN_OUTDIR=man/ XSLTPROC_MAN_OPTIONS=--stringparam man.output.in.separate.dir 1 --stringparam man.output.base.dir # build targets # .PHONY: man html pdf man: $(XSLTPROC) --xinclude --stringparam profile.condition man $(XSLTPROC_MAN_OPTIONS) $(XSLTPROC_MAN_OUTDIR) $(XSLTPROC_MAN_STYLESHEET) arbtt.xml html: $(XSLTPROC) --xinclude --stringparam profile.condition html $(XSLTPROC_HTML_PARAMS) $(XSLTPROC_HTML_STYLESHEET) arbtt.xml cp $(XSLTPROC_HTML_CSS) $(XSLTPROC_HTML_OUTDIR) pdf: #dblatex -tpdf arbtt.xml fop -xml arbtt.xml -xsl /usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl -pdf arbtt.pdf # auxiliary targets # .PHONY: clean clean: -rm -rf users_guide/ man/ arbtt.pdf