refactor: journalCloseTimeLogEntries
This commit is contained in:
		
							parent
							
								
									11d354d426
								
							
						
					
					
						commit
						a430badb85
					
				| @ -28,8 +28,6 @@ $ hledger -f sample.ledger balance o | ||||
| 
 | ||||
| module Hledger.Tests | ||||
| where | ||||
| import Data.Time.Format | ||||
| import System.Locale (defaultTimeLocale) | ||||
| import Test.HUnit.Tools (runVerboseTests) | ||||
| import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible | ||||
| import System.Time (ClockTime(TOD)) | ||||
| @ -308,33 +306,6 @@ tests = TestList [ | ||||
|   --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" | ||||
|   --     `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 ["assets:cash","assets:checking","expenses:vacation"] `is` | ||||
|      ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] | ||||
|  | ||||
| @ -52,7 +52,7 @@ tests_Hledger_Data = TestList | ||||
|     ,Hledger.Data.Parse.tests_Parse | ||||
|     -- ,Hledger.Data.Journal.tests_Journal | ||||
|     -- ,Hledger.Data.Posting.tests_Posting | ||||
|     -- ,Hledger.Data.TimeLog.tests_TimeLog | ||||
|     ,Hledger.Data.TimeLog.tests_TimeLog | ||||
|     -- ,Hledger.Data.Types.tests_Types | ||||
|     -- ,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}} = | ||||
|                                   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. | ||||
| journalAmounts :: Journal -> [MixedAmount] | ||||
| journalAmounts = map pamount . journalPostings | ||||
| @ -241,13 +246,6 @@ journalCommodities = map commodity . concatMap amounts . journalAmounts | ||||
| journalPrecisions :: Journal -> [Int] | ||||
| 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, | ||||
| -- or DateSpan Nothing Nothing if there are none. | ||||
| 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 reftime inname intxt = | ||||
|   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 ? | ||||
| 
 | ||||
| -- parsers | ||||
|  | ||||
| @ -8,6 +8,8 @@ converted to 'Transactions' and queried like a ledger. | ||||
| 
 | ||||
| module Hledger.Data.TimeLog | ||||
| where | ||||
| import Data.Time.Format | ||||
| import System.Locale (defaultTimeLocale) | ||||
| import Hledger.Data.Utils | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Dates | ||||
| @ -35,10 +37,10 @@ instance Read TimeLogCode where | ||||
| -- | Convert time log entries to ledger 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. | ||||
| entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Transaction] | ||||
| entriesFromTimeLogEntries _ [] = [] | ||||
| entriesFromTimeLogEntries now [i] | ||||
|     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now [i',o] | ||||
| timeLogEntriesToTransactions :: LocalTime -> [TimeLogEntry] -> [Transaction] | ||||
| timeLogEntriesToTransactions _ [] = [] | ||||
| timeLogEntriesToTransactions now [i] | ||||
|     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now [i',o] | ||||
|     | otherwise = [entryFromTimeLogInOut i o] | ||||
|     where | ||||
|       o = TimeLogEntry Out end "" | ||||
| @ -47,9 +49,9 @@ entriesFromTimeLogEntries now [i] | ||||
|       (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 now (i:o:rest) | ||||
|     | odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now (i':o:rest) | ||||
|     | otherwise = entryFromTimeLogInOut i o : entriesFromTimeLogEntries now rest | ||||
| timeLogEntriesToTransactions now (i:o:rest) | ||||
|     | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now (i':o:rest) | ||||
|     | otherwise = entryFromTimeLogInOut i o : timeLogEntriesToTransactions now rest | ||||
|     where | ||||
|       (itime,otime) = (tldatetime i,tldatetime o) | ||||
|       (idate,odate) = (localDay itime,localDay otime) | ||||
| @ -88,3 +90,34 @@ entryFromTimeLogInOut i o | ||||
|                           pcomment="",ptype=RegularPosting,ptransaction=Just t} | ||||
|                  --,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