Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

imp: allow timestamp syntax in transaction dates #2233

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

imp: allow timestamp syntax in transaction dates #2233

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
257f996
imp: allow timestamp syntax in transaction dates
Stealthmate Aug 31, 2024
59c5040
fix: incorrect timestamp parsing logic
Stealthmate Sep 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 13 additions & 0 deletions hledger-lib/Hledger/Data/Balancing.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -793,6 +793,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -808,6 +809,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -825,6 +827,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -841,6 +844,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -859,6 +863,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2011 01 01)
Nothing
Unmarked
Expand All @@ -876,6 +881,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2011 01 01)
Nothing
Unmarked
Expand All @@ -895,6 +901,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -913,6 +920,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -931,6 +939,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -946,6 +955,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -961,6 +971,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -980,6 +991,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand All @@ -998,6 +1010,7 @@ tests_Balancing =
0
""
nullsourcepos
Nothing
(fromGregorian 2009 01 01)
Nothing
Unmarked
Expand Down
83 changes: 82 additions & 1 deletion hledger-lib/Hledger/Data/Journal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ module Hledger.Data.Journal (
journalInferEquityFromCosts,
journalInferCostsFromEquity,
journalMarkRedundantCosts,
journalSetTransactionDatetimes,
journalReverse,
journalSetLastReadTime,
journalRenumberAccountDeclarations,
Expand Down Expand Up @@ -117,6 +118,7 @@ module Hledger.Data.Journal (
where

import Control.Applicative ((<|>))
import Control.Monad (foldM)
import Control.Monad.Except (ExceptT(..))
import Control.Monad.State.Strict (StateT)
import Data.Char (toUpper, isDigit)
Expand All @@ -132,6 +134,7 @@ import qualified Data.Text as T
import Safe (headMay, headDef, maximumMay, minimumMay, lastDef)
import Data.Time.Calendar (Day, addDays, fromGregorian, diffDays)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.Clock (UTCTime(UTCTime), utctDayTime, secondsToDiffTime, diffTimeToPicoseconds, picosecondsToDiffTime)
import Data.Tree (Tree(..), flatten)
import Text.Printf (printf)
import Text.Megaparsec (ParsecT)
Expand Down Expand Up @@ -1008,6 +1011,47 @@ journalMarkRedundantCosts j = do
return j{jtxns=ts}
where conversionaccts = journalConversionAccounts j

journalSetTransactionDatetimes :: Journal -> Either String Journal
journalSetTransactionDatetimes j@Journal{jtxns=[]} = Right j
journalSetTransactionDatetimes j@Journal{jtxns=txns} = do
allWithDatetime <- foldM setDateTime [] . sortBy cmpDate $ txns
return j{jtxns=sortBy cmpIndex allWithDatetime}
where
cmpDate t1 t2
| compare (tdate t1) (tdate t2) == EQ =
case (tdatetime t1, tdatetime t2) of
(Just dt1, Just dt2) -> compare dt1 dt2
(_, _) -> compare (tindex t1) (tindex t2)
| otherwise = compare (tdate t1) (tdate t2)
cmpIndex t1 t2 =
let keyOf = tindex
in compare (keyOf t1) (keyOf t2)

setDateTime :: [Transaction] -> Transaction -> Either String [Transaction]
-- If the current transation has a tdatetime, we leave it as it is.
setDateTime txnsRest txn@Transaction{tdatetime = Just _} = Right $ txn:txnsRest
-- All patterns below assume that tdatetime is empty.

-- If the current transaction comes first chronologically,
-- we set tdatetime to the start of the day.
setDateTime [] txn@Transaction{tdate = d} = Right [txn{tdatetime = Just . zeroTime $ d}]
setDateTime (lastTxn:txnsRest) txn = do
lastTxnDatetime <- case tdatetime lastTxn of
Nothing -> Left "Empty tdatetime while folding journal. This should never happen."
Just dt -> Right dt
let lastTxnTime = diffTimeToPicoseconds . utctDayTime $ lastTxnDatetime
nextTxnTime = lastTxnTime + 1000000000
earliestNextTime <- if
nextTxnTime < endOfDay then Right nextTxnTime
else Left "Previous transaction was at the end of the day \
\and the current transaction does not specify a \
\time of day, so it's impossible to deduce a valid timestamp."
Right $ txn{tdatetime=Just . UTCTime (tdate txn) . picosecondsToDiffTime $ earliestNextTime}:lastTxn:txnsRest
zeroTime :: Day -> UTCTime
zeroTime d = UTCTime d . secondsToDiffTime $ 0

endOfDay = 86400 * 1000000000

-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
-- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
Expand Down Expand Up @@ -1242,6 +1286,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 01 01,
tdate2=Nothing,
tstatus=Unmarked,
Expand All @@ -1259,6 +1304,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 06 01,
tdate2=Nothing,
tstatus=Unmarked,
Expand All @@ -1276,6 +1322,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 06 02,
tdate2=Nothing,
tstatus=Unmarked,
Expand All @@ -1293,6 +1340,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 06 03,
tdate2=Nothing,
tstatus=Cleared,
Expand All @@ -1310,6 +1358,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 10 01,
tdate2=Nothing,
tstatus=Unmarked,
Expand All @@ -1326,6 +1375,7 @@ samplejournalMaybeExplicit explicit = nulljournal
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=fromGregorian 2008 12 31,
tdate2=Nothing,
tstatus=Unmarked,
Expand Down Expand Up @@ -1353,5 +1403,36 @@ tests_Journal = testGroup "Journal" [
}
]
}
@?= (DateSpan (Just $ Exact $ fromGregorian 2014 1 10) (Just $ Exact $ fromGregorian 2014 10 11))
@?= (DateSpan (Just $ Exact $ fromGregorian 2014 1 10) (Just $ Exact $ fromGregorian 2014 10 11)),

testCase "journalSetTransactionDatetimes sets correct tdatetime for single transaction" $ do
let txn1 = nulltransaction{tdate = fromGregorian 2024 02 01}
jin = nulljournal{jtxns = [txn1]}
txnsOut <- case fmap jtxns (journalSetTransactionDatetimes jin) of
Right x -> pure x
Left _ -> assertFailure "Must be Right."

txnsOut @=? [txn1{tdatetime=Just $ UTCTime (tdate txn1) (secondsToDiffTime 0)}],

testCase "journalSetTransactionDatetimes sets correct tdatetime when already exists" $ do
let txn1 = nulltransaction{tdate = fromGregorian 2024 02 01, tdatetime = Just $ UTCTime (fromGregorian 2024 02 01) (secondsToDiffTime 0)}
jin = nulljournal{jtxns = [txn1]}
txnsOut <- case fmap jtxns (journalSetTransactionDatetimes jin) of
Right x -> pure x
Left _ -> assertFailure "Must be Right."

txnsOut @=? [txn1],

testCase "journalSetTransactionDatetimes sets correct tdatetime when nothing" $ do
let txn1 = nulltransaction{tindex=1, tdate=fromGregorian 2024 02 01}
txn2 = nulltransaction{tindex=2, tdate=fromGregorian 2024 02 01}
jin = nulljournal{jtxns = [txn1, txn2]}
txnsOut <- case fmap jtxns (journalSetTransactionDatetimes jin) of
Right x -> pure x
Left _ -> assertFailure "Must be Right."

txnsOut @=? [
txn1{tdatetime=Just $ UTCTime (tdate txn1) (picosecondsToDiffTime 0)},
txn2{tdatetime=Just $ UTCTime (tdate txn2) (picosecondsToDiffTime 1000000000)}
]
]
1 change: 1 addition & 0 deletions hledger-lib/Hledger/Data/Timeclock.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,7 @@ entryFromTimeclockInOut i o
t = Transaction {
tindex = 0,
tsourcepos = (tlsourcepos i, tlsourcepos i),
tdatetime = Nothing,
tdate = idate,
tdate2 = Nothing,
tstatus = Cleared,
Expand Down
5 changes: 5 additions & 0 deletions hledger-lib/Hledger/Data/Transaction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,7 @@ nulltransaction :: Transaction
nulltransaction = Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdatetime=Nothing,
tdate=nulldate,
tdate2=Nothing,
tstatus=Unmarked,
Expand Down Expand Up @@ -605,6 +606,7 @@ tests_Transaction =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -629,6 +631,7 @@ tests_Transaction =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -652,6 +655,7 @@ tests_Transaction =
0
""
nullsourcepos
Nothing
(fromGregorian 2007 01 28)
Nothing
Unmarked
Expand All @@ -668,6 +672,7 @@ tests_Transaction =
0
""
nullsourcepos
Nothing
(fromGregorian 2010 01 01)
Nothing
Unmarked
Expand Down
2 changes: 2 additions & 0 deletions hledger-lib/Hledger/Data/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ import qualified Data.Map as M
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.LocalTime (LocalTime)
import Data.Word (Word8)
Expand Down Expand Up @@ -467,6 +468,7 @@ data Transaction = Transaction {
tindex :: Integer, -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available
tprecedingcomment :: Text, -- ^ any comment lines immediately preceding this transaction
tsourcepos :: (SourcePos, SourcePos), -- ^ the file position where the date starts, and where the last posting ends
tdatetime :: Maybe UTCTime,
tdate :: Day,
tdate2 :: Maybe Day,
tstatus :: Status,
Expand Down
Loading
Loading