arbtt-0.3.0: src/Data.hs

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 Control.Applicative
import Control.Monad

type TimeLog a = [TimeLogEntry a]

data TimeLogEntry a = TimeLogEntry
	{ tlTime :: UTCTime
	, tlRate :: Integer -- ^ in milli-seconds
	, tlData :: a }
  deriving (Show)

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)

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 ReadP.get
		       return $ Activity (Just cat) tag)
		   <++ (Activity Nothing `fmap` many1 ReadP.get)

type Category = String

isCategory :: Category -> Activity -> Bool
isCategory cat (Activity (Just cat') _) = cat == cat'
isCategory _   _                        = False


-- Data.Binary instances

instance Binary a => Binary (TimeLogEntry a) where
 put tle = do
 	-- A version tag
 	putWord8 1
	put (tlTime tle)
	put (tlRate tle)
	put (tlData tle)
 get = do
 	v <- getWord8
	when (v /= 1) $ error $ "Wrong TimeLogEntry version tag " ++ show v
	TimeLogEntry <$> get <*> get <*> get

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) (fromRational t)

instance Binary CaptureData where
 put cd = do
 	-- A version tag
 	putWord8 1
	put (cWindows cd)
	put (cLastActivity cd)
 get = do
 	v <- getWord8
	when (v /= 1) $ error $ "Wrong TimeLogEntry version tag " ++ show v
	CaptureData <$> get <*> get