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

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

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]
+  | M.null nonzeros = Mixed [newzero]
-  | otherwise      = Mixed $ toList nonzeros
+  | 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)

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 :: 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.
 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
@@ -1088,9 +1097,7 @@ journalCommodityStyles j =
 -- Can return an error message eg if inconsistent number formats are found.
 journalInferCommodityStyles :: Journal -> Either String Journal
 journalInferCommodityStyles j =
-  case
+  case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of
-    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.

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 $
+          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 ()

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 $
+      S.fromList $
-      concatMap expandAccountName $
+      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 :: 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 }
+        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
 -- of actual change amounts, into a budget performance report.

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
+  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 ?
 -- Keeps the sign of the first amount.

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.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.Maybe
+import Data.Maybe (fromMaybe)
--- import Data.Text (Text)
 import qualified Data.Text as T
--- import Data.Time.Calendar
 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 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:
+          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
           -- another temporary UIState value..
           ascr' = aScreen $

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.

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

hledger-web/templates/add-form.hamlet

@@ -1,7 +1,7 @@
 <script>
   jQuery(document).ready(function() {
     descriptionsSuggester = new Bloodhound({
-      local:#{toBloodhoundJson descriptions},
+      local:#{toBloodhoundJson (toList descriptions)},
       limit:100,
       datumTokenizer: function(d) { return [d.value]; },
       queryTokenizer: function(q) { return [q]; }

hledger/Hledger/Cli/Commands/Aregister.hs

@@ -19,13 +19,12 @@ module Hledger.Cli.Commands.Aregister (
  ,tests_Aregister
 ) where
 
-import Data.List (intersperse)
+import Data.List (find, intersperse)
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
 import Data.Time (addDays)
-import Safe (headDef)
 import System.Console.CmdArgs.Explicit (flagNone, flagReq)
 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)
   argsquery <- either fail (return . fst) $ parseQueryList d querystring
   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
     inclusive = True  -- tree_ ropts
     thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct

hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs

@@ -9,7 +9,6 @@ where
 
 import Data.Function (on)
 import Data.List (groupBy, sortBy)
-import Data.List.Extra (nubSort)
 import Data.Text (Text)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Semigroup ((<>))
@@ -27,7 +26,7 @@ journalCheckUniqueleafnames j = do
     [] -> Right ()
     dupes ->
       -- 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 leafandfullnames = zip dupLeafs dupAccountNames
@@ -39,10 +38,8 @@ finddupes leafandfullnames = zip dupLeafs dupAccountNames
           . sortBy (compare `on` fst)
 
 journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)]
-journalLeafAndFullAccountNames j = map leafAndAccountName as
+journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUsed
   where leafAndAccountName a = (accountLeafName a, a)
-        ps = journalPostings j
-        as = nubSort $ map paccount ps
 
 checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
 checkposting leafandfullnames Posting{paccount,ptransaction} =

hledger/Hledger/Cli/Commands/Commodities.hs

@@ -12,9 +12,7 @@ module Hledger.Cli.Commands.Commodities (
  ,commodities
 ) 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 Hledger
@@ -30,7 +28,5 @@ commoditiesmode = hledgerCommandMode
   ([], Nothing)
 
 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

hledger/Hledger/Cli/Commands/Payees.hs

@@ -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 TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE CPP #-}
 
 module Hledger.Cli.Commands.Payees (
   payeesmode
  ,payees
 ) 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 System.Console.CmdArgs.Explicit as C
 
@@ -40,10 +43,10 @@ payees CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{rsQuery=query}} j = do
     declared = boolopt "declared" rawopts
     used     = boolopt "used"     rawopts
     -- 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
          | not declared && used     -> matchedusedpayees
-         | otherwise                -> matcheddeclaredpayees ++ matchedusedpayees
+         | otherwise                -> matcheddeclaredpayees <> matchedusedpayees
   mapM_ T.putStrLn payees