1 {-|
    2 
    3 A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog
    4 file (see timeclock.el or the command-line version). These can be
    5 converted to 'Transactions' and queried like a ledger.
    6 
    7 -}
    8 
    9 module Hledger.Data.TimeLog
   10 where
   11 import Data.Maybe
   12 import Data.Time.Calendar
   13 import Data.Time.Clock
   14 import Data.Time.Format
   15 import Data.Time.LocalTime
   16 import System.Locale (defaultTimeLocale)
   17 import Test.HUnit
   18 import Text.Printf
   19 
   20 import Hledger.Utils
   21 import Hledger.Data.Types
   22 import Hledger.Data.Dates
   23 import Hledger.Data.Commodity
   24 import Hledger.Data.Transaction
   25 
   26 instance Show TimeLogEntry where 
   27     show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
   28 
   29 instance Show TimeLogCode where 
   30     show SetBalance = "b"
   31     show SetRequiredHours = "h"
   32     show In = "i"
   33     show Out = "o"
   34     show FinalOut = "O"
   35 
   36 instance Read TimeLogCode where 
   37     readsPrec _ ('b' : xs) = [(SetBalance, xs)]
   38     readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]
   39     readsPrec _ ('i' : xs) = [(In, xs)]
   40     readsPrec _ ('o' : xs) = [(Out, xs)]
   41     readsPrec _ ('O' : xs) = [(FinalOut, xs)]
   42     readsPrec _ _ = []
   43 
   44 -- | Convert time log entries to journal transactions. When there is no
   45 -- clockout, add one with the provided current time. Sessions crossing
   46 -- midnight are split into days to give accurate per-day totals.
   47 timeLogEntriesToTransactions :: LocalTime -> [TimeLogEntry] -> [Transaction]
   48 timeLogEntriesToTransactions _ [] = []
   49 timeLogEntriesToTransactions now [i]
   50     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now [i',o]
   51     | otherwise = [entryFromTimeLogInOut i o]
   52     where
   53       o = TimeLogEntry Out end ""
   54       end = if itime > now then itime else now
   55       (itime,otime) = (tldatetime i,tldatetime o)
   56       (idate,odate) = (localDay itime,localDay otime)
   57       o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
   58       i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
   59 timeLogEntriesToTransactions now (i:o:rest)
   60     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now (i':o:rest)
   61     | otherwise = entryFromTimeLogInOut i o : timeLogEntriesToTransactions now rest
   62     where
   63       (itime,otime) = (tldatetime i,tldatetime o)
   64       (idate,odate) = (localDay itime,localDay otime)
   65       o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
   66       i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
   67 
   68 -- | Convert a timelog clockin and clockout entry to an equivalent journal
   69 -- transaction, representing the time expenditure. Note this entry is  not balanced,
   70 -- since we omit the \"assets:time\" transaction for simpler output.
   71 entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction
   72 entryFromTimeLogInOut i o
   73     | otime >= itime = t
   74     | otherwise = 
   75         error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
   76     where
   77       t = Transaction {
   78             tdate         = idate,
   79             teffectivedate = Nothing,
   80             tstatus       = True,
   81             tcode         = "",
   82             tdescription  = showtime itod ++ "-" ++ showtime otod,
   83             tcomment      = "",
   84             tmetadata     = [],
   85             tpostings = ps,
   86             tpreceding_comment_lines=""
   87           }
   88       showtime = take 5 . show
   89       acctname = tlcomment i
   90       itime    = tldatetime i
   91       otime    = tldatetime o
   92       itod     = localTimeOfDay itime
   93       otod     = localTimeOfDay otime
   94       idate    = localDay itime
   95       hrs      = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
   96       amount   = Mixed [hours hrs]
   97       ps       = [Posting{pstatus=False,paccount=acctname,pamount=amount,
   98                           pcomment="",ptype=VirtualPosting,pmetadata=[],ptransaction=Just t}]
   99 
  100 tests_Hledger_Data_TimeLog = TestList [
  101 
  102    "timeLogEntriesToTransactions" ~: do
  103      today <- getCurrentDay
  104      now' <- getCurrentTime
  105      tz <- getCurrentTimeZone
  106      let now = utcToLocalTime tz now'
  107          nowstr = showtime now
  108          yesterday = prevday today
  109          clockin = TimeLogEntry In
  110          mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S"
  111          showtime = formatTime defaultTimeLocale "%H:%M"
  112          assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeLogEntriesToTransactions now es)
  113 
  114      assertEntriesGiveStrings "started yesterday, split session at midnight"
  115                                   [clockin (mktime yesterday "23:00:00") ""]
  116                                   ["23:00-23:59","00:00-"++nowstr]
  117      assertEntriesGiveStrings "split multi-day sessions at each midnight"
  118                                   [clockin (mktime (addDays (-2) today) "23:00:00") ""]
  119                                   ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
  120      assertEntriesGiveStrings "auto-clock-out if needed" 
  121                                   [clockin (mktime today "00:00:00") ""] 
  122                                   ["00:00-"++nowstr]
  123      let future = utcToLocalTime tz $ addUTCTime 100 now'
  124          futurestr = showtime future
  125      assertEntriesGiveStrings "use the clockin time for auto-clockout if it's in the future"
  126                                   [clockin future ""]
  127                                   [printf "%s-%s" futurestr futurestr]
  128 
  129  ]