slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: register: add --sort as in ledger

Browse Source
This commit is contained in:
Michael Rees 2024-07-15 21:55:13 -05:00 committed by Simon Michael
parent c24c09337c
commit 00eb0aa16b
5 changed files with 147 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

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

1
hledger-lib/hledger-lib.cabal
View File

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

2
hledger/Hledger/Cli/Commands/Add.hs
View File

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

5
hledger/Hledger/Cli/Commands/Register.hs
View File

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

76
hledger/test/register/sort.test Normal file
View File

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