From 00eb0aa16b7be068ff7f7cb0bf29bb73413c8312 Mon Sep 17 00:00:00 2001 From: Michael Rees Date: Mon, 15 Jul 2024 21:55:13 -0500 Subject: [PATCH] feat: register: add --sort as in ledger --- hledger-lib/Hledger/Reports/PostingsReport.hs | 76 ++++++++++++++++--- hledger-lib/hledger-lib.cabal | 1 + hledger/Hledger/Cli/Commands/Add.hs | 2 +- hledger/Hledger/Cli/Commands/Register.hs | 5 +- hledger/test/register/sort.test | 76 +++++++++++++++++++ 5 files changed, 147 insertions(+), 13 deletions(-) create mode 100644 hledger/test/register/sort.test diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 701313e4c..88a602bd1 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -15,15 +15,19 @@ module Hledger.Reports.PostingsReport ( PostingsReportItem, postingsReport, mkpostingsReportItem, + SortSpec, + getSortSpec, -- * Tests tests_PostingsReport ) where -import Data.List (nub, sortOn) +import Data.List (nub, sortBy, sortOn, stripPrefix, isPrefixOf) +import Data.List.Split (splitOn) import Data.List.Extra (nubSort) -import Data.Maybe (isJust, isNothing) +import Data.Maybe (isJust, isNothing, fromMaybe) +import Data.Ord import Data.Text (Text) import Data.Time.Calendar (Day) import Safe (headMay) @@ -61,15 +65,44 @@ instance HasAmounts PostingsReportItem where -- with a tuple. type SummaryPosting = (Posting, Period) +-- Possible value expressions taken by the --sort command +-- Each of these takes a bool, which shows if it has been inverted +-- (True -> has been inverted, reverse the order) +data ValueExp + = Date' Bool + | Account' Bool + | Amount' Bool + deriving (Show) +type SortSpec = [ValueExp] + +-- Load a SortSpec from the argument given to --sort +-- If there is no spec given, then sort by [Date' False] by default +getSortSpec :: RawOpts -> SortSpec +getSortSpec opts = + let opt = maybestringopt "sort" opts + optParser s = + let terms = map strip $ splitOn "," s + termParser t = case trimmed of + "date" -> Date' isNegated + "account" -> Account' isNegated + "amount" -> Amount' isNegated + _ -> error' $ "unsupported value expression '" ++ t ++ "' given to --sort" + where isNegated = isPrefixOf "-" t + trimmed = fromMaybe t (stripPrefix "-" t) + in map termParser terms + in maybe [Date' False] optParser opt + -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. -postingsReport :: ReportSpec -> Journal -> PostingsReport -postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items +postingsReport :: ReportSpec -> Maybe SortSpec -> Journal -> PostingsReport +postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} sortspec j = items where (reportspan, colspans) = reportSpanBothDates j rspec whichdate = whichDate ropts mdepth = queryDepth $ _rsQuery rspec multiperiod = interval_ /= NoInterval + -- Sort by the date (or date2) field if nothing else is specified + sspec = fromMaybe [Date' False] sortspec -- postings to be included in the report, and similarly-matched postings before the report start date (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan @@ -82,10 +115,12 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans showempty = empty_ || average_ + sortedps = sortPostings ropts sspec displayps + -- Posting report items ready for display. items = dbg4 "postingsReport items" $ - postingsReportItems displayps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum + postingsReportItems sortedps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum where -- In historical mode we'll need a starting balance, which we -- may be converting to value per hledger_options.m4.md "Effect @@ -110,6 +145,24 @@ registerRunningCalculationFn ropts | average_ ropts = \i avg amt -> avg `maPlus` divideMixedAmount (fromIntegral i) (amt `maMinus` avg) | otherwise = \_ bal amt -> bal `maPlus` amt +-- | Sort two postings by the current list of value expressions (given in SortSpec). +comparePostings :: ReportOpts -> SortSpec -> (Posting, Maybe Period) -> (Posting, Maybe Period) -> Ordering +comparePostings _ [] _ _ = EQ +comparePostings ropts (ex:es) (a, pa) (b, pb) = + let comparison = case ex of + Amount' False -> compare (pamount a) (pamount b) + Account' False -> compare (paccount a) (paccount b) + Date' False -> compare (postingDateOrDate2 (whichDate ropts) a) (postingDateOrDate2 (whichDate ropts) b) + Amount' True -> compare (Down (pamount a)) (Down (pamount b)) + Account' True -> compare (Down (paccount a)) (Down (paccount b)) + Date' True -> compare (Down (postingDateOrDate2 (whichDate ropts) a)) (Down (postingDateOrDate2 (whichDate ropts) b)) + in + if comparison == EQ then comparePostings ropts es (a, pa) (b, pb) else comparison + +-- | Sort postings by the current SortSpec. +sortPostings :: ReportOpts -> SortSpec -> [(Posting, Maybe Period)] -> [(Posting, Maybe Period)] +sortPostings ropts sspec = sortBy (comparePostings ropts sspec) + -- | Find postings matching a given query, within a given date span, -- and also any similarly-matched postings before that date span. -- Date restrictions and depth restrictions in the query are ignored. @@ -220,8 +273,11 @@ negatePostingAmount = postingTransformAmount negate tests_PostingsReport = testGroup "PostingsReport" [ + let sspec = Just [Date' False] + in + testCase "postingsReport" $ do - let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} journal) @?= n + let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} sspec journal) @?= n -- with the query specified explicitly (Any, nulljournal) `gives` 0 (Any, samplejournal) `gives` 13 @@ -230,10 +286,10 @@ tests_PostingsReport = testGroup "PostingsReport" [ (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2 (And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2 -- with query and/or command-line options - (length $ postingsReport defreportspec samplejournal) @?= 13 - (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11 - (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20 - (length $ postingsReport defreportspec{_rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5 + (length $ postingsReport defreportspec sspec samplejournal) @?= 13 + (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} sspec samplejournal) @?= 11 + (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} sspec samplejournal) @?= 20 + (length $ postingsReport defreportspec{_rsQuery=Acct $ toRegex' "assets:bank:checking"} sspec samplejournal) @?= 5 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1) diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index d1cb3fa17..526b106ec 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -147,6 +147,7 @@ library , pretty-simple >4 && <5 , regex-tdfa , safe >=0.3.20 + , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 3761b4ca9..1db6c3133 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -460,7 +460,7 @@ ensureOneNewlineTerminated = (<>"\n") . T.dropWhileEnd (=='\n') registerFromString :: T.Text -> IO TL.Text registerFromString s = do j <- readJournal' s - return . postingsReportAsText opts $ postingsReport rspec j + return . postingsReportAsText opts $ postingsReport rspec Nothing j where ropts = defreportopts{empty_=True} rspec = defreportspec{_rsReportOpts=ropts} diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 77c89a607..c5788f613 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -49,6 +49,7 @@ registermode = hledgerCommandMode ("fuzzy search for one recent posting with description closest to "++arg) ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead" ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign" + ,flagReq ["sort"] (\s opts -> Right $ setopt "sort" s opts) "FlagHelp" "Help" ,flagReq ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" ("set output width (default: " ++ #ifdef mingw32_HOST_OS @@ -85,7 +86,7 @@ register opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j | otherwise = writeOutputLazyText opts $ render $ styleAmounts styles rpt where styles = journalCommodityStylesWith HardRounding j - rpt = postingsReport rspec j + rpt = postingsReport rspec (Just (getSortSpec rawopts)) j render | fmt=="txt" = postingsReportAsText opts | fmt=="csv" = printCSV . postingsReportAsCsv | fmt=="tsv" = printTSV . postingsReportAsCsv @@ -260,7 +261,7 @@ tests_Register = testGroup "Register" [ testCase "unicode in register layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let rspec = defreportspec - (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j) + (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec Nothing j) @?= unlines ["2009-01-01 медвежья шкура расходы:покупки 100 100" diff --git a/hledger/test/register/sort.test b/hledger/test/register/sort.test new file mode 100644 index 000000000..68701f4a2 --- /dev/null +++ b/hledger/test/register/sort.test @@ -0,0 +1,76 @@ +# * register command with --sort flag + +# ** 1. --sort with non-date sorts by the correct account +< +2024-01-01 Demo + a 1 + b + +2024-01-02 Other + c 1 + a +$ hledger -f - register --sort account +2024-01-01 Demo a 1 1 +2024-01-02 Other a -1 0 +2024-01-01 Demo b -1 -1 +2024-01-02 Other c 1 0 + +# ** 2. --sort with two expressions sorts correctly +< +2024-01-01 Demo + a 1 + b + +2024-01-02 Other + c 1 + a +$ hledger -f - register --sort account,amount +2024-01-02 Other a -1 -1 +2024-01-01 Demo a 1 0 + b -1 -1 +2024-01-02 Other c 1 0 + +# ** 3. --sort with negation reverses +< +2024-01-01 Demo + a 1 + b + +2024-01-02 Other + c 1 + a +$ hledger -f - register --sort -account +2024-01-02 Other c 1 1 +2024-01-01 Demo b -1 0 + a 1 1 +2024-01-02 Other a -1 0 + +# ** 4. --sort with negation and multiple accounts +< +2024-01-01 Demo + a 1 + b + +2024-01-02 Other + c 1 + a +$ hledger -f - register --sort amount,-account +2024-01-01 Demo b -1 -1 +2024-01-02 Other a -1 -2 + c 1 -1 +2024-01-01 Demo a 1 0 + +# ** 5. --sort with date, reversed +< +2024-01-01 Demo + a 1 + b + +2024-01-02 Other + c 1 + a +$ hledger -f - register --sort -date +2024-01-02 Other c 1 1 + a -1 0 +2024-01-01 Demo a 1 1 + b -1 0