test and bugfix for multi-day timelog session splitting
This commit is contained in:
parent
564aba4976
commit
0cacc2a7e4
@ -23,10 +23,18 @@ instance Show TimeLog where
|
|||||||
|
|
||||||
-- | Convert time log entries to ledger entries. When there is no
|
-- | Convert time log entries to ledger entries. When there is no
|
||||||
-- clockout, add one with the provided current time. Sessions crossing
|
-- clockout, add one with the provided current time. Sessions crossing
|
||||||
-- midnight are split to give accurate per-day totals.
|
-- midnight are split into days to give accurate per-day totals.
|
||||||
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Entry]
|
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Entry]
|
||||||
entriesFromTimeLogEntries _ [] = []
|
entriesFromTimeLogEntries _ [] = []
|
||||||
entriesFromTimeLogEntries t [i] = [entryFromTimeLogInOut i (TimeLogEntry 'o' t "")]
|
entriesFromTimeLogEntries t [i]
|
||||||
|
| odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries t [i',o]
|
||||||
|
| otherwise = [entryFromTimeLogInOut i o]
|
||||||
|
where
|
||||||
|
o = TimeLogEntry 'o' t ""
|
||||||
|
(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}}
|
||||||
entriesFromTimeLogEntries t (i:o:rest)
|
entriesFromTimeLogEntries t (i:o:rest)
|
||||||
| odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries t (i':o:rest)
|
| odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries t (i':o:rest)
|
||||||
| otherwise = [entryFromTimeLogInOut i o] ++ entriesFromTimeLogEntries t rest
|
| otherwise = [entryFromTimeLogInOut i o] ++ entriesFromTimeLogEntries t rest
|
||||||
|
|||||||
1
NOTES
1
NOTES
@ -10,7 +10,6 @@ clever tricks like the plague." --Edsger Dijkstra
|
|||||||
|
|
||||||
* to do
|
* to do
|
||||||
** errors
|
** errors
|
||||||
*** timelog report for today with no entries ignores an open session from yesterday
|
|
||||||
*** not catching some unbalanced entries, two ways:
|
*** not catching some unbalanced entries, two ways:
|
||||||
**** 1
|
**** 1
|
||||||
1/1 test1
|
1/1 test1
|
||||||
|
|||||||
16
Tests.hs
16
Tests.hs
@ -5,6 +5,8 @@
|
|||||||
module Tests
|
module Tests
|
||||||
where
|
where
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Data.Time.Format
|
||||||
|
import System.Locale (defaultTimeLocale)
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Test.HUnit.Tools (assertRaises, runVerboseTests)
|
import Test.HUnit.Tools (assertRaises, runVerboseTests)
|
||||||
@ -294,6 +296,20 @@ tests = [
|
|||||||
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||||
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||||
|
|
||||||
|
,"entriesFromTimeLogEntries" ~: do
|
||||||
|
today <- getCurrentDay
|
||||||
|
let
|
||||||
|
clockin t a = TimeLogEntry 'i' t a
|
||||||
|
clockout t = TimeLogEntry 'o' t ""
|
||||||
|
yesterday = prevday today
|
||||||
|
mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
|
||||||
|
noon = LocalTime today midday
|
||||||
|
ts `gives` ss = (map edescription $ entriesFromTimeLogEntries noon ts) `is` ss
|
||||||
|
[] `gives` []
|
||||||
|
[clockin (mktime today "00:00:00") ""] `gives` ["00:00-12:00"]
|
||||||
|
[clockin (mktime yesterday "23:00:00") ""] `gives` ["23:00-23:59","00:00-12:00"]
|
||||||
|
[clockin (mktime (addDays (-2) today) "23:00:00") ""] `gives` ["23:00-23:59","00:00-23:59","00:00-12:00"]
|
||||||
|
|
||||||
,"expandAccountNames" ~: do
|
,"expandAccountNames" ~: do
|
||||||
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
|
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
|
||||||
["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
|
["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user