diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -9,6 +9,15 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# a98e6125f + +Improvements + +- hledger-lib now builds with GHC 9.2 and newer libs (#1774). + +- Renamed: CommodityLayout to Layout. + (Stephen Morgan) + # 1.24.1 2021-12-10 Improvements diff --git a/Hledger/Data/Amount.hs b/Hledger/Data/Amount.hs --- a/Hledger/Data/Amount.hs +++ b/Hledger/Data/Amount.hs @@ -73,6 +73,7 @@ noColour, noPrice, oneLine, + csvDisplay, amountstyle, styleAmount, styleAmountExceptPrecision, @@ -200,6 +201,7 @@ data AmountDisplayOpts = AmountDisplayOpts { displayPrice :: Bool -- ^ Whether to display the Price of an Amount. , displayZeroCommodity :: Bool -- ^ If the Amount rounds to 0, whether to display its commodity string. + , displayThousandsSep :: Bool -- ^ Whether to display thousands separators. , displayColour :: Bool -- ^ Whether to colourise negative Amounts. , displayOneLine :: Bool -- ^ Whether to display on one line. , displayMinWidth :: Maybe Int -- ^ Minimum width to pad to @@ -217,6 +219,7 @@ noColour = AmountDisplayOpts { displayPrice = True , displayColour = False , displayZeroCommodity = False + , displayThousandsSep = True , displayOneLine = False , displayMinWidth = Just 0 , displayMaxWidth = Nothing @@ -231,6 +234,10 @@ oneLine :: AmountDisplayOpts oneLine = def{displayOneLine=True, displayPrice=False} +-- | Display Amount and MixedAmount in a form suitable for CSV output. +csvDisplay :: AmountDisplayOpts +csvDisplay = oneLine{displayThousandsSep=False} + ------------------------------------------------------------------------------- -- Amount styles @@ -472,7 +479,7 @@ L -> showC (wbFromText c) space <> quantity' <> price R -> quantity' <> showC space (wbFromText c) <> price where - quantity = showamountquantity a + quantity = showamountquantity $ if displayThousandsSep opts then a else a{astyle=(astyle a){asdigitgroups=Nothing}} (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty diff --git a/Hledger/Data/Balancing.hs b/Hledger/Data/Balancing.hs --- a/Hledger/Data/Balancing.hs +++ b/Hledger/Data/Balancing.hs @@ -903,8 +903,8 @@ transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ] ]} assertRight ej - let Right j = ej - (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] + case ej of Right j -> (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] + Left _ -> error' "balance-assignment test: shouldn't happen" ,testCase "same-day-1" $ do assertRight $ journalBalanceTransactions defbalancingopts $ diff --git a/Hledger/Data/TransactionModifier.hs b/Hledger/Data/TransactionModifier.hs --- a/Hledger/Data/TransactionModifier.hs +++ b/Hledger/Data/TransactionModifier.hs @@ -83,7 +83,7 @@ q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt let fs = map (tmPostingRuleToFunction styles q tmquerytxt) tmpostingrules - generatePostings ps = concatMap (\p -> p : map ($p) (if q `matchesPosting` p then fs else [])) ps + generatePostings = concatMap (\p -> p : map ($ p) (if q `matchesPosting` p then fs else [])) Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, diff --git a/Hledger/Data/Types.hs b/Hledger/Data/Types.hs --- a/Hledger/Data/Types.hs +++ b/Hledger/Data/Types.hs @@ -17,13 +17,19 @@ -} -- {-# LANGUAGE DeriveAnyClass #-} -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} -module Hledger.Data.Types +module Hledger.Data.Types ( + module Hledger.Data.Types, +#if MIN_VERSION_time(1,11,0) + Year +#endif +) where import GHC.Generics (Generic) @@ -47,6 +53,19 @@ import Hledger.Utils.Regex +-- synonyms for various date-related scalars +#if MIN_VERSION_time(1,11,0) +import Data.Time.Calendar (Year) +#else +type Year = Integer +#endif +type Month = Int -- 1-12 +type Quarter = Int -- 1-4 +type YearWeek = Int -- 1-52 +type MonthWeek = Int -- 1-5 +type YearDay = Int -- 1-366 +type MonthDay = Int -- 1-31 +type WeekDay = Int -- 1-7 -- | A possibly incomplete year-month-day date provided by the user, to be -- interpreted as either a date or a date span depending on context. Missing @@ -76,16 +95,6 @@ data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Generic) instance Default DateSpan where def = DateSpan Nothing Nothing - --- synonyms for various date-related scalars -type Year = Integer -type Month = Int -- 1-12 -type Quarter = Int -- 1-4 -type YearWeek = Int -- 1-52 -type MonthWeek = Int -- 1-5 -type YearDay = Int -- 1-366 -type MonthDay = Int -- 1-31 -type WeekDay = Int -- 1-7 -- Typical report periods (spans of time), both finite and open-ended. -- A higher-level abstraction than DateSpan. diff --git a/Hledger/Read/CsvReader.hs b/Hledger/Read/CsvReader.hs --- a/Hledger/Read/CsvReader.hs +++ b/Hledger/Read/CsvReader.hs @@ -1244,8 +1244,8 @@ <|> replaceCsvFieldReference rules record <$> referencep) t where - referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text - isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-') + referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec CustomErr Text Text + isFieldNameChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-') -- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- with that field's value. If it doesn't look like a field reference, or if we diff --git a/Hledger/Reports/BudgetReport.hs b/Hledger/Reports/BudgetReport.hs --- a/Hledger/Reports/BudgetReport.hs +++ b/Hledger/Reports/BudgetReport.hs @@ -241,7 +241,7 @@ (Tab.Group Tab.NoLine $ map Tab.Header colheadings) rows where - colheadings = ["Commodity" | commodity_layout_ == CommodityBare] + colheadings = ["Commodity" | layout_ == LayoutBare] ++ map (reportPeriodName balanceaccum_ spans) spans ++ [" Total" | row_total_] ++ ["Average" | average_] @@ -283,9 +283,9 @@ padcells = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip widths) . maybetranspose padtr = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip trwidths) . maybetranspose - -- commodities are shown with the amounts without `commodity_layout_ == CommodityBare` + -- commodities are shown with the amounts without `layout_ == LayoutBare` prependcs cs - | commodity_layout_ /= CommodityBare = id + | layout_ /= LayoutBare = id | otherwise = zipWith (:) cs rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as @@ -294,8 +294,8 @@ -- functions for displaying budget cells depending on `commodity-layout_` option rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget) - rowfuncs cs = case commodity_layout_ of - CommodityWide width -> + rowfuncs cs = case layout_ of + LayoutWide width -> ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=width} , \a -> pure . percentage a) _ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} @@ -407,7 +407,7 @@ -- heading row ("Account" : - ["Commodity" | commodity_layout_ == CommodityBare ] + ["Commodity" | layout_ == LayoutBare ] ++ concatMap (\span -> [showDateSpan span, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Average","budget"] | average_] @@ -427,7 +427,7 @@ -> PeriodicReportRow a BudgetCell -> [[Text]] rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) - | commodity_layout_ /= CommodityBare = [render row : fmap showNorm all] + | layout_ /= LayoutBare = [render row : fmap showNorm all] | otherwise = joinNames . zipWith (:) cs -- add symbols and names . transpose -- each row becomes a list of Text quantities diff --git a/Hledger/Reports/MultiBalanceReport.hs b/Hledger/Reports/MultiBalanceReport.hs --- a/Hledger/Reports/MultiBalanceReport.hs +++ b/Hledger/Reports/MultiBalanceReport.hs @@ -586,11 +586,11 @@ Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow where renderCh - | commodity_layout_ /= CommodityBare || transpose_ = fmap (Tab.textCell Tab.TopRight) + | layout_ /= LayoutBare || transpose_ = fmap (Tab.textCell Tab.TopRight) | otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight)) renderRow (rh, row) - | commodity_layout_ /= CommodityBare || transpose_ = + | layout_ /= LayoutBare || transpose_ = (Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row) | otherwise = (Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row)) diff --git a/Hledger/Reports/ReportOptions.hs b/Hledger/Reports/ReportOptions.hs --- a/Hledger/Reports/ReportOptions.hs +++ b/Hledger/Reports/ReportOptions.hs @@ -26,7 +26,7 @@ BalanceAccumulation(..), AccountListMode(..), ValuationType(..), - CommodityLayout(..), + Layout(..), defreportopts, rawOptsToReportOpts, defreportspec, @@ -109,9 +109,10 @@ instance Default AccountListMode where def = ALFlat -data CommodityLayout = CommodityWide (Maybe Int) - | CommodityTall - | CommodityBare +data Layout = LayoutWide (Maybe Int) + | LayoutTall + | LayoutBare + | LayoutTidy deriving (Eq, Show) -- | Standard options for customising report filtering and output. @@ -169,7 +170,7 @@ -- whether stdout is an interactive terminal, and the value of -- TERM and existence of NO_COLOR environment variables. ,transpose_ :: Bool - ,commodity_layout_ :: CommodityLayout + ,layout_ :: Layout } deriving (Show) instance Default ReportOpts where def = defreportopts @@ -208,7 +209,7 @@ , normalbalance_ = Nothing , color_ = False , transpose_ = False - , commodity_layout_ = CommodityWide Nothing + , layout_ = LayoutWide Nothing } -- | Generate a ReportOpts from raw command-line input, given a day. @@ -262,7 +263,7 @@ ,pretty_ = pretty ,color_ = useColorOnStdout -- a lower-level helper ,transpose_ = boolopt "transpose" rawopts - ,commodity_layout_ = commoditylayoutopt rawopts + ,layout_ = layoutopt rawopts } -- | The result of successfully parsing a ReportOpts on a particular @@ -337,17 +338,18 @@ CalcValueChange -> Just PerPeriod _ -> Nothing -commoditylayoutopt :: RawOpts -> CommodityLayout -commoditylayoutopt rawopts = fromMaybe (CommodityWide Nothing) $ layout <|> column +layoutopt :: RawOpts -> Layout +layoutopt rawopts = fromMaybe (LayoutWide Nothing) $ layout <|> column where layout = parse <$> maybestringopt "layout" rawopts - column = CommodityBare <$ guard (boolopt "commodity-column" rawopts) + column = LayoutBare <$ guard (boolopt "commodity-column" rawopts) parse opt = maybe err snd $ guard (not $ null s) *> find (isPrefixOf s . fst) checkNames where - checkNames = [ ("wide", CommodityWide w) - , ("tall", CommodityTall) - , ("bare", CommodityBare) + checkNames = [ ("wide", LayoutWide w) + , ("tall", LayoutTall) + , ("bare", LayoutBare) + , ("tidy", LayoutTidy) ] -- For `--layout=elided,n`, elide to the given width (s,n) = break (==',') $ map toLower opt @@ -356,7 +358,7 @@ c | Just w <- readMay c -> Just w _ -> usageError "width in --layout=wide,WIDTH must be an integer" - err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", or \"bare\"" + err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", \"bare\", or \"tidy\"" -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. diff --git a/Hledger/Utils/Regex.hs b/Hledger/Utils/Regex.hs --- a/Hledger/Utils/Regex.hs +++ b/Hledger/Utils/Regex.hs @@ -192,23 +192,25 @@ -- appropriate for this match. Or return an error message. replaceMatch :: Replacement -> String -> MatchText String -> Either RegexError String replaceMatch replpat s matchgroups = - erepl >>= \repl -> Right $ pre ++ repl ++ post - where - ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match - (pre, post') = splitAt off s - post = drop len post' - -- The replacement text: the replacement pattern with all - -- numeric backreferences replaced by the appropriate groups - -- from this match. Or an error message. - erepl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat + case elems matchgroups of + [] -> Right s + ((_,(off,len)):_) -> -- groups should have 0-based indexes, and there should always be at least one, since this is a match + erepl >>= \repl -> Right $ pre ++ repl ++ post where - -- Given some match groups and a numeric backreference, - -- return the referenced group text, or an error message. - lookupMatchGroup :: MatchText String -> String -> Either RegexError String - lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = - case read s of n | n `elem` indices grps -> Right $ fst (grps ! n) -- PARTIAL: should not fail, all digits - _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" - lookupMatchGroup _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" + (pre, post') = splitAt off s + post = drop len post' + -- The replacement text: the replacement pattern with all + -- numeric backreferences replaced by the appropriate groups + -- from this match. Or an error message. + erepl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat + where + -- Given some match groups and a numeric backreference, + -- return the referenced group text, or an error message. + lookupMatchGroup :: MatchText String -> String -> Either RegexError String + lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = + case read s of n | n `elem` indices grps -> Right $ fst (grps ! n) -- PARTIAL: should not fail, all digits + _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" + lookupMatchGroup _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not fail -- regexReplace' :: Regexp -> Replacement -> String -> String diff --git a/hledger-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hledger-lib -version: 1.24.1 +version: 1.24.99 synopsis: A reusable library providing the core functionality of hledger description: A reusable library containing hledger's core functionality. This is used by most hledger* packages so that they support the same @@ -91,7 +91,7 @@ Paths_hledger_lib hs-source-dirs: ./ - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns build-depends: Decimal >=0.5.1 , Glob >=0.9 @@ -99,7 +99,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.11 && <4.16 + , base >=4.11 && <4.17 , blaze-markup >=0.5.1 , bytestring , call-stack @@ -141,7 +141,7 @@ hs-source-dirs: ./ test - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns build-depends: Decimal >=0.5.1 , Glob >=0.7 @@ -149,7 +149,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.11 && <4.16 + , base >=4.11 && <4.17 , blaze-markup >=0.5.1 , bytestring , call-stack @@ -194,7 +194,7 @@ hs-source-dirs: ./ test - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns build-depends: Decimal >=0.5.1 , Glob >=0.9 @@ -202,7 +202,7 @@ , aeson-pretty , ansi-terminal >=0.9 , array - , base >=4.11 && <4.16 + , base >=4.11 && <4.17 , blaze-markup >=0.5.1 , bytestring , call-stack