arbtt-0.8: src/DumpFormat.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
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
import System.Locale
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 "]"