@@ -60,7 +60,7 @@ import qualified Data.Text.Encoding as T
60
60
import qualified Data.Text.IO as T
61
61
import qualified Data.Text.Lazy as TL
62
62
import qualified Data.Text.Lazy.Builder as TB
63
- import Data.Time.Calendar ( Day )
63
+ import Data.Time ( UTCTime , Day , localDay , utcToLocalTime , getCurrentTimeZone , LocalTime ( LocalTime ) )
64
64
import Data.Time.Format (parseTimeM , defaultTimeLocale )
65
65
import Safe (atMay , headMay , lastMay , readDef , readMay )
66
66
import System.Directory (doesFileExist )
@@ -78,6 +78,7 @@ import Text.Printf (printf)
78
78
import Hledger.Data
79
79
import Hledger.Utils
80
80
import Hledger.Read.Common (aliasesFromOpts , Reader (.. ),InputOpts (.. ), amountp , statusp , genericSourcePos , journalFinalise )
81
+ import Data.Time.LocalTime (TimeZone )
81
82
82
83
--- ** doctest setup
83
84
-- $setup
@@ -741,6 +742,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
741
742
-- let (headerlines, datalines) = identifyHeaderLines records
742
743
-- mfieldnames = lastMay headerlines
743
744
745
+ tz <- getCurrentTimeZone
744
746
let
745
747
-- convert CSV records to transactions
746
748
txns = dbg7 " csv txns" $ snd $ mapAccumL
@@ -750,7 +752,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
750
752
line' = (mkPos . (+ 1 ) . unPos) line
751
753
pos' = SourcePos name line' col
752
754
in
753
- (pos, transactionFromCsvRecord pos' rules r)
755
+ (pos, transactionFromCsvRecord pos' rules tz r)
754
756
)
755
757
(initialPos parsecfilename) records
756
758
@@ -874,8 +876,8 @@ hledgerField = getEffectiveAssignment
874
876
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
875
877
hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record
876
878
877
- transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
878
- transactionFromCsvRecord sourcepos rules record = t
879
+ transactionFromCsvRecord :: SourcePos -> CsvRules -> TimeZone -> CsvRecord -> Transaction
880
+ transactionFromCsvRecord sourcepos rules tz record = t
879
881
where
880
882
----------------------------------------------------------------------
881
883
-- 1. Define some helpers:
@@ -884,7 +886,7 @@ transactionFromCsvRecord sourcepos rules record = t
884
886
-- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
885
887
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
886
888
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
887
- parsedate = parseDateWithCustomOrDefaultFormats (rule " date-format" )
889
+ parsedate = parseDateWithCustomOrDefaultFormats tz (rule " date-format" )
888
890
mkdateerror datefield datevalue mdateformat = T. unpack $ T. unlines
889
891
[" error: could not parse \" " <> datevalue<> " \" as a date using date format "
890
892
<> maybe " \" YYYY/M/D\" , \" YYYY-M-D\" or \" YYYY.M.D\" " (T. pack . show ) mdateformat
@@ -1269,16 +1271,24 @@ csvFieldValue rules record fieldname = do
1269
1271
fieldvalue <- T. strip <$> atMay record (fieldindex- 1 )
1270
1272
return fieldvalue
1271
1273
1272
- -- | Parse the date string using the specified date-format, or if unspecified
1273
- -- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading
1274
- -- zeroes optional).
1275
- parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day
1276
- parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
1274
+ -- | Parse a date from a date/datetime string using the specified strptime format,
1275
+ -- or else try all the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD
1276
+ -- with optional leading zeroes).
1277
+ --
1278
+ -- If the string includes time and time zone, the local date (in the provided
1279
+ -- local time zone) will be returned. This could be a day earlier or later than
1280
+ -- the one in the string.
1281
+ parseDateWithCustomOrDefaultFormats :: TimeZone -> Maybe DateFormat -> Text -> Maybe Day
1282
+ parseDateWithCustomOrDefaultFormats tz mformat s = do
1283
+ ut <- asum $ map parsewith formats :: Maybe UTCTime
1284
+ let lt = utcToLocalTime tz ut :: LocalTime
1285
+ let ld = localDay lt :: Day
1286
+ return ld
1277
1287
where
1278
1288
parsewith = flip (parseTimeM True defaultTimeLocale) (T. unpack s)
1279
1289
formats = map T. unpack $ maybe
1280
- [" %Y/ %-m/ %-d"
1281
- ," %Y- %-m- %-d"
1290
+ [" %Y- %-m- %-d"
1291
+ ," %Y/ %-m/ %-d"
1282
1292
," %Y.%-m.%-d"
1283
1293
-- ,"%-m/%-d/%Y"
1284
1294
-- ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)
0 commit comments