diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 88a602bd1..59c7f43a4 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -16,17 +16,15 @@ module Hledger.Reports.PostingsReport ( postingsReport, mkpostingsReportItem, SortSpec, - getSortSpec, -- * Tests tests_PostingsReport ) where -import Data.List (nub, sortBy, sortOn, stripPrefix, isPrefixOf) -import Data.List.Split (splitOn) +import Data.List (nub, sortBy, sortOn) import Data.List.Extra (nubSort) -import Data.Maybe (isJust, isNothing, fromMaybe) +import Data.Maybe (isJust, isNothing) import Data.Ord import Data.Text (Text) import Data.Time.Calendar (Day) @@ -65,44 +63,15 @@ 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 -> Maybe SortSpec -> Journal -> PostingsReport -postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} sortspec j = items +postingsReport :: ReportSpec -> Journal -> PostingsReport +postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} 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 @@ -115,7 +84,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} sortspec j = summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans showempty = empty_ || average_ - sortedps = sortPostings ropts sspec displayps + sortedps = sortPostings ropts sortspec_ displayps -- Posting report items ready for display. items = @@ -273,11 +242,8 @@ 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} sspec journal) @?= n + let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} journal) @?= n -- with the query specified explicitly (Any, nulljournal) `gives` 0 (Any, samplejournal) `gives` 13 @@ -286,10 +252,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 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 + (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 -- (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/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 6f74e486f..1240a2f0e 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -21,6 +21,8 @@ module Hledger.Reports.ReportOptions ( HasReportOpts(..), ReportSpec(..), HasReportSpec(..), + SortField(..), + SortSpec, overEither, setEither, BalanceCalculation(..), @@ -71,7 +73,7 @@ import Data.Char (toLower) import Data.Either (fromRight) import Data.Either.Extra (eitherToMaybe) import Data.Functor.Identity (Identity(..)) -import Data.List.Extra (find, isPrefixOf, nubSort) +import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix) import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) @@ -142,6 +144,8 @@ data ReportOpts = ReportOpts { ,average_ :: Bool -- for posting reports (register) ,related_ :: Bool + -- for sorting reports (register) + ,sortspec_ :: SortSpec -- for account transactions reports (aregister) ,txn_dates_ :: Bool -- for balance reports (bal, bs, cf, is) @@ -197,6 +201,7 @@ defreportopts = ReportOpts , querystring_ = [] , average_ = False , related_ = False + , sortspec_ = [Date' False] -- by default, sort by date in ascending order , txn_dates_ = False , balancecalc_ = def , balanceaccum_ = def @@ -251,6 +256,7 @@ rawOptsToReportOpts d rawopts = ,querystring_ = querystring ,average_ = boolopt "average" rawopts ,related_ = boolopt "related" rawopts + ,sortspec_ = getSortSpec rawopts ,txn_dates_ = boolopt "txn-dates" rawopts ,balancecalc_ = balancecalcopt rawopts ,balanceaccum_ = balanceaccumopt rawopts @@ -663,6 +669,36 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq consIf f b = if b then (f True:) else id consJust f = maybe id ((:) . f) +-- Methods/types needed for --sort argument + +-- Possible arguments 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 SortField + = Date' Bool + | Account' Bool + | Amount' Bool + deriving (Show) +type SortSpec = [SortField] + +-- 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 $ splitAtElement ',' s + termParser t = case trimmed of + "date" -> Date' isNegated + "account" -> Account' isNegated + "amount" -> Amount' isNegated + _ -> error' $ "unsupported field '" ++ t ++ "' given to --sort" + where isNegated = isPrefixOf "-" t + trimmed = fromMaybe t (stripPrefix "-" t) + in map termParser terms + in maybe [Date' False] optParser opt + + -- Report dates. -- | The effective report span is the start and end dates specified by diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 526b106ec..d1cb3fa17 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -147,7 +147,6 @@ 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 1db6c3133..3761b4ca9 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 Nothing j + return . postingsReportAsText opts $ postingsReport rspec 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 c5788f613..5668cfaa5 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -86,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 (Just (getSortSpec rawopts)) j + rpt = postingsReport rspec j render | fmt=="txt" = postingsReportAsText opts | fmt=="csv" = printCSV . postingsReportAsCsv | fmt=="tsv" = printTSV . postingsReportAsCsv @@ -261,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 Nothing j) + (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j) @?= unlines ["2009-01-01 медвежья шкура расходы:покупки 100 100"