refactor: journalCloseTimeLogEntries

This commit is contained in:
Simon Michael 2010-05-22 19:00:20 +00:00
parent 11d354d426
commit a430badb85
5 changed files with 47 additions and 45 deletions

View File

@ -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"]

View File

@ -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
] ]

View File

@ -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

View File

@ -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

View File

@ -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]
]