arbtt (empty) → 0.1
raw patch · 14 files changed
+1493/−0 lines, 14 filesdep +X11dep +basedep +containerssetup-changed
Dependencies added: X11, base, containers, directory, filepath, mtl, parsec, pcre-light, tabular, time, unix
Files
- LICENSE +340/−0
- README +136/−0
- Setup.hs +3/−0
- arbtt-capture.desktop +10/−0
- arbtt.cabal +53/−0
- categorize.cfg +30/−0
- src/Capture.hs +46/−0
- src/Categorize.hs +281/−0
- src/Data.hs +54/−0
- src/Graphics/X11/XScreenSaver.hsc +187/−0
- src/Stats.hs +159/−0
- src/TimeLog.hs +25/−0
- src/capture.hs +32/−0
- src/stats.hs +137/−0
+ LICENSE view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ 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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ README view
@@ -0,0 +1,136 @@+arbtt, the Automatic Rule-Based Time Tracker++© 2009 Joachim Breitner <mail@joachim-breitner.de>++The Automatic Rule-Based Time Tracker is a desktop daemon that runs in the+background and, every minute, records what windows are open on your+desktop, what their titles are, which one is active. The accompanied+statistics program lets you derive information from this log file, i.e.+what how much of your time have you been spending with e-Mail, or what+projects are your largest time wasters. The mapping from the raw window+titles to sensible „tags“ is done by a configuration file with an powerful+syntax.++Installation+============++You can build and install this program as any other Cabalized program:+ $ runhaskell Setup.hs configure+ $ runhaskell Setup.hs build+ $ runhaskell Setup.hs install++You also need to make sure that arbtt-capture is started with your X+session. If you use GNOME or KDE, you can copy the file+"arbtt-capture.desktop" to ~/.config/autostart/. You might need to put the+full path to arbtt-capture in the Exec line there, if you did not do a+system wide installation.++Configuration+=============++Once arbtt-capture is running, it will start recording, without further+configuration. The configuration is only needed to do an analysis of the+recorded data. Thus, if you improve your categorization there, it will+apply even to previous data samples!++The configuration file needs to be placed in ~/.arbtt/categorize.cfg. An+example file is included, which should be more enlighting than this rather+formal description.++Whitespace is non-significant and Haskell-style comments are allowed.++Here is grammar of the file:++Rules := [ "aliases" AliasSpec ] Rule ( ("," Rule)* | (";" Rule)* )++Rule := "{" Rules "}" | Cond "==>" Rule | "if" Cond "then" Rule "else" Rule+ | "tag" Tag++Cond := "(" Cond ")" | "!" Cond | Cond "&&" Cond | Cond "||" Cond + | "$" SVar "==" String | "$" SVar "/=" String+ | "$" SVar "=~" "/" Regex "/" |+ | "$" NVar NOp Number+ | "$" BVar+ | "current window" $cond+ | "any window" $cond++SVar := "title" | "program"+NVar := "idle"+BVar := "active"++The variables $title, $program, $active refer to the "window in scope". At+first, no window is in scope. Only when evaluating the condition passed to+"current window" or "any window", this changes.++For "current window", the currently active window is in scopre. If there is+no such window, the condition is false.++For "any window", the condition is applied to each window, and if any+window matches the condition, the result is true. If it matches more than+one window, of which match the variables $1,.. (see below) will be taken.++Tags are not enclosed in quotation marks, and contain only letters, dashes+or underscores (e.g. work).++They may be prepended with a category,+separated by a colon (e.g. Project:arbtt). This category can later be used+for pie chart like statistics. For each category, no more than one tags can+be matched per sample. If multiple tags with the same category are+generated by the rules, only the first one will be taken.++A tag can also interpolate variables, including in the category part.+Available variables are:+ $1, $2,.. Matches from the last successfully applied regular expression+ in the enclosing condition+ $current.title+ $current.program+ The title or the name of the currently active program. If no+ program happens to be active, this tag will be ignored.++Statistics+==========++Run the statistics program arbtt-stats with the parameter --help to get an+overview of the options.++By default, any sample with the tag "inactive" are excluded from the+statistics, and tags with a percentage lower than one will not be shown.++The tags that affect the selection (-x, -o, --also-inactive) of samples can+be mixed with the report options (-m) and the reports (-i, -t, -c), but+will apply to all reports.++Some useful examples:++ # Only consider the time when I was programming in Haskell + arbtt-stats -o Editing-Haskell++ # Tell me what evolution folders I spend my time in when I actually do+ # work with e-Mail+ are arbtt-stats -o Program:evolution -c Evo-Folder++Development+===========++You are very welcome to help the developement of arbtt. You can find the+latest source at the darcs repository at+ http://darcs.nomeata.de/arbtt++Some of my plans or ideas include:++ * A graphical viewer that allows you to expore the tags in an appealing,+ interactive way. Possibly based on the Charts haskell library.+ * A better representation of the data in the log, to keep the size and + parsing speed down. + * Looking forward and backwards in time when writing rules. (Information+ is already passed to the categorizing function, but not exposed to the+ syntax).+ * $total_idle time, which is the maximum idle time until it is reset. This+ would allow the user to catch the idle times more exactly.+ * Rules based on day of time, to create tags for worktime, weekend, late+ at night.+ * Statistics based on time, to visualize trends.+ * Possibly more data sources?++Any help cleaning, documenting or testing the current code is appreciated+as well.
+ Setup.hs view
@@ -0,0 +1,3 @@+module Main where+import Distribution.Simple+main = defaultMain
+ arbtt-capture.desktop view
@@ -0,0 +1,10 @@+[Desktop Entry]+Encoding=UTF-8+Name=arbtt Data Capture Program+#Icon=+Comment=Records information about the user’s application usage+Type=Application+#Categories=+Exec=arbtt-capture+Terminal=false+StartupNotify=false
+ arbtt.cabal view
@@ -0,0 +1,53 @@+cabal-version: >= 1.6+build-type: Simple+name: arbtt+version: 0.1+license: GPL+license-file: LICENSE+category: Development+author: Joachim Breitner <mail@joachim-breitner.de>+maintainer: Joachim Breitner <mail@joachim-breitner.de>+copyright: Joachim Breitner 2009+synopsis: Automatic Rule-Based Time Tracker+description:+ arbtt is a background daemon that stores which windows are open, which one+ has the focus and how long since your last action (and possbly more sources+ later), and stores this. It is also a program that will, based on+ expressive rules you specify, derive what you were doing, and what for.+ .+ WARNING: The log file might contain very sensitive private data. Make sure+ you understand the consequences of a full-time logger and be careful with this+ data.+homepage: http://www.joachim-breitner.de/projects#arbtt+++extra-source-files:+ categorize.cfg, arbtt-capture.desktop, README++executable arbtt-capture+ main-is: capture.hs+ hs-source-dirs: src+ build-depends:+ base == 4.*, filepath, directory, mtl, time, unix,+ X11 > 1.4.4+ extra-libraries: Xss+ other-modules:+ Data+ Capture+ TimeLog+ Graphics.X11.XScreenSaver++executable arbtt-stats+ main-is: stats.hs+ hs-source-dirs: src+ build-depends:+ base == 4.*, parsec == 2.*, containers, pcre-light, tabular+ other-modules:+ Data+ Categorize+ TimeLog+ Stats++source-repository head+ type: darcs+ location: http://darcs.nomeata.de/arbtt
+ categorize.cfg view
@@ -0,0 +1,30 @@+-- This defines some aliases, to make the reports look nicer:+aliases (+ "sun-awt-X11-XFramePeer" -> "java",+ "sun-awt-X11-XDialogPeer" -> "java",+ "sun-awt-X11-XWindowPeer" -> "java",+ "gramps.py" -> "gramps"+ )++-- A rule that probably everybody wants. Being inactive for over a minute+-- causes this sample to be ignored by default.+$idle > 60 ==> tag inactive,++-- Simple rule that just tags the current program+tag Program:$current.program,++-- I'd like to know what evolution folders I'm working in. But when sending a mail,+-- the window title only contains the (not very helpful) subject. So I do not tag+-- necessarily by the active window title, but the title that contains the folder+current window $program == "evolution" &&+any window ($program == "evolution" && $title =~ /^(.*) \([0-9]+/)+ ==> tag Evo-Folder:$1,++-- A general rule that works well with gvim and gnome-terminal and tells me what+-- project I'm currently working on+current window $title =~ m!(?:~|home/jojo)/projekte/(?:programming/(?:haskell/)?)?([^/)]*)!+ ==> tag Project:$1,++-- Out of curiosity: what percentage of my time am I actually coding Haskell?+current window ($program == "gvim" && $title =~ /^[^ ]+\.hs \(/ )+ ==> tag Editing-Haskell,
+ src/Capture.hs view
@@ -0,0 +1,46 @@+module Capture where++import Data+import Graphics.X11+import Graphics.X11.Xlib.Extras+import Graphics.X11.XScreenSaver (getXIdleTime)+import Control.Monad+import Data.Maybe+import Control.Applicative+import Data.Time.Clock++captureData :: IO CaptureData+captureData = do+ dpy <- openDisplay ":0"+ xSetErrorHandler+ let rwin = defaultRootWindow dpy+ (_,_,cwins) <- queryTree dpy rwin++ cwins <- filterM (isInterestingWindow dpy) cwins+ (fwin,_) <- getInputFocus dpy+ winData <- mapM (\w -> (,,) (w == fwin) <$> getWindowTitle dpy w <*> getProgramName dpy w) cwins++ it <- fromIntegral `fmap` getXIdleTime dpy++ closeDisplay dpy+ return $ CaptureData winData it++-- copied from XMonad/Main.hs, where function "ok" from "scan"+isInterestingWindow :: Display -> Window -> IO Bool+isInterestingWindow dpy w = do+ wa <- getWindowAttributes dpy w+ a <- internAtom dpy "WM_STATE" False+ p <- getWindowProperty32 dpy a w+ let ic = case p of+ Just (3:_) -> True -- 3 for iconified+ _ -> False+ return $ not (wa_override_redirect wa)+ && (wa_map_state wa == waIsViewable || ic)+++getWindowTitle :: Display -> Window -> IO String+getWindowTitle dpy w = fmap (fromMaybe "") $ fetchName dpy w++getProgramName :: Display -> Window -> IO String+getProgramName dpy w = fmap resName $ getClassHint dpy w+
+ src/Categorize.hs view
@@ -0,0 +1,281 @@+module Categorize where++import Data++import Data.Maybe+-- import Text.Regex+import qualified Text.Regex.PCRE.Light.Char8 as RE+import qualified Data.Map as M+import Control.Monad+import Control.Monad.Instances++import Text.ParserCombinators.Parsec hiding (Parser)+import Text.ParserCombinators.Parsec.Token+import Text.ParserCombinators.Parsec.Language+import Text.ParserCombinators.Parsec.Expr+import System.Exit+import Control.Applicative ((<*>),(<$>))+import Data.List+import Data.Maybe+import Data.Char+import Debug.Trace++type Categorizer = TimeLog CaptureData -> TimeLog ActivityData+type Rule = Ctx -> ActivityData++type Parser a = CharParser () a++data Ctx = Ctx+ { cNow :: CaptureData+ , cPast :: [CaptureData]+ , cFuture :: [CaptureData]+ , cWindowInScope :: Maybe (Bool, String, String)+ , cSubsts :: [String]+ }+ deriving (Show)++type Cond = Ctx -> Maybe [String]++readCategorizer :: FilePath -> IO Categorizer+readCategorizer filename = do+ content <- readFile filename+ case parse (do {r <- parseRules; eof ; return r}) filename content of+ Left err -> do+ putStrLn "Parser error:"+ putStrLn (show err)+ exitFailure+ Right cat -> return ((fmap . fmap) (postpare . cat) . prepare)++prepare :: TimeLog CaptureData -> TimeLog Ctx+prepare tl = go' [] (map tlData tl) tl+ where go' past [] []+ = []+ go' past (this:future) (now:rest)+ = now {tlData = Ctx this past future Nothing [] } :+ go' (this:past) future rest++-- | Here, we filter out tags appearing twice, and make sure that only one of+-- each category survives+postpare :: ActivityData -> ActivityData+postpare = nubBy $ go+ where go (Activity (Just c1) _) (Activity (Just c2) _) = c1 == c2+ go a1 a2 = a1 == a2++lang :: TokenParser ()+lang = haskell++parseRules :: Parser Rule+parseRules = do + whiteSpace lang+ a <- option id (reserved lang "aliases" >> parens lang parseAliasSpecs)+ rb <- parseRulesBody+ return (a . rb)++parseAliasSpecs :: Parser (ActivityData -> ActivityData)+parseAliasSpecs = do as <- sepEndBy1 parseAliasSpec (comma lang)+ return $ \ad -> foldr doAlias ad as++doAlias :: (String, String) -> ActivityData -> ActivityData+doAlias (s1,s2) = map go+ where go (Activity cat tag) = Activity (if cat == Just s1 then Just s2 else cat)+ (if tag == s1 then s2 else tag)++parseAliasSpec :: Parser (String, String)+parseAliasSpec = do s1 <- stringLiteral lang+ reservedOp lang "->"+ s2 <- stringLiteral lang+ return (s1,s2)++parseRulesBody :: Parser (Ctx -> ActivityData)+parseRulesBody = do + x <- parseRule+ choice [ do comma lang+ xs <- sepEndBy1 parseRule (comma lang)+ return (matchAny (x:xs))+ , do semi lang+ xs <- many1 (semi lang >> parseRule)+ return (matchFirst (x:xs))+ , return x+ ]++parseRule :: Parser Rule+parseRule = choice+ [ braces lang parseRules+ , do cond <- parseCond+ reservedOp lang "==>"+ rule <- parseRule+ return (ifThenElse cond rule matchNone)+ , do reserved lang "if"+ cond <- parseCond+ reserved lang "then"+ rule1 <- parseRule+ reserved lang "else"+ rule2 <- parseRule+ return (ifThenElse cond rule1 rule2)+ , do reserved lang "tag"+ parseSetTag+ ]++parseCond :: Parser Cond+parseCond = buildExpressionParser [+ [ Prefix (reservedOp lang "!" >> return checkNot) ],+ [ Infix (reservedOp lang "&&" >> return checkAnd) AssocLeft ],+ [ Infix (reservedOp lang "||" >> return checkOr) AssocLeft ]+ ] parseCondPrim++checkAnd :: Cond -> Cond -> Cond +checkAnd c1 c2 = do res1 <- c1+ res2 <- c2+ return $ res1 >> res2+++checkOr :: Cond -> Cond -> Cond +checkOr c1 c2 = do res1 <- c1+ res2 <- c2+ return $ res1 `mplus` res2++checkNot :: Cond -> Cond+checkNot = liftM (maybe (Just []) (const Nothing))++parseCondPrim :: Parser Cond+parseCondPrim = choice+ [ parens lang parseCond+ , do char '$'+ varname <- show `liftM` natural lang <|> identifier lang+ choice+ [ do guard $ varname `elem` ["title","program"]+ choice+ [ do reservedOp lang "=~"+ regex <- parseRegex+ return $ checkRegex varname (RE.compile regex [])+ , do reservedOp lang "==" <|> reservedOp lang "="+ str <- stringLiteral lang+ return $ checkEq varname str+ , do reservedOp lang "/=" <|> reservedOp lang "!="+ str <- stringLiteral lang+ return $ checkNot (checkEq varname str)+ ]+ , do guard $ varname == "idle"+ op <- choice $ map (\(s,o) -> reservedOp lang s >> return o)+ [(">=",(>=)),+ (">", (>)),+ ("=", (==)),+ ("==",(==)),+ ("<",(<)),+ ("<=",(<=))]+ num <- natural lang+ return $ checkNumCmp op varname num+ , do guard $ varname == "active"+ return $ checkActive+ ]+ , do reserved lang "current window"+ cond <- parseCond+ return $ checkCurrentwindow cond+ , do reserved lang "any window"+ cond <- parseCond+ return $ checkAnyWindow cond+ ]++parseRegex :: Parser String+parseRegex = lexeme lang $ choice+ [ between (char '/') (char '/') (many1 (noneOf "/"))+ , do char 'm'+ c <- anyChar+ str <- many1 (noneOf [c])+ char c+ return str+ ]+ ++parseSetTag :: Parser Rule+parseSetTag = lexeme lang $ do+ firstPart <- parseTagPart + choice [ do char ':'+ secondPart <- parseTagPart+ return $ do cat <- firstPart+ tag <- secondPart+ return $ maybeToList $ do+ cat <- cat+ tag <- tag+ return $ Activity (Just cat) tag+ , return $ do tag <- firstPart+ return $ maybeToList $ do+ tag <- tag+ return $ Activity Nothing tag+ ]++parseTagPart :: Parser (Ctx -> Maybe String)+parseTagPart = do parts <- many1 (choice + [ do char '$'+ varname <- many1 (letter <|> oneOf ".") <|> many1 digit+ return $ getVar varname+ , do s <- many1 (letter <|> oneOf "-_")+ return $ const (Just s)+ ])+ return $ (fmap concat . sequence) <$> sequence parts++ifThenElse :: Cond -> Rule -> Rule -> Rule+ifThenElse cond r1 r2 = do res <- cond+ case res of + Just substs -> r1 . setSubsts substs+ Nothing -> r2+ where setSubsts :: [String] -> Ctx -> Ctx+ setSubsts substs ctx = ctx { cSubsts = substs }+ ++matchAny :: [Rule] -> Rule+matchAny rules = concat <$> sequence rules+matchFirst :: [Rule] -> Rule+matchFirst rules = takeFirst <$> sequence rules+ where takeFirst [] = []+ takeFirst ([]:xs) = takeFirst xs+ takeFirst (x:xs) = x++getVar :: String -> Ctx -> Maybe String+getVar v ctx | all isNumber v = + let n = read v in+ listToMaybe (drop (n-1) (cSubsts ctx))+getVar v ctx | "current" `isPrefixOf` v = do+ let var = drop (length "current.") v+ win <- findActive $ cWindows (cNow ctx)+ getVar var (ctx { cWindowInScope = Just win })+getVar "title" ctx = do+ (_,t,_) <- cWindowInScope ctx+ return t+getVar "program" ctx = do+ (_,_,p) <- cWindowInScope ctx+ return p++checkRegex :: String -> RE.Regex -> Cond+checkRegex varname regex ctx = do s <- getVar varname ctx+ matches <- RE.match regex s []+ return (tail matches)++checkEq :: String -> String -> Cond+checkEq varname str ctx = do s <- getVar varname ctx+ [] `justIf` (s == str)++findActive :: [(Bool, t, t1)] -> Maybe (Bool, t, t1)+findActive = find (\(a,_,_) -> a) ++checkCurrentwindow :: Cond -> Cond+checkCurrentwindow cond ctx = cond (ctx { cWindowInScope = findActive (cWindows (cNow ctx)) })++checkAnyWindow :: Cond -> Cond+checkAnyWindow cond ctx = msum $ map (\w -> cond (ctx { cWindowInScope = Just w }))+ (cWindows (cNow ctx))++checkActive :: Cond+checkActive ctx = do (a,_,_) <- cWindowInScope ctx+ guard a+ return []++checkNumCmp :: (Integer -> Integer -> Bool) -> String -> Integer -> Cond+checkNumCmp op "idle" num ctx = [] `justIf` op (cLastActivity (cNow ctx)) (num*1000)++matchNone :: Rule+matchNone = const []++justIf :: a -> Bool -> Maybe a+justIf x True = Just x+justIf x False = Nothing
+ src/Data.hs view
@@ -0,0 +1,54 @@+module Data where++import Data.Time+import Text.ParserCombinators.ReadPrec (readP_to_Prec)+import Text.ParserCombinators.ReadP+import Text.Read (readPrec)++type TimeLog a = [TimeLogEntry a]++data TimeLogEntry a = TimeLogEntry+ { tlTime :: UTCTime+ , tlRate :: Integer -- ^ in milli-seconds+ , tlData :: a }+ deriving (Show, Read)++instance Functor TimeLogEntry where+ fmap f tl = tl { tlData = f (tlData tl) }+ +data CaptureData = CaptureData+ { cWindows :: [ (Bool, String, String) ]+ -- ^ Active window, window title, programm name+ , cLastActivity :: Integer -- ^ in milli-seconds+ }+ deriving (Show, Read)++type ActivityData = [Activity]++data Activity = Activity + { activityCategory :: Maybe Category+ , activityName :: String+ }+ deriving (Ord, Eq)++-- < An activity with special meaning: ignored by default (i.e. for idle times)+inactiveActivity = Activity Nothing "inactive"+++instance Show Activity where+ show (Activity mbC t) = maybe "" (++":") mbC ++ t++instance Read Activity where+ readPrec = readP_to_Prec $ \_ ->+ (do cat <- munch1 (/= ':')+ char ':'+ tag <- many1 get+ return $ Activity (Just cat) tag)+ <++ (Activity Nothing `fmap` many1 get)++type Category = String++isCategory :: Category -> Activity -> Bool+isCategory cat (Activity (Just cat') _) = cat == cat'+isCategory _ _ = False+
+ src/Graphics/X11/XScreenSaver.hsc view
@@ -0,0 +1,187 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------+-- |+-- Module : Graphics.X11.XScreenSaver+-- Copyright : (c) Haskell.org, 2009+-- License : BSD3+--+-- Maintainer: Joachim Breitner <mail@joachim-breitner.de>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------+--+-- Interface to XScreenSaver API+--++module Graphics.X11.XScreenSaver (+ getXIdleTime,+ XScreenSaverState(..),+ XScreenSaverKind(..),+ XScreenSaverInfo(..),+ xScreenSaverQueryExtension,+ xScreenSaverQueryVersion,+ xScreenSaverQueryInfo,+ compiledWithXScreenSaver+ ) where++import Foreign+import Foreign.C.Types+import Graphics.X11.Xlib+import Control.Monad++data XScreenSaverState = ScreenSaverOff | ScreenSaverOn | ScreenSaverDisabled deriving Show+data XScreenSaverKind = ScreenSaverBlanked | ScreenSaverInternal | ScreenSaverExternal deriving Show++-- | Representation of the XScreenSaverInfo struct.+data XScreenSaverInfo = XScreenSaverInfo+ { xssi_window :: !Window,+ xssi_state :: !XScreenSaverState,+-- ^ The state field specified whether or not the screen saver is currently+-- active and how the til-or-since value should be interpreted:+--+-- ['ScreenSaverOff'] The screen is not currently being saved; til-or-since specifies the+-- number of milliseconds until the screen saver is expected to activate.+--+-- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies the number+-- of milliseconds since the screen saver activated.+--+-- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since is zero.+ xssi_kind :: !XScreenSaverKind,+-- ^ The kind field specifies the mechanism that either is currently being used+-- or would have been were the screen being saved:+--+-- ['ScreenSaverBlanked'] The video signal to the display monitor was disabled.+--+-- ['ScreenSaverInternal'] A server-dependent, built-in screen saver image was displayed;+-- either no client had set the screen saver window attributes or a different+-- client had the server grabbed when the screen saver activated. +--+-- ['ScreenSaverExternal'] The screen saver window was mapped with attributes set by a client+-- using the ScreenSaverSetAttributes request. + xssi_til_or_since :: !CULong,+ xssi_idle :: !CULong,+-- ^ The idle field specifies the number of milliseconds since the last input+-- was received from the user on any of the input devices.+ xssi_event_mask :: !CULong+-- ^ The event-mask field specifies which, if any, screen saver events this+-- client has requested using ScreenSaverSelectInput.+ } deriving (Show)++-- | Simple wrapper around 'xScreenSaverQueryInfo' if you are only interested in+-- the idle time, in milliseconds. Returns 0 if the XScreenSaver extension is+-- not available+getXIdleTime :: Display -> IO Int+getXIdleTime dpy = maybe 0 (fromIntegral . xssi_idle) `fmap` xScreenSaverQueryInfo dpy++-- We have XScreenSaver, so the library will actually work+compiledWithXScreenSaver :: Bool+compiledWithXScreenSaver = True++-- for XFree() (already included from scrnsaver.h, but I don't know if I can count on that.)+#include <X11/Xlib.h>+#include <X11/extensions/scrnsaver.h>++xScreenSaverState2CInt :: XScreenSaverState -> CInt+xScreenSaverState2CInt ScreenSaverOn = #const ScreenSaverOn+xScreenSaverState2CInt ScreenSaverOff = #const ScreenSaverOff+xScreenSaverState2CInt ScreenSaverDisabled = #const ScreenSaverDisabled++cInt2XScreenSaverState :: CInt -> XScreenSaverState+cInt2XScreenSaverState (#const ScreenSaverOn) = ScreenSaverOn+cInt2XScreenSaverState (#const ScreenSaverOff) = ScreenSaverOff+cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled+cInt2XScreenSaverState _ = error "Unknown state in xScreenSaverQueryInfo"++instance Storable XScreenSaverState where+ sizeOf _ = sizeOf (undefined :: CInt)+ alignment _ = alignment (undefined :: CInt)+ poke p xsss = poke (castPtr p) (xScreenSaverState2CInt xsss)+ peek p = cInt2XScreenSaverState `fmap` peek (castPtr p)+ ++xScreenSaverKind2CInt :: XScreenSaverKind -> CInt+xScreenSaverKind2CInt ScreenSaverBlanked = #const ScreenSaverBlanked+xScreenSaverKind2CInt ScreenSaverInternal = #const ScreenSaverInternal+xScreenSaverKind2CInt ScreenSaverExternal = #const ScreenSaverExternal++cInt2XScreenSaverKind :: CInt -> XScreenSaverKind+cInt2XScreenSaverKind (#const ScreenSaverBlanked) = ScreenSaverBlanked+cInt2XScreenSaverKind (#const ScreenSaverInternal) = ScreenSaverInternal+cInt2XScreenSaverKind (#const ScreenSaverExternal) = ScreenSaverExternal+cInt2XScreenSaverKind _ = error "Unknown kind in xScreenSaverQueryInfo"++instance Storable XScreenSaverKind where+ sizeOf _ = sizeOf (undefined :: CInt)+ alignment _ = alignment (undefined :: CInt)+ poke p xsss = poke (castPtr p) (xScreenSaverKind2CInt xsss)+ peek p = cInt2XScreenSaverKind `fmap` peek (castPtr p)+ ++instance Storable XScreenSaverInfo where+ sizeOf _ = #{size XScreenSaverInfo}+ -- FIXME: Is this right?+ alignment _ = alignment (undefined :: CInt)++ poke p xssi = do+ #{poke XScreenSaverInfo, window } p $ xssi_window xssi+ #{poke XScreenSaverInfo, state } p $ xssi_state xssi+ #{poke XScreenSaverInfo, kind } p $ xssi_kind xssi+ #{poke XScreenSaverInfo, til_or_since } p $ xssi_til_or_since xssi+ #{poke XScreenSaverInfo, idle } p $ xssi_idle xssi+ #{poke XScreenSaverInfo, eventMask } p $ xssi_event_mask xssi++ peek p = return XScreenSaverInfo+ `ap` (#{peek XScreenSaverInfo, window} p)+ `ap` (#{peek XScreenSaverInfo, state} p)+ `ap` (#{peek XScreenSaverInfo, kind} p)+ `ap` (#{peek XScreenSaverInfo, til_or_since} p)+ `ap` (#{peek XScreenSaverInfo, idle} p)+ `ap` (#{peek XScreenSaverInfo, eventMask} p)+++xScreenSaverQueryExtension :: Display -> IO (Maybe (CInt, CInt))+xScreenSaverQueryExtension dpy = wrapPtr2 (cXScreenSaverQueryExtension dpy) go+ where go False _ _ = Nothing+ go True eventbase errorbase = Just (fromIntegral eventbase, fromIntegral errorbase)++xScreenSaverQueryVersion :: Display -> IO (Maybe (CInt, CInt))+xScreenSaverQueryVersion dpy = wrapPtr2 (cXScreenSaverQueryVersion dpy) go+ where go False _ _ = Nothing+ go True major minor = Just (fromIntegral major, fromIntegral minor)++wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d+wrapPtr2 cfun f =+ withPool $ \pool -> do aptr <- pooledMalloc pool+ bptr <- pooledMalloc pool+ ret <- cfun aptr bptr+ a <- peek aptr+ b <- peek bptr+ return (f ret a b)++-- | xScreenSaverQueryInfo returns information about the current state of the+-- screen server. If the xScreenSaver extension is not available, it returns Nothing+xScreenSaverQueryInfo :: Display -> IO (Maybe XScreenSaverInfo)+xScreenSaverQueryInfo dpy = do+ p <- cXScreenSaverAllocInfo+ if p == nullPtr then return Nothing else do+ s <- cXScreenSaverQueryInfo dpy (defaultRootWindow dpy) p+ if s == 0 then return Nothing else do+ xssi <- peek p+ cXFree p+ return (Just xssi)++foreign import ccall "XScreenSaverQueryExtension"+ cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool++foreign import ccall "XScreenSaverQueryVersion"+ cXScreenSaverQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool++foreign import ccall "XScreenSaverAllocInfo"+ cXScreenSaverAllocInfo :: IO (Ptr XScreenSaverInfo)++foreign import ccall "XScreenSaverQueryInfo"+ cXScreenSaverQueryInfo :: Display -> Drawable -> Ptr XScreenSaverInfo -> IO Status++foreign import ccall "XFree"+ cXFree :: Ptr a -> IO CInt
+ src/Stats.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}+module Stats where++import Data.Time+import Data.Maybe+import Data.List+import Data.Ord+import Text.Tabular+import Text.Printf+import qualified Data.Map as M++import Data+++data Report = GeneralInfos | TotalTime | Category String+ deriving Eq++data Filter = Exclude Activity | Only Activity | AlsoInactive+ deriving Eq++data ReportOption = MinPercentage Double+ deriving Eq++applyFilters :: [Filter] -> TimeLog ActivityData -> TimeLog ActivityData+applyFilters filters tle = + foldr (\flag -> case flag of + Exclude act -> excludeTag act+ Only act -> onlyTag act+ AlsoInactive -> id+ ) (if AlsoInactive `elem` filters then tle else defaultFilter tle) filters+++excludeTag act = filter (notElem act . tlData)+onlyTag act = filter (elem act . tlData)+defaultFilter = excludeTag inactiveActivity++-- | to be used lazily, to re-use computation when generating more than one+-- report at a time+data Calculations = Calculations+ { firstDate :: UTCTime+ , lastDate :: UTCTime+ , timeDiff :: NominalDiffTime+ , totalTimeRec :: Integer+ , totalTimeSel :: Integer+ , fractionRec :: Double+ , fractionSel :: Double+ , fractionSelRec :: Double+ , sums :: M.Map Activity Integer+ , tags :: TimeLog ActivityData+ }++prepareCalculations :: TimeLog ActivityData -> TimeLog ActivityData -> Calculations+prepareCalculations allTags tags =+ let c = Calculations+ { firstDate = tlTime (head allTags)+ , lastDate = tlTime (last allTags)+ , timeDiff = diffUTCTime (lastDate c) (firstDate c)+ , totalTimeRec = sum (map tlRate allTags)+ , totalTimeSel = sum (map tlRate tags)+ , fractionRec = fromIntegral (totalTimeRec c) / (realToFrac (timeDiff c) * 1000)+ , fractionSel = fromIntegral (totalTimeSel c) / (realToFrac (timeDiff c) * 1000)+ , fractionSelRec = fromIntegral (totalTimeSel c) / fromIntegral (totalTimeRec c)+ , sums = sumUp tags+ , tags+ } in c++-- | Sums up each occurence of an 'Activity', weighted by the sampling rate+sumUp :: TimeLog ActivityData -> M.Map Activity Integer+sumUp = foldr go (M.empty) + where go tl m = foldr go' m (tlData tl)+ where go' act = M.insertWith (+) act (tlRate tl)+++renderReport :: [ReportOption] -> Calculations -> Report -> (String, Table String String String)+renderReport opts (Calculations {..}) r = case r of+ GeneralInfos -> ("General Information",+ empty ^..^ colH "Value"+ +.+ row "FirstRecord"+ [show firstDate]+ +.+ row "LastRecord"+ [show lastDate]+ +.+ row "Number of records"+ [show (length tags)]+ +.+ row "Total time recorded"+ [formatSeconds (fromIntegral totalTimeRec / 1000)]+ +.+ row "Total time selected"+ [formatSeconds (fromIntegral totalTimeSel / 1000)]+ +.+ row "Fraction of total time recorded"+ [printf "%3.0f%%" (fractionRec * 100) ]+ +.+ row "Fraction of total time selected"+ [printf "%3.0f%%" (fractionSel * 100) ]+ +.+ row "Fraction of recorded time selected"+ [printf "%3.0f%%" (fractionSelRec * 100) ]+ )++ TotalTime -> ("Total time per tag",+ foldr (\(tag,time) ->+ let perc = fromIntegral time/fromIntegral totalTimeSel*100 in+ if perc >= minPercentage+ then (+.+ row (show tag) [+ formatSeconds (fromIntegral time/100),+ printf "%.1f%%" perc])+ else id+ )+ (empty ^..^ colH "Time" ^..^ colH "Percentage")+ (sortBy (comparing snd) $ M.toList sums)+ )+ + Category cat -> ("Statistics for category " ++ cat,+ let filteredSums = M.filterWithKey (\a _ -> isCategory cat a) sums+ uncategorizedTime = totalTimeSel - M.fold (+) 0 filteredSums+ tooSmallSums = M.filter (\t -> fromIntegral t / fromIntegral totalTimeSel * 100 < minPercentage) filteredSums+ tooSmallTimes = M.fold (+) 0 tooSmallSums+ in++ (if uncategorizedTime > 0+ then (+.+ row "(unmatched time)" [+ formatSeconds (fromIntegral uncategorizedTime/1000),+ printf "%.1f%%" (fromIntegral uncategorizedTime/fromIntegral totalTimeSel*100::Double)])+ else id+ )+ . + (+ if tooSmallTimes > 0+ then (+.+ row (printf "(%d entries omitted)" (M.size tooSmallSums)) [+ formatSeconds (fromIntegral tooSmallTimes/1000),+ printf "%.1f%%" (fromIntegral tooSmallTimes/fromIntegral totalTimeSel*100::Double) ])+ else id+ )+ $ + foldr (\(tag,time) ->+ let perc = fromIntegral time/fromIntegral totalTimeSel*100 in+ if perc >= minPercentage+ then (+.+ row (show tag) [+ formatSeconds (fromIntegral time/100),+ printf "%.1f%%" perc])+ else id+ )++ (empty ^..^ colH "Time" ^..^ colH "Percentage")++ (sortBy (comparing snd) $ M.toList filteredSums)+ )++ where minPercentage = last $ mapMaybe (\f -> case f of {MinPercentage m -> Just m {- ; _ -> Nothing -} }) opts+++formatSeconds :: Double -> String+formatSeconds s' = go $ zip [days,hours,mins,secs] ["d","h","m","s"]+ where s = round s' :: Integer+ days = s `div` (24*60*60)+ hours = (s `div` (60*60)) `mod` 24+ mins = (s `div` (60)) `mod` 60+ secs = (s `mod` (60))+ go | s == 0 = const "0s"+ | otherwise = concat . snd . mapAccumL go' False + go' True (a,u) = (True, printf "%02d%s" a u)+ go' False (a,u) | a > 0 = (True, printf "%2d%s" a u)+ | otherwise = (False, "")
+ src/TimeLog.hs view
@@ -0,0 +1,25 @@+module TimeLog where++import Control.Applicative+import System.IO+import Data+import Control.Concurrent+import Control.Monad+import Data.Time++-- | Runs the given action each delay milliseconds and appends the TimeLog to the+-- given file.+runLogger :: (Show a) => FilePath -> Integer -> IO a -> IO ()+runLogger filename delay action = forever $ do+ entry <- action+ date <- getCurrentTime+ appendTimeLog filename (TimeLogEntry date delay entry)+ threadDelay (fromIntegral delay * 1000)+ ++appendTimeLog :: Show a => FilePath -> TimeLogEntry a -> IO ()+-- Double show to ensure it is one string on one line+appendTimeLog filename tl = appendFile filename $ (++"\n") $ show $ show $ tl++readTimeLog :: Read a => FilePath -> IO (TimeLog a)+readTimeLog filename = (map (read.read) . lines) <$> (openFile filename ReadMode >>= hGetContents)
+ src/capture.hs view
@@ -0,0 +1,32 @@+module Main where++import Control.Monad+import Control.Concurrent++import Capture+import TimeLog+import System.Directory+import System.FilePath+import Graphics.X11.XScreenSaver (compiledWithXScreenSaver)+import System.IO+import System.Posix.IO+import System.IO.Error+import System.Exit+++-- | sampleRate in seconds+sampleRate = 60 ++-- | This is very raw, someone ought to improve this+lockFile filename = flip catch (\e -> hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") >> exitFailure) $ do+ fd <- openFd (filename ++ ".lck") WriteOnly (Just 0644) defaultFileFlags+ setLock fd (WriteLock, AbsoluteSeek, 0, 0)++main = do+ unless compiledWithXScreenSaver $+ hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver"+ dir <- getAppUserDataDirectory "arbtt"+ createDirectoryIfMissing False dir+ let captureFile = dir </> "capture.log"+ lockFile captureFile+ runLogger captureFile (sampleRate * 1000) captureData
+ src/stats.hs view
@@ -0,0 +1,137 @@+module Main where+import System.Directory+import System.FilePath+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO+import Control.Monad+import qualified Data.Map as M+import Data.List+import Data.Ord+import Data.Time+import Text.Printf+import Data.Maybe+import Data.Version (showVersion)+import qualified Text.Tabular.AsciiArt as TA++import TimeLog+import Data+import Categorize+import Stats++import Paths_arbtt (version)++data Flag = Help | Version |+ Report Report |+ Filter Filter |+ ReportOption ReportOption+ deriving Eq++getReports = mapMaybe (\f -> case f of {Report r -> Just r; _ -> Nothing})+getFilters = mapMaybe (\f -> case f of {Filter f -> Just f; _ -> Nothing})+getRepOpts = mapMaybe (\f -> case f of {ReportOption o -> Just o; _ -> Nothing})++versionStr = "arbtt-stats " ++ showVersion version+header = "Usage: arbtt-stats [OPTIONS...]"++options :: [OptDescr Flag]+options =+ [ Option "h?" ["help"]+ (NoArg Help)+ "show this help"+ , Option ['V'] ["version"]+ (NoArg Version)+ "show the version number"+-- , Option ['g'] ["graphical"] (NoArg Graphical) "render the reports as graphical charts"+ , Option ['x'] ["exclude"]+ (ReqArg (Filter . Exclude . Activity Nothing) "TAG")+ "ignore samples containing this tag"+ , Option ['o'] ["only"]+ (ReqArg (Filter . Only . read) "TAG")+ "only consider samples containing this tag"+ , Option [] ["also-inactive"]+ (NoArg (Filter AlsoInactive))+ "include samples with the tag \"inactive\""+ , Option ['m'] ["min-percentage"]+ (ReqArg (ReportOption . MinPercentage . read) "PERC")+ "do not show tags with a percentage lower than PERC% (default: 1)"+ , Option ['i'] ["information"]+ (NoArg (Report GeneralInfos))+ "show general statistics about the data"+ , Option ['t'] ["total-time"]+ (NoArg (Report TotalTime))+ "show total time for each tag"+ , Option ['c'] ["category"]+ (ReqArg (Report . Category) "CATEGORY")+ "show statistics about category CATEGORY"+ ]+++main = do+ args <- getArgs+ flags <- case getOpt Permute options args of+ (o,[],[]) | Help `notElem` o && Version `notElem` o -> return o+ (o,_,_) | Version `elem` o -> do+ hPutStrLn stderr versionStr+ exitSuccess+ (o,_,_) | Help `elem` o -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ (_,_,errs) -> do+ hPutStr stderr (concat errs ++ usageInfo header options)+ exitFailure++ dir <- getAppUserDataDirectory "arbtt"++ let categorizeFilename = dir </> "categorize.cfg"+ fileEx <- doesFileExist categorizeFilename+ unless (fileEx) $ do+ putStrLn $ printf "Configuration file %s does not exist." categorizeFilename+ putStrLn $ "Please see the example file and the README for more details"+ exitFailure+ categorizer <- readCategorizer categorizeFilename++ let captureFilename = dir </> "capture.log"+ captures <- readTimeLog captureFilename+ let allTags = categorizer captures+ when (null allTags) $ do+ putStrLn "Nothing recorded yet"+ exitFailure+ + let tags = applyFilters (getFilters flags) allTags+ let opts = case getRepOpts flags of {[] -> [MinPercentage 1]; ropts -> ropts }+ let reps = case getReports flags of {[] -> [TotalTime]; reps -> reps }++ -- These are defined here, but of course only evaluated when any report+ -- refers to them. Some are needed by more than one report, which is then+ -- advantageous.+ let c = prepareCalculations allTags tags+ + sequence_ $ intersperse (putStrLn "")+ $ map (\r -> let (h,t) = renderReport opts c r in do+ putStrLnUnderlined h+ putStr (TA.render id id id t)+ )+ $ reps++putStrLnUnderlined str = do+ putStrLn str+ putStrLn $ map (const '=') str+++{-+import Data.Accessor+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk++ graphicalReport TotalTime = do+ let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..]+ let plot = plot_bars_values ^= values $ defaultPlotBars+ let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList sums)) $+ defaultLayoutAxis+ let layout = layout1_plots ^= [Right (plotBars plot)] $+ layout1_bottom_axis ^= layoutaxis $+ defaultLayout1+ do renderableToWindow (toRenderable layout) 800 600+-}