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.
This commit is contained in:
		
							parent
							
								
									7fe58f1346
								
							
						
					
					
						commit
						4609e79f2c
					
				| @ -41,11 +41,12 @@ module Hledger.Data.AccountName ( | |||||||
| ) | ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
| import Data.List.Extra (nubSort) | import Data.Foldable (toList) | ||||||
| import qualified Data.List.NonEmpty as NE | import qualified Data.List.NonEmpty as NE | ||||||
| #if !(MIN_VERSION_base(4,11,0)) | #if !(MIN_VERSION_base(4,11,0)) | ||||||
| import Data.Semigroup ((<>)) | import Data.Semigroup ((<>)) | ||||||
| #endif | #endif | ||||||
|  | import qualified Data.Set as S | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Tree (Tree(..)) | import Data.Tree (Tree(..)) | ||||||
| @ -113,7 +114,7 @@ accountNameDrop n a | |||||||
| -- ie these plus all their parent accounts up to the root. | -- 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"] | -- Eg: ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] | ||||||
| expandAccountNames :: [AccountName] -> [AccountName] | expandAccountNames :: [AccountName] -> [AccountName] | ||||||
| expandAccountNames as = nubSort $ concatMap expandAccountName as | expandAccountNames = toList . foldMap (S.fromList . expandAccountName) | ||||||
| 
 | 
 | ||||||
| -- | "a:b:c" -> ["a","a:b","a:b:c"] | -- | "a:b:c" -> ["a","a:b","a:b:c"] | ||||||
| expandAccountName :: AccountName -> [AccountName] | expandAccountName :: AccountName -> [AccountName] | ||||||
| @ -121,7 +122,7 @@ expandAccountName = map accountNameFromComponents . NE.tail . NE.inits . account | |||||||
| 
 | 
 | ||||||
| -- | ["a:b:c","d:e"] -> ["a","d"] | -- | ["a:b:c","d:e"] -> ["a","d"] | ||||||
| topAccountNames :: [AccountName] -> [AccountName] | topAccountNames :: [AccountName] -> [AccountName] | ||||||
| topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1] | topAccountNames = filter ((1==) . accountNameLevel) . expandAccountNames | ||||||
| 
 | 
 | ||||||
| parentAccountName :: AccountName -> AccountName | parentAccountName :: AccountName -> AccountName | ||||||
| parentAccountName = accountNameFromComponents . init . accountNameComponents | parentAccountName = accountNameFromComponents . init . accountNameComponents | ||||||
|  | |||||||
| @ -148,7 +148,7 @@ import Control.Monad (foldM) | |||||||
| import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) | import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) | ||||||
| import Data.Default (Default(..)) | import Data.Default (Default(..)) | ||||||
| import Data.Foldable (toList) | 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 Data.List.NonEmpty (NonEmpty(..), nonEmpty) | ||||||
| import qualified Data.Map.Strict as M | import qualified Data.Map.Strict as M | ||||||
| import Data.Maybe (fromMaybe) | import Data.Maybe (fromMaybe) | ||||||
| @ -708,10 +708,10 @@ normaliseMixedAmount = normaliseHelper False | |||||||
| normaliseHelper :: Bool -> MixedAmount -> MixedAmount | normaliseHelper :: Bool -> MixedAmount -> MixedAmount | ||||||
| normaliseHelper squashprices (Mixed as) | normaliseHelper squashprices (Mixed as) | ||||||
|   | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not |   | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not | ||||||
|   | M.null nonzeros= Mixed [newzero] |   | M.null nonzeros = Mixed [newzero] | ||||||
|   | otherwise      = Mixed $ toList nonzeros |   | otherwise       = Mixed $ toList nonzeros | ||||||
|   where |   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 |     (zeros, nonzeros) = M.partition amountIsZero amtMap | ||||||
|     amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as |     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) |     key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p) | ||||||
|  | |||||||
| @ -57,6 +57,7 @@ module Hledger.Data.Journal ( | |||||||
|   journalPayeesUsed, |   journalPayeesUsed, | ||||||
|   journalPayeesDeclaredOrUsed, |   journalPayeesDeclaredOrUsed, | ||||||
|   journalCommoditiesDeclared, |   journalCommoditiesDeclared, | ||||||
|  |   journalCommodities, | ||||||
|   journalDateSpan, |   journalDateSpan, | ||||||
|   journalDateSpanBothDates, |   journalDateSpanBothDates, | ||||||
|   journalStartDate, |   journalStartDate, | ||||||
| @ -101,6 +102,7 @@ import Control.Monad.ST (ST, runST) | |||||||
| import Data.Array.ST (STArray, getElems, newListArray, writeArray) | import Data.Array.ST (STArray, getElems, newListArray, writeArray) | ||||||
| import Data.Char (toUpper, isDigit) | import Data.Char (toUpper, isDigit) | ||||||
| import Data.Default (Default(..)) | import Data.Default (Default(..)) | ||||||
|  | import Data.Foldable (toList) | ||||||
| import Data.Function ((&)) | import Data.Function ((&)) | ||||||
| import qualified Data.HashTable.Class as H (toList) | import qualified Data.HashTable.Class as H (toList) | ||||||
| import qualified Data.HashTable.ST.Cuckoo as H | import qualified Data.HashTable.ST.Cuckoo as H | ||||||
| @ -277,8 +279,12 @@ journalPostings :: Journal -> [Posting] | |||||||
| journalPostings = concatMap tpostings . jtxns | journalPostings = concatMap tpostings . jtxns | ||||||
| 
 | 
 | ||||||
| -- | Sorted unique commodity symbols declared by commodity directives in this journal. | -- | Sorted unique commodity symbols declared by commodity directives in this journal. | ||||||
| journalCommoditiesDeclared :: Journal -> [AccountName] | journalCommoditiesDeclared :: Journal -> [CommoditySymbol] | ||||||
| journalCommoditiesDeclared = nubSort . M.keys . jcommodities | 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. | -- | Unique transaction descriptions used in this journal. | ||||||
| journalDescriptions :: Journal -> [Text] | 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. | -- | Sorted unique payees used in transactions or declared by payee directives in this journal. | ||||||
| journalPayeesDeclaredOrUsed :: Journal -> [Payee] | 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. | -- | Sorted unique account names posted to by this journal's transactions. | ||||||
| journalAccountNamesUsed :: Journal -> [AccountName] | journalAccountNamesUsed :: Journal -> [AccountName] | ||||||
| @ -312,19 +319,21 @@ journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts | |||||||
| -- | Sorted unique account names declared by account directives or posted to | -- | Sorted unique account names declared by account directives or posted to | ||||||
| -- by transactions in this journal. | -- by transactions in this journal. | ||||||
| journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName] | 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 | -- | Sorted unique account names declared by account directives, or posted to | ||||||
| -- or implied as parents by transactions in this journal. | -- or implied as parents by transactions in this journal. | ||||||
| journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName] | 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. | -- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied. | ||||||
| journalAccountNames :: Journal -> [AccountName] | journalAccountNames :: Journal -> [AccountName] | ||||||
| journalAccountNames = journalAccountNamesDeclaredOrImplied | journalAccountNames = journalAccountNamesDeclaredOrImplied | ||||||
| 
 | 
 | ||||||
| journalAccountNameTree :: Journal -> Tree AccountName | journalAccountNameTree :: Journal -> Tree AccountName | ||||||
| journalAccountNameTree = accountNameTreeFrom . journalAccountNames | journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied | ||||||
| 
 | 
 | ||||||
| -- | Find up to N most similar and most recent transactions matching | -- | Find up to N most similar and most recent transactions matching | ||||||
| -- the given transaction description and query. Transactions are | -- 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". | -- "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. | -- Can return an error message eg if inconsistent number formats are found. | ||||||
| journalInferCommodityStyles :: Journal -> Either String Journal | journalInferCommodityStyles :: Journal -> Either String Journal | ||||||
| journalInferCommodityStyles j =  | journalInferCommodityStyles j = | ||||||
|   case |   case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of | ||||||
|     commodityStylesFromAmounts $ journalStyleInfluencingAmounts j |  | ||||||
|   of |  | ||||||
|     Left e   -> Left e |     Left e   -> Left e | ||||||
|     Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} |     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 | -- | Given a list of amount styles (assumed to be from parsed amounts | ||||||
| -- in a single commodity), in parse order, choose a canonical style. | -- in a single commodity), in parse order, choose a canonical style. | ||||||
| canonicalStyleFrom :: [AmountStyle] -> AmountStyle | canonicalStyleFrom :: [AmountStyle] -> AmountStyle | ||||||
| -- canonicalStyleFrom [] = amountstyle |  | ||||||
| canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss | canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss | ||||||
| 
 | 
 | ||||||
| -- TODO: should probably detect and report inconsistencies here. | -- TODO: should probably detect and report inconsistencies here. | ||||||
|  | |||||||
| @ -151,7 +151,6 @@ import Text.Megaparsec.Custom | |||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Safe (headMay) |  | ||||||
| import Text.Printf (printf) | import Text.Printf (printf) | ||||||
| 
 | 
 | ||||||
| --- ** doctest setup | --- ** doctest setup | ||||||
| @ -423,10 +422,8 @@ journalCheckCommoditiesDeclared j = | |||||||
|                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) |                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) | ||||||
|       where |       where | ||||||
|         mfirstundeclaredcomm = |         mfirstundeclaredcomm = | ||||||
|           headMay $ filter (not . (`elem` cs)) $ catMaybes $ |           find (`M.notMember` jcommodities j) . map acommodity $ | ||||||
|           (acommodity . baamount <$> pbalanceassertion) : |           (maybe id ((:) . baamount) pbalanceassertion) (filter (/= missingamt) $ amounts pamount) | ||||||
|           (map (Just . acommodity) . filter (/= missingamt) $ amounts pamount) |  | ||||||
|         cs = journalCommoditiesDeclared j |  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| setYear :: Year -> JournalParser m () | setYear :: Year -> JournalParser m () | ||||||
|  | |||||||
| @ -27,21 +27,20 @@ module Hledger.Reports.BudgetReport ( | |||||||
| ) | ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
|  | import Control.Applicative ((<|>)) | ||||||
| import Data.Decimal (roundTo) | import Data.Decimal (roundTo) | ||||||
| import Data.Default (def) | import Data.Default (def) | ||||||
| import Data.HashMap.Strict (HashMap) | import Data.HashMap.Strict (HashMap) | ||||||
| import qualified Data.HashMap.Strict as HM | 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.List.Extra (nubSort) | ||||||
| import Data.Maybe (fromMaybe) | import Data.Maybe (fromMaybe) | ||||||
| #if !(MIN_VERSION_base(4,11,0)) | #if !(MIN_VERSION_base(4,11,0)) | ||||||
| import Data.Monoid ((<>)) | import Data.Monoid ((<>)) | ||||||
| #endif | #endif | ||||||
| import Safe (headDef) |  | ||||||
| --import Data.List |  | ||||||
| --import Data.Maybe |  | ||||||
| import qualified Data.Map as Map |  | ||||||
| import Data.Map (Map) | import Data.Map (Map) | ||||||
|  | import qualified Data.Map as Map | ||||||
|  | import qualified Data.Set as S | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import qualified Data.Text.Lazy as TL | import qualified Data.Text.Lazy as TL | ||||||
| @ -83,8 +82,8 @@ budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport | |||||||
|     showunbudgeted = empty_ ropts |     showunbudgeted = empty_ ropts | ||||||
|     budgetedaccts = |     budgetedaccts = | ||||||
|       dbg3 "budgetedacctsinperiod" $ |       dbg3 "budgetedacctsinperiod" $ | ||||||
|       nub $ |       S.fromList $ | ||||||
|       concatMap expandAccountName $ |       expandAccountNames $ | ||||||
|       accountNamesFromPostings $ |       accountNamesFromPostings $ | ||||||
|       concatMap tpostings $ |       concatMap tpostings $ | ||||||
|       concatMap (`runPeriodicTransaction` reportspan) $ |       concatMap (`runPeriodicTransaction` reportspan) $ | ||||||
| @ -130,25 +129,20 @@ journalAddBudgetGoalTransactions assrt _ropts reportspan j = | |||||||
| --    with a budget goal, so that only budgeted accounts are shown. | --    with a budget goal, so that only budgeted accounts are shown. | ||||||
| --    This can be disabled by -E/--empty. | --    This can be disabled by -E/--empty. | ||||||
| -- | -- | ||||||
| journalWithBudgetAccountNames :: [AccountName] -> Bool -> Journal -> Journal | journalWithBudgetAccountNames :: S.Set AccountName -> Bool -> Journal -> Journal | ||||||
| journalWithBudgetAccountNames budgetedaccts showunbudgeted j =  | journalWithBudgetAccountNames budgetedaccts showunbudgeted j = | ||||||
|   dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $  |   dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $ | ||||||
|   j { jtxns = remapTxn <$> jtxns j } |   j { jtxns = remapTxn <$> jtxns j } | ||||||
|   where |   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 |       where | ||||||
|         mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } |         budgetedparent = find (`S.member` budgetedaccts) $ parentAccountNames a | ||||||
|         remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = Just . fromMaybe p $ poriginal p } |         u = unbudgetedAccountName | ||||||
|           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 |  | ||||||
| 
 | 
 | ||||||
| -- | Combine a per-account-and-subperiod report of budget goals, and one | -- | Combine a per-account-and-subperiod report of budget goals, and one | ||||||
| -- of actual change amounts, into a budget performance report. | -- of actual change amounts, into a budget performance report. | ||||||
|  | |||||||
| @ -515,8 +515,7 @@ sortRowsLike sortedas rows = mapMaybe (`HM.lookup` rowMap) sortedas | |||||||
| -- those which fork between different branches | -- those which fork between different branches | ||||||
| subaccountTallies :: [AccountName] -> HashMap AccountName Int | subaccountTallies :: [AccountName] -> HashMap AccountName Int | ||||||
| subaccountTallies = foldr incrementParent mempty . expandAccountNames | subaccountTallies = foldr incrementParent mempty . expandAccountNames | ||||||
|   where |   where incrementParent a = HM.insertWith (+) (parentAccountName a) 1 | ||||||
|     incrementParent a = HM.insertWith (+) (parentAccountName a) 1 |  | ||||||
| 
 | 
 | ||||||
| -- | A helper: what percentage is the second mixed amount of the first ? | -- | A helper: what percentage is the second mixed amount of the first ? | ||||||
| -- Keeps the sign of the first amount. | -- Keeps the sign of the first amount. | ||||||
|  | |||||||
| @ -10,23 +10,17 @@ Released under GPL version 3 or later. | |||||||
| 
 | 
 | ||||||
| module Hledger.UI.Main where | module Hledger.UI.Main where | ||||||
| 
 | 
 | ||||||
| -- import Control.Applicative |  | ||||||
| -- import Lens.Micro.Platform ((^.)) |  | ||||||
| import Control.Concurrent (threadDelay) | import Control.Concurrent (threadDelay) | ||||||
| import Control.Concurrent.Async | import Control.Concurrent.Async (withAsync) | ||||||
| import Control.Monad | import Control.Monad (forM_, void, when) | ||||||
| -- import Control.Monad.IO.Class (liftIO) | import Data.List (find) | ||||||
| -- import Data.Monoid              -- |  | ||||||
| import Data.List.Extra (nubSort) | import Data.List.Extra (nubSort) | ||||||
| import Data.Maybe | import Data.Maybe (fromMaybe) | ||||||
| -- import Data.Text (Text) |  | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| -- import Data.Time.Calendar |  | ||||||
| import Graphics.Vty (mkVty) | import Graphics.Vty (mkVty) | ||||||
| import Safe | import System.Directory (canonicalizePath) | ||||||
| import System.Directory | import System.FilePath (takeDirectory) | ||||||
| import System.FilePath | import System.FSNotify (Event(Modified), isPollingManager, watchDir, withManager) | ||||||
| import System.FSNotify |  | ||||||
| import Brick | import Brick | ||||||
| 
 | 
 | ||||||
| import qualified Brick.BChan as BC | import qualified Brick.BChan as BC | ||||||
| @ -141,11 +135,11 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp | |||||||
|       -- to that as usual. |       -- to that as usual. | ||||||
|       Just apat -> (rsSetAccount acct False registerScreen, [ascr']) |       Just apat -> (rsSetAccount acct False registerScreen, [ascr']) | ||||||
|         where |         where | ||||||
|           acct = headDef (error' $ "--register "++apat++" did not match any account")  -- PARTIAL: |           acct = fromMaybe (error' $ "--register "++apat++" did not match any account")  -- PARTIAL: | ||||||
|                  . filterAccts $ journalAccountNames j |                  . firstMatch $ journalAccountNamesDeclaredOrImplied j | ||||||
|           filterAccts = case toRegexCI $ T.pack apat of |           firstMatch = case toRegexCI $ T.pack apat of | ||||||
|               Right re -> filter (regexMatchText re) |               Right re -> find (regexMatchText re) | ||||||
|               Left  _  -> const [] |               Left  _  -> const Nothing | ||||||
|           -- Initialising the accounts screen is awkward, requiring |           -- Initialising the accounts screen is awkward, requiring | ||||||
|           -- another temporary UIState value.. |           -- another temporary UIState value.. | ||||||
|           ascr' = aScreen $ |           ascr' = aScreen $ | ||||||
|  | |||||||
| @ -10,6 +10,7 @@ where | |||||||
| import Brick.Widgets.Edit | import Brick.Widgets.Edit | ||||||
| import Data.List ((\\), foldl', sort) | import Data.List ((\\), foldl', sort) | ||||||
| import Data.Maybe (fromMaybe) | import Data.Maybe (fromMaybe) | ||||||
|  | import Data.Semigroup (Max(..)) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Text.Zipper (gotoEOL) | import Data.Text.Zipper (gotoEOL) | ||||||
| import Data.Time.Calendar (Day) | import Data.Time.Calendar (Day) | ||||||
| @ -264,7 +265,7 @@ resetDepth = updateReportDepth (const Nothing) | |||||||
| 
 | 
 | ||||||
| -- | Get the maximum account depth in the current journal. | -- | Get the maximum account depth in the current journal. | ||||||
| maxDepth :: UIState -> Int | 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, | -- | Decrement the current depth limit towards 0. If there was no depth limit, | ||||||
| -- set it to one less than the maximum account depth. | -- set it to one less than the maximum account depth. | ||||||
|  | |||||||
| @ -13,11 +13,13 @@ module Hledger.Web.Widget.AddForm | |||||||
| 
 | 
 | ||||||
| import Control.Monad.State.Strict (evalStateT) | import Control.Monad.State.Strict (evalStateT) | ||||||
| import Data.Bifunctor (first) | import Data.Bifunctor (first) | ||||||
|  | import Data.Foldable (toList) | ||||||
| import Data.List (dropWhileEnd, intercalate, unfoldr) | import Data.List (dropWhileEnd, intercalate, unfoldr) | ||||||
| import Data.Maybe (isJust) | import Data.Maybe (isJust) | ||||||
| #if !(MIN_VERSION_base(4,13,0)) | #if !(MIN_VERSION_base(4,13,0)) | ||||||
| import Data.Semigroup ((<>)) | import Data.Semigroup ((<>)) | ||||||
| #endif | #endif | ||||||
|  | import qualified Data.Set as S | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time (Day) | import Data.Time (Day) | ||||||
| @ -27,7 +29,6 @@ import Yesod | |||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
| import Hledger.Web.Settings (widgetFile) | import Hledger.Web.Settings (widgetFile) | ||||||
| import Data.List.Extra (nubSort) |  | ||||||
| 
 | 
 | ||||||
| addModal :: | addModal :: | ||||||
|      ( MonadWidget m |      ( MonadWidget m | ||||||
| @ -72,7 +73,7 @@ addForm j today = identifyForm "add" $ \extra -> do | |||||||
|   let (postRes, displayRows) = validatePostings acctRes amtRes |   let (postRes, displayRows) = validatePostings acctRes amtRes | ||||||
| 
 | 
 | ||||||
|   -- bindings used in add-form.hamlet |   -- 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 |       journals = fst <$> jfiles j | ||||||
| 
 | 
 | ||||||
|   pure (validateTransaction dateRes descRes postRes, $(widgetFile "add-form")) |   pure (validateTransaction dateRes descRes postRes, $(widgetFile "add-form")) | ||||||
|  | |||||||
| @ -1,7 +1,7 @@ | |||||||
| <script> | <script> | ||||||
|   jQuery(document).ready(function() { |   jQuery(document).ready(function() { | ||||||
|     descriptionsSuggester = new Bloodhound({ |     descriptionsSuggester = new Bloodhound({ | ||||||
|       local:#{toBloodhoundJson descriptions}, |       local:#{toBloodhoundJson (toList descriptions)}, | ||||||
|       limit:100, |       limit:100, | ||||||
|       datumTokenizer: function(d) { return [d.value]; }, |       datumTokenizer: function(d) { return [d.value]; }, | ||||||
|       queryTokenizer: function(q) { return [q]; } |       queryTokenizer: function(q) { return [q]; } | ||||||
|  | |||||||
| @ -19,13 +19,12 @@ module Hledger.Cli.Commands.Aregister ( | |||||||
|  ,tests_Aregister |  ,tests_Aregister | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Data.List (intersperse) | import Data.List (find, intersperse) | ||||||
| import Data.Maybe (fromMaybe, isJust) | import Data.Maybe (fromMaybe, isJust) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import qualified Data.Text.Lazy as TL | import qualified Data.Text.Lazy as TL | ||||||
| import qualified Data.Text.Lazy.Builder as TB | import qualified Data.Text.Lazy.Builder as TB | ||||||
| import Data.Time (addDays) | import Data.Time (addDays) | ||||||
| import Safe (headDef) |  | ||||||
| import System.Console.CmdArgs.Explicit (flagNone, flagReq) | import System.Console.CmdArgs.Explicit (flagNone, flagReq) | ||||||
| import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) | import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) | ||||||
| 
 | 
 | ||||||
| @ -75,11 +74,11 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do | |||||||
|       (a:as) -> return (a, map T.pack as) |       (a:as) -> return (a, map T.pack as) | ||||||
|   argsquery <- either fail (return . fst) $ parseQueryList d querystring |   argsquery <- either fail (return . fst) $ parseQueryList d querystring | ||||||
|   let |   let | ||||||
|     acct = headDef (error' $ show apat++" did not match any account")   -- PARTIAL: |     acct = fromMaybe (error' $ show apat++" did not match any account")   -- PARTIAL: | ||||||
|            . filterAccts $ journalAccountNames j |            . firstMatch $ journalAccountNamesDeclaredOrImplied j | ||||||
|     filterAccts = case toRegexCI $ T.pack apat of |     firstMatch = case toRegexCI $ T.pack apat of | ||||||
|         Right re -> filter (regexMatchText re) |         Right re -> find (regexMatchText re) | ||||||
|         Left  _  -> const [] |         Left  _  -> const Nothing | ||||||
|     -- gather report options |     -- gather report options | ||||||
|     inclusive = True  -- tree_ ropts |     inclusive = True  -- tree_ ropts | ||||||
|     thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct |     thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct | ||||||
|  | |||||||
| @ -9,7 +9,6 @@ where | |||||||
| 
 | 
 | ||||||
| import Data.Function (on) | import Data.Function (on) | ||||||
| import Data.List (groupBy, sortBy) | import Data.List (groupBy, sortBy) | ||||||
| import Data.List.Extra (nubSort) |  | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| #if !(MIN_VERSION_base(4,11,0)) | #if !(MIN_VERSION_base(4,11,0)) | ||||||
| import Data.Semigroup ((<>)) | import Data.Semigroup ((<>)) | ||||||
| @ -25,9 +24,9 @@ journalCheckUniqueleafnames j = do | |||||||
|   -- find all duplicate leafnames, and the full account names they appear in |   -- find all duplicate leafnames, and the full account names they appear in | ||||||
|   case finddupes $ journalLeafAndFullAccountNames j of |   case finddupes $ journalLeafAndFullAccountNames j of | ||||||
|     [] -> Right () |     [] -> Right () | ||||||
|     dupes ->  |     dupes -> | ||||||
|       -- report the first posting that references one of them (and its position), for now |       -- report the first posting that references one of them (and its position), for now | ||||||
|       sequence_ $ map (checkposting dupes) $ journalPostings j |       mapM_ (checkposting dupes) $ journalPostings j | ||||||
| 
 | 
 | ||||||
| finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])] | finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])] | ||||||
| finddupes leafandfullnames = zip dupLeafs dupAccountNames | finddupes leafandfullnames = zip dupLeafs dupAccountNames | ||||||
| @ -39,10 +38,8 @@ finddupes leafandfullnames = zip dupLeafs dupAccountNames | |||||||
|           . sortBy (compare `on` fst) |           . sortBy (compare `on` fst) | ||||||
| 
 | 
 | ||||||
| journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)] | journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)] | ||||||
| journalLeafAndFullAccountNames j = map leafAndAccountName as | journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUsed | ||||||
|   where leafAndAccountName a = (accountLeafName a, a) |   where leafAndAccountName a = (accountLeafName a, a) | ||||||
|         ps = journalPostings j |  | ||||||
|         as = nubSort $ map paccount ps |  | ||||||
| 
 | 
 | ||||||
| checkposting :: [(Text,[AccountName])] -> Posting -> Either String () | checkposting :: [(Text,[AccountName])] -> Posting -> Either String () | ||||||
| checkposting leafandfullnames Posting{paccount,ptransaction} = | checkposting leafandfullnames Posting{paccount,ptransaction} = | ||||||
|  | |||||||
| @ -12,9 +12,7 @@ module Hledger.Cli.Commands.Commodities ( | |||||||
|  ,commodities |  ,commodities | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Control.Monad | import qualified Data.Set as S | ||||||
| import Data.List.Extra (nubSort) |  | ||||||
| import qualified Data.Map as M |  | ||||||
| import qualified Data.Text.IO as T | import qualified Data.Text.IO as T | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
| @ -30,7 +28,5 @@ commoditiesmode = hledgerCommandMode | |||||||
|   ([], Nothing) |   ([], Nothing) | ||||||
| 
 | 
 | ||||||
| commodities :: CliOpts -> Journal -> IO () | commodities :: CliOpts -> Journal -> IO () | ||||||
| commodities _copts j = do | commodities _copts = | ||||||
|   let cs = filter (/= "AUTO") $ |   mapM_ T.putStrLn . S.filter (/= "AUTO") . journalCommodities | ||||||
|            nubSort $ M.keys (jcommodities j) ++ M.keys (jinferredcommodities j) |  | ||||||
|   forM_ cs T.putStrLn |  | ||||||
|  | |||||||
| @ -4,18 +4,21 @@ The @payees@ command lists all unique payees (description part before a |) seen | |||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| {-# LANGUAGE MultiWayIf #-} | {-# LANGUAGE CPP                 #-} | ||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE MultiWayIf          #-} | ||||||
|  | {-# LANGUAGE OverloadedStrings   #-} | ||||||
| {-# LANGUAGE ScopedTypeVariables #-} | {-# LANGUAGE ScopedTypeVariables #-} | ||||||
| {-# LANGUAGE TemplateHaskell #-} | {-# LANGUAGE TemplateHaskell     #-} | ||||||
| {-# LANGUAGE CPP #-} |  | ||||||
| 
 | 
 | ||||||
| module Hledger.Cli.Commands.Payees ( | module Hledger.Cli.Commands.Payees ( | ||||||
|   payeesmode |   payeesmode | ||||||
|  ,payees |  ,payees | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Data.List.Extra (nubSort) | #if !(MIN_VERSION_base(4,11,0)) | ||||||
|  | import Data.Semigroup ((<>)) | ||||||
|  | #endif | ||||||
|  | import qualified Data.Set as S | ||||||
| import qualified Data.Text.IO as T | import qualified Data.Text.IO as T | ||||||
| import System.Console.CmdArgs.Explicit as C | import System.Console.CmdArgs.Explicit as C | ||||||
| 
 | 
 | ||||||
| @ -36,14 +39,14 @@ payeesmode = hledgerCommandMode | |||||||
| -- | The payees command. | -- | The payees command. | ||||||
| payees :: CliOpts -> Journal -> IO () | payees :: CliOpts -> Journal -> IO () | ||||||
| payees CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{rsQuery=query}} j = do | payees CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{rsQuery=query}} j = do | ||||||
|   let  |   let | ||||||
|     declared = boolopt "declared" rawopts |     declared = boolopt "declared" rawopts | ||||||
|     used     = boolopt "used"     rawopts |     used     = boolopt "used"     rawopts | ||||||
|     -- XXX matchesPayee is currently an alias for matchesDescription, not sure if it matters |     -- XXX matchesPayee is currently an alias for matchesDescription, not sure if it matters | ||||||
|     matcheddeclaredpayees = filter (matchesPayeeWIP query) $ journalPayeesDeclared j |     matcheddeclaredpayees = S.fromList . filter (matchesPayeeWIP query) $ journalPayeesDeclared j | ||||||
|     matchedusedpayees     = map transactionPayee $ filter (matchesTransaction query) $ jtxns j |     matchedusedpayees     = S.fromList . map transactionPayee $ filter (matchesTransaction query) $ jtxns j | ||||||
|     payees = nubSort $ |     payees = | ||||||
|       if | declared     && not used -> matcheddeclaredpayees |       if | declared     && not used -> matcheddeclaredpayees | ||||||
|          | not declared && used     -> matchedusedpayees |          | not declared && used     -> matchedusedpayees | ||||||
|          | otherwise                -> matcheddeclaredpayees ++ matchedusedpayees |          | otherwise                -> matcheddeclaredpayees <> matchedusedpayees | ||||||
|   mapM_ T.putStrLn payees |   mapM_ T.putStrLn payees | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user