From 4609e79f2ceaabd7cc833226d913e73f41c46ad4 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Mon, 1 Mar 2021 22:35:21 +1100 Subject: [PATCH] lib,cli,ui,web: A number of AccountName and Journal functions which are supposed to produce unique sorted use Sets internally to be slightly more efficient. There is also a new function journalCommodities. --- hledger-lib/Hledger/Data/AccountName.hs | 7 ++-- hledger-lib/Hledger/Data/Amount.hs | 8 ++-- hledger-lib/Hledger/Data/Journal.hs | 28 ++++++++----- hledger-lib/Hledger/Read/Common.hs | 7 +--- hledger-lib/Hledger/Reports/BudgetReport.hs | 40 ++++++++----------- .../Hledger/Reports/MultiBalanceReport.hs | 3 +- hledger-ui/Hledger/UI/Main.hs | 30 ++++++-------- hledger-ui/Hledger/UI/UIState.hs | 3 +- hledger-web/Hledger/Web/Widget/AddForm.hs | 5 ++- hledger-web/templates/add-form.hamlet | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 13 +++--- .../Cli/Commands/Check/Uniqueleafnames.hs | 9 ++--- hledger/Hledger/Cli/Commands/Commodities.hs | 10 ++--- hledger/Hledger/Cli/Commands/Payees.hs | 23 ++++++----- 14 files changed, 88 insertions(+), 100 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 32003f5b4..0e6e230b8 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -41,11 +41,12 @@ module Hledger.Data.AccountName ( ) where -import Data.List.Extra (nubSort) +import Data.Foldable (toList) import qualified Data.List.NonEmpty as NE #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..)) @@ -113,7 +114,7 @@ accountNameDrop n a -- ie these plus all their parent accounts up to the root. -- Eg: ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] expandAccountNames :: [AccountName] -> [AccountName] -expandAccountNames as = nubSort $ concatMap expandAccountName as +expandAccountNames = toList . foldMap (S.fromList . expandAccountName) -- | "a:b:c" -> ["a","a:b","a:b:c"] expandAccountName :: AccountName -> [AccountName] @@ -121,7 +122,7 @@ expandAccountName = map accountNameFromComponents . NE.tail . NE.inits . account -- | ["a:b:c","d:e"] -> ["a","d"] topAccountNames :: [AccountName] -> [AccountName] -topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1] +topAccountNames = filter ((1==) . accountNameLevel) . expandAccountNames parentAccountName :: AccountName -> AccountName parentAccountName = accountNameFromComponents . init . accountNameComponents diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index f2bed321b..48eab34d1 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -148,7 +148,7 @@ import Control.Monad (foldM) import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) import Data.Default (Default(..)) import Data.Foldable (toList) -import Data.List (foldl', intercalate, intersperse, mapAccumL, partition) +import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition) import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) @@ -708,10 +708,10 @@ normaliseMixedAmount = normaliseHelper False normaliseHelper :: Bool -> MixedAmount -> MixedAmount normaliseHelper squashprices (Mixed as) | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not - | M.null nonzeros= Mixed [newzero] - | otherwise = Mixed $ toList nonzeros + | M.null nonzeros = Mixed [newzero] + | otherwise = Mixed $ toList nonzeros where - newzero = maybe nullamt snd . M.lookupMin $ M.filter (not . T.null . acommodity) zeros + newzero = fromMaybe nullamt $ find (not . T.null . acommodity) zeros (zeros, nonzeros) = M.partition amountIsZero amtMap amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 78f23103a..b8867166d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -57,6 +57,7 @@ module Hledger.Data.Journal ( journalPayeesUsed, journalPayeesDeclaredOrUsed, journalCommoditiesDeclared, + journalCommodities, journalDateSpan, journalDateSpanBothDates, journalStartDate, @@ -101,6 +102,7 @@ import Control.Monad.ST (ST, runST) import Data.Array.ST (STArray, getElems, newListArray, writeArray) import Data.Char (toUpper, isDigit) import Data.Default (Default(..)) +import Data.Foldable (toList) import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H @@ -277,8 +279,12 @@ journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns -- | Sorted unique commodity symbols declared by commodity directives in this journal. -journalCommoditiesDeclared :: Journal -> [AccountName] -journalCommoditiesDeclared = nubSort . M.keys . jcommodities +journalCommoditiesDeclared :: Journal -> [CommoditySymbol] +journalCommoditiesDeclared = M.keys . jcommodities + +-- | Sorted unique commodity symbols declared or inferred from this journal. +journalCommodities :: Journal -> S.Set CommoditySymbol +journalCommodities j = M.keysSet (jcommodities j) <> M.keysSet (jinferredcommodities j) -- | Unique transaction descriptions used in this journal. journalDescriptions :: Journal -> [Text] @@ -294,7 +300,8 @@ journalPayeesUsed = nubSort . map transactionPayee . jtxns -- | Sorted unique payees used in transactions or declared by payee directives in this journal. journalPayeesDeclaredOrUsed :: Journal -> [Payee] -journalPayeesDeclaredOrUsed j = nubSort $ journalPayeesDeclared j ++ journalPayeesUsed j +journalPayeesDeclaredOrUsed j = toList $ foldMap S.fromList + [journalPayeesDeclared j, journalPayeesUsed j] -- | Sorted unique account names posted to by this journal's transactions. journalAccountNamesUsed :: Journal -> [AccountName] @@ -312,19 +319,21 @@ journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName] -journalAccountNamesDeclaredOrUsed j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesUsed j +journalAccountNamesDeclaredOrUsed j = toList $ foldMap S.fromList + [journalAccountNamesDeclared j, journalAccountNamesUsed j] -- | Sorted unique account names declared by account directives, or posted to -- or implied as parents by transactions in this journal. journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName] -journalAccountNamesDeclaredOrImplied j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesImplied j +journalAccountNamesDeclaredOrImplied j = toList $ foldMap S.fromList + [journalAccountNamesDeclared j, expandAccountNames $ journalAccountNamesUsed j] -- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied. journalAccountNames :: Journal -> [AccountName] journalAccountNames = journalAccountNamesDeclaredOrImplied journalAccountNameTree :: Journal -> Tree AccountName -journalAccountNameTree = accountNameTreeFrom . journalAccountNames +journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied -- | Find up to N most similar and most recent transactions matching -- the given transaction description and query. Transactions are @@ -1087,10 +1096,8 @@ journalCommodityStyles j = -- "the format of the first amount, adjusted to the highest precision of all amounts". -- Can return an error message eg if inconsistent number formats are found. journalInferCommodityStyles :: Journal -> Either String Journal -journalInferCommodityStyles j = - case - commodityStylesFromAmounts $ journalStyleInfluencingAmounts j - of +journalInferCommodityStyles j = + case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of Left e -> Left e Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} @@ -1111,7 +1118,6 @@ commodityStylesFromAmounts = -- | Given a list of amount styles (assumed to be from parsed amounts -- in a single commodity), in parse order, choose a canonical style. canonicalStyleFrom :: [AmountStyle] -> AmountStyle --- canonicalStyleFrom [] = amountstyle canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss -- TODO: should probably detect and report inconsistencies here. diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index fee9e7824..7e0944381 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -151,7 +151,6 @@ import Text.Megaparsec.Custom import Hledger.Data import Hledger.Utils -import Safe (headMay) import Text.Printf (printf) --- ** doctest setup @@ -423,10 +422,8 @@ journalCheckCommoditiesDeclared j = (linesPrepend " " . (<>"\n") . textChomp $ showTransaction t) where mfirstundeclaredcomm = - headMay $ filter (not . (`elem` cs)) $ catMaybes $ - (acommodity . baamount <$> pbalanceassertion) : - (map (Just . acommodity) . filter (/= missingamt) $ amounts pamount) - cs = journalCommoditiesDeclared j + find (`M.notMember` jcommodities j) . map acommodity $ + (maybe id ((:) . baamount) pbalanceassertion) (filter (/= missingamt) $ amounts pamount) setYear :: Year -> JournalParser m () diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 26aa97e82..6942644ec 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -27,21 +27,20 @@ module Hledger.Reports.BudgetReport ( ) where +import Control.Applicative ((<|>)) import Data.Decimal (roundTo) import Data.Default (def) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM -import Data.List (nub, partition, transpose) +import Data.List (find, partition, transpose) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif -import Safe (headDef) ---import Data.List ---import Data.Maybe -import qualified Data.Map as Map import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -83,8 +82,8 @@ budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport showunbudgeted = empty_ ropts budgetedaccts = dbg3 "budgetedacctsinperiod" $ - nub $ - concatMap expandAccountName $ + S.fromList $ + expandAccountNames $ accountNamesFromPostings $ concatMap tpostings $ concatMap (`runPeriodicTransaction` reportspan) $ @@ -130,25 +129,20 @@ journalAddBudgetGoalTransactions assrt _ropts reportspan j = -- with a budget goal, so that only budgeted accounts are shown. -- This can be disabled by -E/--empty. -- -journalWithBudgetAccountNames :: [AccountName] -> Bool -> Journal -> Journal -journalWithBudgetAccountNames budgetedaccts showunbudgeted j = - dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $ +journalWithBudgetAccountNames :: S.Set AccountName -> Bool -> Journal -> Journal +journalWithBudgetAccountNames budgetedaccts showunbudgeted j = + dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $ j { jtxns = remapTxn <$> jtxns j } where - remapTxn = mapPostings (map remapPosting) + remapTxn = txnTieKnot . transactionTransformPostings remapPosting + remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = poriginal p <|> Just p } + remapAccount a + | a `S.member` budgetedaccts = a + | Just p <- budgetedparent = if showunbudgeted then a else p + | otherwise = if showunbudgeted then u <> acctsep <> a else u where - mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } - remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = Just . fromMaybe p $ poriginal p } - where - remapAccount a - | hasbudget = a - | hasbudgetedparent = if showunbudgeted then a else budgetedparent - | otherwise = if showunbudgeted then u <> acctsep <> a else u - where - hasbudget = a `elem` budgetedaccts - hasbudgetedparent = not $ T.null budgetedparent - budgetedparent = headDef "" $ filter (`elem` budgetedaccts) $ parentAccountNames a - u = unbudgetedAccountName + budgetedparent = find (`S.member` budgetedaccts) $ parentAccountNames a + u = unbudgetedAccountName -- | Combine a per-account-and-subperiod report of budget goals, and one -- of actual change amounts, into a budget performance report. diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 5c7ed4a51..589d4a520 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -515,8 +515,7 @@ sortRowsLike sortedas rows = mapMaybe (`HM.lookup` rowMap) sortedas -- those which fork between different branches subaccountTallies :: [AccountName] -> HashMap AccountName Int subaccountTallies = foldr incrementParent mempty . expandAccountNames - where - incrementParent a = HM.insertWith (+) (parentAccountName a) 1 + where incrementParent a = HM.insertWith (+) (parentAccountName a) 1 -- | A helper: what percentage is the second mixed amount of the first ? -- Keeps the sign of the first amount. diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 728c2fbce..b1c76e1f2 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -10,23 +10,17 @@ Released under GPL version 3 or later. module Hledger.UI.Main where --- import Control.Applicative --- import Lens.Micro.Platform ((^.)) import Control.Concurrent (threadDelay) -import Control.Concurrent.Async -import Control.Monad --- import Control.Monad.IO.Class (liftIO) --- import Data.Monoid -- +import Control.Concurrent.Async (withAsync) +import Control.Monad (forM_, void, when) +import Data.List (find) import Data.List.Extra (nubSort) -import Data.Maybe --- import Data.Text (Text) +import Data.Maybe (fromMaybe) import qualified Data.Text as T --- import Data.Time.Calendar import Graphics.Vty (mkVty) -import Safe -import System.Directory -import System.FilePath -import System.FSNotify +import System.Directory (canonicalizePath) +import System.FilePath (takeDirectory) +import System.FSNotify (Event(Modified), isPollingManager, watchDir, withManager) import Brick import qualified Brick.BChan as BC @@ -141,11 +135,11 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp -- to that as usual. Just apat -> (rsSetAccount acct False registerScreen, [ascr']) where - acct = headDef (error' $ "--register "++apat++" did not match any account") -- PARTIAL: - . filterAccts $ journalAccountNames j - filterAccts = case toRegexCI $ T.pack apat of - Right re -> filter (regexMatchText re) - Left _ -> const [] + acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL: + . firstMatch $ journalAccountNamesDeclaredOrImplied j + firstMatch = case toRegexCI $ T.pack apat of + Right re -> find (regexMatchText re) + Left _ -> const Nothing -- Initialising the accounts screen is awkward, requiring -- another temporary UIState value.. ascr' = aScreen $ diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 7e40a3dda..79ed48ad0 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -10,6 +10,7 @@ where import Brick.Widgets.Edit import Data.List ((\\), foldl', sort) import Data.Maybe (fromMaybe) +import Data.Semigroup (Max(..)) import qualified Data.Text as T import Data.Text.Zipper (gotoEOL) import Data.Time.Calendar (Day) @@ -264,7 +265,7 @@ resetDepth = updateReportDepth (const Nothing) -- | Get the maximum account depth in the current journal. maxDepth :: UIState -> Int -maxDepth UIState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames j +maxDepth UIState{ajournal=j} = getMax . foldMap (Max . accountNameLevel) $ journalAccountNamesDeclaredOrImplied j -- | Decrement the current depth limit towards 0. If there was no depth limit, -- set it to one less than the maximum account depth. diff --git a/hledger-web/Hledger/Web/Widget/AddForm.hs b/hledger-web/Hledger/Web/Widget/AddForm.hs index d7e50f53e..d484b4d0e 100644 --- a/hledger-web/Hledger/Web/Widget/AddForm.hs +++ b/hledger-web/Hledger/Web/Widget/AddForm.hs @@ -13,11 +13,13 @@ module Hledger.Web.Widget.AddForm import Control.Monad.State.Strict (evalStateT) import Data.Bifunctor (first) +import Data.Foldable (toList) import Data.List (dropWhileEnd, intercalate, unfoldr) import Data.Maybe (isJust) #if !(MIN_VERSION_base(4,13,0)) import Data.Semigroup ((<>)) #endif +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) @@ -27,7 +29,6 @@ import Yesod import Hledger import Hledger.Web.Settings (widgetFile) -import Data.List.Extra (nubSort) addModal :: ( MonadWidget m @@ -72,7 +73,7 @@ addForm j today = identifyForm "add" $ \extra -> do let (postRes, displayRows) = validatePostings acctRes amtRes -- bindings used in add-form.hamlet - let descriptions = nubSort $ journalPayeesDeclaredOrUsed j ++ journalDescriptions j + let descriptions = foldMap S.fromList [journalPayeesDeclaredOrUsed j, journalDescriptions j] journals = fst <$> jfiles j pure (validateTransaction dateRes descRes postRes, $(widgetFile "add-form")) diff --git a/hledger-web/templates/add-form.hamlet b/hledger-web/templates/add-form.hamlet index 1ad394ecb..60db496f9 100644 --- a/hledger-web/templates/add-form.hamlet +++ b/hledger-web/templates/add-form.hamlet @@ -1,7 +1,7 @@