{-# LANGUAGE CPP, OverloadedStrings #-}
module Hledger.Data.Timeclock (
timeclockEntriesToTransactions
,tests_Timeclock
)
where
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
#if !(MIN_VERSION_time(1,5,0))
import System.Locale (defaultTimeLocale)
#endif
import Text.Printf
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Amount
import Hledger.Data.Posting
import Hledger.Data.Transaction
instance Show TimeclockEntry where
show t = printf "%s %s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t)
instance Show TimeclockCode where
show SetBalance = "b"
show SetRequiredHours = "h"
show In = "i"
show Out = "o"
show FinalOut = "O"
instance Read TimeclockCode where
readsPrec _ ('b' : xs) = [(SetBalance, xs)]
readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]
readsPrec _ ('i' : xs) = [(In, xs)]
readsPrec _ ('o' : xs) = [(Out, xs)]
readsPrec _ ('O' : xs) = [(FinalOut, xs)]
readsPrec _ _ = []
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions _ [] = []
timeclockEntriesToTransactions now [i]
| odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now [i',o]
| otherwise = [entryFromTimeclockInOut i o]
where
o = TimeclockEntry (tlsourcepos i) Out end "" ""
end = if itime > now then itime else now
(itime,otime) = (tldatetime i,tldatetime o)
(idate,odate) = (localDay itime,localDay otime)
o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
timeclockEntriesToTransactions now (i:o:rest)
| odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest)
| otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactions now rest
where
(itime,otime) = (tldatetime i,tldatetime o)
(idate,odate) = (localDay itime,localDay otime)
o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut i o
| otime >= itime = t
| otherwise =
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
where
t = Transaction {
tindex = 0,
tsourcepos = tlsourcepos i,
tdate = idate,
tdate2 = Nothing,
tstatus = Cleared,
tcode = "",
tdescription = desc,
tcomment = "",
ttags = [],
tpostings = ps,
tprecedingcomment=""
}
itime = tldatetime i
otime = tldatetime o
itod = localTimeOfDay itime
otod = localTimeOfDay otime
idate = localDay itime
desc | T.null (tldescription i) = T.pack $ showtime itod ++ "-" ++ showtime otod
| otherwise = tldescription i
showtime = take 5 . show
hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
acctname = tlaccount i
amount = Mixed [hrs hours]
ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}]
tests_Timeclock = tests "Timeclock" [
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
step "gathering data"
today <- getCurrentDay
now' <- getCurrentTime
tz <- getCurrentTimeZone
let now = utcToLocalTime tz now'
nowstr = showtime now
yesterday = prevday today
clockin = TimeclockEntry nullsourcepos In
mktime d = LocalTime d . fromMaybe midnight .
#if MIN_VERSION_time(1,5,0)
parseTimeM True defaultTimeLocale "%H:%M:%S"
#else
parseTime defaultTimeLocale "%H:%M:%S"
#endif
showtime = formatTime defaultTimeLocale "%H:%M"
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future
step "started yesterday, split session at midnight"
txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr]
step "split multi-day sessions at each midnight"
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
step "auto-clock-out if needed"
txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr]
step "use the clockin time for auto-clockout if it's in the future"
txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr]
]