Add --dump-samples to stats, very plain version
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 22 Dec 2013 15:38:57 +0000 (15:38 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 22 Dec 2013 15:38:57 +0000 (15:38 +0000)
src/DumpFormat.hs
src/Stats.hs
src/dump-main.hs
src/stats-main.hs

index 598bf30..0b88e07 100644 (file)
@@ -4,8 +4,9 @@ module DumpFormat where
 import Data.MyText (unpack, Text)
 import Data.Aeson
 import qualified Data.ByteString.Lazy as LBS
-import Data.Time.Format
+import Data.Time
 import System.Locale
+import Data.Char
 
 import Data
 import Text.Printf
@@ -15,6 +16,7 @@ data DumpFormat
     = DFShow
     | DFHuman
     | DFJSON 
+    deriving (Show, Eq)
 
 instance ToJSON Text where
     toJSON = toJSON . unpack
@@ -27,21 +29,47 @@ instance ToJSON (TimeLogEntry CaptureData) where
         "windows" .= map (\(a,p,t) -> object ["active" .= a, "program" .= p, "title" .= t]) (cWindows 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, ActivityData) -> IO ()
+dumpActivity = mapM_ go
+ where
+    go tle = do
+        dumpHeader (tlTime tle) (cLastActivity cd)
+        mapM_ dumpWindow (cWindows cd)
+        dumpTags ad
+      where
+        (cd, ad) = tlData tle
+
+dumpTags :: ActivityData -> IO ()
+dumpTags = mapM_ go
+  where go act = printf "    %s\n" (show act)
+
+dumpHeader :: UTCTime -> Integer -> IO ()
+dumpHeader time lastActivity = do
+    printf "%s (%dms inactive):\n" (formatTime defaultTimeLocale "%F %X" 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)
+
 dumpSamples :: DumpFormat -> TimeLog CaptureData -> IO ()
 dumpSamples DFShow = mapM_ print
 
 dumpSamples DFHuman = mapM_ go
   where
-    go tle = do 
-        printf "%s (%dms inactive):\n" (formatTime defaultTimeLocale "%F %X" (tlTime tle)) (cLastActivity (tlData tle))
-        mapM_ goW (cWindows (tlData tle))
-    goW :: (Bool, Text, Text) -> IO ()
-    goW (active, title, program) = do
-        printf "    %s %-15s %s\n"
-            (if active then ("(*)"::String) else "( )")
-            (unpack program ++ ":")
-            (unpack title)
-             
+    go tle = do
+        dumpHeader (tlTime tle) (cLastActivity (tlData tle))
+        mapM_ dumpWindow (cWindows (tlData tle))
 dumpSamples DFJSON = enclose . sequence_ . intersperse (putStrLn ",") . map (LBS.putStr . encode)
   where
     enclose m = putStrLn "[" >> m >> putStrLn "]"
index 591afa2..460e57a 100644 (file)
@@ -31,10 +31,12 @@ import Control.Applicative
 import Data.Strict ((:!:), Pair(..))
 import qualified Data.Strict as Strict
 import Data.Traversable (sequenceA)
+import Control.Arrow
 
 import Data
 import Categorize
 import LeftFold
+import DumpFormat
 
 
 data Report = GeneralInfos
@@ -43,6 +45,7 @@ data Report = GeneralInfos
     | EachCategory
     | IntervalCategory Category
     | IntervalTag Activity
+    | DumpSamples
         deriving (Show, Eq)
 
 data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String
@@ -86,6 +89,7 @@ data ReportResults =
         | ListOfIntervals String [Interval]
         | MultipleReportResults [ReportResults]
         | RepeatedReportResults String [(String, ReportResults)]
+        | DumpResult (TimeLog (CaptureData, ActivityData))
 
 
 filterPredicate :: [Filter] -> TimeLogEntry (Ctx, ActivityData) -> Bool
@@ -169,17 +173,17 @@ calcSums = LeftFold M.empty
 
 processRepeater :: Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
 processRepeater ByDay rep =
-    filterElems (\(b :!: _) -> b) $ 
+    filterElems (\(b :!: _) -> b) $
     pure (RepeatedReportResults "Day" . map (\(d,rr) -> (showGregorian d, rr)) . M.toList) <*>
     multiplex (utctDay . tlTime . Strict.snd) rep
 processRepeater ByMonth rep =
-    filterElems (\(b :!: _) -> b) $ 
+    filterElems (\(b :!: _) -> b) $
     pure (RepeatedReportResults "Month" . map (\((y,m),rr) -> (show y ++ "-" ++ show m, rr)) . M.toList) <*>
-    multiplex ((\(y,m,d) -> (y, m)). toGregorian . utctDay . tlTime . Strict.snd) rep
+    multiplex ((\(y,m,_) -> (y, m)). toGregorian . utctDay . tlTime . Strict.snd) rep
 processRepeater ByYear rep =
-    filterElems (\(b :!: _) -> b) $ 
+    filterElems (\(b :!: _) -> b) $
     pure (RepeatedReportResults "Year" . map (\(y,rr) -> (show y, rr)) . M.toList) <*>
-    multiplex ((\(y,m,d) -> y). toGregorian . utctDay . tlTime . Strict.snd) rep
+    multiplex ((\(y,_,_) -> y). toGregorian . utctDay . tlTime . Strict.snd) rep
 
 processReport :: ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
 processReport opts GeneralInfos =
@@ -244,6 +248,9 @@ processReport opts (IntervalTag tag) =
         extractTag :: Activity -> ActivityData -> Maybe String
         extractTag tag = fmap show . listToMaybe . filter ( (==tag) )
 
+processReport opts DumpSamples =
+    DumpResult <$> onSelected (toList `mapElems` (fmap (first (tlData . cNow))))
+
 calcCategories :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Category]
 calcCategories = fmap S.toList $ leftFold S.empty $ \s tl ->
     foldl' go' s (snd (tlData tl))
@@ -336,12 +343,13 @@ intervalReportToTable title extr = ListOfIntervals title $
 -}           
             
 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
index 393da2d..4ad4fd8 100644 (file)
@@ -54,11 +54,9 @@ options =
                "use this file instead of ~/.arbtt/capture.log"
      , Option "t"      ["format"]
               (ReqArg (\arg opt ->
-                case map toLower arg of 
-                    "human"      -> return $ opt { optFormat = DFHuman }
-                    "show"       -> return $ opt { optFormat = DFShow }
-                    "json"       -> return $ opt { optFormat = DFJSON }
-                    _            -> do
+                case readDumpFormat arg of
+                    Just fm -> return $ opt { optFormat = fm}
+                    Nothing -> do
                         hPutStrLn stderr ("Invalid format \"" ++ arg ++ "\".")
                         hPutStr stderr (usageInfo header options)
                         exitFailure) "FORMAT")
index 4006651..0e04a28 100644 (file)
@@ -6,7 +6,7 @@ import System.Environment
 import System.Exit
 import System.IO
 import Control.Monad
-import qualified Data.MyText as T
+import Data.Maybe
 import Data.Char (toLower)
 import Text.Printf
 import Data.Version (showVersion)
@@ -17,12 +17,14 @@ import Data.ByteString.Lazy.Progress
 import System.Posix.Files
 import System.ProgressBar
 import TermSize
+import qualified Data.MyText as T
 
 import TimeLog
 import Categorize
 import Stats
 import CommonStartup
 import LeftFold
+import DumpFormat
 
 import Paths_arbtt (version)
 
@@ -122,6 +124,10 @@ options =
                                        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")