arbtt-0.9.0.13/0000755000000000000000000000000013074765620011256 5ustar0000000000000000arbtt-0.9.0.13/setup.iss0000644000000000000000000000471113074765620013141 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.9.0.13/Setup.hs0000644000000000000000000000241313074765620012712 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.9.0.13/modpath.iss0000644000000000000000000001172213074765620013435 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.9.0.13/arbtt-capture.desktop0000644000000000000000000000033313074765620015425 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.9.0.13/LICENSE0000644000000000000000000004311013074765620012262 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.9.0.13/categorize.cfg0000644000000000000000000001154513074765620014101 0ustar0000000000000000-- -*- mode: haskell; -*- -- Comments in this file use the Haskell syntax: -- A "--" comments the rest of the line. -- A set of {- ... -} comments out a group of lines. -- This defines some aliases, to make the reports look nicer: aliases ( "sun-awt-X11-XFramePeer" -> "java", "sun-awt-X11-XDialogPeer" -> "java", "sun-awt-X11-XWindowPeer" -> "java", "gramps.py" -> "gramps", "___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, -- Another simple rule, just tags the current desktop (a.k.a. workspace) tag Desktop:$desktop, -- I'd like to know what evolution folders I'm working in. But when sending a -- mail, the window title only contains the (not very helpful) subject. So I do -- not tag necessarily by the active window title, but the title that contains -- 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.9.0.13/README.md0000644000000000000000000001125413074765620012540 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 of the User’s Guide](http://darcs.nomeata.de/arbtt/doc/users_guide/) Beware that this will also reflect the latest development version. Development ----------- You are very welcome to help the developement of arbtt. You can find the latest source at the darcs repository at http://darcs.nomeata.de/arbtt Git mirrors are available at * http://git.nomeata.de/?p=darcs-mirror-arbtt.git * https://github.com/nomeata/darcs-mirror-arbtt * https://bitbucket.org/nomeata/arbtt User and Developer discussion happens on the arbtt mailing list: arbtt@lists.nomeata.de To subscribe to the list, visit: http://lists.nomeata.de/mailman/listinfo/arbtt The issue tracker is hosted on bitbucket: https://bitbucket.org/nomeata/arbtt/issues Why Bitbucket and not GitHub? Why not, and we need diversitiy even in the cloud! (Don’t worry, you can use your GitHub account there.) Some of my plans or ideas include: * A graphical viewer that allows you to expore the tags in an appealing, interactive way. Possibly based on the Charts haskell library. * Looking forward and backwards in time when writing rules. (Information is already passed to the categorizing function, but not exposed to the syntax). * `$total_idle` time, which is the maximum idle time until it is reset. This would allow the user to catch the idle times more exactly. * Rules based on time of day, to create tags for worktime, weekend, late at night. (Partially done) * Storing the current timezone in the tags, for the prevoius entry to be more to be more useful. * Storing the hostname, in case a user has several. * Statistics based on time, to visualize trends. * Possibly more data sources? Any help cleaning, documenting or testing the current code is appreciated as well. Creating the Windows Installer ------------------------------ The file `setup.iss` contains an installer script for Inno Setup and can be used to create the windows installer for arbtt. It can be used under wine. To build arbtt under Windows, you need to install the Haskell Platform. Because the Haskell Platform ships an older version of the w32api package from mingw, you also need to download `w32api-3.14-mingw32-dev.tar.gz` and copy at least the files `include/psapi.h` and `lib/libpsapi.a` over the files installed by the Haskell Platform. For the `pcre-light` package, you need to install the `pcre` library. Unless you run a German version of Windows, you’ll need to adjust the path to the `pcre3.dll` file in `setup.iss`. Install `Inno Setup`. Create the documentation (`make -C doc`) and configure arbtt with the `--with-ISCC-flag`: $ wine runhaskell Setup.hs configure --with-ISCC='C:\Programme\Inno Setup 5\ISCC.exe' again adjusting the path if you do not have a German version of Windows. This will put the version name into `setup.iss` and create the output file as `dist/arbtt-setup-.exe.` Download links: * http://hackage.haskell.org/platform/2009.2.0.2/HaskellPlatform-2009.2.0.2-setup.exe * http://sourceforge.net/projects/mingw/files/MinGW%20API%20for%20MS-Windows/ * http://gnuwin32.sourceforge.net/downlinks/pcre.php * http://www.jrsoftware.org/download.php/is-unicode.exe arbtt-0.9.0.13/arbtt.cabal0000644000000000000000000001640113074765620013360 0ustar0000000000000000name: arbtt version: 0.9.0.13 license: GPL license-file: LICENSE category: Desktop cabal-version: >= 1.10 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. . The documentation, which includes the changelog, can also be found at . . 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://arbtt.nomeata.de/ bug-reports: https://bitbucket.org/nomeata/arbtt/issues extra-source-files: categorize.cfg, arbtt-capture.desktop, README.md, doc/arbtt.xml, doc/fptools.css, doc/Makefile, setup.iss, modpath.iss, tests/*.log, tests/*.out, tests/*.in, tests/*.cfg flag old-locale description: If false then depend on time >= 1.5. . If true then depend on time < 1.5 together with old-locale. default: False executable arbtt-capture main-is: capture-main.hs hs-source-dirs: src build-depends: base >= 4.7 && < 4.10, filepath, directory, transformers, utf8-string, aeson >= 0.6 && < 1.3, binary >= 0.5, bytestring, deepseq if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup Capture TimeLog UpgradeLog1 LeftFold ghc-options: -rtsopts if !os(windows) build-depends: unix 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 if os(darwin) cpp-options: -DDARWIN frameworks: Foundation Carbon IOKit other-modules: Capture.OSX Graphics.OSX.Window System.Locale.SetLocale else extra-libraries: Xss other-modules: Capture.X11 Graphics.X11.XScreenSaver System.Locale.SetLocale build-depends: X11 > 1.4.4 default-language: Haskell98 executable arbtt-stats main-is: stats-main.hs hs-source-dirs: src build-depends: base >= 4.7 && < 4.10, parsec == 3.*, containers == 0.5.*, pcre-light, binary >= 0.5, deepseq, bytestring, utf8-string, strict, transformers, directory, filepath, aeson >= 0.6 && < 1.3, array == 0.4.* || == 0.5.*, terminal-progress-bar, bytestring-progress if !os(windows) build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 other-modules: Data Data.MyText Data.Binary.StringRef DumpFormat LeftFold 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 default-language: Haskell98 executable arbtt-dump main-is: dump-main.hs hs-source-dirs: src build-depends: base >= 4.7 && < 4.10, parsec == 3.*, containers == 0.5.*, aeson >= 0.6 && < 1.3, array == 0.4.* || == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string, strict, transformers, directory, filepath if !os(windows) build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 other-modules: Data Data.MyText Data.Binary.StringRef CommonStartup TimeLog DumpFormat Data.List.TakeR ghc-options: -rtsopts if os(windows) cpp-options: -DWIN32 else other-modules: System.Locale.SetLocale default-language: Haskell98 executable arbtt-import main-is: import-main.hs hs-source-dirs: src build-depends: base >= 4.7 && < 4.10, parsec == 3.*, containers == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string, strict, transformers, directory, filepath if !os(windows) build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 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 default-language: Haskell98 executable arbtt-recover main-is: recover-main.hs hs-source-dirs: src build-depends: base >= 4.7 && < 4.10, containers == 0.5.*, binary >= 0.5, deepseq, bytestring, utf8-string, directory, filepath if !os(windows) build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 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 default-language: Haskell98 test-suite test Type: exitcode-stdio-1.0 Hs-source-dirs: tests src Main-is: test.hs other-modules: Categorize Data Data.Binary.StringRef Data.MyText Text.Parsec.ExprFail Text.Regex.PCRE.Light.Text TimeLog Build-depends: base >= 4.7 && < 4.10 , tasty >= 0.7 && < 0.12 , tasty-golden >= 2.2.0.2 && < 2.4 , tasty-hunit >= 0.2 && < 0.11 , process-extras >= 0.2 && < 0.8 , deepseq , binary >= 0.5 , bytestring , utf8-string , directory , parsec == 3.* , containers == 0.5.* , pcre-light , transformers if !os(windows) build-depends: unix if flag(old-locale) build-depends: time == 1.4.*, old-locale else build-depends: time >= 1.5 default-language: Haskell98 source-repository head type: darcs location: http://darcs.nomeata.de/arbtt arbtt-0.9.0.13/doc/0000755000000000000000000000000013074765620012023 5ustar0000000000000000arbtt-0.9.0.13/doc/Makefile0000644000000000000000000000217613074765620013471 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 arbtt-0.9.0.13/doc/fptools.css0000644000000000000000000000147213074765620014227 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.9.0.13/doc/arbtt.xml0000644000000000000000000025717413074765620013701 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 Waldir Pimenta Documentation writer waldir@email.com Gwern Branwen Documentation writer gwern@gwern.net 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. It is comparable to the window trackers RescueTime, selfspy, TimeSnapper, and Productive Peach; but it differs from the manual timetrackers like Project Hamster which require the user to type a description of their activities. 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, the name of the current workspace 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. The name of the current desktop (or workspace) is available as $desktop. 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 $desktop 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. Effective Use of Arbtt Now that the syntax has been described and the toolbox laid out, how do you practically go about using and configuring arbtt? Enabling data collection After installing arbtt, you need to configure it to run. There are many ways you can run the arbtt-capture daemon. One standard way is to include the command arbtt-capture & in your desktop environments startup script, e.g. ~/.xinitrc or similar. Another trick is add it as a cron job. To do so, edit your crontab file (crontab -e) and add a line like this: DISPLAY=:0 @reboot arbtt-capture --logfile=/home/username/doc/arbtt/capture.log At boot, arbtt-capture will be run in the background and will capture a snapshot of the X metadata for active windows every 60 seconds (the default). If you want more fine-grained time data at the expense of doubling storage use, you could increase the sampling rate with an option like --sample-rate=30. To be resilient to any errors or segfaults, you could also wrap it in an infinite loop to restart the daemon should it ever crash, with a command like DISPLAY=:0 @reboot while true; do arbtt-capture --sample-rate=30; sleep 1m; done Checking data availability arbtt tracks X properties like window title, class, and running program, and you write rules to classify those strings as you wish; but this assumes that the necessary data is present in those properties. For some programs, this is the case. For example, web browsers like Firefox typically set the X title to the HTML <title> element of the web page in the currently-focused tab, which is enough for classification. Some programs have title-setting available as plugins. The IRC client irssi in a GNU screen or X terminal usually sets the title to just "irssi", which blocks more accurate time-classification based on IRC channel (one channel may be for recreation, another for programming, and yet another for work), but can be easily configured to set the title using the extension title.pl. Some programs do not set titles or class, and all arbtt sees is empty strings like ""; or they may set the title/class to a constant like "Liferea", which may be acceptable if that program is used for only one purpose, but if it is used for many purposes, then you cannot write a rule matching it without producing highly-misleading time analyses. (For example, a web browser may be used for countless purposes, ranging from work to research to music to writing to programming; but if the web browser's title/class were always just "Web browser", how would you classify 5 hours spent using the web browser? If the 5 hours are classified as any or all of those purposes, then the results will be misleading garbage - you probably did not spend 5 hours just listening to music, but a mixture of those purposes, which changes from day to day.) You should check for such problematic programs upon starting using arbtt. It would be unfortunate if you were to log for a few months, go back for a detailed report for some reason, and discover that the necessary data was never available for arbtt to log! These programs can sometimes be customized internally, a bug report filed with the maintainers, or their titles can be externally set by wmctrl or xprop. <literal>xprop</literal> You can check the X properties of a running window by running the command xprop and clicking on the window; xprop will print out all the relevant X information. For example, the output for Emacs might look like this $ xprop | tail -5 WM_CLASS(STRING) = "emacs", "Emacs" WM_ICON_NAME(STRING) = "emacs@elan" _NET_WM_ICON_NAME(UTF8_STRING) = "emacs@elan" WM_NAME(STRING) = "emacs@elan" _NET_WM_NAME(UTF8_STRING) = "emacs@elan" This is not very helpful: it does not tell us the filename being edited, the mode being used, or anything. You could classify time spent in Emacs as "programming" or "writing", but this would be imperfect, especially if you do both activities regularly. However, Emacs can be customized by editing ~/.emacs, and after some searching with queries like "setting Emacs window title", the Emacs wiki and manual advise us to put something like this Elisp in our .emacs file: (setq frame-title-format "%f") Now the output looks different: $ xprop | tail -5 WM_CLASS(STRING) = "emacs", "Emacs" WM_ICON_NAME(STRING) = "/home/gwern/arbtt.page" _NET_WM_ICON_NAME(UTF8_STRING) = "/home/gwern/arbtt.page" WM_NAME(STRING) = "/home/gwern/arbtt.page" _NET_WM_NAME(UTF8_STRING) = "/home/gwern/arbtt.page" With this, we can usefully classify all such time samples as being “writing”: current window $title == "/home/gwern/arbtt.page" ==> tag Writing, Another common gap is terminals/shells: they often do not include information in the title like the current working directory or last shell command. For example, urxvt/Bash: WM_COMMAND(STRING) = { "urxvt" } _NET_WM_ICON_NAME(UTF8_STRING) = "urxvt" WM_ICON_NAME(STRING) = "urxvt" _NET_WM_NAME(UTF8_STRING) = "urxvt" WM_NAME(STRING) = "urxvt" Programmers may spend many hours in the shell doing a variety of things (like Emacs), so this is a problem. Fortunately, this is also solvable by customizing one's .bashrc to set the prompt to emit an escape code interpreted by the terminal (baroque, but it works). The following will include the working directory, a timestamp, and the last command: trap 'echo -ne "\033]2;$(pwd); $(history 1 | sed "s/^[ ]*[0-9]*[ ]*//g")\007"' DEBUG Now the urxvt samples are useful: _NET_WM_NAME(UTF8_STRING) = "/home/gwern/wiki; 2014-09-03 13:39:32 arbtt-stats --help" Some distributions (e.g. Debian) already provide the relevant configuration for this to happen. If it does not work for you, you can try to add . /etc/profile.d/vte.sh to your ~/.bashrc. A rule could classify based on the directory you are working in, the command one ran, or both. Other shells like zsh can be fixed this way too but the exact command may differ; you will need to research and experiment. Some programs can be tricky to set. The X image viewer feh has a --title option but it cannot be set in the configuration file, .config/feh/themes, because it needs to be specified dynamically; so you need to set up a shell alias or script to wrap the command like feh --title "$(pwd) / %f / %n". Raw samples xprop can be tedious to use on every running window and you may forget to check seldomly used programs. A better approach is to use arbtt-stats’s --dump-samples option: this option will print out the collected data for specified time periods, allowing you to examine the X properties en masse. This option can be used with the --exclude= option to print the samples for samples not matched by existing rules as well, which is indispensable for improving coverage and suggesting ideas for new rules. A good way to figure out what customizations to make is to run arbtt as a daemon for a day or so, and then begin examining the raw samples for problems. An initial configuration session An example: suppose I create a simple category file named foo with just the line $idle > 30 ==> tag inactive I can then dump all my arbtt samples for the past day with a command like this: arbtt-stats --categorizefile=foo --m=0 --filter='$sampleage <24:00' --dump-samples Because there are so many open windows, this produces a large amount (26586 lines) of hard-to-read output: ... ( ) Navigator: /r/Touhou's Favorite Arranges! Part 71: Retribution for the Eternal Night ~ Imperishable Night : touhou - Iceweasel ( ) Navigator: Configuring the arbtt categorizer (arbtt-stats) - Iceweasel ( ) evince: ATTACHMENT02 ( ) evince: 2009-geisler.pdf — Heart rate variability predicts self-control in goal pursuit ( ) urxvt: /home/gwern; arbtt-stats --categorizefile=foo --m=0 --filter='$sampleage <24:00' --dump-samples ( ) mnemosyne: Mnemosyne ( ) urxvt: /home/gwern; 2014-09-03 13:11:45 xprop ( ) urxvt: /home/gwern; 2014-09-03 13:42:17 history 1 | cut --delimiter=' ' --fields=5- ( ) urxvt: /home/gwern; 2014-09-03 13:12:21 git log -p .emacs (*) emacs: emacs@elan ( ) urxvt: /home/gwern; 2014-09-01 14:50:30 while true; do cd ~/ && getmail_fetch --ssl pop.gmail.com gwern0 'ugaozoumbhwcijxb' ./mail/; done ( ) urxvt: /home/gwern/blackmarket-mirrors/silkroad2-forums; 2014-08-31 23:20:10 mv /home/gwern/cookies.txt ./; http_proxy="localhost:8118" wget... ( ) urxvt: /home/gwern/blackmarket-mirrors/agora; 2014-08-31 23:15:50 mv /home/gwern/cookies.txt ./; http_proxy="localhost:8118" wget --mirror ... ( ) urxvt: /home/gwern/blackmarket-mirrors/evolution-forums; 2014-08-31 23:04:10 mv ~/cookies.txt ./; http_proxy="localhost:8118" wget --mirror ... ( ) puddletag: puddletag: /home/gwern/music Active windows are denoted by an asterisk, so I can focus & simplify by adding a pipe like | fgrep '(*)', producing more manageable output like (*) urxvt: irssi (*) urxvt: irssi (*) urxvt: irssi (*) Navigator: Pyramid of Technology - NextNature.net - Iceweasel (*) Navigator: Search results - gwern0@gmail.com - Gmail - Iceweasel (*) Navigator: [New comment] The Wrong Path - gwern0@gmail.com - Gmail - Iceweasel (*) Navigator: Iceweasel (*) Navigator: Litecoin Exchange Rate - $4.83 USD - litecoinexchangerate.org - Iceweasel (*) Navigator: PredictionBook: LiteCoin will trade at >=10 USD per ltc in 2 years, - Iceweasel (*) urxvt: irssi (*) Navigator: Bug#691547 closed by Mikhail Gusarov <dottedmag@dottedmag.net> (Re: s3cmd: Man page: --default-mime-type documentation incomplete...) (*) Navigator: Bug#691547 closed by Mikhail Gusarov <dottedmag@dottedmag.net> (Re: s3cmd: Man page: --default-mime-type documentation incomplete...) (*) Navigator: Bug#691547 closed by Mikhail Gusarov <dottedmag@dottedmag.net> (Re: s3cmd: Man page: --default-mime-type documentation incomplete...) (*) urxvt: /home/gwern; 2014-09-02 14:25:17 man s3cmd (*) evince: bayesiancausality.pdf (*) evince: bayesiancausality.pdf (*) puddletag: puddletag: /home/gwern/music (*) puddletag: puddletag: /home/gwern/music (*) evince: bayesiancausality.pdf (*) Navigator: ▶ Umineko no Naku Koro ni Music Box 4 - オルガン小曲 第2億番 ハ短調 - YouTube - Iceweasel ... This is better. We can see a few things: the windows all now produce enough information to be usefully classified (Gmail can be classified under email, irssi can be classified as IRC, the urxvt usage can clearly be classified as programming, the PDF being read is statistics, etc) in part because of customizations to bash/urxvt. The duplication still impedes focus, and we don't know what's most common. We can use another pipeline to sort, count duplicates, and sort by number of duplicates (| sort | uniq --count | sort --general-numeric-sort), yielding: ... 14 (*) Navigator: A Bluer Shade of White Chapter 4, a frozen fanfic | FanFiction - Iceweasel 14 (*) Navigator: Iceweasel 15 (*) evince: 2009-geisler.pdf — Heart rate variability predicts self-control in goal pursuit 15 (*) Navigator: Tool use by animals - Wikipedia, the free encyclopedia - Iceweasel 16 (*) Navigator: Hacker News | Add Comment - Iceweasel 17 (*) evince: bayesiancausality.pdf 17 (*) Navigator: Comments - Less Wrong Discussion - Iceweasel 17 (*) Navigator: Keith Gessen · Why not kill them all?: In Donetsk · LRB 11 September 2014 - Iceweasel 17 (*) Navigator: Notes on the Celebrity Data Theft | Hacker News - Iceweasel 18 (*) Navigator: A Bluer Shade of White Chapter 1, a frozen fanfic | FanFiction - Iceweasel 19 (*) gl: mplayer2 19 (*) Navigator: Neural networks and deep learning - Iceweasel 20 (*) Navigator: Harry Potter and the Philosopher's Zombie, a harry potter fanfic | FanFiction - Iceweasel 20 (*) Navigator: [OBNYC] Time tracking app - gwern0@gmail.com - Gmail - Iceweasel 25 (*) evince: ps2007.pdf — untitled 35 (*) emacs: /home/gwern/arbtt.page 43 (*) Navigator: CCC comments on The Octopus, the Dolphin and Us: a Great Filter tale - Less Wrong - Iceweasel 62 (*) evince: The physics of information processing superobjects - Anders Sandberg - 1999.pdf — Brains2 69 (*) liferea: Liferea 82 (*) evince: BMS_raftery.pdf — untitled 84 (*) emacs: emacs@elan 87 (*) Navigator: overview for gwern - Iceweasel 109 (*) puddletag: puddletag: /home/gwern/music 150 (*) urxvt: irssi Put this way, we can see what rules we should write to categorize: we could categorize the activities here into a few categories of "recreational", "statistics", "music", "email", "IRC", "research", and "writing"; and add to the categorize.cfg some rules like thus: $idle > 30 ==> tag inactive, current window $title =~ [/.*Hacker News.*/, /.*Less Wrong.*/, /.*overview for gwern.*/, /.*[fF]an[fF]ic.*/, /.* LRB .*/] || current window $program == "liferea" ==> tag Recreation, current window $title =~ [/.*puddletag.*/, /.*mplayer2.*/] ==> tag Music, current window $title =~ [/.*[bB]ayesian.*/, /.*[nN]eural [nN]etworks.*/, /.*ps2007.pdf.*/, /.*[Rr]aftery.*/] ==> tag Statistics, current window $title =~ [/.*Wikipedia.*/, /.*Heart rate variability.*/, /.*Anders Sandberg.*/] ==> tag Research, current window $title =~ [/.*Gmail.*/] ==> tag Email, current window $title =~ [/.*arbtt.*/] ==> tag Writing, current window $title == "irssi" ==> tag IRC, If we reran the command, we'd see the same output, so we need to leverage our new rules and exclude any samples matching our current tags, so now we run a command like: arbtt-stats --categorizefile=foo --filter='$sampleage <24:00' --dump-samples --exclude=Recreation --exclude=Music --exclude=Statistics --exclude=Research --exclude=Email --exclude=Writing --exclude=IRC | fgrep '(*)' | sort | uniq --count | sort --general-numeric-sort Now the previous samples disappear, leaving us with a fresh batch of unclassified samples to work with: 9 (*) Navigator: New Web Order > Nik Cubrilovic - - Notes on the Celebrity Data Theft - Iceweasel 9 ( ) urxvt: /home/gwern; arbtt-stats --categorizefile=foo --filter='$sampleage <24:00' --dump-samples | fgrep '(*)' | less 10 (*) evince: ATTACHMENT02 10 (*) Navigator: These Giant Copper Orbs Show Just How Much Metal Comes From a Mine | Design | WIRED - Iceweasel 12 (*) evince: [Jon_Elster]_Alchemies_of_the_Mind_Rationality_an(BookFi.org).pdf — Alchemies of the mind 12 (*) Navigator: Morality Quiz/Test your Morals, Values & Ethics - YourMorals.Org - Iceweasel 33 ( ) urxvt: /home/gwern; arbtt-stats --categorizefile=foo --filter='$sampleage <24:00' --dump-samples | fgrep '(*)'... We can add rules categorizing these as 'Recreational', 'Writing', 'Research', 'Recreational', 'Research', 'Writing', and 'Writing' respectively; and we might decide at this point that 'Writing' is starting to become overloaded, so we'll split it into two tags, 'Writing' and 'Programming'. And then after tossing another --exclude=Programming into our rules, we can repeat the process. As we refine our rules, we will quickly spot instances where the title/class/program are insufficient to allow accurate classification, and we will figure out the best collection of tags for our particular purposes. A few iterations is enough for most purposes. Categorizing advice When building up rules, a few rules of thumb should be kept in mind: Categorize by purpose, not by program This leads to misleading time reports. Avoid, for example, lumping all web browser time into a single category named 'Internet'; this is more misleading than helpful. Good categories describe an activity or goal, such as 'Work' or 'Recreation', not a tool, like 'Emacs' or 'Vim'. When in doubt, write narrow rules and generalize later Regexps are tricky and it can be easy to write rules far broader than one intended. The --exclude filters mean that one will never see samples which are matched accidentally. If one is in doubt, it can be helpful to take a specific sample one wants to match and several similar strings and look at how well one's regexp rule works in Emacs's regexp-builder or online regexp-testers like regexpal. Don't try to classify everything You will never classify 100% of samples because sometimes programs do not include useful X properties and cannot be fixed, you have samples from before you fixed them, or they are too transient (like popups and dialogues) to be worth fixing. It is not necessary to classify 100% of your time, since as long as the most common programs and, say, 80% of your time is classified, then you have most of the value. It is easy to waste more time tweaking arbtt than one gains from increased accuracy or more finely-grained tags. Avoid large and microscopic tags If a tag takes up more than a third or so of your time, it is probably too large, masks variation, and can be broken down into more meaningful tags. Conversely, a tag too narrow to show up regularly in reports (because it is below the default 1% filter) may not be helpful because it is usually tiny, and can be combined with the most similar tag to yield more compact and easily interpreted reports. Long-term storage Each halving of the sampling rate doubles the number of samples taken and hence the storage requirement; sampling rates below 20s are probably wasteful. But even the default 60s can accumulate into a nontrivial amount of data over a year. A constantly-changing binary file can interact poorly with backup systems, may make arbtt analyses slower, and if one's system occasionally crashes or experiences other problems, cause some corruption of the log and be a nuisance in having to run arbtt-recover. Thus it may be a good idea to archive one's capture.log on an annual basis. If one needs to query the historical data, the particular log file can be specified as an option like --logfile=/home/gwern/doc/arbtt/2013-2014.log External processing of arbtt statistics arbtt supports CSV export of time by category in various levels of granularity in a 'long' format (multiple rows for each day, with n row specifying a category's value for that day). These CSV exports can be imported into statistical programs like R or Excel and manipulated as desired. R users may prefer to have their time data in a 'wide' format (each row is 1 day, with n columns for each possible category); this can be done with the reshape default library. After reading in the CSV, the time-intervals can be converted to counts and the data to a wide data-frame with R code like the following: arbtt <- read.csv("arbtt.csv") interval <- function(x) { if (!is.na(x)) { if (grepl(" s",x)) as.integer(sub(" s","",x)) else { y <- unlist(strsplit(x, ":")); as.integer(y[[1]])*3600 + as.integer(y[[2]])*60 + as.integer(y[[3]]); } } else NA } arbtt$Time <- sapply(as.character(arbtt$Time), interval) library(reshape) arbtt <- reshape(arbtt, v.names="Time", timevar="Tag", idvar="Day", direction="wide") Contributed tools Due to the export facilities of arbtt (as explained in ), tools analyzing arbtt’s data can be developed independently. This section lists those that we are aware of. If you create a tool of your own, or find one somewhere, please tell us on the mailing list (see ). arbtt-graph Jayesh Kumar Gupta created a nice d3-based visualization of your arbtt data, including daily pie charts and barcode graphs. You can find his tool on https://github.com/rejuvyesh/arbtt-graph. 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 various textual formats. 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 TAG 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. PERIOD This is not a report of its own, but causes the selected report to be executed for each of the given PERIOD (which can be minute, hour,day, month or year) where there exist selected samples. All the reports will then be printed one after another or, in the case of CSV output, with an additional column. Note that if this option is enabled, samples that are filtered out are completely ignored (to avoid empty reports for periods with only filtered samples). Therefore, the report will print the numbers for the samples selected also for the totals. 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 dump one current sample instead of modifying the logfile 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 FORMAT FORMAT dumping format to use, where FORMAT is one of human (the default), show or JSON. Case in-sensitive. NUMBER NUMBER dump only the last NUMBER of samples. Files ~/.arbtt/capture.log binary file, storing the arbtt data samples Formats Human This format is intended for human inspection, but not for further processing. Hence, it may change in new versions of arbtt without notice. Example output: 2013-06-20 14:53:50 (48ms inactive): ( ) Navigator: arbtt-dump - Iceweasel ( ) gnome-terminal-server: jojo@kirk:~/projekte/programming/arbtt/doc (*) gvim: arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2 The line with a star indicates the currently active window. Show This is the default serialization format of Haskell's Show type class, one entry per line. This can be useful if the data is to be processed by further Haskell code. Example output, with indentation added manually: TimeLogEntry { tlTime = 2013-06-20 14:53:50.957763 UTC , tlRate = 60000 , tlData = CaptureData { cWindows = [ (False,"arbtt-dump - Iceweasel","Navigator") , (False,"jojo@kirk:~/projekte/programming/arbtt/doc","gnome-terminal-server") , (True,"arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2","gvim") ] , cLastActivity = 48 } } JSON For interoperability, arbtt supports dumping its data to JSON, which can easily be parsed by many different programming languages. Some level of backward-compatibility will be provided, as far as possible. Default output, again with indentation and spacing added manually: [ ..., { "windows": [ { "program": "arbtt-dump - Iceweasel", "title": "Navigator", "active": false}, { "program": "jojo@kirk:~/projekte/programming/arbtt/doc", "title":" gnome-terminal-server", "active": false}, { "program": "arbtt.xml + (~/projekte/programming/arbtt/doc) - GVIM2", "title": "gvim", "active":true }], "inactive": 48, "date": "2013-06-20T14:53:50.957Z", "rate": 60000}, ... ] 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 read the 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 side 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.recovered 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 is documented here. Version 0.9 The option of arbtt-stats now supports grouping results by minute or hour. Gwern Branwen contributed the . Version 0.8.1 The syntax now allows for time differences larger than 99:99. (issue #14) Version 0.8 arbtt-dump can now show the data in other formats as well, as suggested by Waldir Pimenta (option ). This includes a human-readale output and JSON. New option of arbtt-dump. arbtt-recover can handle larger datasets with a reasonable amount of memory. When dumping samples with arbtt-stats or arbtt-dump (in human-readable mode), times are printed in the local time zone, as suggested by Oren Gampel. arbtt-capture now supports the option for development and debugging purposes. The name of the current desktop (or workspace) is also recorded, and available as $desktop (issue #1). Two bugs in the parser were fixed (issue #4 and issue #5). arbtt-stats can print reports split by time interval, using the option. arbtt-stats can print the actual samples selected, with . Support for GHC-7.8 was added, with help from Jayesh Kumar Gupta (issue #8). Arbtt now has a proper testsuite integrated into Cabal, and an automated test infrastructure on Travis. Waldir Pimenta contributed a new web page, hosted at arbtt.nomeata.de. 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.9.0.13/src/0000755000000000000000000000000013074765620012045 5ustar0000000000000000arbtt-0.9.0.13/src/import-main.hs0000644000000000000000000000363713074765620014646 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.9.0.13/src/Capture.hs0000644000000000000000000000046213074765620014006 0ustar0000000000000000{-# LANGUAGE CPP #-} module Capture ( #if defined(WIN32) module Capture.Win32 #elif defined(DARWIN) module Capture.OSX #else module Capture.X11 #endif ) where #if defined(WIN32) import Capture.Win32 #elif defined(DARWIN) import Capture.OSX #else import Capture.X11 #endif arbtt-0.9.0.13/src/LeftFold.hs0000644000000000000000000001244113074765620014102 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 import qualified Data.Map.Strict as M import Data.Maybe 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 filterElems :: (x -> Bool) -> LeftFold x a -> LeftFold x a filterElems _ (Pure x) = (Pure x) filterElems pred (LeftFold s p f) = LeftFold s (\s x -> if pred x then p s x else s) f adjoin :: (x -> Bool) -> LeftFold (Bool :!: x) a -> LeftFold x a adjoin p f = f `mapElems` (\x -> (p x :!: x)) onSelected :: LeftFold x a -> LeftFold (Bool :!: x) a onSelected (Pure x) = Pure x onSelected (LeftFold s p f) = LeftFold s (\s (b :!: x) -> if b then p s x else s) f 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)) multiplex :: Ord k => (a -> k) -> LeftFold a b -> LeftFold a (M.Map k b) multiplex key (LeftFold si pi fi) = LeftFold M.empty go finish where go m x = M.alter go' (key x) m where go' mbOld = Just $ pi (fromMaybe si mbOld) x finish = M.map fi lfLength :: LeftFold x Int lfLength = leftFold 0 (\c _ -> c + 1) 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.9.0.13/src/UpgradeLog1.hs0000644000000000000000000000416113074765620014515 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 (T.pack "") arbtt-0.9.0.13/src/capture-main.hs0000644000000000000000000000622613074765620014774 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 Data.Time.LocalTime import Capture import TimeLog import UpgradeLog1 import CommonStartup import DumpFormat import Paths_arbtt (version) data Options = Options { optSampleRate :: Integer , optLogFile :: String , optDump :: Bool } defaultOptions :: FilePath -> Options defaultOptions dir = Options { optSampleRate = 60 , optLogFile = dir "capture.log" , optDump = False } versionStr = "arbtt-capture " ++ showVersion version 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)" , Option "d" ["dump"] (NoArg (\opt -> return opt { optDump = True })) "dump one sample to standard out, instead of modifying the log file" ] -- | This is very raw, someone ought to improve this 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 if optDump flags then do setupCapture tz <- getCurrentTimeZone captureData >>= mkTimeLogEntry (optSampleRate flags * 1000) >>= dumpSample tz else do createDirectoryIfMissing False dir lockFile (optLogFile flags) upgradeLogFile1 (optLogFile flags) setupCapture runLogger (optLogFile flags) (optSampleRate flags * 1000) captureData arbtt-0.9.0.13/src/TermSize.hsc0000644000000000000000000000265713074765620014320 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface, CPP #-} {- 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 STDERR_FILENO) (#const TIOCGWINSZ) ws WinSize row col <- peek ws return (fromIntegral row, fromIntegral col) #endif arbtt-0.9.0.13/src/Data.hs0000644000000000000000000000777413074765620013271 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 , cDesktop :: Text -- ^ Current desktop name } deriving (Show, Read) instance NFData CaptureData where rnf (CaptureData a b c) = a `deepseq` b `deepseq` c `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 3 ls_put strs (cWindows cd) ls_put strs (cLastActivity cd) ls_put strs (cDesktop cd) ls_get strs = do v <- getWord8 case v of 1 -> CaptureData <$> get <*> get <*> pure "" 2 -> CaptureData <$> ls_get strs <*> ls_get strs <*> pure "" 3 -> CaptureData <$> ls_get strs <*> ls_get strs <*> ls_get strs _ -> error $ "Unsupported CaptureData version tag " ++ show v -- | 'getMany n' get 'n' elements in order, without blowing the stack. -- 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.9.0.13/src/TimeLog.hs0000644000000000000000000001170613074765620013746 0ustar0000000000000000{-# LANGUAGE CPP #-} module 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 #ifndef mingw32_HOST_OS import System.Posix.Files #endif import System.IO.Unsafe (unsafeInterleaveIO) import qualified Data.ByteString.Lazy as BS import Data.Maybe magic = BS.pack $ map (fromIntegral.ord) "arbtt-timelog-v1\n" mkTimeLogEntry :: Integer -> a -> IO (TimeLogEntry a) mkTimeLogEntry delay entry = do date <- getCurrentTime return $ TimeLogEntry date delay entry -- | Runs the given action each delay milliseconds and appends the TimeLog to the -- given file. runLogger :: ListOfStringable a => FilePath -> Integer -> IO a -> IO () runLogger filename delay action = flip fix Nothing $ \loop prev -> do entry <- action tle <- mkTimeLogEntry delay entry createTimeLog False filename #ifndef mingw32_HOST_OS setFileMode filename (ownerReadMode `unionFileModes` ownerWriteMode) #endif appendTimeLog filename prev tle threadDelay (fromIntegral delay * 1000) loop (Just entry) 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... -- Use of unsafeInterleaveIO should be replaced by conduit, pipe or something the like recoverTimeLog :: ListOfStringable a => FilePath -> IO (TimeLog a) recoverTimeLog filename = do content <- BS.readFile filename 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 input off off flip (maybe (return [])) mb $ \(v,rest,off') -> if BS.null rest then return [v] else (v:) <$> (unsafeInterleaveIO $ go (Just (tlData v)) rest off') tryGet prev input off orig_off = catch ( do -- putStrLn $ "Trying value at offset " ++ show off let (v,rest,off') = runGetState (ls_get strs) input off evaluate rest when (off /= orig_off) $ putStrLn $ "Skipped from " ++ show orig_off ++ ", succesful read at position " ++ show off ++ ", lost " ++ show (off - orig_off) ++ " bytes." return (Just (v,rest,off')) ) ( \e -> do 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 tryGet prev (BS.tail input) (off+1) orig_off ) 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.9.0.13/src/Stats.hs0000644000000000000000000004500413074765620013502 0ustar0000000000000000{-# LANGUAGE RecordWildCards, NamedFieldPuns, TypeOperators, TupleSections, GADTSyntax, ExistentialQuantification, CPP #-} module Stats ( Report(..), ReportOptions(..), ReportFormat(..), ReportResults(..), ActivityFilter(..), Filter(..), Repeater(..), defaultFilter, defaultReportOptions, parseActivityMatcher, filterPredicate, prepareCalculations, processReport, processRepeater, 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) #if MIN_VERSION_time(1,5,0) import Data.Time.Format(defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif import Control.Applicative import Data.Strict ((:!:), Pair(..)) import qualified Data.Strict as Strict import Data.Traversable (sequenceA) import Control.Arrow import Debug.Trace import Data import Categorize import LeftFold import DumpFormat data Report = GeneralInfos | TotalTime | Category Category | EachCategory | IntervalCategory Category | IntervalTag Activity | DumpSamples 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) data Repeater = ByMinute | ByHour | ByDay | ByMonth | ByYear 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] | MultipleReportResults [ReportResults] | RepeatedReportResults String [(String, ReportResults)] | DumpResult (TimeLog (CaptureData, TimeZone, ActivityData)) 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 filterActivity :: [ActivityFilter] -> ActivityData -> ActivityData filterActivity fs = filter (applyActivityFilter fs) applyActivityFilter :: [ActivityFilter] -> Activity -> Bool applyActivityFilter fs act = all go fs where go (ExcludeActivity matcher) = not (matchActivityMatcher matcher act) 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 processRepeater :: TimeZone -> Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processRepeater tz r rep = case repeaterImpl r of RepeaterImpl catR showR -> filterElems (\(b :!: _) -> b) $ pure (RepeatedReportResults (repeaterTitle r) . map (first showR) . M.toList) <*> multiplex (catR . utcToLocalTime tz . tlTime . Strict.snd) rep data RepeaterImpl where RepeaterImpl :: Ord r => (LocalTime -> r) -> (r -> String) -> RepeaterImpl repeaterTitle :: Repeater -> String repeaterTitle ByMinute = "Minute" repeaterTitle ByHour = "Hour" repeaterTitle ByDay = "Day" repeaterTitle ByMonth = "Month" repeaterTitle ByYear = "Year" repeaterImpl :: Repeater -> RepeaterImpl repeaterImpl ByMinute = RepeaterImpl -- a somewhat lazy implementations, using strings... (formatTime defaultTimeLocale "%F %H:%M") id repeaterImpl ByHour = RepeaterImpl (formatTime defaultTimeLocale "%F %H:00") id repeaterImpl ByDay = RepeaterImpl localDay showGregorian repeaterImpl ByMonth = RepeaterImpl ((\(y,m,_) -> (y, m)) . toGregorian . localDay) (\(y,m) -> show y ++ "-" ++ show m) repeaterImpl ByYear = RepeaterImpl ((\(y,_,_) -> y) . toGregorian . localDay) show processReport :: ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processReport opts GeneralInfos = pure (\n firstDate lastDate ttr tts -> let timeDiff = diffUTCTime lastDate firstDate fractionRec = realToFrac ttr / (realToFrac timeDiff) :: Double fractionSel = realToFrac tts / (realToFrac timeDiff) :: Double fractionSelRec = realToFrac tts / realToFrac ttr :: Double in ListOfFields "General Information" [ ("FirstRecord", show firstDate) , ("LastRecord", show lastDate) , ("Number of records", show n) , ("Total time recorded", showTimeDiff opts ttr) , ("Total time selected", showTimeDiff opts tts) , ("Fraction of total time recorded", printf "%3.0f%%" (fractionRec * 100)) , ("Fraction of total time selected", printf "%3.0f%%" (fractionSel * 100)) , ("Fraction of recorded time selected", printf "%3.0f%%" (fractionSelRec * 100)) ]) <*> onAll lfLength <*> onAll calcFirstDate <*> onAll calcLastDate <*> onAll calcTotalTime <*> onSelected calcTotalTime processReport opts TotalTime = onSelected $ pure (\totalTimeSel sums -> ListOfTimePercValues "Total time per tag" . mapMaybe (\(tag,time) -> let perc = realToFrac time/realToFrac totalTimeSel pick = applyActivityFilter (roActivityFilter opts) tag in if pick && perc*100 >= roMinPercentage opts then Just $ ( show tag , showTimeDiff opts time , perc) else Nothing ) . reverse . sortBy (comparing snd) $ M.toList $ sums) <*> calcTotalTime <*> calcSums processReport opts (Category cat) = pure (\c -> processCategoryReport opts c cat) <*> prepareCalculations processReport opts EachCategory = pure (\c cats -> MultipleReportResults $ map (processCategoryReport opts c) cats) <*> prepareCalculations <*> onSelected calcCategories processReport opts (IntervalCategory cat) = processIntervalReport opts ("Intervals for category " ++ show cat) (extractCat cat) where extractCat :: Category -> ActivityData -> Maybe String extractCat cat = fmap (unpack . activityName) . listToMaybe . filter ( (==Just cat) . activityCategory ) processReport opts (IntervalTag tag) = processIntervalReport opts ("Intervals for category " ++ show tag) (extractTag tag) where extractTag :: Activity -> ActivityData -> Maybe String extractTag tag = fmap show . listToMaybe . filter ( (==tag) ) processReport opts DumpSamples = DumpResult <$> onSelected (mapElems toList $ fmap $ \(cd,ad) -> (tlData (cNow cd), cTimeZone cd, filterActivity (roActivityFilter opts) ad) ) calcCategories :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Category] calcCategories = fmap S.toList $ leftFold S.empty $ \s tl -> foldl' go' s (snd (tlData tl)) 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 opts time , perc) else Nothing ) (reverse $ sortBy (comparing snd) $ M.toList filteredSums) ++ ( if tooSmallTimes > 0 then [( printf "(%d entries omitted)" (M.size tooSmallSums) , showTimeDiff opts tooSmallTimes , realToFrac tooSmallTimes/realToFrac totalTimeSel )] else [] ) ++ (if uncategorizedTime > 0 then [( "(unmatched time)" , showTimeDiff opts uncategorizedTime , realToFrac uncategorizedTime/realToFrac totalTimeSel )] else [] ) tlRateTimediff :: TimeLogEntry a -> NominalDiffTime tlRateTimediff tle = fromIntegral (tlRate tle) / 1000 processIntervalReport :: ReportOptions -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processIntervalReport opts title extr = runOnIntervals go1 go2 where go1 :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Interval] go1 = go3 `mapElems` fmap (extr . snd) go3 :: LeftFold (TimeLogEntry (Maybe String)) [Interval] go3 = runOnGroups sameGroup go4 (onJusts toList) sameGroup tl1 tl2 = tlData tl1 == tlData tl2 && tlTime tl2 `diffUTCTime` tlTime tl1 < 2 * tlRateTimediff tl1 go4 :: LeftFold (TimeLogEntry (Maybe String)) (Maybe Interval) go4 = pure (\fe le -> case tlData fe of Just str -> Just ( str , showUtcTime (tlTime fe) , showUtcTime (tlRateTimediff le `addUTCTime` tlTime le) , showTimeDiff opts $ tlTime le `diffUTCTime` tlTime fe + tlRateTimediff le ) 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 (DumpResult samples) = dumpActivity samples renderReport opts (MultipleReportResults reports) = sequence_ . intersperse (putStrLn "") . map (renderReport opts) $ reports renderReport opts reportdata = putStr $ doRender opts reportdata doRender :: ReportOptions -> ReportResults -> String doRender opts reportdata = case roReportFormat opts of RFText -> renderReportText id reportdata RFCSV -> renderWithDelimiter "," $ renderXSV reportdata RFTSV -> renderWithDelimiter "\t" $ renderXSV reportdata renderReportText titleMod (ListOfFields title dats) = underline (titleMod title) ++ (tabulate False $ map (\(f,v) -> [f,v]) dats) renderReportText titleMod (ListOfTimePercValues title dats) = underline (titleMod title) ++ (tabulate True $ listOfValues dats) renderReportText titleMod (PieChartOfTimePercValues title dats) = underline (titleMod title) ++ (tabulate True $ piechartOfValues dats) renderReportText titleMod (ListOfIntervals title dats) = underline (titleMod title) ++ (tabulate True $ listOfIntervals dats) renderReportText titleMod (RepeatedReportResults cat reps) = intercalate "\n" $ map (\(v,rr) -> renderReportText (titleMod . mod v) rr) reps where mod v s = s ++ " (" ++ cat ++ " " ++ v ++ ")" listOfValues dats = ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats 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. renderXSV (ListOfFields title dats) = error ("\"" ++ title ++ "\"" ++ " not supported for this output format") renderXSV (ListOfTimePercValues _ dats) = listOfValues dats renderXSV (PieChartOfTimePercValues _ dats) = piechartOfValues dats renderXSV (ListOfIntervals title dats) = listOfIntervals dats -- A bit code-smelly here. renderXSV (RepeatedReportResults cat reps) = title : fields where title = cat : head (renderXSV (snd (head reps))) fields = concatMap (\(v,rr) -> map (v:) (tail (renderXSV rr))) reps renderWithDelimiter :: String -> [[String]] -> String renderWithDelimiter delim datasource = unlines $ map (intercalate delim) datasource tabulate :: Bool -> [[String]] -> String tabulate titlerow rows = unlines $ addTitleRow $ map (intercalate " | " . zipWith (\l s -> take (l - length s) (repeat ' ') ++ s) colwidths) rows 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 :: ReportOptions -> NominalDiffTime -> String showTimeDiff (ReportOptions { roReportFormat = RFText }) = showTimeDiffHuman showTimeDiff _ = showTimeDiffMachine showTimeDiffHuman :: NominalDiffTime -> String showTimeDiffHuman t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"] where s = round t :: Integer days = s `div` (24*60*60) hours = (s `div` (60*60)) `mod` 24 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 showTimeDiffMachine :: NominalDiffTime -> String showTimeDiffMachine t = printf "%d:%02d:%02d" hours mins secs where s = round t :: Integer hours = s `div` (60*60) mins = (s `div` 60) `mod` 60 secs = s `mod` 60 showUtcTime :: UTCTime -> String showUtcTime = formatTime defaultTimeLocale "%x %X" underline :: String -> String underline str = unlines [ str , map (const '=') str ] arbtt-0.9.0.13/src/stats-main.hs0000644000000000000000000002362313074765620014467 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 Data.Maybe 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.ProgressBar import TermSize import qualified Data.MyText as T import Data.Time.LocalTime import TimeLog import Categorize import Stats import CommonStartup import LeftFold import DumpFormat import Paths_arbtt (version) data Options = Options { optReports :: [Report] , optFilters :: [Filter] , optRepeater :: [Repeater] , optAlsoInactive :: Bool , optReportOptions :: ReportOptions , optLogFile :: String , optCategorizeFile :: String } defaultOptions :: FilePath -> Options defaultOptions dir = Options { optReports = [] , optFilters = [] , optRepeater = [] , 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 }) "PERC") "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 "" ["dump-samples"] (NoArg (\opt -> let reports = DumpSamples : optReports opt in return opt { optReports = reports })) "Dump the raw samples and tags." , Option "" ["output-format"] (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roReportFormat = readReportFormat arg } in return opt { optReportOptions = ro }) "FORMAT") "one of: text, csv (comma-separated values), tsv (TAB-separated values) (default: Text)" , Option "" ["for-each"] (ReqArg (\arg opt -> let repeater = readRepeater arg : optRepeater opt in return opt { optRepeater = repeater }) "PERIOD") "one of: day, month, year" ] readRepeater :: String -> Repeater readRepeater arg = case map toLower arg of "minute" -> ByMinute "hour" -> ByHour "day" -> ByDay "month" -> ByMonth "year" -> ByYear _ -> error ("Unsupported parameter to --for-each: '" ++ arg ++ "'") readReportFormat :: String -> ReportFormat readReportFormat arg = case map toLower arg of "text" -> RFText "csv" -> RFCSV "tsv" -> RFTSV _ -> error ("Unsupported report output format: '" ++ arg ++ "'") 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 tz <- getCurrentTimeZone 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) timeloghandle <- openBinaryFile (optLogFile flags) ReadMode size <- hFileSize timeloghandle timelog <- BS.hGetContents timeloghandle isTerm <- hIsTerminalDevice stderr trackedTimelog <- case isTerm of True -> do hSetBuffering stderr NoBuffering 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 False -> return 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 rep = case optReports flags of [] -> TotalTime [x] -> x _ -> error "Please specify exactly one report to generate" let repeater = foldr (.) id $ map (processRepeater tz) (optRepeater flags) let opts = optReportOptions flags let fold = filterPredicate filters `adjoin` repeater (processReport opts rep) let result = runLeftFold fold allTags -- Force the results a bit, to ensure the progress bar to be shown before the title result `seq` return () renderReport opts result {- 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.9.0.13/src/CommonStartup.hs0000644000000000000000000000033413074765620015214 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.9.0.13/src/dump-main.hs0000644000000000000000000000562013074765620014273 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 Data.Char import Data.List.TakeR import Data.Time.LocalTime import TimeLog import Data import CommonStartup import DumpFormat import Paths_arbtt (version) data Options = Options { optLogFile :: String , optFormat :: DumpFormat , optLast :: Maybe Int } defaultOptions dir = Options { optLogFile = dir "capture.log" , optFormat = DFHuman , optLast = Nothing } 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" , Option "t" ["format"] (ReqArg (\arg opt -> case readDumpFormat arg of Just fm -> return $ opt { optFormat = fm} Nothing -> do hPutStrLn stderr ("Invalid format \"" ++ arg ++ "\".") hPutStr stderr (usageInfo header options) exitFailure) "FORMAT") "output format, one of Human (default), Show or JSON " , Option "l" ["last"] (ReqArg (\arg opt -> case reads arg of [(n, "")] | n >= 0 -> return $ opt { optLast = Just n } _ -> do hPutStrLn stderr ("Invalid number \"" ++ arg ++ "\".") hPutStr stderr (usageInfo header options) exitFailure) "NUMBER") "only dump the last NUMBER of samples." ] main = do 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) captures <- case optLast flags of Nothing -> return captures Just n -> return $ takeR n captures tz <- getCurrentTimeZone dumpSamples tz (optFormat flags) captures arbtt-0.9.0.13/src/recover-main.hs0000644000000000000000000000400613074765620014770 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 putStrLn $ "Wrote data recovered from " ++ optInFile flags ++ " to " ++ optOutFile flags arbtt-0.9.0.13/src/Categorize.hs0000644000000000000000000005221413074765620014501 0ustar0000000000000000{-# LANGUAGE Rank2Types, CPP #-} 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.IO 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) #if MIN_VERSION_time(1,5,0) import Data.Time.Format(defaultTimeLocale, iso8601DateFormat) #else import System.Locale (defaultTimeLocale, iso8601DateFormat) #endif 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 h <- openFile filename ReadMode hSetEncoding h utf8 content <- hGetContents h 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 <- parseRule `sepEndBy1` comma lang return (matchAny (x:xs)) , do semi lang xs <- parseRule `sepEndBy1` semi lang 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 <- read <$> many1 digit 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") , do guard $ varname == "desktop" return $ CondString (getVar "desktop") ] ] "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 hour <- read <$> many1 digit char ':' minute <- read <$> count 2 digit return $ (hour * 60 + minute) * 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 <- read <$> many1 digit 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 "desktop" ctx = do return $ cDesktop (tlData (cNow ctx)) 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.9.0.13/src/DumpFormat.hs0000644000000000000000000000540113074765620014457 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, CPP #-} module DumpFormat ( DumpFormat(..) , readDumpFormat , dumpActivity , dumpSample , dumpSamples ) where import Data.MyText (unpack, null, Text) import Data.Aeson import qualified Data.ByteString.Lazy as LBS import Data.Time #if MIN_VERSION_time(1,5,0) import Data.Time.Format(defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif import Data.Char import Data import Text.Printf import Data.List hiding (null) import Prelude hiding (null) data DumpFormat = DFShow | DFHuman | DFJSON deriving (Show, Eq) instance ToJSON Text where toJSON = toJSON . unpack instance ToJSON (TimeLogEntry CaptureData) where toJSON (TimeLogEntry {..}) = object [ "date" .= tlTime, "rate" .= tlRate, "inactive" .= cLastActivity tlData, "windows" .= map (\(a,p,t) -> object ["active" .= a, "program" .= p, "title" .= t]) (cWindows tlData), "desktop" .= cDesktop tlData ] readDumpFormat :: String -> Maybe DumpFormat readDumpFormat arg = case map toLower arg of "human" -> return DFHuman "show" -> return DFShow "json" -> return DFJSON _ -> Nothing dumpActivity :: TimeLog (CaptureData, TimeZone, ActivityData) -> IO () dumpActivity = mapM_ go where go tle = do dumpHeader tz (tlTime tle) (cLastActivity cd) dumpDesktop (cDesktop cd) mapM_ dumpWindow (cWindows cd) dumpTags ad where (cd, tz, ad) = tlData tle dumpTags :: ActivityData -> IO () dumpTags = mapM_ go where go act = printf " %s\n" (show act) dumpHeader :: TimeZone -> UTCTime -> Integer -> IO () dumpHeader tz time lastActivity = do printf "%s (%dms inactive):\n" (formatTime defaultTimeLocale "%F %X" (utcToLocalTime tz time)) lastActivity dumpWindow :: (Bool, Text, Text) -> IO () dumpWindow (active, title, program) = do printf " %s %-15s %s\n" (if active then ("(*)"::String) else "( )") (unpack program ++ ":") (unpack title) dumpDesktop :: Text -> IO () dumpDesktop d | null d = return () | otherwise = printf " Current Desktop: %s\n" (unpack d) dumpSample :: TimeZone -> TimeLogEntry CaptureData -> IO () dumpSample tz tle = do dumpHeader tz (tlTime tle) (cLastActivity (tlData tle)) dumpDesktop (cDesktop (tlData tle)) mapM_ dumpWindow (cWindows (tlData tle)) dumpSamples :: TimeZone -> DumpFormat -> TimeLog CaptureData -> IO () dumpSamples _ DFShow = mapM_ print dumpSamples tz DFHuman = mapM_ (dumpSample tz) dumpSamples _ DFJSON = enclose . sequence_ . intersperse (putStrLn ",") . map (LBS.putStr . encode) where enclose m = putStrLn "[" >> m >> putStrLn "]" arbtt-0.9.0.13/src/Text/0000755000000000000000000000000013074765620012771 5ustar0000000000000000arbtt-0.9.0.13/src/Text/ParserCombinators/0000755000000000000000000000000013074765620016426 5ustar0000000000000000arbtt-0.9.0.13/src/Text/ParserCombinators/Parsec/0000755000000000000000000000000013074765620017643 5ustar0000000000000000arbtt-0.9.0.13/src/Text/ParserCombinators/Parsec/ExprFail.hs0000644000000000000000000001231113074765620021707 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.9.0.13/src/Text/Regex/0000755000000000000000000000000013074765620014043 5ustar0000000000000000arbtt-0.9.0.13/src/Text/Regex/PCRE/0000755000000000000000000000000013074765620014574 5ustar0000000000000000arbtt-0.9.0.13/src/Text/Regex/PCRE/Light/0000755000000000000000000000000013074765620015643 5ustar0000000000000000arbtt-0.9.0.13/src/Text/Regex/PCRE/Light/Text.hs0000644000000000000000000001425113074765620017126 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.9.0.13/src/Text/Parsec/0000755000000000000000000000000013074765620014206 5ustar0000000000000000arbtt-0.9.0.13/src/Text/Parsec/ExprFail.hs0000644000000000000000000001507613074765620016265 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.9.0.13/src/System/0000755000000000000000000000000013074765620013331 5ustar0000000000000000arbtt-0.9.0.13/src/System/Win32/0000755000000000000000000000000013074765620014233 5ustar0000000000000000arbtt-0.9.0.13/src/System/Win32/Mutex.hsc0000644000000000000000000000164713074765620016044 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.9.0.13/src/System/Locale/0000755000000000000000000000000013074765620014530 5ustar0000000000000000arbtt-0.9.0.13/src/System/Locale/SetLocale.hsc0000644000000000000000000000325013074765620017102 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DeriveDataTypeable #-} {- 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, Typeable) #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.9.0.13/src/Graphics/0000755000000000000000000000000013074765620013605 5ustar0000000000000000arbtt-0.9.0.13/src/Graphics/Win32/0000755000000000000000000000000013074765620014507 5ustar0000000000000000arbtt-0.9.0.13/src/Graphics/Win32/Window/0000755000000000000000000000000013074765620015756 5ustar0000000000000000arbtt-0.9.0.13/src/Graphics/Win32/Window/Extra.hsc0000644000000000000000000001047413074765620017546 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 (tryJust) import System.IO.Error (isPermissionError) 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 ignoreEPerm = tryJust (guard . isPermissionError) fetchWindowTitles :: IO [(HWND, String,String)] fetchWindowTitles = do resultRef <- newIORef [] callback <- mkEnumWindowsProc $ \winh _ -> do ignoreEPerm $ do v <- c_IsWindowVisible winh -- only consider visible windows when v $ 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.9.0.13/src/Graphics/X11/0000755000000000000000000000000013074765620014156 5ustar0000000000000000arbtt-0.9.0.13/src/Graphics/X11/XScreenSaver.hsc0000644000000000000000000001757013074765620017237 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.9.0.13/src/Graphics/OSX/0000755000000000000000000000000013074765620014256 5ustar0000000000000000arbtt-0.9.0.13/src/Graphics/OSX/Window.hs0000644000000000000000000003334013074765620016064 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -------------------------------------------------------------------- -- | -- Module : Graphics.OSX.Window -- Copyright : (c) Vincent Rasneur -- License : GPL2 -- -- Maintainer: Vincent Rasneur -- Stability : provisional -- Portability: unportable -- -------------------------------------------------------------------- -- -- Interface to the windows and idle time functions in Mac OS X -- module Graphics.OSX.Window ( fetchWindowTitles , getForegroundWindow , getIdleTime ) where import Control.Monad import Data.Maybe (fromJust, fromMaybe, isNothing, isJust, catMaybes) import Data.Bits (shiftL, (.|.)) import Foreign.C import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Marshal.Alloc (alloca, mallocBytes, free) import Foreign.Storable (peek) import System.IO (hPutStrLn, stderr) -- Core Foundation basic types type Boolean = CUChar bTRUE = 1 :: Boolean bFALSE = 0 :: Boolean type CFTypeID = CULong type CFIndex = CLong type CFStringEncoding = CUInt -- Core Foundation pointer types data CFType = CFType type CFTypeRef = Ptr CFType data CFNumber = CFNumber type CFNumberRef = Ptr CFNumber data CFString = CFString type CFStringRef = Ptr CFString data CFArray = CFArray type CFArrayRef = Ptr CFArray data CFDictionary = CFDictionary type CFDictionaryRef = Ptr CFDictionary type CFMutableDictionaryRef = Ptr CFDictionary data CFAllocator = CFAllocator type CFAllocatorRef = Ptr CFAllocator -- IOKit types type Ckern_return_t = CInt iKERN_SUCCESS = 0 :: Ckern_return_t type Cmach_port_t = CUInt type Cio_object_t = Cmach_port_t type Cio_iterator_t = Cio_object_t type Cio_registry_entry_t = Cio_object_t type CIOOptionBits = CUInt -- type getter functions foreign import ccall "CFGetTypeID" c_CFGetTypeID :: CFTypeRef -> IO CFTypeID foreign import ccall "CFNumberGetTypeID" c_CFNumberGetTypeID :: IO CFTypeID foreign import ccall "CFStringGetTypeID" c_CFStringGetTypeID :: IO CFTypeID foreign import ccall "CFArrayGetTypeID" c_CFArrayGetTypeID :: IO CFTypeID foreign import ccall "CFDictionaryGetTypeID" c_CFDictionaryGetTypeID :: IO CFTypeID -- memory management functions foreign import ccall "CFRetain" c_CFRetain :: CFTypeRef -> IO () foreign import ccall "CFRelease" c_CFRelease :: CFTypeRef -> IO () -- allocator variables foreign import ccall "&kCFAllocatorDefault" c_kCFAllocatorDefaultPtr :: Ptr CFAllocatorRef foreign import ccall "&kCFAllocatorNull" c_kCFAllocatorNullPtr :: Ptr CFAllocatorRef c_kCFAllocatorDefault :: IO CFAllocatorRef c_kCFAllocatorDefault = peek c_kCFAllocatorDefaultPtr c_kCFAllocatorNull :: IO CFAllocatorRef c_kCFAllocatorNull = peek c_kCFAllocatorNullPtr -- number functions kCFNumberSInt64Type = 4 :: CInt foreign import ccall unsafe "CFNumberGetValue" c_CFNumberGetValue :: CFNumberRef -> CInt -> Ptr a -> IO Boolean -- string functions kCFStringEncodingUTF8 = 0x08000100 :: CFStringEncoding foreign import ccall unsafe "CFStringGetLength" c_CFStringGetLength :: CFStringRef -> IO CFIndex foreign import ccall unsafe "CFStringGetMaximumSizeForEncoding" c_CFStringGetMaximumSizeForEncoding :: CFIndex -> CFStringEncoding -> IO CFIndex foreign import ccall unsafe "CFStringGetCStringPtr" c_CFStringGetCStringPtr :: CFStringRef -> CFStringEncoding -> IO CString foreign import ccall unsafe "CFStringGetCString" c_CFStringGetCString :: CFStringRef -> CString -> CFIndex -> CFStringEncoding -> IO Boolean foreign import ccall unsafe "CFStringCreateWithCStringNoCopy" c_CFStringCreateWithCStringNoCopy :: CFAllocatorRef -> CString -> CFStringEncoding -> CFAllocatorRef -> IO CFStringRef -- array functions foreign import ccall unsafe "CFArrayGetCount" c_CFArrayGetCount :: CFArrayRef -> IO CLong foreign import ccall unsafe "CFArrayGetValueAtIndex" c_CFArrayGetValueAtIndex :: CFArrayRef -> CFIndex -> IO CFTypeRef -- dictionary functions foreign import ccall unsafe "CFDictionaryGetValue" c_CFDictionaryGetValue :: CFDictionaryRef -> Ptr a -> IO (Ptr b) -- window functions type CGWindowListOption = CUInt kCGWindowListOptionOnScreenOnly = (1 `shiftL` 0) :: CGWindowListOption kCGWindowListExcludeDesktopElements = (1 `shiftL` 4) :: CGWindowListOption type CGWindowID = CUInt kCGNullWindowID = 0 :: CGWindowID foreign import ccall unsafe "CGWindowListCopyWindowInfo" c_CGWindowListCopyWindowInfo :: CGWindowListOption -> CGWindowID -> IO CFArrayRef -- IOKit functions cMACH_PORT_NULL = 0 :: Cmach_port_t foreign import ccall unsafe "IOObjectRelease" c_IOObjectRelease :: Cio_object_t -> IO Ckern_return_t foreign import ccall unsafe "IOMasterPort" c_IOMasterPort :: Cmach_port_t -> Ptr Cmach_port_t -> IO Ckern_return_t foreign import ccall unsafe "IOServiceGetMatchingServices" c_IOServiceGetMatchingServices :: Cmach_port_t -> CFDictionaryRef -> Ptr Cio_iterator_t -> IO Ckern_return_t foreign import ccall unsafe "IOServiceMatching" c_IOServiceMatching :: CString -> IO CFMutableDictionaryRef foreign import ccall unsafe "IOIteratorNext" c_IOIteratorNext :: Cio_iterator_t -> IO Cio_object_t foreign import ccall unsafe "IORegistryEntryCreateCFProperty" c_IORegistryEntryCreateCFProperty :: Cio_registry_entry_t -> CFStringRef -> CFAllocatorRef -> CIOOptionBits -> IO CFTypeRef -- misc utilities cond :: Monad m => Bool -> a -> m a -> m a cond True val _ = return val cond False _ a = a condM :: Monad m => Bool -> m a -> m a -> m a condM True val _ = val condM False _ a = a condMsg :: Bool -> String -> a -> IO a -> IO a condMsg True msg val _ = hPutStrLn stderr msg >> return val condMsg False _ _ a = a -- type utilities isTypeRef :: IO CULong -> CFTypeRef -> IO Bool isTypeRef typeFun ref = do cond (ref == nullPtr) False $ do typ <- c_CFGetTypeID ref funTyp <- typeFun return (typ == funTyp) isStringRef :: CFTypeRef -> IO Bool isStringRef = isTypeRef c_CFStringGetTypeID isNumberRef :: CFTypeRef -> IO Bool isNumberRef = isTypeRef c_CFNumberGetTypeID isArrayRef :: CFTypeRef -> IO Bool isArrayRef = isTypeRef c_CFArrayGetTypeID isDictionaryRef :: CFTypeRef -> IO Bool isDictionaryRef = isTypeRef c_CFDictionaryGetTypeID -- string utilities getConstUTF8String :: CFStringRef -> IO CString getConstUTF8String strRef = c_CFStringGetCStringPtr strRef kCFStringEncodingUTF8 createUTF8StringRefNoCopy :: CString -> IO CFStringRef createUTF8StringRefNoCopy str = do allocDefault <- c_kCFAllocatorDefault allocNull <- c_kCFAllocatorNull c_CFStringCreateWithCStringNoCopy allocDefault str kCFStringEncodingUTF8 allocNull -- returns malloc'ed memory (or a NULL pointer) getUTF8String :: CFStringRef -> IO CString getUTF8String strRef = do length <- c_CFStringGetLength strRef maxSize <- c_CFStringGetMaximumSizeForEncoding length kCFStringEncodingUTF8 buffer <- mallocBytes $ (fromIntegral maxSize) + 1 res <- c_CFStringGetCString strRef buffer maxSize kCFStringEncodingUTF8 cond (res == bTRUE) buffer $ do free buffer return nullPtr convertString :: CString -> IO (Maybe String) convertString str = do cond (str == nullPtr) Nothing $ do peekCString str >>= return . Just -- Core Foundation objects conversion getString :: CFTypeRef -> IO (Maybe String) getString ref = isStringRef ref >>= onlyStringRef where onlyStringRef False = return Nothing onlyStringRef True = do let strRef = castPtr ref cstr <- getConstUTF8String strRef condM (cstr /= nullPtr) (convertString cstr) $ do cstr <- getUTF8String strRef cond (cstr == nullPtr) Nothing $ do hstr <- convertString cstr free cstr return hstr getInt :: CFTypeRef -> IO (Maybe Int) getInt ref = isNumberRef ref >>= onlyNumberRef where onlyNumberRef False = return Nothing onlyNumberRef True = do let numRef = castPtr ref alloca $ \ptr -> do res <- c_CFNumberGetValue numRef kCFNumberSInt64Type (ptr :: Ptr CLong) condMsg (res == bFALSE) "Cannot convert Core Foundation number to signed 64-bit integer." Nothing $ do num <- peek ptr return $ Just $ fromIntegral num -- dictionary utilities getDictFromArray :: CFArrayRef -> CFIndex -> IO (Maybe CFDictionaryRef) getDictFromArray arrayRef idx = do ref <- c_CFArrayGetValueAtIndex arrayRef idx isDictionaryRef ref >>= return . onlyDictRef ref where onlyDictRef ref True = Just $ castPtr ref onlyDictRef ref False = Nothing getDictValue :: CFDictionaryRef -> String -> IO CFTypeRef getDictValue dictRef str = do strRef <- createUTF8StringRefNoCopy =<< newCString str condMsg (strRef == nullPtr) ("Cannot convert string '" ++ str ++"' to Core Foundation string.") nullPtr $ do obj <- c_CFDictionaryGetValue dictRef strRef c_CFRelease $ castPtr strRef return obj -- IOKit utilities getHIDSystemIterator :: IO Cio_iterator_t getHIDSystemIterator = do masterPort <- alloca $ \ptr -> do res <- c_IOMasterPort cMACH_PORT_NULL ptr condMsg (res /= iKERN_SUCCESS) ("Cannot create master port: error " ++ show res ++ ".") 0 $ peek ptr condMsg (masterPort == 0) "Got empty master port." 0 $ alloca $ \ptr -> do dictRef <- c_IOServiceMatching =<< newCString "IOHIDSystem" condMsg (dictRef == nullPtr) "Cannot create the IOHIDSystem matching dictionary." 0 $ do res <- c_IOServiceGetMatchingServices masterPort dictRef ptr condMsg (res /= iKERN_SUCCESS) ("Cannot get the iterator handle: error " ++ show res ++ ".") 0 $ peek ptr getHIDSystemIdleTime :: Cio_registry_entry_t -> IO CFTypeRef getHIDSystemIdleTime entry = do cond (entry == 0) nullPtr $ do strRef <- createUTF8StringRefNoCopy =<< newCString "HIDIdleTime" condMsg (strRef == nullPtr) "Cannot create HIDIdleTime Core Foundation string." nullPtr $ do allocDefault <- c_kCFAllocatorDefault ref <- c_IORegistryEntryCreateCFProperty entry strRef allocDefault 0 c_CFRelease $ castPtr strRef condMsg (ref == nullPtr) "Cannot create the HIDIdleTime property string." nullPtr $ return ref withIOObject :: Cio_object_t -> IO Int -> IO Int withIOObject obj comp = do condMsg (obj == 0) "Got empty IO object." (-1) $ do res <- comp c_IOObjectRelease obj return res -- in nanoseconds getIdleTimeNs :: IO Int getIdleTimeNs = do iter <- getHIDSystemIterator withIOObject iter $ do curObj <- c_IOIteratorNext iter withIOObject curObj $ do idleRef <- getHIDSystemIdleTime curObj getInt idleRef >>= return . fromMaybe (-1) -- window properties getWindowInfo :: IO CFArrayRef getWindowInfo = do let opts = kCGWindowListExcludeDesktopElements .|. kCGWindowListOptionOnScreenOnly c_CGWindowListCopyWindowInfo opts kCGNullWindowID getWindowTitle :: CFArrayRef -> CLong -> IO (Maybe (Int, String, String)) getWindowTitle info idx = do dict <- getDictFromArray info idx >>= return . fromMaybe nullPtr condMsg (dict == nullPtr) ("Cannot retrieve the properties dictionary for window " ++ show idx ++ ".") Nothing $ do layer <- getDictValue dict "kCGWindowLayer" >>= getInt cond (isNothing layer || fromJust layer /= 0) Nothing $ do window <- getDictValue dict "kCGWindowName" >>= getString owner <- getDictValue dict "kCGWindowOwnerName" >>= getString cond (isNothing window || isNothing owner) Nothing $ do return $ Just (fromIntegral idx, fromJust window, fromJust owner) fetchWindowTitles :: IO [(Int, String, String)] fetchWindowTitles = do windowInfo <- getWindowInfo condMsg (windowInfo == nullPtr) "Cannot get the windows information array." [] $ do count <- c_CFArrayGetCount windowInfo titles <- (forM [0..count - 1] $ getWindowTitle windowInfo) >>= return . catMaybes c_CFRelease $ castPtr windowInfo return titles getWindowIdx :: Maybe (Int, String, String) -> Maybe Int getWindowIdx Nothing = Nothing getWindowIdx (Just (idleTime, _, _)) = Just idleTime getForegroundWindowIdx :: CFArrayRef -> CLong -> CLong -> IO (Maybe Int) getForegroundWindowIdx info idx count = do cond (count == 0) Nothing $ do title <- getWindowTitle info idx cond (isJust title) (getWindowIdx title) $ getForegroundWindowIdx info (idx + 1) (count - 1) getForegroundWindow :: IO Int getForegroundWindow = do windowInfo <- getWindowInfo condMsg (windowInfo == nullPtr) "Cannot get the windows information array." (-1) $ do count <- c_CFArrayGetCount windowInfo idx <- getForegroundWindowIdx windowInfo 0 count c_CFRelease $ castPtr windowInfo return $ fromMaybe (-1) idx -- idle time -- in milliseconds getIdleTime :: IO Integer getIdleTime = getIdleTimeNs >>= return . \idleTime -> quot (fromIntegral idleTime) 1000000 arbtt-0.9.0.13/src/Data/0000755000000000000000000000000013074765620012716 5ustar0000000000000000arbtt-0.9.0.13/src/Data/MyText.hs0000644000000000000000000000501413074765620014504 0ustar0000000000000000module Data.MyText where import qualified Data.ByteString.UTF8 as BSU import qualified Data.ByteString.Lazy.UTF8 as BLU 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, null) 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 get = pack <$> get -- The following code exploits that the Binary Char instance uses UTF8 as well -- The downside is that it quietly suceeds for broken input -- Unfortunately, with binary-0.7, it is no longer possible to implement -- this nice and lazily, so go via String :-( {- get = do n <- get :: Get Int bs <- lookAhead $ getRemainingLazyByteString let utf8bs = BLU.take (fromIntegral n) bs unless (BLU.length utf8bs == n) $ fail $ "Coult not parse the expected " ++ show n ++ " utf8 characters." let sbs = LBS.toStrict utf8bs skip $ BS.length sbs return $ Text sbs -} {- 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 null :: Text -> Bool null = BS.null . toBytestring arbtt-0.9.0.13/src/Data/Binary/0000755000000000000000000000000013074765620014142 5ustar0000000000000000arbtt-0.9.0.13/src/Data/Binary/StringRef.hs0000644000000000000000000001003713074765620016402 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.9.0.13/src/Data/List/0000755000000000000000000000000013074765620013631 5ustar0000000000000000arbtt-0.9.0.13/src/Data/List/TakeR.hs0000644000000000000000000000160513074765620015175 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Data.List.TakeR where import Control.Monad.ST import Debug.Trace import Data.Array.MArray import Data.Array.ST -- Efficient taking of last r values takeR n l = go (drop n l) l where go [] r = r go (x:xs) (y:ys) = go xs ys -- Much faster and better evaluation properties than: {- takeR :: forall a. Int -> [a] -> [a] takeR n l | n <= 0 = [] takeR n l = runST stAction where stAction :: forall s. ST s [a] stAction = do buffer <- newArray_ (0, n-1) i <- go (buffer :: STArray s Int a) 0 l let s = min i n sequence $ [ readArray buffer (j `mod` n) | j <- [i-s..i-1] ] go buffer i [] = return i go buffer i (x:xs) = writeArray buffer (i `mod` n) x >> go buffer (i+1) xs -} -- Correctness asserted by -- quickCheck (\n l -> n <= 100000 ==> takeR n l == reverse (take n (reverse (l::[Int]) ))) arbtt-0.9.0.13/src/Capture/0000755000000000000000000000000013074765620013450 5ustar0000000000000000arbtt-0.9.0.13/src/Capture/X11.hs0000644000000000000000000001004713074765620014357 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 -- Desktops current_desktop <- flip catchIOError (\_ -> return "") $ do a <- internAtom dpy "_NET_CURRENT_DESKTOP" False p <- getWindowProperty32 dpy a rwin let desk_index = do {[d] <- p; return (fromIntegral d)} a <- internAtom dpy "_NET_DESKTOP_NAMES" False tp <- getTextProperty dpy rwin a names <- wcTextPropertyToTextList dpy tp return $ case desk_index of Nothing -> "" Just n -> if 0 <= n && n < length names then names !! n else show n -- Windows a <- internAtom dpy "_NET_CLIENT_LIST" False p <- getWindowProperty32 dpy a rwin wins <- case p of Just wins -> filterM (isInteresting dpy) (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 (T.pack current_desktop) 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 -- | Ignore, for example, Desktop and Docks windows isInteresting :: Display -> Window -> IO Bool isInteresting d w = do a <- internAtom d "_NET_WM_WINDOW_TYPE" False dock <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False desk <- internAtom d "_NET_WM_WINDOW_TYPE_DESKTOP" False mbr <- getWindowProperty32 d a w case mbr of Just [r] -> return $ fromIntegral r `notElem` [dock, desk] _ -> return True -- | better than fetchName from X11, as it supports _NET_WM_NAME and unicode -- -- 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.9.0.13/src/Capture/Win32.hs0000644000000000000000000000122013074765620014701 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 (T.pack "") arbtt-0.9.0.13/src/Capture/OSX.hs0000644000000000000000000000105113074765620014452 0ustar0000000000000000module Capture.OSX where import Data import qualified Data.MyText as T import Control.Monad import Control.Applicative import Graphics.OSX.Window 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 (T.pack "") arbtt-0.9.0.13/tests/0000755000000000000000000000000013074765620012420 5ustar0000000000000000arbtt-0.9.0.13/tests/unicode.cfg0000644000000000000000000000012613074765620014526 0ustar0000000000000000any window $title =~ /aäα/ ==> tag ok, any window $title =~ /aäƱ/ ==> tag notok, arbtt-0.9.0.13/tests/issue4.cfg0000644000000000000000000000035313074765620014316 0ustar0000000000000000-- Firefox current window $program == "program" ==> if current window $title =~ /^(aaa)/ then tag Cat:$1 else if current window $title =~ /^(aa)/ then tag Cat:$1 else if current window $title =~ /^(a)/ then tag Cat:$1 else tag None arbtt-0.9.0.13/tests/small_import.in0000644000000000000000000000246713074765620015463 0ustar0000000000000000TimeLogEntry {tlTime = 2010-03-20 13:59:15.075576 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 2909, cDesktop = ""}} TimeLogEntry {tlTime = 2010-03-20 14:00:15.157669 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 557, cDesktop = ""}} TimeLogEntry {tlTime = 2010-03-20 14:01:15.220521 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 58004, cDesktop = ""}} arbtt-0.9.0.13/tests/small_borked_recover.out0000644000000000000000000000104213074765620017331 0ustar0000000000000000arbtt-timelog-v1 ?,wH`(stats-main.hs (~/darcs/arbtt/src) - GVIMgvim`ghci' mrtrac@curie:~ urxvt`irssi' mrtrac@curie:~ urxvtmrtrac@curie:~/darcs/arbtt urxvt`mutt' mrtrac@curie:~ urxvt2HackageDB: network-bytestring-0.1.2.1 - Vimperator Navigator ]A B@`  -) B@`  arbtt-0.9.0.13/tests/small_dump.out0000644000000000000000000000246713074765620015317 0ustar0000000000000000TimeLogEntry {tlTime = 2010-03-20 13:59:15.075576 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 2909, cDesktop = ""}} TimeLogEntry {tlTime = 2010-03-20 14:00:15.157669 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 557, cDesktop = ""}} TimeLogEntry {tlTime = 2010-03-20 14:01:15.220521 UTC, tlRate = 60000, tlData = CaptureData {cWindows = [(False,"stats-main.hs (~/darcs/arbtt/src) - GVIM","gvim"),(False,"`ghci' mrtrac@curie:~ ","urxvt"),(False,"`irssi' mrtrac@curie:~ ","urxvt"),(True,"mrtrac@curie:~/darcs/arbtt ","urxvt"),(False,"`mutt' mrtrac@curie:~ ","urxvt"),(False,"HackageDB: network-bytestring-0.1.2.1 - Vimperator","Navigator")], cLastActivity = 58004, cDesktop = ""}} arbtt-0.9.0.13/tests/unicode.log0000644000000000000000000000013513074765620014550 0ustar0000000000000000arbtt-timelog-v1 ?,wH`aäαunicodearbtt-0.9.0.13/tests/small.log0000644000000000000000000000100713074765620014231 0ustar0000000000000000arbtt-timelog-v1 ?,wH`(stats-main.hs (~/darcs/arbtt/src) - GVIMgvim`ghci' mrtrac@curie:~ urxvt`irssi' mrtrac@curie:~ urxvtmrtrac@curie:~/darcs/arbtt urxvt`mutt' mrtrac@curie:~ urxvt2HackageDB: network-bytestring-0.1.2.1 - Vimperator Navigator ]A B@`  -) B@`  arbtt-0.9.0.13/tests/gap-handling.out0000644000000000000000000000132413074765620015502 0ustar0000000000000000Intervals for category "Program" ================================ __________________Tag_|______________From_|_____________Until_|_Duration_ gnome-terminal-server | 09/20/15 14:24:03 | 09/20/15 14:25:22 | 1m19s Navigator | 09/20/15 14:25:22 | 09/20/15 14:26:22 | 1m00s Navigator | 09/20/15 14:49:31 | 09/20/15 14:55:41 | 6m10s gnome-terminal-server | 09/20/15 14:55:41 | 09/20/15 14:56:31 | 50s gnome-terminal-server | 09/20/15 18:51:47 | 09/20/15 18:52:17 | 30s Navigator | 09/20/15 18:52:17 | 09/20/15 18:52:37 | 20s Navigator | 09/20/15 18:53:15 | 09/20/15 18:53:55 | 40s gnome-terminal-server | 09/20/15 18:53:55 | 09/20/15 18:54:25 | 30s arbtt-0.9.0.13/tests/categorize.cfg0000644000000000000000000000167713074765620015250 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", ) -- A rule that probably everybody wants. Being inactive for over a minute -- causes this sample to be ignored by default. $idle > 60 ==> tag inactive, -- Simple rule that just tags the current program tag Program:$current.program, -- To be able to match on the time of day, I introduce tags for that as well $time >= 2:00 && $time < 8:00 ==> tag time-of-day:night, $time >= 8:00 && $time < 12:00 ==> tag time-of-day:morning, $time >= 12:00 && $time < 14:00 ==> tag time-of-day:lunchtime, $time >= 14:00 && $time < 18:00 ==> tag time-of-day:afternoon, $time >= 18:00 && $time < 22:00 ==> tag time-of-day:evening, $time >= 22:00 || $time < 2:00 ==> tag time-of-day:late-evening, -- This tag always refers to the last 24h $sampleage <= 24:00 ==> tag last-day, arbtt-0.9.0.13/tests/unicode_stats.out0000644000000000000000000000013313074765620016012 0ustar0000000000000000Total time per tag ================== Tag_|___Time_|_Percentage_ ok | 1m00s | 100.00 arbtt-0.9.0.13/tests/issue14.cfg0000644000000000000000000000010113074765620014366 0ustar0000000000000000$sampleage > 100:00 ==> tag old, $sampleage < 100:00 ==> tag new arbtt-0.9.0.13/tests/small_stats_csv.out0000644000000000000000000000010113074765620016342 0ustar0000000000000000Tag,Time,Percentage arbtt,0:03:00,100.00 before_14,0:01:00,33.33 arbtt-0.9.0.13/tests/small.cfg0000644000000000000000000000012313074765620014205 0ustar0000000000000000current window $title =~ m/arbtt/ ==> tag arbtt, $time < 14:00 ==> tag before_14 arbtt-0.9.0.13/tests/gap-handling.cfg0000644000000000000000000000003513074765620015430 0ustar0000000000000000tag Program:$current.program arbtt-0.9.0.13/tests/gap-handling.log0000644000000000000000000001352413074765620015461 0ustar0000000000000000arbtt-timelog-v1 1  B@`"amenthes@Kepler: ~/workspace/arbttgnome-terminal-server^nomeata / arbtt / issues / #29 - Lock-Screen and machine off / standby — Bitbucket - Iceweasel Navigator*arbtt-standby.txt (~/Schreibtisch) - geditgedit Arbeitsfläche 1ť  '"amenthes@Kepler: ~/workspace/arbttgnome-terminal-server^nomeata / arbtt / issues / #29 - Lock-Screen and machine off / standby — Bitbucket - Iceweasel Navigator*arbtt-standby.txt (~/Schreibtisch) - geditgeditArbeitsfläche 1AG$'&Arbeitsfläche 1  B@'MArbeitsfläche 1liА'tArbeitsfläche 1c$'Arbeitsfläche 1WD B@'Arbeitsfläche 1Gp B@'9Arbeitsfläche 1ih  '`Arbeitsfläche 1é5':Arbeitsfläche 1 5'YArbeitsfläche 1]? B@'xArbeitsfläche 1U.m B@' Arbeitsfläche 1 m B@'LArbeitsfläche 1/7 'wArbeitsfläche 1#А'8Arbeitsfläche 17 '_Arbeitsfläche 1*p B@'Arbeitsfläche 1S]H'Arbeitsfläche 1,>'Arbeitsfläche 170} @'#Arbeitsfläche 1Pr B@'#@Arbeitsfläche 1Y"&s B@'J`Arbeitsfläche 1s B@'qArbeitsfläche 1cz'Arbeitsfläche 1vt B@'Arbeitsfläche 1EBu B@'Arbeitsfläche 1"v B@' Arbeitsfläche 1ںv B@'5Arbeitsfläche 1Y:u$'\+Arbeitsfläche 18; 'IArbeitsfläche 1G!А'_Arbeitsfläche 1]y B@'tArbeitsfläche 1y B@'Arbeitsfläche 1cOz B@'Arbeitsfläche 11]H'FArbeitsfläche 1G׀{ B@'mArbeitsfläche 1 > 'Arbeitsfläche 1kb| B@'Arbeitsfläche 13K} B@'9Arbeitsfläche 1]> ' PArbeitsfläche 1Z>? '1oArbeitsfläche 19 B@'XArbeitsfläche 1 @'Arbeitsfläche 1{#@ 'Arbeitsfläche 1U@'Arbeitsfläche 1C|x B@'Arbeitsfläche 1G B@'Arbeitsfläche 12D@'AArbeitsfläche 13B B@'& Arbeitsfläche 1vۃ B@'M@Arbeitsfläche 1[Mt B@'t`Arbeitsfläche 1m B@'~Arbeitsfläche 1祅 B@'œArbeitsfläche 1 y@'"amenthes@Kepler: ~/workspace/arbttgnome-terminal-server^nomeata / arbtt / issues / #29 - Lock-Screen and machine off / standby — Bitbucket - Iceweasel Navigator+*arbtt-standby.txt (~/Schreibtisch) - geditgeditArbeitsfläche 1 '&Arbeitsfläche 1oAB@'Arbeitsfläche 1 eB@'$nArbeitsfläche 1) @'Arbeitsfläche 1H' Arbeitsfläche 1~noz'^Arbeitsfläche 1ᡁА'sArbeitsfläche 1UB@'\Arbeitsfläche 1]8B@'VArbeitsfläche 1?)+ @'FtArbeitsfläche 15 H'lArbeitsfläche 1arbtt-0.9.0.13/tests/small_stats.out0000644000000000000000000000020713074765620015476 0ustar0000000000000000Total time per tag ================== ______Tag_|___Time_|_Percentage_ arbtt | 3m00s | 100.00 before_14 | 1m00s | 33.33 arbtt-0.9.0.13/tests/issue5.cfg0000644000000000000000000000020313074765620014311 0ustar0000000000000000current window $title =~ /^aaa/ ==> tag A3; current window $title =~ /^aa/ ==> tag A2; current window $title =~ /^a/ ==> tag A1 arbtt-0.9.0.13/tests/small_import.out0000644000000000000000000000104213074765620015650 0ustar0000000000000000arbtt-timelog-v1 ?,wH`(stats-main.hs (~/darcs/arbtt/src) - GVIMgvim`ghci' mrtrac@curie:~ urxvt`irssi' mrtrac@curie:~ urxvtmrtrac@curie:~/darcs/arbtt urxvt`mutt' mrtrac@curie:~ urxvt2HackageDB: network-bytestring-0.1.2.1 - Vimperator Navigator ]A B@`  -) B@`  arbtt-0.9.0.13/tests/small_borked.log0000644000000000000000000000100713074765620015557 0ustar0000000000000000arbpt-timelog-v1 ?,wH`(stats-main.hs (~/darcs/arbtt/src) - GVIMgvim`ghci' mrtrac@curie:~ urxvt`irssi' mrtrac@curie:~ urxvtmrtrac@curie:~/darcs/arbtt urxvt`mutt' mrtrac@curie:~ urxvt2HackageDB: network-bytestring-0.1.2.1 - Vimperator Navigator ]A B@`  -) B@`  arbtt-0.9.0.13/tests/test.hs0000644000000000000000000000773213074765620013744 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} import Test.Tasty hiding (defaultMain) import Test.Tasty.Golden.Manage import Test.Tasty.Golden import Test.Tasty.HUnit import System.Process.ByteString.Lazy import qualified Data.ByteString.Lazy as B import Control.Monad import Control.Exception import Data.Typeable import System.Exit import System.Environment import Data.Maybe import Categorize import TimeLog import Data import Data.Time.Clock main = do setEnv "TZ" "UTC" -- to make tests reproducible distDir <- fromMaybe "dist" `liftM` lookupEnv "HASKELL_DIST_DIR" defaultMain (tests distDir) tests :: FilePath -> TestTree tests distDir = testGroup "Tests" [goldenTests distDir, regressionTests] regressionTests :: TestTree regressionTests = testGroup "Regression tests" [ testCase "Issue #4" $ do cat <- readCategorizer "tests/issue4.cfg" let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "") let [TimeLogEntry _ _ (_,acts)] = cat [sample] [Activity (Just "Cat") "aa"] @=? acts return () , testCase "Issue #5" $ do cat <- readCategorizer "tests/issue5.cfg" let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "") let [TimeLogEntry _ _ (_,acts)] = cat [sample] [Activity Nothing "A2"] @=? acts return () , testCase "Issue #14" $ do cat <- readCategorizer "tests/issue14.cfg" now <- getCurrentTime let backThen = (-60*60*101) `addUTCTime` now let sample = TimeLogEntry backThen 0 (CaptureData [(True, "aa", "program")] 0 "") let [TimeLogEntry _ _ (_,acts)] = cat [sample] [Activity Nothing "old"] @=? acts return () ] goldenTests :: FilePath -> TestTree goldenTests distDir = testGroup "Golden tests" [ goldenVsString "dump small" "tests/small_dump.out" $ run (distDir ++ "/build/arbtt-dump/arbtt-dump") ["-f","tests/small.log", "-t", "Show"] B.empty , goldenVsFile "import small" "tests/small_import.out" "tests/small_import.out.actual" $ void $ B.readFile "tests/small_import.in" >>= run (distDir ++ "/build/arbtt-import/arbtt-import") ["-f","tests/small_import.out.actual"] , goldenVsFile "recover small" "tests/small_borked_recover.out" "tests/small_borked_recover.out.actual" $ void $ run (distDir ++ "/build/arbtt-recover/arbtt-recover") ["-i","tests/small_borked_recover.out", "-o", "tests/small_borked_recover.out.actual"] B.empty , goldenVsString "stats small" "tests/small_stats.out" $ run (distDir ++ "/build/arbtt-stats/arbtt-stats") ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg"] B.empty , goldenVsString "stats small csv" "tests/small_stats_csv.out" $ run (distDir ++ "/build/arbtt-stats/arbtt-stats") ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg", "--output-format", "csv"] B.empty , goldenVsString "stats small unicode" "tests/unicode_stats.out" $ run (distDir ++ "/build/arbtt-stats/arbtt-stats") ["--logfile", "tests/unicode.log", "--categorize", "tests/unicode.cfg"] B.empty , goldenVsString "stats gap handling" "tests/gap-handling.out" $ run (distDir ++ "/build/arbtt-stats/arbtt-stats") ["--logfile", "tests/gap-handling.log", "--categorize", "tests/gap-handling.cfg", "--intervals", "Program:"] B.empty ] run :: FilePath -> [FilePath] -> B.ByteString -> IO B.ByteString run cmd args stdin = do (ex,stdout,stderr) <- readProcessWithExitCode cmd args stdin unless (B.null stderr) $ throwIO $ StderrException stderr case ex of ExitSuccess -> return (B.filter (not . (==13)) stdout) -- windows compat ExitFailure r -> throwIO $ ExitCodeException r data StderrException = StderrException B.ByteString deriving (Show, Typeable) data ExitCodeException = ExitCodeException Int deriving (Show, Typeable) instance Exception StderrException instance Exception ExitCodeException