mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
4cfd3cb590
(SourcePos, SourcePos). This has been marked for possible removal for a while. We are keeping strictly more information. Possible edge cases arise with Timeclock and CsvReader, but I think these are covered. The particular motivation for getting rid of this is that GenericSourcePos is creating some awkward import considerations for little gain. Removing this enables some flattening of the module dependency tree.
151 lines
6.5 KiB
Haskell
151 lines
6.5 KiB
Haskell
{-|
|
|
|
|
A 'TimeclockEntry' is a clock-in, clock-out, or other directive in a timeclock
|
|
file (see timeclock.el or the command-line version). These can be
|
|
converted to 'Transactions' and queried like a ledger.
|
|
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Hledger.Data.Timeclock (
|
|
timeclockEntriesToTransactions
|
|
,tests_Timeclock
|
|
)
|
|
where
|
|
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Data.Text as T
|
|
import Data.Time.Calendar (addDays)
|
|
import Data.Time.Clock (addUTCTime, getCurrentTime)
|
|
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
|
|
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), getCurrentTimeZone,
|
|
localTimeToUTC, midnight, utc, utcToLocalTime)
|
|
import Text.Printf (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 _ _ = []
|
|
|
|
-- | Convert time log entries to journal transactions. When there is no
|
|
-- clockout, add one with the provided current time. Sessions crossing
|
|
-- midnight are split into days to give accurate per-day totals.
|
|
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
|
|
timeclockEntriesToTransactions _ [] = []
|
|
timeclockEntriesToTransactions now [i]
|
|
| tlcode i /= In = errorExpectedCodeButGot In 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)
|
|
| tlcode i /= In = errorExpectedCodeButGot In i
|
|
| tlcode o /= Out =errorExpectedCodeButGot Out o
|
|
| 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}}
|
|
{- HLINT ignore timeclockEntriesToTransactions -}
|
|
|
|
errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual)
|
|
where line = unPos . sourceLine $ tlsourcepos actual
|
|
|
|
errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg
|
|
|
|
-- | Convert a timeclock clockin and clockout entry to an equivalent journal
|
|
-- transaction, representing the time expenditure. Note this entry is not balanced,
|
|
-- since we omit the \"assets:time\" transaction for simpler output.
|
|
entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
|
|
entryFromTimeclockInOut i o
|
|
| otime >= itime = t
|
|
| otherwise = error' . T.unpack $
|
|
"clock-out time less than clock-in time in:\n" <> showTransaction t -- PARTIAL:
|
|
where
|
|
t = Transaction {
|
|
tindex = 0,
|
|
tsourcepos = (tlsourcepos i, 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
|
|
-- Generate an hours amount. Unusually, we also round the internal Decimal value,
|
|
-- since otherwise it will often have large recurring decimal parts which (since 1.21)
|
|
-- print would display all 255 digits of. timeclock amounts have one second resolution,
|
|
-- so two decimal places is precise enough (#1527).
|
|
amount = mixedAmount $ setAmountInternalPrecision 2 $ hrs hours
|
|
ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}]
|
|
|
|
|
|
-- tests
|
|
|
|
tests_Timeclock = testGroup "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 (initialPos "") In
|
|
mktime d = LocalTime d . fromMaybe midnight .
|
|
parseTimeM True defaultTimeLocale "%H:%M:%S"
|
|
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]
|
|
]
|