refactor: journalCloseTimeLogEntries
This commit is contained in:
		
							parent
							
								
									11d354d426
								
							
						
					
					
						commit
						a430badb85
					
				| @ -28,8 +28,6 @@ $ hledger -f sample.ledger balance o | |||||||
| 
 | 
 | ||||||
| module Hledger.Tests | module Hledger.Tests | ||||||
| where | where | ||||||
| import Data.Time.Format |  | ||||||
| import System.Locale (defaultTimeLocale) |  | ||||||
| import Test.HUnit.Tools (runVerboseTests) | import Test.HUnit.Tools (runVerboseTests) | ||||||
| import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible | import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible | ||||||
| import System.Time (ClockTime(TOD)) | import System.Time (ClockTime(TOD)) | ||||||
| @ -308,33 +306,6 @@ tests = TestList [ | |||||||
|   --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" |   --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" | ||||||
|   --     `is` "aa:aa:aaaaaaaaaaaaaa") |   --     `is` "aa:aa:aaaaaaaaaaaaaa") | ||||||
| 
 | 
 | ||||||
|   ,"entriesFromTimeLogEntries" ~: do |  | ||||||
|      today <- getCurrentDay |  | ||||||
|      now' <- getCurrentTime |  | ||||||
|      tz <- getCurrentTimeZone |  | ||||||
|      let now = utcToLocalTime tz now' |  | ||||||
|          nowstr = showtime now |  | ||||||
|          yesterday = prevday today |  | ||||||
|          clockin = TimeLogEntry In |  | ||||||
|          mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S" |  | ||||||
|          showtime = formatTime defaultTimeLocale "%H:%M" |  | ||||||
|          assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ entriesFromTimeLogEntries now es) |  | ||||||
| 
 |  | ||||||
|      assertEntriesGiveStrings "started yesterday, split session at midnight" |  | ||||||
|                                   [clockin (mktime yesterday "23:00:00") ""] |  | ||||||
|                                   ["23:00-23:59","00:00-"++nowstr] |  | ||||||
|      assertEntriesGiveStrings "split multi-day sessions at each midnight" |  | ||||||
|                                   [clockin (mktime (addDays (-2) today) "23:00:00") ""] |  | ||||||
|                                   ["23:00-23:59","00:00-23:59","00:00-"++nowstr] |  | ||||||
|      assertEntriesGiveStrings "auto-clock-out if needed"  |  | ||||||
|                                   [clockin (mktime today "00:00:00") ""]  |  | ||||||
|                                   ["00:00-"++nowstr] |  | ||||||
|      let future = utcToLocalTime tz $ addUTCTime 100 now' |  | ||||||
|          futurestr = showtime future |  | ||||||
|      assertEntriesGiveStrings "use the clockin time for auto-clockout if it's in the future" |  | ||||||
|                                   [clockin future ""] |  | ||||||
|                                   [printf "%s-%s" futurestr futurestr] |  | ||||||
| 
 |  | ||||||
|   ,"expandAccountNames" ~: |   ,"expandAccountNames" ~: | ||||||
|     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"] | ||||||
|  | |||||||
| @ -52,7 +52,7 @@ tests_Hledger_Data = TestList | |||||||
|     ,Hledger.Data.Parse.tests_Parse |     ,Hledger.Data.Parse.tests_Parse | ||||||
|     -- ,Hledger.Data.Journal.tests_Journal |     -- ,Hledger.Data.Journal.tests_Journal | ||||||
|     -- ,Hledger.Data.Posting.tests_Posting |     -- ,Hledger.Data.Posting.tests_Posting | ||||||
|     -- ,Hledger.Data.TimeLog.tests_TimeLog |     ,Hledger.Data.TimeLog.tests_TimeLog | ||||||
|     -- ,Hledger.Data.Types.tests_Types |     -- ,Hledger.Data.Types.tests_Types | ||||||
|     -- ,Hledger.Data.Utils.tests_Utils |     -- ,Hledger.Data.Utils.tests_Utils | ||||||
|     ] |     ] | ||||||
|  | |||||||
| @ -229,6 +229,11 @@ canonicaliseAmounts costbasis j@Journal{jtxns=ts} = j{jtxns=map fixledgertransac | |||||||
|                         where canonicaliseCommodity a@Amount{commodity=Commodity{symbol=s}} = |                         where canonicaliseCommodity a@Amount{commodity=Commodity{symbol=s}} = | ||||||
|                                   a{commodity=findWithDefault (error "programmer error: canonicaliseCommodity failed") s canonicalcommoditymap} |                                   a{commodity=findWithDefault (error "programmer error: canonicaliseCommodity failed") s canonicalcommoditymap} | ||||||
| 
 | 
 | ||||||
|  | -- | Close any open timelog sessions using the provided current time. | ||||||
|  | journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal | ||||||
|  | journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} = | ||||||
|  |   j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []} | ||||||
|  | 
 | ||||||
| -- | Get just the amounts from a ledger, in the order parsed. | -- | Get just the amounts from a ledger, in the order parsed. | ||||||
| journalAmounts :: Journal -> [MixedAmount] | journalAmounts :: Journal -> [MixedAmount] | ||||||
| journalAmounts = map pamount . journalPostings | journalAmounts = map pamount . journalPostings | ||||||
| @ -241,13 +246,6 @@ journalCommodities = map commodity . concatMap amounts . journalAmounts | |||||||
| journalPrecisions :: Journal -> [Int] | journalPrecisions :: Journal -> [Int] | ||||||
| journalPrecisions = map precision . journalCommodities | journalPrecisions = map precision . journalCommodities | ||||||
| 
 | 
 | ||||||
| -- | Close any open timelog sessions using the provided current time. |  | ||||||
| journalConvertTimeLog :: LocalTime -> Journal -> Journal |  | ||||||
| journalConvertTimeLog t l0 = l0 { jtxns = convertedTimeLog ++ jtxns l0 |  | ||||||
|                                   , open_timelog_entries = [] |  | ||||||
|                                   } |  | ||||||
|     where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0 |  | ||||||
| 
 |  | ||||||
| -- | The (fully specified) date span containing all the raw ledger's transactions, | -- | The (fully specified) date span containing all the raw ledger's transactions, | ||||||
| -- or DateSpan Nothing Nothing if there are none. | -- or DateSpan Nothing Nothing if there are none. | ||||||
| journalDateSpan :: Journal -> DateSpan | journalDateSpan :: Journal -> DateSpan | ||||||
|  | |||||||
| @ -217,7 +217,7 @@ parseJournalFile t f   = liftIO (readFile f) >>= parseJournal t f | |||||||
| parseJournal :: LocalTime -> FilePath -> String -> ErrorT String IO Journal | parseJournal :: LocalTime -> FilePath -> String -> ErrorT String IO Journal | ||||||
| parseJournal reftime inname intxt = | parseJournal reftime inname intxt = | ||||||
|   case runParser ledgerFile emptyCtx inname intxt of |   case runParser ledgerFile emptyCtx inname intxt of | ||||||
|     Right m  -> liftM (journalConvertTimeLog reftime) $ m `ap` return nulljournal |     Right m  -> liftM (journalCloseTimeLogEntries reftime) $ m `ap` return nulljournal | ||||||
|     Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ? |     Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ? | ||||||
| 
 | 
 | ||||||
| -- parsers | -- parsers | ||||||
|  | |||||||
| @ -8,6 +8,8 @@ converted to 'Transactions' and queried like a ledger. | |||||||
| 
 | 
 | ||||||
| module Hledger.Data.TimeLog | module Hledger.Data.TimeLog | ||||||
| where | where | ||||||
|  | import Data.Time.Format | ||||||
|  | import System.Locale (defaultTimeLocale) | ||||||
| import Hledger.Data.Utils | import Hledger.Data.Utils | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Dates | import Hledger.Data.Dates | ||||||
| @ -35,10 +37,10 @@ instance Read TimeLogCode where | |||||||
| -- | Convert time log entries to ledger transactions. When there is no | -- | Convert time log entries to ledger transactions. 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 into days to give accurate per-day totals. | -- midnight are split into days to give accurate per-day totals. | ||||||
| entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Transaction] | timeLogEntriesToTransactions :: LocalTime -> [TimeLogEntry] -> [Transaction] | ||||||
| entriesFromTimeLogEntries _ [] = [] | timeLogEntriesToTransactions _ [] = [] | ||||||
| entriesFromTimeLogEntries now [i] | timeLogEntriesToTransactions now [i] | ||||||
|     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now [i',o] |     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now [i',o] | ||||||
|     | otherwise = [entryFromTimeLogInOut i o] |     | otherwise = [entryFromTimeLogInOut i o] | ||||||
|     where |     where | ||||||
|       o = TimeLogEntry Out end "" |       o = TimeLogEntry Out end "" | ||||||
| @ -47,9 +49,9 @@ entriesFromTimeLogEntries now [i] | |||||||
|       (idate,odate) = (localDay itime,localDay otime) |       (idate,odate) = (localDay itime,localDay otime) | ||||||
|       o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} |       o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} | ||||||
|       i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} |       i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} | ||||||
| entriesFromTimeLogEntries now (i:o:rest) | timeLogEntriesToTransactions now (i:o:rest) | ||||||
|     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now (i':o:rest) |     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now (i':o:rest) | ||||||
|     | otherwise = entryFromTimeLogInOut i o : entriesFromTimeLogEntries now rest |     | otherwise = entryFromTimeLogInOut i o : timeLogEntriesToTransactions now rest | ||||||
|     where |     where | ||||||
|       (itime,otime) = (tldatetime i,tldatetime o) |       (itime,otime) = (tldatetime i,tldatetime o) | ||||||
|       (idate,odate) = (localDay itime,localDay otime) |       (idate,odate) = (localDay itime,localDay otime) | ||||||
| @ -88,3 +90,34 @@ entryFromTimeLogInOut i o | |||||||
|                           pcomment="",ptype=RegularPosting,ptransaction=Just t} |                           pcomment="",ptype=RegularPosting,ptransaction=Just t} | ||||||
|                  --,Posting "assets:time" (-amount) "" RegularPosting |                  --,Posting "assets:time" (-amount) "" RegularPosting | ||||||
|                  ] |                  ] | ||||||
|  | 
 | ||||||
|  | tests_TimeLog = TestList [ | ||||||
|  | 
 | ||||||
|  |    "timeLogEntriesToTransactions" ~: do | ||||||
|  |      today <- getCurrentDay | ||||||
|  |      now' <- getCurrentTime | ||||||
|  |      tz <- getCurrentTimeZone | ||||||
|  |      let now = utcToLocalTime tz now' | ||||||
|  |          nowstr = showtime now | ||||||
|  |          yesterday = prevday today | ||||||
|  |          clockin = TimeLogEntry In | ||||||
|  |          mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S" | ||||||
|  |          showtime = formatTime defaultTimeLocale "%H:%M" | ||||||
|  |          assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeLogEntriesToTransactions now es) | ||||||
|  | 
 | ||||||
|  |      assertEntriesGiveStrings "started yesterday, split session at midnight" | ||||||
|  |                                   [clockin (mktime yesterday "23:00:00") ""] | ||||||
|  |                                   ["23:00-23:59","00:00-"++nowstr] | ||||||
|  |      assertEntriesGiveStrings "split multi-day sessions at each midnight" | ||||||
|  |                                   [clockin (mktime (addDays (-2) today) "23:00:00") ""] | ||||||
|  |                                   ["23:00-23:59","00:00-23:59","00:00-"++nowstr] | ||||||
|  |      assertEntriesGiveStrings "auto-clock-out if needed"  | ||||||
|  |                                   [clockin (mktime today "00:00:00") ""]  | ||||||
|  |                                   ["00:00-"++nowstr] | ||||||
|  |      let future = utcToLocalTime tz $ addUTCTime 100 now' | ||||||
|  |          futurestr = showtime future | ||||||
|  |      assertEntriesGiveStrings "use the clockin time for auto-clockout if it's in the future" | ||||||
|  |                                   [clockin future ""] | ||||||
|  |                                   [printf "%s-%s" futurestr futurestr] | ||||||
|  | 
 | ||||||
|  |  ] | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user