packages feed

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