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

lib: Make queryDepth return Maybe Int.

Browse Source
This commit is contained in:
Stephen Morgan 2020-07-16 19:30:18 +10:00 committed by Simon Michael
parent dc076b0d5b
commit 51ea6d9f25
5 changed files with 21 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
hledger-lib/Hledger/Query.hs
View File

@ -64,7 +64,7 @@ import Data.Monoid ((<>))
#endif #endif
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Safe (readDef, maximumByDef, maximumDef, minimumDef) import Safe (readDef, maximumByMay, maximumMay, minimumMay)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
@ -488,33 +488,33 @@ queryDateSpan' _ = nulldatespan
-- | What is the earliest of these dates, where Nothing is earliest ? -- | What is the earliest of these dates, where Nothing is earliest ?
earliestMaybeDate :: [Maybe Day] -> Maybe Day earliestMaybeDate :: [Maybe Day] -> Maybe Day
earliestMaybeDate = minimumDef Nothing earliestMaybeDate = fromMaybe Nothing . minimumMay
-- | What is the latest of these dates, where Nothing is earliest ? -- | What is the latest of these dates, where Nothing is earliest ?
latestMaybeDate :: [Maybe Day] -> Maybe Day latestMaybeDate :: [Maybe Day] -> Maybe Day
latestMaybeDate = maximumDef Nothing latestMaybeDate = fromMaybe Nothing . maximumMay
-- | What is the earliest of these dates, where Nothing is the latest ? -- | What is the earliest of these dates, where Nothing is the latest ?
earliestMaybeDate' :: [Maybe Day] -> Maybe Day earliestMaybeDate' :: [Maybe Day] -> Maybe Day
earliestMaybeDate' = minimumDef Nothing . filter isJust earliestMaybeDate' = fromMaybe Nothing . minimumMay . filter isJust
-- | What is the latest of these dates, where Nothing is the latest ? -- | What is the latest of these dates, where Nothing is the latest ?
latestMaybeDate' :: [Maybe Day] -> Maybe Day latestMaybeDate' :: [Maybe Day] -> Maybe Day
latestMaybeDate' = maximumByDef Nothing compareNothingMax latestMaybeDate' = fromMaybe Nothing . maximumByMay compareNothingMax
where where
compareNothingMax Nothing Nothing = EQ compareNothingMax Nothing Nothing = EQ
compareNothingMax (Just _) Nothing = LT compareNothingMax (Just _) Nothing = LT
compareNothingMax Nothing (Just _) = GT compareNothingMax Nothing (Just _) = GT
compareNothingMax (Just a) (Just b) = compare a b compareNothingMax (Just a) (Just b) = compare a b
-- | The depth limit this query specifies, or a large number if none. -- | The depth limit this query specifies, if it has one
queryDepth :: Query -> Int queryDepth :: Query -> Maybe Int
queryDepth = minimumDef maxBound . queryDepth' queryDepth = minimumMay . queryDepth'
where where
queryDepth' (Depth d) = [d] queryDepth' (Depth d) = [d]
queryDepth' (Or qs) = concatMap queryDepth' qs queryDepth' (Or qs) = concatMap queryDepth' qs
queryDepth' (And qs) = concatMap queryDepth' qs queryDepth' (And qs) = concatMap queryDepth' qs
queryDepth' _ = [] queryDepth' _ = []
-- | The account we are currently focussed on, if any, and whether subaccounts are included. -- | The account we are currently focussed on, if any, and whether subaccounts are included.
-- Just looks at the first query option. -- Just looks at the first query option.

8
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -289,7 +289,7 @@ acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
as = filterAccounts . drop 1 $ accountsFromPostings ps as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts = case accountlistmode_ ropts of filterAccounts = case accountlistmode_ ropts of
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit. ALFlat -> maybe id clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings) filter ((0<) . anumpostings)
depthq = dbg "depthq" $ filterQuery queryIsDepth q depthq = dbg "depthq" $ filterQuery queryIsDepth q
@ -299,8 +299,8 @@ calculateAccountChanges :: ReportOpts -> Query -> [DateSpan]
-> Map DateSpan [Posting] -> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts q colspans colps calculateAccountChanges ropts q colspans colps
| queryDepth q == 0 = acctchanges <> elided | queryDepth q == Just 0 = acctchanges <> elided
| otherwise = acctchanges | otherwise = acctchanges
where where
-- Transpose to get each account's balance changes across all columns. -- Transpose to get each account's balance changes across all columns.
acctchanges = transposeMap colacctchanges acctchanges = transposeMap colacctchanges
@ -461,7 +461,7 @@ displayedAccounts ropts q valuedaccts
tallies = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts tallies = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
isZeroRow balance = all (mixedAmountLooksZero . balance) isZeroRow balance = all (mixedAmountLooksZero . balance)
depth = queryDepth q depth = fromMaybe maxBound $ queryDepth q
-- | Sort the rows by amount or by account declaration order. -- | Sort the rows by amount or by account declaration order.
sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]

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

@ -72,7 +72,7 @@ postingsReport ropts@ReportOpts{..} q j =
where where
reportspan = adjustReportDates ropts q j reportspan = adjustReportDates ropts q j
whichdate = whichDateFromOpts ropts whichdate = whichDateFromOpts ropts
depth = queryDepth q depth = fromMaybe maxBound $ queryDepth q
styles = journalCommodityStyles j styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval

4
hledger-ui/Hledger/UI/Main.hs
View File

@ -92,7 +92,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
reportopts_= ropts{ reportopts_= ropts{
-- incorporate any depth: query args into depth_, -- incorporate any depth: query args into depth_,
-- any date: query args into period_ -- any date: query args into period_
depth_ =depthfromoptsandargs, depth_ =queryDepth q,
period_=periodfromoptsandargs, period_=periodfromoptsandargs,
query_ =unwords -- as in ReportOptions, with same limitations query_ =unwords -- as in ReportOptions, with same limitations
$ collectopts filteredQueryArg (rawopts_ copts), $ collectopts filteredQueryArg (rawopts_ copts),
@ -107,8 +107,6 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
} }
where where
q = queryFromOpts d ropts q = queryFromOpts d ropts
depthfromoptsandargs = case queryDepth q of 99999 -> Nothing
d -> Just d
datespanfromargs = queryDateSpan (date2_ ropts) $ fst $ parseQuery d (T.pack $ query_ ropts) datespanfromargs = queryDateSpan (date2_ ropts) $ fst $ parseQuery d (T.pack $ query_ ropts)
periodfromoptsandargs = periodfromoptsandargs =
dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs] dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs]

8
hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -74,10 +74,10 @@ accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
-- 3. if there's a depth limit, depth-clip and remove any no longer useful items -- 3. if there's a depth limit, depth-clip and remove any no longer useful items
clippedaccts = clippedaccts =
dbg1 "clippedaccts" $ dbg1 "clippedaccts" $
filter (matchesAccount acctq) $ -- clipping can leave accounts that no longer match the query, remove such filter (matchesAccount acctq) $ -- clipping can leave accounts that no longer match the query, remove such
nub $ -- clipping can leave duplicates (adjacent, hopefully) nub $ -- clipping can leave duplicates (adjacent, hopefully)
filter (not . T.null) $ -- depth:0 can leave nulls filter (not . T.null) $ -- depth:0 can leave nulls
map (clipAccountName depth) $ -- clip at depth if specified maybe id (map . clipAccountName) depth $ -- clip at depth if specified
sortedaccts sortedaccts
-- 4. print what remains as a list or tree, maybe applying --drop in the former case -- 4. print what remains as a list or tree, maybe applying --drop in the former case