hledger-lib 1.50.2 → 1.50.3
raw patch · 57 files changed
+625/−490 lines, 57 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Hledger.Data: dateSpansToPeriodData :: [DateSpan] -> Maybe (PeriodData Day)
- Hledger.Data: maybePeriodDataToDateSpans :: Maybe (PeriodData Day) -> [DateSpan]
- Hledger.Data: periodDataToDateSpans :: PeriodData Day -> [DateSpan]
- Hledger.Data.Dates: intervalBoundaryBefore :: Interval -> Day -> Day
- Hledger.Data.Dates: spansFromBoundaries :: Day -> [Day] -> [DateSpan]
- Hledger.Data.Dates: splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
- Hledger.Data.Dates: tests_Dates :: TestTree
- Hledger.Read: defaultJournalSafelyWith :: InputOpts -> IO (Either String Journal)
- Hledger.Utils.String: unwords' :: [String] -> String
+ Hledger.Data: boundariesToDayPartition :: NonEmpty Day -> DayPartition
+ Hledger.Data: boundariesToMaybeDayPartition :: [Day] -> Maybe DayPartition
+ Hledger.Data: data DayPartition
+ Hledger.Data: dayPartitionFind :: Day -> DayPartition -> (Maybe Day, Day)
+ Hledger.Data: dayPartitionStartEnd :: DayPartition -> (Day, Day)
+ Hledger.Data: dayPartitionToDateSpans :: DayPartition -> [DateSpan]
+ Hledger.Data: dayPartitionToList :: DayPartition -> [(Day, Day)]
+ Hledger.Data: dayPartitionToNonEmpty :: DayPartition -> NonEmpty (Day, Day)
+ Hledger.Data: intervalBoundaryBefore :: Interval -> Day -> Day
+ Hledger.Data: maybeDayPartitionToDateSpans :: Maybe DayPartition -> [DateSpan]
+ Hledger.Data: splitSpan :: Bool -> Interval -> DateSpan -> Maybe DayPartition
+ Hledger.Data: tests_DayPartition :: TestTree
+ Hledger.Data: unionDayPartitions :: DayPartition -> DayPartition -> Maybe DayPartition
+ Hledger.Data.Dates: addGregorianMonthsToMonthday :: MonthDay -> Integer -> Day -> Day
+ Hledger.Data.Dates: advanceToNthWeekday :: Int -> WeekDay -> Day -> Day
+ Hledger.Data.Dates: isEmptySpan :: DateSpan -> Bool
+ Hledger.Data.Dates: nextNthWeekdayOfMonth :: Int -> WeekDay -> Day -> Day
+ Hledger.Data.Dates: nextday :: Day -> Day
+ Hledger.Data.Dates: nextmonthandday :: Month -> MonthDay -> Day -> Day
+ Hledger.Data.Dates: nextnthdayofmonth :: MonthDay -> Day -> Day
+ Hledger.Data.Dates: nextweek :: Day -> Day
+ Hledger.Data.Dates: nthdayofweekcontaining :: WeekDay -> Day -> Day
+ Hledger.Data.Dates: prevNthWeekdayOfMonth :: Int -> WeekDay -> Day -> Day
+ Hledger.Data.Dates: startofmonth :: Day -> Day
+ Hledger.Data.Dates: startofquarter :: Day -> Day
+ Hledger.Data.Dates: startofweek :: Day -> Day
+ Hledger.Data.Dates: startofyear :: Day -> Day
+ Hledger.Data.Types: instance GHC.Classes.Ord a => GHC.Classes.Ord (Hledger.Data.Types.PeriodData a)
+ Hledger.Read: defaultJournalPathSafely :: IO (Either String String)
+ Hledger.Read: defaultJournalWithSafely :: InputOpts -> IO (Either String Journal)
+ Hledger.Utils: takeUntilFails :: (a -> Bool) -> [a] -> [a]
+ Hledger.Utils: takeUntilFailsNE :: (a -> Bool) -> NonEmpty a -> NonEmpty a
- Hledger.Data: PeriodData :: a -> IntMap a -> PeriodData a
+ Hledger.Data: PeriodData :: a -> Map Day a -> PeriodData a
- Hledger.Data: [pdperiods] :: PeriodData a -> IntMap a
+ Hledger.Data: [pdperiods] :: PeriodData a -> Map Day a
- Hledger.Data.Types: PeriodData :: a -> IntMap a -> PeriodData a
+ Hledger.Data.Types: PeriodData :: a -> Map Day a -> PeriodData a
- Hledger.Data.Types: [pdperiods] :: PeriodData a -> IntMap a
+ Hledger.Data.Types: [pdperiods] :: PeriodData a -> Map Day a
- Hledger.Reports.MultiBalanceReport: generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
+ Hledger.Reports.MultiBalanceReport: generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData
- Hledger.Reports.MultiBalanceReport: generatePeriodicReport :: Show c => (forall a. () => ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c) -> (b -> MixedAmount) -> (c -> MixedAmount) -> ReportOpts -> Maybe (PeriodData Day) -> Account b -> PeriodicReport DisplayName c
+ Hledger.Reports.MultiBalanceReport: generatePeriodicReport :: Show c => (forall a. () => ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c) -> (b -> MixedAmount) -> (c -> MixedAmount) -> ReportOpts -> Maybe DayPartition -> Account b -> PeriodicReport DisplayName c
- Hledger.Reports.MultiBalanceReport: makePeriodicReportRow :: c -> (IntMap c -> (c, c)) -> ReportOpts -> (b -> c) -> a -> Account b -> PeriodicReportRow a c
+ Hledger.Reports.MultiBalanceReport: makePeriodicReportRow :: c -> (Map Day c -> (c, c)) -> ReportOpts -> (b -> c) -> a -> Account b -> PeriodicReportRow a c
- Hledger.Reports.ReportOptions: reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
+ Hledger.Reports.ReportOptions: reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
- Hledger.Reports.ReportOptions: reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
+ Hledger.Reports.ReportOptions: reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
Files
- CHANGES.md +5/−3
- Hledger/Data.hs +8/−6
- Hledger/Data/Account.hs +5/−6
- Hledger/Data/AccountName.hs +4/−4
- Hledger/Data/Amount.hs +4/−4
- Hledger/Data/Balancing.hs +5/−5
- Hledger/Data/Currency.hs +1/−1
- Hledger/Data/Dates.hs +19/−153
- Hledger/Data/DayPartition.hs +285/−0
- Hledger/Data/Errors.hs +1/−1
- Hledger/Data/Journal.hs +3/−3
- Hledger/Data/JournalChecks.hs +4/−4
- Hledger/Data/JournalChecks/Ordereddates.hs +1/−1
- Hledger/Data/JournalChecks/Uniqueleafnames.hs +1/−1
- Hledger/Data/Json.hs +6/−7
- Hledger/Data/Ledger.hs +1/−1
- Hledger/Data/Period.hs +1/−1
- Hledger/Data/PeriodData.hs +36/−72
- Hledger/Data/PeriodicTransaction.hs +4/−3
- Hledger/Data/Posting.hs +5/−5
- Hledger/Data/StringFormat.hs +1/−1
- Hledger/Data/Timeclock.hs +1/−1
- Hledger/Data/Transaction.hs +4/−4
- Hledger/Data/TransactionModifier.hs +3/−3
- Hledger/Data/Types.hs +10/−9
- Hledger/Data/Valuation.hs +3/−3
- Hledger/Query.hs +1/−1
- Hledger/Read.hs +54/−39
- Hledger/Read/Common.hs +4/−4
- Hledger/Read/JournalReader.hs +11/−9
- Hledger/Read/RulesReader.hs +9/−9
- Hledger/Read/TimedotReader.hs +1/−1
- Hledger/Reports/AccountTransactionsReport.hs +1/−1
- Hledger/Reports/BudgetReport.hs +7/−7
- Hledger/Reports/MultiBalanceReport.hs +17/−22
- Hledger/Reports/PostingsReport.hs +2/−2
- Hledger/Reports/ReportOptions.hs +17/−16
- Hledger/Reports/ReportTypes.hs +1/−1
- Hledger/Utils.hs +15/−2
- Hledger/Utils/IO.hs +6/−6
- Hledger/Utils/Parse.hs +3/−3
- Hledger/Utils/Regex.hs +1/−1
- Hledger/Utils/String.hs +9/−15
- Hledger/Utils/Test.hs +1/−1
- Hledger/Utils/Text.hs +3/−8
- Hledger/Write/Beancount.hs +3/−3
- Hledger/Write/Csv.hs +3/−3
- Hledger/Write/Html.hs +3/−3
- Hledger/Write/Html/Attribute.hs +1/−1
- Hledger/Write/Html/Blaze.hs +5/−5
- Hledger/Write/Html/HtmlCommon.hs +1/−1
- Hledger/Write/Html/Lucid.hs +5/−5
- Hledger/Write/Ods.hs +8/−8
- Hledger/Write/Spreadsheet.hs +3/−3
- Text/Tabular/AsciiWide.hs +2/−2
- Text/WideString.hs +2/−2
- hledger-lib.cabal +5/−4
CHANGES.md view
@@ -17,6 +17,8 @@ For user-visible changes, see the hledger package changelog. +# 1.50.3 2025-11-18+ # 1.50.2 2025-09-26 # 1.50.1 2025-09-16@@ -1409,16 +1411,16 @@ - add support for GHC 8.8, base-compat 0.11 (#1090) We are now using the new fail from the MonadFail class, which we- always import qualified as Fail.fail, from base-compat-batteries+ always import as qualified Fail.fail, from base-compat-batteries Control.Monad.Fail.Compat to work with old GHC versions. If old fail is needed (shouldn't be) it should be imported qualified as Prelude.Fail, using imports such as: import Prelude hiding (fail)- import qualified Prelude (fail)+ import Prelude qualified (fail) import Control.Monad.State.Strict hiding (fail) import "base-compat-batteries" Prelude.Compat hiding (fail)- import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail+ import "base-compat-batteries" qualified Control.Monad.Fail.Compat as Fail - hledger and hledger-lib unit tests have been ported to tasty.
Hledger/Data.hs view
@@ -10,19 +10,20 @@ module Hledger.Data ( module Hledger.Data.Account,- module Hledger.Data.BalanceData,- module Hledger.Data.PeriodData, module Hledger.Data.AccountName, module Hledger.Data.Amount,+ module Hledger.Data.BalanceData, module Hledger.Data.Balancing, module Hledger.Data.Currency, module Hledger.Data.Dates,+ module Hledger.Data.DayPartition, module Hledger.Data.Errors, module Hledger.Data.Journal, module Hledger.Data.JournalChecks, module Hledger.Data.Json, module Hledger.Data.Ledger, module Hledger.Data.Period,+ module Hledger.Data.PeriodData, module Hledger.Data.PeriodicTransaction, module Hledger.Data.Posting, module Hledger.Data.RawOptions,@@ -39,18 +40,19 @@ import Test.Tasty (testGroup) import Hledger.Data.Account import Hledger.Data.BalanceData-import Hledger.Data.PeriodData import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Balancing import Hledger.Data.Currency import Hledger.Data.Dates+import Hledger.Data.DayPartition import Hledger.Data.Errors import Hledger.Data.Journal import Hledger.Data.JournalChecks import Hledger.Data.Json import Hledger.Data.Ledger import Hledger.Data.Period+import Hledger.Data.PeriodData import Hledger.Data.PeriodicTransaction import Hledger.Data.Posting import Hledger.Data.RawOptions@@ -64,14 +66,14 @@ tests_Data = testGroup "Data" [ tests_Account ,tests_AccountName- ,tests_BalanceData- ,tests_PeriodData ,tests_Amount+ ,tests_BalanceData ,tests_Balancing+ ,tests_DayPartition -- ,tests_Currency- ,tests_Dates ,tests_Journal ,tests_Ledger+ ,tests_PeriodData ,tests_Posting ,tests_Valuation ,tests_StringFormat
Hledger/Data/Account.hs view
@@ -42,17 +42,16 @@ ) where import Control.Applicative ((<|>))-import qualified Data.HashSet as HS-import qualified Data.HashMap.Strict as HM-import qualified Data.IntMap as IM+import Data.HashSet qualified as HS+import Data.HashMap.Strict qualified as HM import Data.List (find, sortOn) #if !MIN_VERSION_base(4,20,0) import Data.List (foldl') #endif import Data.List.NonEmpty (NonEmpty(..), groupWith)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (fromMaybe)-import qualified Data.Text as T+import Data.Text qualified as T import Data.These (These(..)) import Data.Time (Day(..), fromGregorian) import Safe (headMay)@@ -388,7 +387,7 @@ testCase "no postings, no days" $ accountFromPostings undefined [] @?= accountTree "root" [] ,testCase "no postings, only 2000-01-01" $- allAccounts (all (\d -> (ModifiedJulianDay $ toInteger d) == fromGregorian 2000 01 01) . IM.keys . pdperiods . adata)+ allAccounts (all (== fromGregorian 2000 01 01) . M.keys . pdperiods . adata) (accountFromPostings undefined []) @? "Not all adata have exactly 2000-01-01" ] ]
Hledger/Data/AccountName.hs view
@@ -63,13 +63,13 @@ import Control.Applicative ((<|>)) import Control.Monad (foldM) import Data.Foldable (asum, find, toList)-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as M+import Data.List.NonEmpty qualified as NE+import Data.Map qualified as M import Data.Maybe (mapMaybe) import Data.MemoUgly (memo)-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Tree (Tree(..), unfoldTree) import Safe import Text.DocLayout (realLength)
Hledger/Data/Amount.hs view
@@ -187,12 +187,12 @@ import Data.List (foldl') #endif import Data.List.NonEmpty (NonEmpty(..), nonEmpty)-import qualified Data.Map.Strict as M-import qualified Data.Set as S+import Data.Map.Strict qualified as M+import Data.Set qualified as S import Data.Maybe (fromMaybe, isNothing) import Data.Semigroup (Semigroup(..))-import qualified Data.Text as T-import qualified Data.Text.Lazy.Builder as TB+import Data.Text qualified as T+import Data.Text.Lazy.Builder qualified as TB import Data.Word (Word8) import Safe (headDef, lastDef, lastMay) import System.Console.ANSI (Color(..),ColorIntensity(..))
Hledger/Data/Balancing.hs view
@@ -38,15 +38,15 @@ import Data.Foldable (asum) import Data.Function ((&)) import Data.Functor ((<&>), void)-import qualified Data.HashTable.Class as H (toList)-import qualified Data.HashTable.ST.Cuckoo as H+import Data.HashTable.Class qualified as H (toList)+import Data.HashTable.ST.Cuckoo qualified as H import Data.List (partition, sortOn) import Data.List.Extra (nubSort) import Data.Maybe (fromJust, fromMaybe, isJust, isNothing, mapMaybe)-import qualified Data.Set as S-import qualified Data.Text as T+import Data.Set qualified as S+import Data.Text qualified as T import Data.Time.Calendar (fromGregorian)-import qualified Data.Map as M+import Data.Map qualified as M import Safe (headErr) import Text.Printf (printf)
Hledger/Data/Currency.hs view
@@ -15,7 +15,7 @@ currencyCodeToSymbol, ) where-import qualified Data.Map as M+import Data.Map qualified as M import Data.Text (Text) -- | An ISO 4217 currency code, like EUR. Usually three upper case letters.
Hledger/Data/Dates.hs view
@@ -70,8 +70,6 @@ daysSpan, latestSpanContaining, smartdate,- splitSpan,- spansFromBoundaries, groupByDateSpan, fixSmartDate, fixSmartDateStr,@@ -80,15 +78,28 @@ yearp, daysInSpan, - tests_Dates-, intervalBoundaryBefore)-where+ -- Temp exports+ startofyear,+ startofquarter,+ startofmonth,+ startofweek,+ nextday,+ nextweek,+ nextmonthandday,+ nextnthdayofmonth,+ prevNthWeekdayOfMonth,+ nthdayofweekcontaining,+ addGregorianMonthsToMonthday,+ advanceToNthWeekday,+ nextNthWeekdayOfMonth,+ isEmptySpan+) where import Prelude hiding (Applicative(..)) import Control.Applicative (Applicative(..)) import Control.Applicative.Permutations import Control.Monad (guard, unless)-import qualified Control.Monad.Fail as Fail (MonadFail, fail)+import Control.Monad.Fail qualified as Fail (MonadFail, fail) import Data.Char (digitToInt, isDigit) import Data.Default (def) import Data.Foldable (asum)@@ -97,9 +108,9 @@ import Data.List (elemIndex, group, sort, sortBy) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import Data.Ord (comparing)-import qualified Data.Set as Set+import Data.Set qualified as Set import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Format hiding (months) import Data.Time.Calendar (Day, addDays, addGregorianYearsClip, addGregorianMonthsClip, diffDays,@@ -188,76 +199,6 @@ spansSpan :: [DateSpan] -> DateSpan spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< lastMay spans) --- | Split a DateSpan into consecutive exact spans of the specified Interval.--- If no interval is specified, the original span is returned.--- If the original span is the null date span, ie unbounded, the null date span is returned.--- If the original span is empty, eg if the end date is <= the start date, no spans are returned.------ ==== Date adjustment--- Some intervals respect the "adjust" flag (years, quarters, months, weeks, every Nth weekday--- of month seem to be the ones that need it). This will move the start date earlier, if needed,--- to the previous natural interval boundary (first of year, first of quarter, first of month,--- monday, previous Nth weekday of month). Related: #1982 #2218------ The end date is always moved later if needed to the next natural interval boundary,--- so that the last period is the same length as the others.------ ==== Examples--- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)--- >>> t NoInterval 2008 01 01 2009 01 01--- [DateSpan 2008]--- >>> t (Quarters 1) 2008 01 01 2009 01 01--- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4]--- >>> splitSpan True (Quarters 1) nulldatespan--- [DateSpan ..]--- >>> t (Days 1) 2008 01 01 2008 01 01 -- an empty datespan--- []--- >>> t (Quarters 1) 2008 01 01 2008 01 01--- []--- >>> t (Months 1) 2008 01 01 2008 04 01--- [DateSpan 2008-01,DateSpan 2008-02,DateSpan 2008-03]--- >>> t (Months 2) 2008 01 01 2008 04 01--- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30]--- >>> t (Weeks 1) 2008 01 01 2008 01 15--- [DateSpan 2008-W01,DateSpan 2008-W02,DateSpan 2008-W03]--- >>> t (Weeks 2) 2008 01 01 2008 01 15--- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27]--- >>> t (MonthDay 2) 2008 01 01 2008 04 01--- [DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01]--- >>> t (NthWeekdayOfMonth 2 4) 2011 01 01 2011 02 15--- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]--- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15--- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17]--- >>> t (MonthAndDay 11 29) 2012 10 01 2013 10 15--- [DateSpan 2012-11-29..2013-11-28]----splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]-splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]-splitSpan _ _ ds | isEmptySpan ds = []-splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]-splitSpan _ NoInterval ds = [ds]-splitSpan _ (Days n) ds = splitspan id addDays n ds-splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds-splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds-splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds-splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds-splitSpan adjust (NthWeekdayOfMonth n wd) ds = splitspan (if adjust then prevstart else nextstart) advancemonths 1 ds- where- prevstart = prevNthWeekdayOfMonth n wd- nextstart = nextNthWeekdayOfMonth n wd- advancemonths 0 = id- advancemonths m = advanceToNthWeekday n wd . startofmonth . addGregorianMonthsClip m-splitSpan _ (MonthDay dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds-splitSpan _ (MonthAndDay m d) ds = splitspan (nextmonthandday m d) (addGregorianYearsClip) 1 ds-splitSpan _ (DaysOfWeek []) ds = [ds]-splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys- where- (s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds- -- can't show this when debugging, it'll hang:- bdrys = concatMap (flip map starts . addDays) [0,7..]- -- The first representative of each weekday- starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days- -- Like addGregorianMonthsClip, add one month to the given date, clipping when needed -- to fit it within the next month's length. But also, keep a target day of month in mind, -- and revert to that or as close to it as possible in subsequent longer months.@@ -267,31 +208,6 @@ let (y,m,_) = toGregorian $ addGregorianMonthsClip n d in fromGregorian y m dom --- Split the given span into exact spans using the provided helper functions:------ 1. The start function is used to adjust the provided span's start date to get the first sub-span's start date.------ 2. The next function is used to calculate subsequent sub-spans' start dates, possibly with stride increased by a multiplier.--- It should handle spans of varying length, eg when splitting on "every 31st of month",--- it adjusts to 28/29/30 in short months but returns to 31 in the long months.----splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]-splitspan start next mult ds = spansFromBoundaries e bdrys- where- (s, e) = dateSpanSplitLimits start (next (toInteger mult)) ds- bdrys = mapM (next . toInteger) [0,mult..] $ start s---- | Fill in missing start/end dates for calculating 'splitSpan'.-dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)-dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = (start $ fromEFDay s, fromEFDay e)-dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = (start $ fromEFDay s, next $ start $ fromEFDay s)-dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = (start $ fromEFDay e, next $ start $ fromEFDay e)-dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = error' "dateSpanSplitLimits: should not be nulldatespan" -- PARTIAL: This case should have been handled in splitSpan---- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.-spansFromBoundaries :: Day -> [Day] -> [DateSpan]-spansFromBoundaries e bdrys = zipWith (DateSpan `on` (Just . Exact)) (takeWhile (< e) bdrys) $ drop 1 bdrys- -- | Count the days in a DateSpan, or if it is open-ended return Nothing. daysInSpan :: DateSpan -> Maybe Integer daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays (fromEFDay d2) (fromEFDay d1)@@ -669,14 +585,6 @@ nextyear = startofyear . addGregorianYearsClip 1 startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day --- Get the natural start for the given interval that falls on or before the given day,--- when applicable. Works for Weeks, Months, Quarters, Years, eg.-intervalBoundaryBefore :: Interval -> Day -> Day-intervalBoundaryBefore i d =- case splitSpan True i (DateSpan (Just $ Exact d) (Just $ Exact $ addDays 1 d)) of- (DateSpan (Just start) _:_) -> fromEFDay start- _ -> d- -- | Find the next occurrence of the specified month and day of month, on or after the given date. -- The month should be 1-12 and the day of month should be 1-31, or an error will be raised. --@@ -1263,45 +1171,3 @@ nulldate :: Day nulldate = fromGregorian 0 1 1----- tests--tests_Dates = testGroup "Dates"- [ testCase "weekday" $ do- splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))- @?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 06 29))- , (DateSpan (Just $ Exact $ fromGregorian 2021 06 29) (Just $ Exact $ fromGregorian 2021 06 30))- , (DateSpan (Just $ Exact $ fromGregorian 2021 06 30) (Just $ Exact $ fromGregorian 2021 07 01))- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 02))- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))- -- next week- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 06))- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 06) (Just $ Exact $ fromGregorian 2021 07 07))- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 07) (Just $ Exact $ fromGregorian 2021 07 08))- ]-- splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))- @?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 07 02))- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))- -- next week- , (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 09))- ]-- , testCase "match dayOfWeek" $ do- let dayofweek n = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1- matchdow ds day = splitSpan False (DaysOfWeek [day]) ds @?= dayofweek day ds- ys2021 = fromGregorian 2021 01 01- ye2021 = fromGregorian 2021 12 31- ys2022 = fromGregorian 2022 01 01- mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ye2021))) [1..7]- mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ys2022))) [1..7]- mapM_ (matchdow (DateSpan (Just $ Exact ye2021) (Just $ Exact ys2022))) [1..7]-- mapM_ (matchdow (DateSpan (Just $ Exact ye2021) Nothing)) [1..7]- mapM_ (matchdow (DateSpan (Just $ Exact ys2022) Nothing)) [1..7]-- mapM_ (matchdow (DateSpan Nothing (Just $ Exact ye2021))) [1..7]- mapM_ (matchdow (DateSpan Nothing (Just $ Exact ys2022))) [1..7]-- ]
+ Hledger/Data/DayPartition.hs view
@@ -0,0 +1,285 @@+{-|+A partition of time into contiguous spans, for defining reporting periods.+-}+module Hledger.Data.DayPartition+( DayPartition+-- * constructors+, boundariesToDayPartition+, boundariesToMaybeDayPartition+-- * conversions+, dayPartitionToNonEmpty+, dayPartitionToList+, dayPartitionToDateSpans+, dayPartitionToPeriodData+, maybeDayPartitionToDateSpans+-- * operations+, unionDayPartitions+, dayPartitionStartEnd+, dayPartitionFind+, splitSpan+, intervalBoundaryBefore+-- * tests+, tests_DayPartition+) where++import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Map qualified as M+import Data.Time (Day (..), addDays, addGregorianMonthsClip, addGregorianYearsClip, fromGregorian)++import Hledger.Data.Dates+import Hledger.Data.PeriodData+import Hledger.Data.Types+import Hledger.Utils+++-- | A partition of time into one or more contiguous periods,+-- plus a historical period that precedes them.+-- Note 'DayPartition' does not store per-period data - only the periods' start/end dates.++-- Each period is at least one day in length.+-- The historical period is open ended, with no start date.+-- The last period has an end date, but note some queries (like 'dayPartitionFind') ignore that, acting as if the last period is open ended.+-- Only smart constructors are exported, so that a DayPartition always satisfies these invariants.+--+-- This is implemented as a newtype wrapper around 'PeriodData Day', which is a map from date to date.+-- The map's keys are the period start dates, and the values are the corresponding period end dates.+-- Note unlike 'DateSpan', which stores exclusive end dates ( @[start, end)@ ),+-- here both start and end dates are inclusive ( @[start, end]@ ).+--+newtype DayPartition = DayPartition { dayPartitionToPeriodData :: PeriodData Day } deriving (Eq, Ord, Show)+++-- constructors:++-- | Construct a 'DayPartition' from a non-empty list of period boundary dates (start dates plus a final exclusive end date).+--+-- >>> boundariesToDayPartition (fromGregorian 2025 01 01 :| [fromGregorian 2025 02 01])+-- DayPartition {dayPartitionToPeriodData = PeriodData{ pdpre = 2024-12-31, pdperiods = fromList [(2025-01-01,2025-01-31)]}}+--+boundariesToDayPartition :: NonEmpty Day -> DayPartition+boundariesToDayPartition xs = DayPartition . periodDataFromList (addDays (-1) b) $ case bs of+ [] -> [(b, b)] -- If only one boundary is supplied, it ends on the same day+ _:_ -> zip (b:bs) $ map (addDays (-1)) bs -- Guaranteed non-empty+ where b:|bs = NE.nub $ NE.sort xs++-- | Construct a 'DayPartition' from a list of period boundary dates (start dates plus a final exclusive end date),+-- if it's a non-empty list.+boundariesToMaybeDayPartition :: [Day] -> Maybe DayPartition+boundariesToMaybeDayPartition = fmap boundariesToDayPartition . NE.nonEmpty+++-- conversions:++-- | Convert 'DayPartition' to a non-empty list of period start and end dates (both inclusive).+-- Each end date will be one day before the next period's start date.+dayPartitionToNonEmpty :: DayPartition -> NonEmpty (Day, Day)+dayPartitionToNonEmpty (DayPartition xs) = NE.fromList . snd $ periodDataToList xs -- Constructors guarantee this is non-empty++-- | Convert 'DayPartition' to a list (which will always be non-empty) of period start and end dates (both inclusive).+-- Each end date will be one day before the next period's start date.+dayPartitionToList :: DayPartition -> [(Day, Day)]+dayPartitionToList = NE.toList . dayPartitionToNonEmpty++-- | Convert 'DayPartition' to a list of 'DateSpan's.+-- Each span will end one day before the next span begins+-- (the span's exclusive end date will be equal to the next span's start date).+dayPartitionToDateSpans :: DayPartition -> [DateSpan]+dayPartitionToDateSpans = map toDateSpan . dayPartitionToList+ where+ toDateSpan (s, e) = DateSpan (toEFDay s) (toEFDay $ addDays 1 e)+ toEFDay = Just . Exact++-- Convert a 'Maybe DayPartition' to a list of one or more 'DateSpans'.+-- Each span will end one day before the next span begins+-- (the span's exclusive end date will be equal to the next span's start date).+-- If given Nothing, it returns a single open-ended span.+maybeDayPartitionToDateSpans :: Maybe DayPartition -> [DateSpan]+maybeDayPartitionToDateSpans = maybe [DateSpan Nothing Nothing] dayPartitionToDateSpans+++-- operations:++-- | Check that a DayPartition has been constructed correctly,+-- with internal invariants satisfied, as well as the external ones described in 'DayPartition'.+-- Internally, all constructors must guarantee:+-- 1. The pdperiods map contains at least one key and value.+-- 2. The value stored in pdpre is one day before pdperiods' smallest key.+-- 3. Each value stored in pdperiods is one day before the next largest key,+-- (except for the value associated with the largest key).+isValidDayPartition :: DayPartition -> Bool+isValidDayPartition (DayPartition pd) = case ds of+ [] -> False+ xs -> and $ zipWith isContiguous ((nulldate, h) : xs) xs+ where+ (h, ds) = periodDataToList pd+ isContiguous (_, e) (s, _) = addDays 1 e == s++-- | Return the union of two 'DayPartition's if that is a valid 'DayPartition',+-- or 'Nothing' otherwise.+unionDayPartitions :: DayPartition -> DayPartition -> Maybe DayPartition+unionDayPartitions (DayPartition (PeriodData h as)) (DayPartition (PeriodData h' as')) =+ if equalIntersection as as' && isValidDayPartition union then Just union else Nothing+ where+ union = DayPartition . PeriodData (min h h') $ as <> as'+ equalIntersection x y = and $ M.intersectionWith (==) x y++-- | Get this DayPartition's overall start date and end date (both inclusive).+dayPartitionStartEnd :: DayPartition -> (Day, Day)+dayPartitionStartEnd (DayPartition (PeriodData _ ds)) =+ -- Guaranteed not to error because the IntMap is non-empty.+ (fst $ M.findMin ds, snd $ M.findMax ds)++-- | Find the start and end dates of the period within a 'DayPartition' which contains a given day.+-- If the day is after the end of the last period, it is assumed to be within the last period.+-- If the day is before the start of the first period (ie, in the historical period),+-- only the historical period's end date is returned.+dayPartitionFind :: Day -> DayPartition -> (Maybe Day, Day)+dayPartitionFind d (DayPartition xs) = lookupPeriodDataOrHistorical d xs++-- | Split a 'DateSpan' into a 'DayPartition' consisting of consecutive exact+-- spans of the specified Interval, or `Nothing` if the span is invalid.+-- If no interval is specified, the original span is returned.+-- If the original span is the null date span, ie unbounded, `Nothing` is returned.+-- If the original span is empty, eg if the end date is <= the start date, `Nothing` is returned.+--+-- ==== Date adjustment+-- Some intervals respect the "adjust" flag (years, quarters, months, weeks, every Nth weekday+-- of month seem to be the ones that need it). This will move the start date earlier, if needed,+-- to the previous natural interval boundary (first of year, first of quarter, first of month,+-- monday, previous Nth weekday of month). Related: #1982 #2218+--+-- The end date is always moved later if needed to the next natural interval boundary,+-- so that the last period is the same length as the others.+--+-- ==== Examples+-- >>> let t i y1 m1 d1 y2 m2 d2 = fmap dayPartitionToNonEmpty . splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)+-- >>> t NoInterval 2008 01 01 2009 01 01+-- Just ((2008-01-01,2008-12-31) :| [])+-- >>> t (Quarters 1) 2008 01 01 2009 01 01+-- Just ((2008-01-01,2008-03-31) :| [(2008-04-01,2008-06-30),(2008-07-01,2008-09-30),(2008-10-01,2008-12-31)])+-- >>> splitSpan True (Quarters 1) nulldatespan+-- Nothing+-- >>> t (Days 1) 2008 01 01 2008 01 01 -- an empty datespan+-- Nothing+-- >>> t (Quarters 1) 2008 01 01 2008 01 01+-- Nothing+-- >>> t (Months 1) 2008 01 01 2008 04 01+-- Just ((2008-01-01,2008-01-31) :| [(2008-02-01,2008-02-29),(2008-03-01,2008-03-31)])+-- >>> t (Months 2) 2008 01 01 2008 04 01+-- Just ((2008-01-01,2008-02-29) :| [(2008-03-01,2008-04-30)])+-- >>> t (Weeks 1) 2008 01 01 2008 01 15+-- Just ((2007-12-31,2008-01-06) :| [(2008-01-07,2008-01-13),(2008-01-14,2008-01-20)])+-- >>> t (Weeks 2) 2008 01 01 2008 01 15+-- Just ((2007-12-31,2008-01-13) :| [(2008-01-14,2008-01-27)])+-- >>> t (MonthDay 2) 2008 01 01 2008 04 01+-- Just ((2008-01-02,2008-02-01) :| [(2008-02-02,2008-03-01),(2008-03-02,2008-04-01)])+-- >>> t (NthWeekdayOfMonth 2 4) 2011 01 01 2011 02 15+-- Just ((2010-12-09,2011-01-12) :| [(2011-01-13,2011-02-09),(2011-02-10,2011-03-09)])+-- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15+-- Just ((2010-12-28,2011-01-03) :| [(2011-01-04,2011-01-10),(2011-01-11,2011-01-17)])+-- >>> t (MonthAndDay 11 29) 2012 10 01 2013 10 15+-- Just ((2012-11-29,2013-11-28) :| [])+splitSpan :: Bool -> Interval -> DateSpan -> Maybe DayPartition+splitSpan _ _ (DateSpan Nothing Nothing) = Nothing+splitSpan _ _ ds | isEmptySpan ds = Nothing+splitSpan _ NoInterval (DateSpan (Just s) (Just e)) = Just $ boundariesToDayPartition (fromEFDay s :| [fromEFDay e])+splitSpan _ NoInterval _ = Nothing+splitSpan _ (Days n) ds = splitspan id addDays n ds+splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds+splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds+splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds+splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds+splitSpan adjust (NthWeekdayOfMonth n wd) ds = splitspan (startWeekdayOfMonth n wd) advancemonths 1 ds+ where+ startWeekdayOfMonth = if adjust then prevNthWeekdayOfMonth else nextNthWeekdayOfMonth+ advancemonths 0 = id+ advancemonths m = advanceToNthWeekday n wd . startofmonth . addGregorianMonthsClip m+splitSpan _ (MonthDay dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds+splitSpan _ (MonthAndDay m d) ds = splitspan (nextmonthandday m d) addGregorianYearsClip 1 ds+splitSpan _ (DaysOfWeek []) _ = Nothing+splitSpan _ (DaysOfWeek days@(n:_)) ds = do+ (s, e) <- dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds+ let -- can't show this when debugging, it'll hang:+ bdrys = concatMap (\d -> map (addDays d) starts) [0,7..]+ -- The first representative of each weekday+ starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days+ spansFromBoundaries e bdrys++-- | Fill in missing start/end dates for calculating 'splitSpan'.+dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> Maybe (Day, Day)+dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = Nothing+dateSpanSplitLimits _ _ ds | isEmptySpan ds = Nothing+dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = Just (start $ fromEFDay s, fromEFDay e)+dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = Just (start $ fromEFDay s, next $ start $ fromEFDay s)+dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = Just (start $ fromEFDay e, next $ start $ fromEFDay e)++-- Split the given span into exact spans using the provided helper functions:+--+-- 1. The start function is used to adjust the provided span's start date to get the first sub-span's start date.+--+-- 2. The next function is used to calculate subsequent sub-spans' start dates, possibly with stride increased by a multiplier.+-- It should handle spans of varying length, eg when splitting on "every 31st of month",+-- it adjusts to 28/29/30 in short months but returns to 31 in the long months.+splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> Maybe DayPartition+splitspan start next mult ds = do+ (s, e) <- dateSpanSplitLimits start (next (toInteger mult)) ds+ let bdrys = mapM (next . toInteger) [0,mult..] $ start s+ spansFromBoundaries e bdrys++-- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.+spansFromBoundaries :: Day -> [Day] -> Maybe DayPartition+spansFromBoundaries _ [] = Nothing+spansFromBoundaries e (x:_) | x >= e = Nothing+spansFromBoundaries e (x:xs) = Just . boundariesToDayPartition $ takeUntilFailsNE (<e) (x:|xs)++-- | Get the natural start for the given interval that falls on or before the given day,+-- when applicable. Works for Weeks, Months, Quarters, Years, eg.+intervalBoundaryBefore :: Interval -> Day -> Day+intervalBoundaryBefore i d =+ case dayPartitionToNonEmpty <$> splitSpan True i (DateSpan (Just $ Exact d) (Just . Exact $ addDays 1 d)) of+ Just ((start, _) :| _ ) -> start+ _ -> d+++-- tests:++tests_DayPartition =+ testGroup "splitSpan" [+ testCase "weekday" $ do+ fmap dayPartitionToNonEmpty (splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08)))+ @?= Just ( (fromGregorian 2021 06 28, fromGregorian 2021 06 28) :|+ [ (fromGregorian 2021 06 29, fromGregorian 2021 06 29)+ , (fromGregorian 2021 06 30, fromGregorian 2021 06 30)+ , (fromGregorian 2021 07 01, fromGregorian 2021 07 01)+ , (fromGregorian 2021 07 02, fromGregorian 2021 07 04)+ -- next week+ , (fromGregorian 2021 07 05, fromGregorian 2021 07 05)+ , (fromGregorian 2021 07 06, fromGregorian 2021 07 06)+ , (fromGregorian 2021 07 07, fromGregorian 2021 07 07)+ ])++ fmap dayPartitionToNonEmpty (splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08)))+ @?= Just ( (fromGregorian 2021 06 28, fromGregorian 2021 07 01) :|+ [ (fromGregorian 2021 07 02, fromGregorian 2021 07 04)+ -- next week+ , (fromGregorian 2021 07 05, fromGregorian 2021 07 08)+ ])++ , testCase "match dayOfWeek" $ do+ let dayofweek n = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1+ matchdow ds day = splitSpan False (DaysOfWeek [day]) ds @?= dayofweek day ds+ ys2021 = fromGregorian 2021 01 01+ ye2021 = fromGregorian 2021 12 31+ ys2022 = fromGregorian 2022 01 01+ mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ye2021))) [1..7]+ mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ys2022))) [1..7]+ mapM_ (matchdow (DateSpan (Just $ Exact ye2021) (Just $ Exact ys2022))) [1..7]++ mapM_ (matchdow (DateSpan (Just $ Exact ye2021) Nothing)) [1..7]+ mapM_ (matchdow (DateSpan (Just $ Exact ys2022) Nothing)) [1..7]++ mapM_ (matchdow (DateSpan Nothing (Just $ Exact ye2021))) [1..7]+ mapM_ (matchdow (DateSpan Nothing (Just $ Exact ys2022))) [1..7]++ ]
Hledger/Data/Errors.hs view
@@ -19,7 +19,7 @@ import Data.Function ((&)) import Data.List (find) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Hledger.Data.Transaction (showTransaction) import Hledger.Data.Posting (postingStripCosts)
Hledger/Data/Journal.hs view
@@ -131,11 +131,11 @@ import Data.List (foldl') #endif import Data.List.Extra (nubSort)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Safe (headMay, headDef, maximumMay, minimumMay, lastDef) import Data.Time.Calendar (Day, addDays, fromGregorian, diffDays) import Data.Time.Clock.POSIX (POSIXTime)
Hledger/Data/JournalChecks.hs view
@@ -24,8 +24,8 @@ import Data.Char (isSpace) import Data.List.Extra import Data.Maybe-import qualified Data.Map.Strict as M-import qualified Data.Text as T+import Data.Map.Strict qualified as M+import Data.Text qualified as T import Safe (atMay, lastMay, headMay) import Text.Printf (printf) @@ -63,11 +63,11 @@ "%s:%d:" ,"%s" ,"Strict account checking is enabled, and"- ,"account %s has not been declared."+ ,"account \"%s\" has not been declared." ,"Consider adding an account directive. Examples:" ,"" ,"account %s"- ]) f l ex (show a) a+ ]) f l ex a a where (f,l,_mcols,ex) = makePostingAccountErrorExcerpt p
Hledger/Data/JournalChecks/Ordereddates.hs view
@@ -6,7 +6,7 @@ import Control.Monad (forM) import Data.List (groupBy) import Text.Printf (printf)-import qualified Data.Text as T (pack, unlines)+import Data.Text qualified as T (pack, unlines) import Hledger.Data.Errors (makeTransactionErrorExcerpt) import Hledger.Data.Transaction (transactionFile)
Hledger/Data/JournalChecks/Uniqueleafnames.hs view
@@ -8,7 +8,7 @@ import Data.Function (on) import Data.List (groupBy, sortBy) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Safe (headErr) import Text.Printf (printf)
Hledger/Data/Json.hs view
@@ -20,13 +20,12 @@ import Data.Aeson.Encode.Pretty (Config(..), Indent(..), NumberFormat(..), encodePretty', encodePrettyToTextBuilder') --import Data.Aeson.TH-import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy qualified as BL import Data.Decimal (DecimalRaw(..), roundTo)-import qualified Data.IntMap as IM import Data.Maybe (fromMaybe)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB-import Data.Time (Day(..))+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB+import Data.Map qualified as M import Text.Megaparsec (Pos, SourcePos, mkPos, unPos) import Hledger.Data.Types@@ -161,7 +160,7 @@ instance ToJSON a => ToJSON (PeriodData a) where toJSON a = object [ "pdpre" .= pdpre a- , "pdperiods" .= map (\(d, x) -> (ModifiedJulianDay (toInteger d), x)) (IM.toList $ pdperiods a)+ , "pdperiods" .= (M.toList $ pdperiods a) ] instance ToJSON a => ToJSON (Account a) where@@ -227,7 +226,7 @@ instance FromJSON a => FromJSON (PeriodData a) where parseJSON = withObject "PeriodData" $ \v -> PeriodData <$> v .: "pdpre"- <*> (IM.fromList . map (\(d, x) -> (fromInteger $ toModifiedJulianDay d, x)) <$> v .: "pdperiods")+ <*> (M.fromList <$> v .: "pdperiods") -- XXX The ToJSON instance replaces subaccounts with just names. -- Here we should try to make use of those to reconstruct the
Hledger/Data/Ledger.hs view
@@ -24,7 +24,7 @@ ) where -import qualified Data.Map as M+import Data.Map qualified as M import Safe (headDef) import Text.Printf
Hledger/Data/Period.hs view
@@ -35,7 +35,7 @@ where import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate
Hledger/Data/PeriodData.hs view
@@ -18,10 +18,6 @@ , mergePeriodData , padPeriodData -, periodDataToDateSpans-, maybePeriodDataToDateSpans-, dateSpansToPeriodData- , tests_PeriodData ) where @@ -30,15 +26,13 @@ #else import Control.Applicative (liftA2) #endif-import Data.Bifunctor (first)-import qualified Data.IntMap.Strict as IM #if !MIN_VERSION_base(4,20,0) import Data.List (foldl') #endif-import Data.Time (Day(..), fromGregorian)+import Data.Map qualified as M+import Data.Time (Day (..), fromGregorian) import Hledger.Data.Amount-import Hledger.Data.Dates import Hledger.Data.Types import Hledger.Utils @@ -49,7 +43,7 @@ showString "PeriodData" . showString "{ pdpre = " . shows h . showString ", pdperiods = "- . showString "fromList " . shows (map (\(day, x) -> (intToDay day, x)) $ IM.toList ds)+ . showString "fromList " . shows (M.toList ds) . showChar '}' instance Foldable PeriodData where@@ -67,94 +61,64 @@ instance Traversable PeriodData where traverse f (PeriodData h as) = liftA2 PeriodData (f h) $ traverse f as --- | The Semigroup instance for 'AccountBalance' will simply take the union of+-- | The Semigroup instance for 'PeriodData' simply takes the union of -- keys in the date map section. This may not be the result you want if the -- keys are not identical. instance Semigroup a => Semigroup (PeriodData a) where- PeriodData h1 as1 <> PeriodData h2 as2 = PeriodData (h1 <> h2) $ IM.unionWith (<>) as1 as2+ PeriodData h1 as1 <> PeriodData h2 as2 = PeriodData (h1 <> h2) $ M.unionWith (<>) as1 as2 instance Monoid a => Monoid (PeriodData a) where mempty = PeriodData mempty mempty --- | Construct an 'PeriodData' from a list.+-- | Construct a 'PeriodData' from a historical data value and a list of (period start, period data) pairs. periodDataFromList :: a -> [(Day, a)] -> PeriodData a-periodDataFromList h = PeriodData h . IM.fromList . map (\(d, a) -> (dayToInt d, a))+periodDataFromList h = PeriodData h . M.fromList --- | Convert 'PeriodData' to a list of pairs.+-- | Convert 'PeriodData' to a historical data value and a list of (period start, period data) pairs. periodDataToList :: PeriodData a -> (a, [(Day, a)])-periodDataToList (PeriodData h as) = (h, map (\(s, e) -> (intToDay s, e)) $ IM.toList as)-+periodDataToList (PeriodData h as) = (h, M.toList as) --- | Get account balance information for the period containing a given 'Day',--- along with the start of the period, or 'Nothing' if this day lies in the--- historical period.+-- | Get the data for the period containing the given 'Day', and that period's start date.+-- If the day is after the end of the last period, it is assumed to be within the last period.+-- If the day is before the start of the first period (ie, in the historical period), return Nothing. lookupPeriodData :: Day -> PeriodData a -> Maybe (Day, a)-lookupPeriodData d (PeriodData _ as) = first intToDay <$> IM.lookupLE (dayToInt d) as+lookupPeriodData d (PeriodData _ as) = M.lookupLE d as --- | Get account balance information for the period containing a given 'Day'--- or the historical data if this day lies in the historical period, along with--- the start of the period or 'Nothing' if it lies in the historical period.+-- | Get the data for the period containing the given 'Day', and that period's start date.+-- If the day is after the end of the last period, it is assumed to be within the last period.+-- If the day is before the start of the first period (ie, in the historical period),+-- return the data for the historical period and no start date. lookupPeriodDataOrHistorical :: Day -> PeriodData a -> (Maybe Day, a) lookupPeriodDataOrHistorical d pd@(PeriodData h _) = case lookupPeriodData d pd of- Nothing -> (Nothing, h)- Just (a, b) -> (Just a, b)+ Nothing -> (Nothing, h)+ Just (a, b) -> (Just a, b) --- | Add account balance information to the appropriate location in 'PeriodData'.+-- | Set historical or period data in the appropriate location in a 'PeriodData'. insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a insertPeriodData mday b balances = case mday of Nothing -> balances{pdpre = pdpre balances <> b}- Just day -> balances{pdperiods = IM.insertWith (<>) (dayToInt day) b $ pdperiods balances}+ Just day -> balances{pdperiods = M.insertWith (<>) day b $ pdperiods balances} --- | Merges two 'PeriodData', using the given operation to combine their balance information.+-- | Merge two 'PeriodData', using the given operation to combine their data values. -- -- This will drop keys if they are not present in both 'PeriodData'. opPeriodData :: (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c opPeriodData f (PeriodData h1 as1) (PeriodData h2 as2) =- PeriodData (f h1 h2) $ IM.intersectionWith f as1 as2+ PeriodData (f h1 h2) $ M.intersectionWith f as1 as2 --- | Merges two 'PeriodData', using the given operations for balance--- information only in the first, only in the second, or in both--- 'PeriodData', respectively.-mergePeriodData :: (a -> c) -> (b -> c) -> (a -> b -> c)- -> PeriodData a -> PeriodData b -> PeriodData c+-- | Merge two 'PeriodData', using the given operations for combining data+-- that's only in the first, only in the second, or in both, respectively.+mergePeriodData :: (a -> c) -> (b -> c) -> (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c mergePeriodData only1 only2 f = \(PeriodData h1 as1) (PeriodData h2 as2) ->- PeriodData (f h1 h2) $ merge as1 as2+ PeriodData (f h1 h2) $ merge as1 as2 where- merge = IM.mergeWithKey (\_ x y -> Just $ f x y) (fmap only1) (fmap only2)+ merge = M.mergeWithKey (\_ x y -> Just $ f x y) (fmap only1) (fmap only2) --- | Pad out the datemap of a 'PeriodData' so that every key from another 'PeriodData' is present.+-- | Pad out the date map of a 'PeriodData' so that every key from another 'PeriodData' is present. padPeriodData :: a -> PeriodData b -> PeriodData a -> PeriodData a padPeriodData x pad bal = bal{pdperiods = pdperiods bal <> (x <$ pdperiods pad)} --- | Convert 'PeriodData Day' to a list of 'DateSpan's.-periodDataToDateSpans :: PeriodData Day -> [DateSpan]-periodDataToDateSpans = map (\(s, e) -> DateSpan (toEFDay s) (toEFDay e)) . snd . periodDataToList- where toEFDay = Just . Exact---- Convert a periodic report 'Maybe (PeriodData Day)' to a list of 'DateSpans',--- replacing the empty case with an appropriate placeholder.-maybePeriodDataToDateSpans :: Maybe (PeriodData Day) -> [DateSpan]-maybePeriodDataToDateSpans = maybe [DateSpan Nothing Nothing] periodDataToDateSpans---- | Convert a list of 'DateSpan's to a 'PeriodData Day', or 'Nothing' if it is not well-formed.--- PARTIAL:-dateSpansToPeriodData :: [DateSpan] -> Maybe (PeriodData Day)--- Handle the cases of partitions which would arise from journals with no transactions-dateSpansToPeriodData [] = Nothing-dateSpansToPeriodData [DateSpan Nothing Nothing] = Nothing-dateSpansToPeriodData [DateSpan Nothing (Just _)] = Nothing-dateSpansToPeriodData [DateSpan (Just _) Nothing] = Nothing--- Handle properly defined reports-dateSpansToPeriodData (x:xs) = Just $ periodDataFromList (fst $ boundaries x) (map boundaries (x:xs))- where- boundaries spn = makeJust (spanStart spn, spanEnd spn)- makeJust (Just a, Just b) = (a, b)- makeJust ab = error' $ "dateSpansToPeriodData: expected all spans to have start and end dates, but one has " ++ show ab--intToDay = ModifiedJulianDay . toInteger-dayToInt = fromInteger . toModifiedJulianDay- -- tests tests_PeriodData =@@ -163,12 +127,12 @@ dayMap2 = periodDataFromList (mixed [usd 2]) [(fromGregorian 2000 01 01, mixed [usd 4]), (fromGregorian 2004 02 28, mixed [usd 6])] in testGroup "PeriodData" [ - testCase "periodDataFromList" $ do- length dayMap @?= 3,+ testCase "periodDataFromList" $ do+ length dayMap @?= 3, - testCase "Semigroup instance" $ do- dayMap <> dayMap @?= dayMap2,+ testCase "Semigroup instance" $ do+ dayMap <> dayMap @?= dayMap2, - testCase "Monoid instance" $ do- dayMap <> mempty @?= dayMap- ]+ testCase "Monoid instance" $ do+ dayMap <> mempty @?= dayMap+ ]
Hledger/Data/PeriodicTransaction.hs view
@@ -13,12 +13,13 @@ import Data.Function ((&)) import Data.Maybe (isNothing)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Text.Printf import Hledger.Data.Types import Hledger.Data.Dates+import Hledger.Data.DayPartition import Hledger.Data.Amount import Hledger.Data.Posting (post, generatedTransactionTagName) import Hledger.Data.Transaction@@ -198,7 +199,7 @@ runPeriodicTransaction :: Bool -> PeriodicTransaction -> DateSpan -> [Transaction] runPeriodicTransaction verbosetags PeriodicTransaction{..} requestedspan =- [ t{tdate=d} | (DateSpan (Just efd) _) <- alltxnspans, let d = fromEFDay efd, spanContainsDate requestedspan d ]+ [ t{tdate=d} | (d, _) <- maybe [] dayPartitionToList alltxnspans, spanContainsDate requestedspan d ] where t = nulltransaction{ tsourcepos = ptsourcepos
Hledger/Data/Posting.hs view
@@ -85,17 +85,17 @@ import Data.Default (def) import Data.Foldable (asum) import Data.Function ((&))-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.List (sort, union) #if !MIN_VERSION_base(4,20,0) import Data.List (foldl') #endif-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Data.Time.Calendar (Day) import Safe (maximumBound) import Text.DocLayout (realLength)
Hledger/Data/StringFormat.hs view
@@ -21,7 +21,7 @@ import Data.Default (Default(..)) import Data.Maybe (isJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Text.Megaparsec import Text.Megaparsec.Char (char, digitChar, string)
Hledger/Data/Timeclock.hs view
@@ -18,7 +18,7 @@ import Data.List (partition, sortBy, uncons) import Data.Maybe (fromMaybe)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (addDays) import Data.Time.Clock (addUTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
Hledger/Data/Transaction.hs view
@@ -68,10 +68,10 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Semigroup (Endo(..)) import Data.Text (Text)-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Map qualified as M+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Data.Time.Calendar (Day, fromGregorian) import Hledger.Utils
Hledger/Data/TransactionModifier.hs view
@@ -15,9 +15,9 @@ import Prelude hiding (Applicative(..)) import Control.Applicative (Applicative(..), (<|>)) import Data.Function ((&))-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (catMaybes)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day) import Safe (headDef) import Hledger.Data.Types@@ -65,7 +65,7 @@ -- Currently the only kind of modification possible is adding automated -- postings when certain other postings are present. ----- >>> import qualified Data.Text.IO as T+-- >>> import Data.Text.IO qualified as T -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False -- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate True
Hledger/Data/Types.hs view
@@ -40,17 +40,16 @@ import Data.Decimal (Decimal, DecimalRaw(..)) import Data.Default (Default(..)) import Data.Functor (($>))-import qualified Data.IntMap.Strict as IM import Data.List (intercalate, sortBy) --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html --Note: You should use Data.Map.Strict instead of this module if: --You will eventually need all the values stored. --The stored values don't represent large virtual data structures to be lazily computed.-import qualified Data.Map as M+import Data.Map qualified as M import Data.Ord (comparing) import Data.Semigroup (Min(..)) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day) import Data.Time.Clock.POSIX (POSIXTime) import Data.Time.LocalTime (LocalTime)@@ -750,13 +749,15 @@ ,adata :: PeriodData a -- ^ associated data per report period } deriving (Generic, Functor) --- | Data values for zero or more report periods, and for the pre-report period.--- Report periods are assumed to be contiguous, and represented only by start dates--- (as keys of an IntMap). XXX how does that work, again ?+-- | A general container for storing data values associated with zero or more+-- contiguous report (sub)periods, and with the (open ended) pre-report period.+-- The report periods are typically all the same length, but need not be.+--+-- Report periods are represented only by their start dates, used as the keys of a Map. data PeriodData a = PeriodData {- pdpre :: a -- ^ data from the pre-report period (e.g. historical balances)- ,pdperiods :: IM.IntMap a -- ^ data for the periods- } deriving (Eq, Functor, Generic)+ pdpre :: a -- ^ data for the period before the report+ ,pdperiods :: M.Map Day a -- ^ data for each period within the report+ } deriving (Eq, Ord, Functor, Generic) -- | Data that's useful in "balance" reports: -- subaccount-exclusive and -inclusive amounts,
Hledger/Data/Valuation.hs view
@@ -35,9 +35,9 @@ import Data.Function ((&), on) import Data.List (partition, intercalate, sortBy) import Data.List.Extra (nubSortBy)-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Text as T+import Data.Map qualified as M+import Data.Set qualified as S+import Data.Text qualified as T import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo) import GHC.Generics (Generic)
Hledger/Query.hs view
@@ -83,7 +83,7 @@ import Data.List (partition, intercalate) import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day, fromGregorian ) import Safe (headErr, readMay, maximumByMay, maximumMay, minimumMay) import Text.Megaparsec (between, noneOf, sepBy, try, (<?>), notFollowedBy)
Hledger/Read.hs view
@@ -88,10 +88,11 @@ -- * Journal files defaultJournal,- defaultJournalWith, defaultJournalSafely,- defaultJournalSafelyWith,+ defaultJournalWith,+ defaultJournalWithSafely, defaultJournalPath,+ defaultJournalPathSafely, requireJournalFileExists, ensureJournalFileExists, journalEnvVar,@@ -131,7 +132,7 @@ ) where --- ** imports-import qualified Control.Exception as C+import Control.Exception qualified as C import Control.Monad (unless, when, forM, (<=<)) import "mtl" Control.Monad.Except (ExceptT(..), runExceptT, liftEither) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -143,8 +144,8 @@ import Data.Ord (comparing) import Data.Semigroup (sconcat) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.Time (Day) import Safe (headDef, headMay) import System.Directory (doesFileExist)@@ -174,7 +175,6 @@ --- ** journal reading journalEnvVar = "LEDGER_FILE"-journalEnvVar2 = "LEDGER" journalDefaultFilename = ".hledger.journal" -- | Read the default journal file specified by the environment, @@ -182,49 +182,64 @@ defaultJournal :: IO Journal defaultJournal = defaultJournalSafely >>= either error' return -- PARTIAL: --- | Read the default journal file specified by the environment,--- with the given input options, or raise an error.-defaultJournalWith :: InputOpts -> IO Journal-defaultJournalWith iopts = defaultJournalSafelyWith iopts >>= either error' return -- PARTIAL:---- | Read the default journal file specified by the environment,--- with default input options, or return an error message.+-- | Like defaultJournal, but return an error message instead of raising an error. defaultJournalSafely :: IO (Either String Journal)-defaultJournalSafely = defaultJournalSafelyWith definputopts+defaultJournalSafely = defaultJournalWithSafely definputopts --- | Read the default journal file specified by the environment,--- with the given input options, or return an error message.-defaultJournalSafelyWith :: InputOpts -> IO (Either String Journal)-defaultJournalSafelyWith iopts = (do+-- | Like defaultJournal, but use the given input options.+defaultJournalWith :: InputOpts -> IO Journal+defaultJournalWith iopts = defaultJournalWithSafely iopts >>= either error' return -- PARTIAL:++-- | Like defaultJournalWith, but return an error message instead of raising an error.+defaultJournalWithSafely :: InputOpts -> IO (Either String Journal)+defaultJournalWithSafely iopts = (do f <- defaultJournalPath runExceptT $ readJournalFile iopts f- ) `C.catches` [ -- XXX+ )+ `C.catches` [ -- XXX C.Handler (\(e :: C.ErrorCall) -> return $ Left $ show e) ,C.Handler (\(e :: C.IOException) -> return $ Left $ show e) ]--- | Get the default journal file path specified by the environment.--- Like ledger, we look first for the LEDGER_FILE environment--- variable, and if that does not exist, for the legacy LEDGER--- environment variable. If neither is set, or the value is blank,--- return the hard-coded default, which is @.hledger.journal@ in the--- users's home directory (or in the current directory, if we cannot--- determine a home directory).++-- | Get the default journal file path, and check that it exists; or raise an error.+--+-- This looks for the LEDGER_FILE environment variable, like Ledger.+-- The value should be a file path; ~ at the start is supported, meaning user's home directory.+-- The value can also be a glob pattern, for convenience; if so we consider only the first matched file.+-- If no such file exists, an error is raised.+--+-- If LEDGER_FILE is unset or set to the empty string, we return a default file path:+-- @.hledger.journal@ in the user's home directory.+-- Or if we can't find the user's home directory, in the current directory.+-- If this default file doesn't exist, an error is raised.+-- defaultJournalPath :: IO String defaultJournalPath = do- p <- envJournalPath- if null p- then defpath+ ledgerfile <- getEnv journalEnvVar `C.catch` (\(_::C.IOException) -> return "")+ if null ledgerfile+ then do+ homedir <- fromMaybe "" <$> getHomeSafe+ let defaultfile = homedir </> journalDefaultFilename+ exists <- doesFileExist defaultfile+ if exists then return defaultfile+ -- else error' $ "LEDGER_FILE is unset and \"" <> defaultfile <> "\" was not found"+ else error' $ "neither LEDGER_FILE nor \"" <> defaultfile <> "\" were found" else do- ps <- expandGlob "." p `C.catch` (\(_::C.IOException) -> return [])- maybe defpath return $ headMay ps- where- envJournalPath =- getEnv journalEnvVar- `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2- `C.catch` (\(_::C.IOException) -> return ""))- defpath = do- home <- fromMaybe "" <$> getHomeSafe- return $ home </> journalDefaultFilename+ mf <- headMay <$> expandGlob "." ledgerfile `C.catch` (\(_::C.IOException) -> return [])+ case mf of+ Just f -> return f+ Nothing -> error' $ "LEDGER_FILE points to nonexistent \"" <> ledgerfile <> "\""++-- | Like defaultJournalPath, but return an error message instead of raising an error.+defaultJournalPathSafely :: IO (Either String String)+defaultJournalPathSafely = (do+ f <- defaultJournalPath+ return $ Right f+ )+ `C.catches` [+ C.Handler (\(e :: C.ErrorCall) -> return $ Left $ show e)+ ,C.Handler (\(e :: C.IOException) -> return $ Left $ show e)+ ] -- | @readJournal iopts mfile txt@ --
Hledger/Read/Common.hs view
@@ -129,7 +129,7 @@ --- ** imports import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault) import Control.Monad (foldM, liftM2, when, unless, (>=>), (<=<))-import qualified Control.Monad.Fail as Fail (fail)+import Control.Monad.Fail qualified as Fail (fail) import Control.Monad.Except (ExceptT(..), liftEither, withExceptT) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State.Strict (MonadState, evalStateT, modify', get, put)@@ -143,10 +143,10 @@ import Data.List (find, genericReplicate, union) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)-import qualified Data.Map as M-import qualified Data.Semigroup as Sem+import Data.Map qualified as M+import Data.Semigroup qualified as Sem import Data.Text (Text, stripEnd)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day, fromGregorianValid, toGregorian) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))
Hledger/Read/JournalReader.hs view
@@ -71,7 +71,7 @@ where --- ** imports-import qualified Control.Exception as C+import Control.Exception qualified as C import Control.Monad (forM_, when, void, unless, filterM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except (ExceptT(..), runExceptT)@@ -79,12 +79,12 @@ import Control.Monad.Trans.Class (lift) import Data.Char (toLower) import Data.Either (isRight, lefts)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Text (Text) import Data.String import Data.List import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar import Data.Time.LocalTime import Safe@@ -99,10 +99,10 @@ import Hledger.Read.Common import Hledger.Utils -import qualified Hledger.Read.CsvReader as CsvReader (reader)-import qualified Hledger.Read.RulesReader as RulesReader (reader)-import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)-import qualified Hledger.Read.TimedotReader as TimedotReader (reader)+import Hledger.Read.CsvReader qualified as CsvReader (reader)+import Hledger.Read.RulesReader qualified as RulesReader (reader)+import Hledger.Read.TimeclockReader qualified as TimeclockReader (reader)+import Hledger.Read.TimedotReader qualified as TimedotReader (reader) import System.Directory (canonicalizePath, doesFileExist) import Data.Functor ((<&>)) @@ -303,8 +303,7 @@ includedirectivep iopts = do -- save the position at start of include directive, for error messages eoff <- getOffset- -- and the parent file's path, for error messages and debug output- parentf <- getSourcePos >>= sourcePosFilePath+ pos <- getSourcePos -- parse the directive string "include"@@ -312,6 +311,7 @@ prefixedglob <- rstrip . T.unpack <$> takeWhileP Nothing (`notElem` [';','\n']) lift followingcommentp let (mprefix,glb) = splitReaderPrefix prefixedglob+ parentf <- sourcePosFilePath pos -- a little slow, don't do too often when (null $ dbg6 (parentf <> " include: glob pattern") glb) $ customFailure $ parseErrorAt eoff $ "include needs a file path or glob pattern argument" @@ -496,6 +496,8 @@ -- (since the parse file's path is probably always absolute). sourcePosFilePath :: (MonadIO m) => SourcePos -> m FilePath sourcePosFilePath = liftIO . canonicalizePath . sourceName+-- "canonicalizePath is a very big hammer. If you only need an absolute path, makeAbsolute is sufficient"+-- but we only do this once per include directive, seems ok to leave it as is. -- | Lift an IO action into the exception monad, rethrowing any IO -- error with the given message prepended.
Hledger/Read/RulesReader.hs view
@@ -48,16 +48,16 @@ import Control.DeepSeq (deepseq) import Control.Monad (unless, void, when) import Control.Monad.Except (ExceptT(..), liftEither, throwError)-import qualified Control.Monad.Fail as Fail+import Control.Monad.Fail qualified as Fail import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Control.Monad.Trans.Class (lift) import Data.Char (toLower, isDigit, isSpace, isAlphaNum, ord) import Data.Bifunctor (first)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Csv as Cassava-import qualified Data.Csv.Parser.Megaparsec as CassavaMegaparsec+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.Csv qualified as Cassava+import Data.Csv.Parser.Megaparsec qualified as CassavaMegaparsec import Data.Encoding (encodingFromStringExplicit, DynEncoding) import Data.Either (fromRight) import Data.Functor ((<&>))@@ -70,11 +70,11 @@ import Data.List.Extra (groupOn) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo)-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.IO qualified as T import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime), defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC, utctDay) import Safe (atMay, headMay, lastMay, readMay)
Hledger/Read/TimedotReader.hs view
@@ -44,7 +44,7 @@ import Control.Monad.State.Strict import Data.Char (isSpace) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time (Day) import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char
Hledger/Reports/AccountTransactionsReport.hs view
@@ -27,7 +27,7 @@ import Data.List.Extra (nubSort) import Data.Maybe (catMaybes) import Data.Ord (Down(..), comparing)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day) import Hledger.Data
Hledger/Reports/BudgetReport.hs view
@@ -21,10 +21,9 @@ import Data.List (find, maximumBy, intercalate) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Ord (comparing)-import qualified Data.Set as S-import qualified Data.Text as T+import Data.Set qualified as S+import Data.Text qualified as T import Data.These (These(..), these)-import Data.Time (Day) import Safe (minimumDef) import Hledger.Data@@ -84,12 +83,13 @@ (_, actualspans) = dbg5 "actualspans" $ reportSpan actualj rspec (_, budgetspans) = dbg5 "budgetspans" $ reportSpan budgetj rspec- allspans = case interval_ ropts of+ allspans = dbg5 "allspans" $ case (interval_ ropts, budgetspans) of -- If no interval is specified: -- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- it should be safe to replace it with the latter, so they combine well.- NoInterval -> actualspans- _ -> maybe id (padPeriodData nulldate) budgetspans <$> actualspans+ (NoInterval, _) -> actualspans+ (_, Nothing) -> actualspans+ (_, Just bspan) -> unionDayPartitions bspan =<< actualspans actualps = dbg5 "actualps" $ getPostings rspec actualj priceoracle reportspan budgetps = dbg5 "budgetps" $ getPostings rspec budgetj priceoracle reportspan@@ -107,7 +107,7 @@ -- | Lay out a set of postings grouped by date span into a regular matrix with rows -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport -- from the columns.-generateBudgetReport :: ReportOpts -> Maybe (PeriodData Day) -> Account (These BalanceData BalanceData) -> BudgetReport+generateBudgetReport :: ReportOpts -> Maybe DayPartition -> Account (These BalanceData BalanceData) -> BudgetReport generateBudgetReport = generatePeriodicReport makeBudgetReportRow treeActualBalance flatActualBalance where treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs)
Hledger/Reports/MultiBalanceReport.hs view
@@ -39,15 +39,15 @@ #endif import Control.Monad (guard) import Data.Foldable (toList)+import Data.HashSet qualified as HS import Data.List (sortOn) import Data.List.NonEmpty (NonEmpty((:|)))-import qualified Data.HashSet as HS-import qualified Data.IntMap.Strict as IM+import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust) import Data.Ord (Down(..)) import Data.Semigroup (sconcat) import Data.These (these)-import Data.Time.Calendar (Day(..), addDays, fromGregorian)+import Data.Time.Calendar (Day(..), fromGregorian) import Data.Traversable (mapAccumL) import Hledger.Data@@ -162,7 +162,7 @@ subreportTotal (_, sr, increasestotal) = (if increasestotal then id else fmap maNegate) $ prTotals sr - cbr = CompoundPeriodicReport "" (maybePeriodDataToDateSpans colspans) subreports overalltotals+ cbr = CompoundPeriodicReport "" (maybeDayPartitionToDateSpans colspans) subreports overalltotals -- | Remove any date queries and insert queries from the report span.@@ -216,7 +216,7 @@ -- | Generate the 'Account' for the requested multi-balance report from a list -- of 'Posting's.-generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData+generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData generateMultiBalanceAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans = -- Add declared accounts if called with --declared and --empty (if (declared_ ropts && empty_ ropts) then addDeclaredAccounts rspec j else id)@@ -262,7 +262,7 @@ -- | Gather the account balance changes into a regular matrix, then -- accumulate and value amounts, as specified by the report options. -- Makes sure all report columns have an entry.-calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData+calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData calculateReportAccount _ _ _ Nothing _ = accountFromBalances "root" $ periodDataFromList mempty [(nulldate, mempty)] calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just colspans) ps =@@ -292,18 +292,17 @@ avalue = periodDataValuation ropts j priceoracle colspans changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) .- mapPeriodData (padPeriodData mempty colspans) $+ mapPeriodData (padPeriodData mempty (dayPartitionToPeriodData colspans)) $ accountFromPostings getIntervalStartDate ps - getIntervalStartDate p = fst <$> lookupPeriodData (getPostingDate p) colspans+ getIntervalStartDate p = fst $ dayPartitionFind (getPostingDate p) colspans getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec)) -- | The valuation function to use for the chosen report options.--- This can call error in various situations.-periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> PeriodData Day+periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> DayPartition -> PeriodData BalanceData -> PeriodData BalanceData-periodDataValuation ropts j priceoracle periodEnds =- opPeriodData valueBalanceData balanceDataPeriodEnds+periodDataValuation ropts j priceoracle colspans =+ opPeriodData valueBalanceData (dayPartitionToPeriodData colspans) where valueBalanceData :: Day -> BalanceData -> BalanceData valueBalanceData d = mapBalanceData (valueMixedAmount d)@@ -311,10 +310,6 @@ valueMixedAmount :: Day -> MixedAmount -> MixedAmount valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle - -- The end date of a period is one before the beginning of the next period- balanceDataPeriodEnds :: PeriodData Day- balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ addDays (-1) <$> periodEnds- -- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports. markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}@@ -367,7 +362,7 @@ -- | Build a report row. -- -- Calculate the column totals. These are always the sum of column amounts.-generateMultiBalanceReport :: ReportOpts -> Maybe (PeriodData Day) -> Account BalanceData -> MultiBalanceReport+generateMultiBalanceReport :: ReportOpts -> Maybe DayPartition -> Account BalanceData -> MultiBalanceReport generateMultiBalanceReport ropts colspans = reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans @@ -377,9 +372,9 @@ generatePeriodicReport :: Show c => (forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c) -> (b -> MixedAmount) -> (c -> MixedAmount)- -> ReportOpts -> Maybe (PeriodData Day) -> Account b -> PeriodicReport DisplayName c+ -> ReportOpts -> Maybe DayPartition -> Account b -> PeriodicReport DisplayName c generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =- PeriodicReport (maybePeriodDataToDateSpans colspans) (buildAndSort acct) totalsrow+ PeriodicReport (maybeDayPartitionToDateSpans colspans) (buildAndSort acct) totalsrow where -- Build report rows and sort them buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of@@ -399,7 +394,7 @@ amt = mixedAmountStripCosts . sortKey . fmap treeAmt . pdperiods . adata sortKey = case balanceaccum_ ropts of PerPeriod -> maSum- _ -> maybe nullmixedamt snd . IM.lookupMax+ _ -> maybe nullmixedamt snd . M.lookupMax sortFlatByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))@@ -459,7 +454,7 @@ -- | Build a report row. -- -- Calculate the column totals. These are always the sum of column amounts.-makePeriodicReportRow :: c -> (IM.IntMap c -> (c, c))+makePeriodicReportRow :: c -> (M.Map Day c -> (c, c)) -> ReportOpts -> (b -> c) -> a -> Account b -> PeriodicReportRow a c makePeriodicReportRow nullEntry totalAndAverage ropts balance name acct =@@ -470,7 +465,7 @@ -- Total for a cumulative/historical report is always the last column. rowtotal = case balanceaccum_ ropts of PerPeriod -> total- _ -> maybe nullEntry snd $ IM.lookupMax rowbals+ _ -> maybe nullEntry snd $ M.lookupMax rowbals -- | Map the report rows to percentages if needed reportPercent :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
Hledger/Reports/PostingsReport.hs view
@@ -209,12 +209,12 @@ -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any. -- Each summary posting will have a non-Nothing interval end date.-summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> Maybe (PeriodData Day) -> [Posting] -> [SummaryPosting]+summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> Maybe DayPartition -> [Posting] -> [SummaryPosting] summarisePostingsByInterval wd mdepth showempty colspans = concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps) -- Group postings into their columns. We try to be efficient, since -- there can possibly be a very large number of intervals (cf #1683)- . groupByDateSpan showempty (postingDateOrDate2 wd) (maybePeriodDataToDateSpans colspans)+ . groupByDateSpan showempty (postingDateOrDate2 wd) (maybeDayPartitionToDateSpans colspans) -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per
Hledger/Reports/ReportOptions.hs view
@@ -71,7 +71,7 @@ import Prelude hiding (Applicative(..)) import Control.Applicative (Applicative(..), Const(..), (<|>))-import Control.Monad ((<=<), guard, join)+import Control.Monad (guard, join) import Data.Char (toLower) import Data.Either (fromRight) import Data.Either.Extra (eitherToMaybe)@@ -79,10 +79,10 @@ import Data.List (partition) import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix) import Data.Maybe (fromMaybe, isJust, isNothing)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..))-import Safe (headMay, lastDef, lastMay, maximumMay, readMay)+import Safe (lastDef, lastMay, maximumMay, readMay) import Hledger.Data import Hledger.Query@@ -670,16 +670,17 @@ -- with no interval it's the last date of the overall report period -- (which for an end value report may have been extended to include the latest non-future P directive). -- To get the period's last day, we subtract one from the (exclusive) period end date.- postingperiodend = addDays (-1) . fromMaybe err . mPeriodEnd . postingDateOrDate2 (whichDate ropts)+ postingperiodend = postingPeriodEnd . postingDateOrDate2 (whichDate ropts) where- mPeriodEnd = case interval_ ropts of- NoInterval -> const . spanEnd . fst $ reportSpan j rspec- _ -> spanEnd <=< latestSpanContaining (historical : spans)+ postingPeriodEnd d = fromMaybe err $ case interval_ ropts of+ NoInterval -> fmap (snd . dayPartitionStartEnd) . snd $ reportSpan j rspec+ _ -> fmap (snd . dayPartitionFind d) . snd $ reportSpanBothDates j rspec+ -- Should never happen, because there are only invalid dayPartitions+ -- when there are no transactions, in which case this function is never called+ err = error' "journalApplyValuationFromOpts: expected all spans to have an end date" - historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans- spans = maybePeriodDataToDateSpans . snd $ reportSpanBothDates j rspec+ styles = journalCommodityStyles j- err = error' "journalApplyValuationFromOpts: expected all spans to have an end date" -- | Select the Account valuation functions required for performing valuation after summing -- amounts. Used in MultiBalanceReport to value historical and similar reports.@@ -778,18 +779,18 @@ -- (or non-future market price date, when doing an end value report) is used. -- If none of these things are present, the null date span is returned. -- The report sub-periods caused by a report interval, if any, are also returned.-reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))+reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition) reportSpan = reportSpanHelper False -- Note: In end value reports, the report end date and valuation date are the same. -- If valuation date ever needs to be different, journalApplyValuationFromOptsWith is the place. -- | Like reportSpan, but considers both primary and secondary dates, not just one or the other.-reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))+reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition) reportSpanBothDates = reportSpanHelper True -reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))+reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition) reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts, _rsDay=today} =- (enlargedreportspan, dateSpansToPeriodData $ if not (null intervalspans) then intervalspans else [enlargedreportspan])+ (enlargedreportspan, intervalspans) where -- The date span specified by -b/-e/-p options and query args if any. requestedspan = dbg3 "requestedspan" $@@ -823,8 +824,8 @@ -- The requested span enlarged to enclose a whole number of intervals. -- This can be the null span if there were no intervals. enlargedreportspan = dbg3 "enlargedreportspan" $- DateSpan (fmap Exact . spanStart =<< headMay intervalspans)- (fmap Exact . spanEnd =<< lastMay intervalspans)+ maybe (DateSpan Nothing Nothing) (mkSpan . dayPartitionStartEnd) intervalspans+ where mkSpan (s, e) = DateSpan (Just $ Exact s) (Just . Exact $ addDays 1 e) reportStartDate :: Journal -> ReportSpec -> Maybe Day reportStartDate j = spanStart . fst . reportSpan j
Hledger/Reports/ReportTypes.hs view
@@ -45,7 +45,7 @@ import Hledger.Data import Hledger.Query (Query) import Hledger.Reports.ReportOptions (ReportOpts)-import qualified Data.Text as T+import Data.Text qualified as T import Data.List (intercalate) type Percentage = Decimal
Hledger/Utils.hs view
@@ -25,6 +25,8 @@ splitAtElement, sumStrict, all1,+ takeUntilFails,+ takeUntilFailsNE, -- * Trees treeLeaves,@@ -73,11 +75,12 @@ import Data.Char (toLower) import Data.List (intersperse) import Data.List.Extra (chunksOf, foldl1', uncons, unsnoc)+import qualified Data.List.NonEmpty as NE #if !MIN_VERSION_base(4,20,0) import Data.List (foldl') #endif-import qualified Data.Set as Set-import qualified Data.Text as T (pack, unpack)+import Data.Set qualified as Set+import Data.Text qualified as T (pack, unpack) import Data.Tree (foldTree, Tree (Node, subForest)) import Language.Haskell.TH (DecsQ, Name, mkName, nameBase) import Lens.Micro ((&), (.~))@@ -180,6 +183,16 @@ all1 :: (a -> Bool) -> [a] -> Bool all1 _ [] = False all1 p as = all p as++-- | Take elements from a non-empty list until a predicate fails, and then keep+-- the first failing element as well.+takeUntilFailsNE :: (a -> Bool) -> NE.NonEmpty a -> NE.NonEmpty a+takeUntilFailsNE p = NE.fromList . takeUntilFails p . NE.toList -- Result guaranteed to be non-empty++-- | Take elements from a list until a predicate fails, and then keep the first+-- failing element as well.+takeUntilFails :: (a -> Bool) -> [a] -> [a]+takeUntilFails p = foldr (\x -> if p x then (x :) else const [x]) [] -- Trees
Hledger/Utils/IO.hs view
@@ -132,11 +132,11 @@ import Data.Functor ((<&>)) import Data.List hiding (uncons) import Data.Maybe (isJust, catMaybes)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Text.Encoding.Error (UnicodeException)-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text.IO qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime) import Data.Word (Word16)@@ -155,7 +155,7 @@ import "Glob" System.FilePath.Glob (glob) import System.Info (os) import System.IO (Handle, IOMode (..), hClose, hGetEncoding, hIsTerminalDevice, hPutStr, hPutStrLn, hSetNewlineMode, hSetEncoding, openFile, stderr, stdin, stdout, universalNewlineMode, utf8_bom)-import qualified System.IO.Encoding as Enc+import System.IO.Encoding qualified as Enc import System.IO.Unsafe (unsafePerformIO) import System.Process (CreateProcess(..), StdStream(CreatePipe), createPipe, shell, waitForProcess, withCreateProcess) import Text.Pretty.Simple (CheckColorTty(..), OutputOptions(..), defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)@@ -407,7 +407,7 @@ ('~':_) -> ioError $ userError "~USERNAME in paths is not supported" p -> return p --- | Given a current directory, convert a possibly relative, possibly tilde-containing+-- | Given a current directory, convert a possibly relative, possibly tilde-prefixed -- file path to an absolute one. -- ~username is not supported. Leaves "-" unchanged. Can raise an error. expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers
Hledger/Utils/Parse.hs view
@@ -90,7 +90,7 @@ where import Control.Monad (when)-import qualified Data.Text as T+import Data.Text qualified as T import Safe (tailErr) import Text.Megaparsec import Text.Printf@@ -105,9 +105,9 @@ import Control.Monad.Except (ExceptT, MonadError, catchError, throwError) import Control.Monad.Trans.Class (lift)-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Monoid (Alt(..))-import qualified Data.Set as S+import Data.Set qualified as S import Hledger.Utils.Debug (debugLevel, dbg0Msg)
Hledger/Utils/Regex.hs view
@@ -74,7 +74,7 @@ #endif import Data.MemoUgly (memo) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Text.Regex.TDFA ( Regex, CompOption(..), defaultCompOpt, defaultExecOpt, makeRegexOptsM, AllMatches(getAllMatches), match, MatchText,
Hledger/Utils/String.hs view
@@ -15,7 +15,6 @@ -- quotechars, -- whitespacechars, words',- unwords', stripAnsi, -- * single-line layout strip,@@ -40,7 +39,7 @@ import Data.Char (isSpace, toLower, toUpper) import Data.List (intercalate, dropWhileEnd)-import qualified Data.Text as T+import Data.Text qualified as T import Safe (headErr, tailErr) import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec.Char (char)@@ -165,26 +164,25 @@ -- >>> quoteForCommandLine "\"" -- "'\"'" -- >>> quoteForCommandLine "$"--- "'\\$'"+-- "'$'" -- quoteForCommandLine :: String -> String quoteForCommandLine s- | any (`elem` s) (quotechars++whitespacechars++shellchars) = singleQuote $ quoteShellChars s+ | any (`elem` s) (quotechars++whitespacechars++shellchars) = singleQuote $ escapeSingleQuotes s | otherwise = s --- | Try to backslash-quote common shell-significant characters in this string.--- Doesn't handle single quotes, & probably others.-quoteShellChars :: String -> String-quoteShellChars = concatMap escapeShellChar+-- | Escape single quotes appearing in a string we're protecting by wrapping in single quotes+escapeSingleQuotes :: String -> String+escapeSingleQuotes = concatMap escapeSingleQuote where- escapeShellChar c | c `elem` shellchars = ['\\',c]- escapeShellChar c = [c]+ escapeSingleQuote c | c `elem` "'" = ['\\',c]+ escapeSingleQuote c = [c] quotechars, whitespacechars, redirectchars, shellchars :: [Char] quotechars = "'\"" whitespacechars = " \t\n\r" redirectchars = "<>"-shellchars = "<>(){}[]$7?#!~`"+shellchars = "<>(){}[]$&?#!~`*+\\" -- | Quote-aware version of words - don't split on spaces which are inside quotes. -- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails.@@ -197,10 +195,6 @@ patterns = many (noneOf whitespacechars) singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"")---- | Quote-aware version of unwords - single-quote strings which contain whitespace-unwords' :: [String] -> String-unwords' = unwords . map quoteIfNeeded -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: String -> String
Hledger/Utils/Test.hs view
@@ -25,7 +25,7 @@ import Control.Monad.State.Strict (StateT, evalStateT, execStateT) import Data.Default (Default(..)) import Data.List (isInfixOf)-import qualified Data.Text as T+import Data.Text qualified as T import Test.Tasty hiding (defaultMain) import Test.Tasty.HUnit -- import Test.Tasty.QuickCheck as QC
Hledger/Utils/Text.hs view
@@ -23,7 +23,6 @@ -- escapeSingleQuotes, -- escapeQuotes, -- words',- -- unwords', stripquotes, -- isSingleQuoted, -- isDoubleQuoted,@@ -55,9 +54,9 @@ import Data.Default (def) import Data.Maybe (catMaybes) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Text.DocLayout (charWidth, realLength) import Test.Tasty (testGroup)@@ -161,10 +160,6 @@ -- pattern = many (noneOf whitespacechars) -- singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") -- doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"")---- -- | Quote-aware version of unwords - single-quote strings which contain whitespace--- unwords' :: [Text] -> Text--- unwords' = T.unwords . map quoteIfNeeded -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: Text -> Text
Hledger/Write/Beancount.hs view
@@ -24,9 +24,9 @@ import Data.Char import Data.Default (def) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Safe (maximumBound) import Text.DocLayout (realLength) import Text.Printf
Hledger/Write/Csv.hs view
@@ -23,9 +23,9 @@ import Prelude hiding (Applicative(..)) import Data.List (intersperse) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Hledger.Utils
Hledger/Write/Html.hs view
@@ -23,9 +23,9 @@ tests_Hledger_Write_Html ) where -import qualified Data.Text as T (Text)-import qualified Data.Text.Lazy as TL (Text, toStrict)-import qualified Lucid as L (renderText, toHtml)+import Data.Text qualified as T (Text)+import Data.Text.Lazy qualified as TL (Text, toStrict)+import Lucid qualified as L (renderText, toHtml) import Test.Tasty (testGroup) import Hledger.Write.Html.Lucid (Html, formatRow, styledTableHtml)
Hledger/Write/Html/Attribute.hs view
@@ -21,7 +21,7 @@ vpad, ) where -import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Text (Text)
Hledger/Write/Html/Blaze.hs view
@@ -9,14 +9,14 @@ formatCell, ) where -import qualified Hledger.Write.Html.Attribute as Attr-import qualified Hledger.Write.Spreadsheet as Spr+import Hledger.Write.Html.Attribute qualified as Attr+import Hledger.Write.Spreadsheet qualified as Spr import Hledger.Write.Html.HtmlCommon (Lines, borderStyles) import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) -import qualified Text.Blaze.Html4.Transitional.Attributes as HtmlAttr-import qualified Text.Blaze.Html4.Transitional as Html-import qualified Data.Text as Text+import Text.Blaze.Html4.Transitional.Attributes qualified as HtmlAttr+import Text.Blaze.Html4.Transitional qualified as Html+import Data.Text qualified as Text import Text.Blaze.Html4.Transitional (Html, toHtml, (!)) import Data.Foldable (traverse_)
Hledger/Write/Html/HtmlCommon.hs view
@@ -11,7 +11,7 @@ import Data.Text (Text) import Hledger.Write.Spreadsheet (Cell(..))-import qualified Hledger.Write.Spreadsheet as Spr+import Hledger.Write.Spreadsheet qualified as Spr borderStyles :: Lines border => Cell border text -> [Text]
Hledger/Write/Html/Lucid.hs view
@@ -12,14 +12,14 @@ ) where import Data.Foldable (traverse_)-import qualified Data.Text as Text-import qualified Lucid.Base as L-import qualified Lucid as L+import Data.Text qualified as Text+import Lucid.Base qualified as L+import Lucid qualified as L -import qualified Hledger.Write.Html.Attribute as Attr+import Hledger.Write.Html.Attribute qualified as Attr import Hledger.Write.Html.HtmlCommon import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))-import qualified Hledger.Write.Spreadsheet as Spr+import Hledger.Write.Spreadsheet qualified as Spr type Html = L.Html ()
Hledger/Write/Ods.hs view
@@ -16,23 +16,23 @@ import Control.Monad (guard) import Control.Applicative (Applicative(..)) -import qualified Data.Text.Lazy as TL-import qualified Data.Text as T+import Data.Text.Lazy qualified as TL+import Data.Text qualified as T import Data.Text (Text) -import qualified Data.Foldable as Fold-import qualified Data.List as List-import qualified Data.Map as Map-import qualified Data.Set as Set+import Data.Foldable qualified as Fold+import Data.List qualified as List+import Data.Map qualified as Map+import Data.Set qualified as Set import Data.Foldable (fold) import Data.Map (Map) import Data.Set (Set) import Data.Maybe (catMaybes) -import qualified System.IO as IO+import System.IO qualified as IO import Text.Printf (printf) -import qualified Hledger.Write.Spreadsheet as Spr+import Hledger.Write.Spreadsheet qualified as Spr import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) import Hledger.Data.Types (CommoditySymbol, AmountPrecision(..)) import Hledger.Data.Types (acommodity, aquantity, astyle, asprecision)
Hledger/Write/Spreadsheet.hs view
@@ -28,12 +28,12 @@ integerCell, ) where -import qualified Hledger.Data.Amount as Amt+import Hledger.Data.Amount qualified as Amt import Hledger.Data.Types (Amount, MixedAmount, acommodity) import Hledger.Data.Amount (AmountFormat) -import qualified Data.List as List-import qualified Data.Text as Text+import Data.List qualified as List+import Data.Text qualified as Text import Data.Text (Text) import Text.WideString (WideBuilder)
Text/Tabular/AsciiWide.hs view
@@ -30,8 +30,8 @@ import Data.List (intersperse, transpose) import Data.Semigroup (stimesMonoid) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText) import Safe (maximumMay) import Text.Tabular
Text/WideString.hs view
@@ -9,8 +9,8 @@ ) where import Data.Text (Text)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB import Text.DocLayout (realLength)
hledger-lib.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hledger-lib-version: 1.50.2+version: 1.50.3 synopsis: A library providing the core functionality of hledger description: This library contains hledger's core functionality. It is used by most hledger* packages so that they support the same@@ -116,6 +116,7 @@ Text.WideString other-modules: Hledger.Data.BalanceData+ Hledger.Data.DayPartition Hledger.Data.PeriodData Paths_hledger_lib autogen-modules:@@ -172,7 +173,7 @@ , uglymemo , unordered-containers >=0.2 , utf8-string >=0.3.5- default-language: Haskell2010+ default-language: GHC2021 if (flag(debug)) cpp-options: -DDEBUG @@ -232,7 +233,7 @@ , uglymemo , unordered-containers >=0.2 , utf8-string >=0.3.5- default-language: Haskell2010+ default-language: GHC2021 if (flag(debug)) cpp-options: -DDEBUG if impl(ghc >= 9.0) && impl(ghc < 9.2)@@ -295,6 +296,6 @@ , unordered-containers >=0.2 , utf8-string >=0.3.5 buildable: True- default-language: Haskell2010+ default-language: GHC2021 if (flag(debug)) cpp-options: -DDEBUG