diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs index b9943ca47..07cfc08ee 100644 --- a/Ledger/Dates.hs +++ b/Ledger/Dates.hs @@ -54,13 +54,17 @@ dayToUTC :: Day -> UTCTime dayToUTC d = localTimeToUTC utc (LocalTime d midnight) -- | Convert a period expression to a date span using the provided reference date. -spanFromPeriodExpr refdate = spanFromSmartDateString refdate - +spanFromPeriodExpr refdate = fromparse . parsewith (periodexpr refdate) + -- | Convert a smart date string to a date span using the provided reference date. spanFromSmartDateString :: Day -> String -> DateSpan -spanFromSmartDateString refdate s = DateSpan (Just b) (Just e) +spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate where sdate = fromparse $ parsewith smartdate s + +spanFromSmartDate :: Day -> SmartDate -> DateSpan +spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) + where (ry,rm,rd) = toGregorian refdate (b,e) = span sdate span :: SmartDate -> (Day,Day) @@ -288,3 +292,21 @@ lastthisnextthing = do ] return ("",r,p) +periodexpr :: Day -> Parser DateSpan +periodexpr rdate = try (doubledateperiod rdate) <|> (singledateperiod rdate) + +doubledateperiod :: Day -> Parser DateSpan +doubledateperiod rdate = do + string "from" + many spacenonewline + b <- smartdate + many spacenonewline + string "to" + many spacenonewline + e <- smartdate + let span = DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) + return span + +singledateperiod :: Day -> Parser DateSpan +singledateperiod rdate = smartdate >>= return . spanFromSmartDate rdate + diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index 149082950..87397d741 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -20,7 +20,7 @@ instance Show ModifierEntry where show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) instance Show PeriodicEntry where - show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) + show e = "~ " ++ (periodicexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) nullentry = Entry { edate=parsedate "1900/1/1", diff --git a/Ledger/Types.hs b/Ledger/Types.hs index f6d9ac040..7bad37bdc 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -56,7 +56,7 @@ data ModifierEntry = ModifierEntry { -- | a ledger "periodic" entry. Currently ignored. data PeriodicEntry = PeriodicEntry { - periodexpr :: String, + periodicexpr :: String, p_transactions :: [RawTransaction] } deriving (Eq)