feat: register: add --sort as in ledger

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 :: ReportSpec -> Maybe SortSpec -> Journal -> PostingsReport
-postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
+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 sspec samplejournal) @?= 13
-    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
+    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} sspec samplejournal) @?= 11
-    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
+    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} sspec samplejournal) @?= 20
-    (length $ postingsReport defreportspec{_rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
+    (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)

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

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}

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"

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