slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

dev:TimeclockReader, Timeclock: refactor/reindent [#2417]

Browse Source
This commit is contained in:
Simon Michael 2025-09-01 06:22:46 +01:00
parent a2710a5c2b
commit 7ac0fa1aaa
2 changed files with 163 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

230
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -10,8 +10,8 @@ converted to 'Transactions' and queried like a ledger.
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
module Hledger.Data.Timeclock ( module Hledger.Data.Timeclock (
timeclockEntriesToTransactions timeclockToTransactions
,timeclockEntriesToTransactionsSingle ,timeclockToTransactionsOld
,tests_Timeclock ,tests_Timeclock
) )
where where
@ -54,16 +54,124 @@ instance Read TimeclockCode where
readsPrec _ ('O':xs) = [(FinalOut, xs)] readsPrec _ ('O':xs) = [(FinalOut, xs)]
readsPrec _ _ = [] readsPrec _ _ = []
data Session = Session data Session = Session {
{ in' :: TimeclockEntry, in' :: TimeclockEntry,
out :: TimeclockEntry out :: TimeclockEntry
} deriving Show } deriving Show
data Sessions = Sessions data Sessions = Sessions {
{ completed :: [Session], completed :: [Session],
active :: [TimeclockEntry] active :: [TimeclockEntry]
} deriving Show } deriving Show
-- | Convert timeclock entries to journal transactions.
-- This is the old version from hledger <1.43, now enabled by --old-timeclock.
-- It requires strictly alternating clock-in and clock-entries.
-- It was documented as allowing only one clocked-in session at a time,
-- but in fact it allows concurrent sessions, even with the same account name.
--
-- Entries must be a strict alternation of in and out, beginning with in.
-- When there is no clockout, one is added with the provided current time.
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- If entries are not in the expected in/out order, an error is raised.
--
timeclockToTransactionsOld :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockToTransactionsOld _ [] = []
timeclockToTransactionsOld now [i]
| tlcode i /= In = errorExpectedCodeButGot In i
| odate > idate = entryFromTimeclockInOut i o' : timeclockToTransactionsOld 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}}
timeclockToTransactionsOld now (i:o:rest)
| tlcode i /= In = errorExpectedCodeButGot In i
| tlcode o /= Out = errorExpectedCodeButGot Out o
| odate > idate = entryFromTimeclockInOut i o' : timeclockToTransactionsOld now (i':o:rest)
| otherwise = entryFromTimeclockInOut i o : timeclockToTransactionsOld 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 timeclockToTransactionsOld -}
-- | Convert timeclock entries to journal transactions.
-- This is the new, default version added in hledger 1.43 and improved in 1.50.
-- It allows concurrent clocked-in sessions (though not with the same account name),
-- and clock-in/clock-out entries in any order.
--
-- Entries are processed in time order, then (for entries with the same time) in parse order.
-- When there is no clockout, one is added with the provided current time.
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- If any entries cannot be paired as expected, an error is raised.
--
timeclockToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockToTransactions now entries = transactions
where
sessions = dbg6 "sessions" $ pairClockEntries (sortTimeClockEntries entries) [] []
transactionsFromSession s = entryFromTimeclockInOut (in' s) (out s)
-- If any "in" sessions are in the future, then set their out time to the initial time
outtime te = max now (tldatetime te)
createout te = TimeclockEntry (tlsourcepos te) Out (outtime te) (tlaccount te) "" "" []
outs = map createout (active sessions)
stillopen = dbg6 "stillopen" $ pairClockEntries ((active sessions) <> outs) [] []
transactions = map transactionsFromSession $ sortBy (\s1 s2 -> compare (in' s1) (in' s2)) (completed sessions ++ completed stillopen)
-- | Sort timeclock entries first by date and time (with time zone ignored as usual), then by file position.
-- Ie, sort by time, but preserve the parse order of entries with the same time.
sortTimeClockEntries :: [TimeclockEntry] -> [TimeclockEntry]
sortTimeClockEntries = sortBy (\e1 e2 -> compare (tldatetime e1, tlsourcepos e1) (tldatetime e2, tlsourcepos e2))
-- | Assuming that entries have been sorted, we go through each time log entry.
-- We collect all of the "i" in the list "actives," and each time we encounter
-- an "o," we look for the corresponding "i" in actives.
-- If we cannot find it, then it is an error (since the list is sorted).
-- If the "o" is recorded on a different day than the "i" then we close the
-- active entry at the end of its day, replace it in the active list
-- with a start at midnight on the next day, and try again.
-- This raises an error if any outs cannot be paired with an in.
pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries [] actives sessions1 = Sessions {completed = sessions1, active = actives}
pairClockEntries (entry:es) actives sessions1
| tlcode entry == In = pairClockEntries es inentries sessions1
| tlcode entry == Out = pairClockEntries es' actives' sessions2
| otherwise = pairClockEntries es actives sessions1
where
(inentry, newactive) = findInForOut entry (partition (\e -> tlaccount e == tlaccount entry) actives)
(itime, otime) = (tldatetime inentry, tldatetime entry)
(idate, odate) = (localDay itime, localDay otime)
omidnight = entry {tldatetime = itime {localDay = idate, localTimeOfDay = TimeOfDay 23 59 59}}
imidnight = inentry {tldatetime = itime {localDay = addDays 1 idate, localTimeOfDay = midnight}}
(sessions2, actives', es')
| odate > idate = (Session {in' = inentry, out = omidnight} : sessions1, imidnight:newactive, entry:es)
| otherwise = (Session {in' = inentry, out = entry} : sessions1, newactive, es)
inentries = case filter ((== tlaccount entry) . tlaccount) actives of
[] -> entry:actives
activesinthisacct -> error' $ T.unpack $ makeTimeClockErrorExcerpt entry $ T.unlines $ [
""
,"overlaps with session beginning at:"
,""
]
<> map (flip makeTimeClockErrorExcerpt "") activesinthisacct
<> [ "Overlapping sessions with the same account name are not supported." ]
-- XXX better to show full session(s)
-- <> map T.show (filter ((`elem` activesinthisacct).in') sessions)
where
makeTimeClockErrorExcerpt :: TimeclockEntry -> T.Text -> T.Text
makeTimeClockErrorExcerpt e@TimeclockEntry{tlsourcepos=pos} msg = T.unlines [
T.pack (sourcePosPretty pos) <> ":"
,l <> " | " <> T.show e
-- ,T.replicate (T.length l) " " <> " |" -- <> T.replicate c " " <> "^")
] <> msg
where
l = T.show $ unPos $ sourceLine $ tlsourcepos e
-- c = unPos $ sourceColumn $ tlsourcepos e
-- | Find the relevant clockin in the actives list that should be paired with this clockout. -- | Find the relevant clockin in the actives list that should be paired with this clockout.
-- If there is a session that has the same account name, then use that. -- If there is a session that has the same account name, then use that.
-- Otherwise, if there is an active anonymous session, use that. -- Otherwise, if there is an active anonymous session, use that.
@ -86,112 +194,6 @@ findInForOut o ([], activeins) =
(l ++ " | " ++ show o) (l ++ " | " ++ show o)
(replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^") (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^")
-- | Assuming that entries have been sorted, we go through each time log entry.
-- We collect all of the "i" in the list "actives," and each time we encounter
-- an "o," we look for the corresponding "i" in actives.
-- If we cannot find it, then it is an error (since the list is sorted).
-- If the "o" is recorded on a different day than the "i" then we close the
-- active entry at the end of its day, replace it in the active list
-- with a start at midnight on the next day, and try again.
-- This raises an error if any outs cannot be paired with an in.
pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries [] actives sessions = Sessions {completed = sessions, active = actives}
pairClockEntries (entry : rest) actives sessions
| tlcode entry == In = pairClockEntries rest inentries sessions
| tlcode entry == Out = pairClockEntries rest' actives' sessions'
| otherwise = pairClockEntries rest actives sessions
where
(inentry, newactive) = findInForOut entry (partition (\e -> tlaccount e == tlaccount entry) actives)
(itime, otime) = (tldatetime inentry, tldatetime entry)
(idate, odate) = (localDay itime, localDay otime)
omidnight = entry {tldatetime = itime {localDay = idate, localTimeOfDay = TimeOfDay 23 59 59}}
imidnight = inentry {tldatetime = itime {localDay = addDays 1 idate, localTimeOfDay = midnight}}
(sessions', actives', rest')
| odate > idate = (Session {in' = inentry, out = omidnight} : sessions, imidnight : newactive, entry : rest)
| otherwise = (Session {in' = inentry, out = entry} : sessions, newactive, rest)
inentries = case filter ((== tlaccount entry) . tlaccount) actives of
[] -> entry : actives
activesinthisacct -> error' $ T.unpack $ makeTimeClockErrorExcerpt entry $ T.unlines $ [
""
,"overlaps with session beginning at:"
,""
]
<> map (flip makeTimeClockErrorExcerpt "") activesinthisacct
<> [
"Overlapping sessions with the same account name are not supported."
]
-- XXX better to show full session(s)
-- <> map T.show (filter ((`elem` activesinthisacct).in') sessions)
makeTimeClockErrorExcerpt :: TimeclockEntry -> T.Text -> T.Text
makeTimeClockErrorExcerpt e@TimeclockEntry{tlsourcepos=pos} msg = T.unlines [
T.pack (sourcePosPretty pos) <> ":"
,l <> " | " <> T.show e
-- ,T.replicate (T.length l) " " <> " |" -- <> T.replicate c " " <> "^")
] <> msg
where
l = T.show $ unPos $ sourceLine $ tlsourcepos e
-- c = unPos $ sourceColumn $ tlsourcepos e
-- | Convert time log entries to journal transactions, allowing multiple clocked-in sessions at once.
-- This is the new, default behaviour.
-- Entries are processed in time order, then (for entries with the same time) in parse order.
-- When there is no clockout, one is added with the provided current time.
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- If any entries cannot be paired as expected, an error is raised.
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions now entries = transactions
where
sessions = dbg6 "sessions" $ pairClockEntries (sortTimeClockEntries entries) [] []
transactionsFromSession s = entryFromTimeclockInOut (in' s) (out s)
-- If any "in" sessions are in the future, then set their out time to the initial time
outtime te = max now (tldatetime te)
createout te = TimeclockEntry (tlsourcepos te) Out (outtime te) (tlaccount te) "" "" []
outs = map createout (active sessions)
stillopen = dbg6 "stillopen" $ pairClockEntries ((active sessions) <> outs) [] []
transactions = map transactionsFromSession $ sortBy (\s1 s2 -> compare (in' s1) (in' s2)) (completed sessions ++ completed stillopen)
-- | Sort timeclock entries first by date and time (with time zone ignored as usual), then by file position.
-- Ie, sort by time, but preserve the parse order of entries with the same time.
sortTimeClockEntries :: [TimeclockEntry] -> [TimeclockEntry]
sortTimeClockEntries = sortBy (\e1 e2 -> compare (tldatetime e1, tlsourcepos e1) (tldatetime e2, tlsourcepos e2))
-- | Convert time log entries to journal transactions, allowing only one clocked-in session at a time.
-- Entries must be a strict alternation of in and out, beginning with in.
-- When there is no clockout, one is added with the provided current time.
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- If entries are not in the expected in/out order, an error is raised.
-- This is the old, legacy behaviour, enabled by --old-timeclock.
timeclockEntriesToTransactionsSingle :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactionsSingle _ [] = []
timeclockEntriesToTransactionsSingle now [i]
| tlcode i /= In = errorExpectedCodeButGot In i
| odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactionsSingle 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}}
timeclockEntriesToTransactionsSingle now (i:o:rest)
| tlcode i /= In = errorExpectedCodeButGot In i
| tlcode o /= Out = errorExpectedCodeButGot Out o
| odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactionsSingle now (i':o:rest)
| otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactionsSingle 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 timeclockEntriesToTransactionsSingle -}
errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot expected actual = error' $ printf errorExpectedCodeButGot expected actual = error' $ printf
("%s:\n%s\n%s\n\nExpected a timeclock %s entry but got %s.\n" ("%s:\n%s\n%s\n\nExpected a timeclock %s entry but got %s.\n"
@ -265,7 +267,7 @@ entryFromTimeclockInOut i o
-- tests -- tests
tests_Timeclock = testGroup "Timeclock" [ tests_Timeclock = testGroup "Timeclock" [
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do testCaseSteps "timeclockToTransactions tests" $ \step -> do
step "gathering data" step "gathering data"
today <- getCurrentDay today <- getCurrentDay
now' <- getCurrentTime now' <- getCurrentTime
@ -278,7 +280,7 @@ tests_Timeclock = testGroup "Timeclock" [
mktime d = LocalTime d . fromMaybe midnight . mktime d = LocalTime d . fromMaybe midnight .
parseTimeM True defaultTimeLocale "%H:%M:%S" parseTimeM True defaultTimeLocale "%H:%M:%S"
showtime = formatTime defaultTimeLocale "%H:%M" showtime = formatTime defaultTimeLocale "%H:%M"
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now txndescs = map (T.unpack . tdescription) . timeclockToTransactions now
future = utcToLocalTime tz $ addUTCTime 100 now' future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future futurestr = showtime future
step "started yesterday, split session at midnight" step "started yesterday, split session at midnight"

15
hledger-lib/Hledger/Read/TimeclockReader.hs
View File

@ -182,7 +182,8 @@ parse iopts fp t = initialiseAndParseJournal (timeclockfilep iopts) iopts fp t
-- timeclockfilep args -- timeclockfilep args
timeclockfilep :: MonadIO m => InputOpts -> JournalParser m ParsedJournal timeclockfilep :: MonadIO m => InputOpts -> JournalParser m ParsedJournal
timeclockfilep iopts = do many timeclockitemp timeclockfilep iopts = do
many timeclockitemp
eof eof
j@Journal{jparsetimeclockentries=es} <- get j@Journal{jparsetimeclockentries=es} <- get
-- Convert timeclock entries in this journal to transactions, closing any unfinished sessions. -- Convert timeclock entries in this journal to transactions, closing any unfinished sessions.
@ -190,14 +191,16 @@ timeclockfilep iopts = do many timeclockitemp
-- but it simplifies code above. -- but it simplifies code above.
now <- liftIO getCurrentLocalTime now <- liftIO getCurrentLocalTime
-- journalFinalise expects the transactions in reverse order, so reverse the output in either case -- journalFinalise expects the transactions in reverse order, so reverse the output in either case
let j' = if _oldtimeclock iopts then let
-- timeclockEntriesToTransactionsSingle expects the entries to be in normal order, j' = if _oldtimeclock iopts
then
-- timeclockToTransactionsOld expects the entries to be in normal order,
-- but they have been parsed in reverse order, so reverse them before calling -- but they have been parsed in reverse order, so reverse them before calling
j{jtxns = reverse $ timeclockEntriesToTransactionsSingle now $ reverse es, jparsetimeclockentries = []} j{jtxns = reverse $ timeclockToTransactionsOld now $ reverse es, jparsetimeclockentries = []}
else else
-- We don't need to reverse these transactions -- We don't need to reverse these transactions
-- since they are sorted inside of timeclockEntriesToTransactions -- since they are sorted inside of timeclockToTransactions
j{jtxns = reverse $ timeclockEntriesToTransactions now es, jparsetimeclockentries = []} j{jtxns = reverse $ timeclockToTransactions now es, jparsetimeclockentries = []}
return j' return j'
where where
-- As all ledger line types can be distinguished by the first -- As all ledger line types can be distinguished by the first