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

lib,cli,ui,web: Make Regexp a wrapper for Regex.

Browse Source
This commit is contained in:
Stephen Morgan 2020-08-15 19:14:27 +10:00
parent ccd6fdd7b9
commit e5371d5a6a
25 changed files with 389 additions and 440 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
hledger-lib/Hledger/Data/Account.hs
View File

@ -14,7 +14,7 @@ import Data.List.Extra (groupSort, groupOn)
import Data.Maybe (fromMaybe)
import Data.Ord (Down(..))
import qualified Data.Map as M
import Data.Text (pack,unpack)
import qualified Data.Text as T
import Safe (headMay, lookupJustDef)
import Text.Printf
@ -28,11 +28,12 @@ import Hledger.Utils
-- deriving instance Show Account
instance Show Account where
show Account{..} = printf "Account %s (boring:%s, postings:%d, ebalance:%s, ibalance:%s)"
(pack $ regexReplace ":" "_" $ unpack aname) -- hide : so pretty-show doesn't break line
(T.map colonToUnderscore aname) -- hide : so pretty-show doesn't break line
(if aboring then "y" else "n" :: String)
anumpostings
(showMixedAmount aebalance)
(showMixedAmount aibalance)
where colonToUnderscore x = if x == ':' then '_' else x
instance Eq Account where
(==) a b = aname a == aname b -- quick equality test for speed

16
hledger-lib/Hledger/Data/AccountName.hs
View File

@ -18,7 +18,6 @@ module Hledger.Data.AccountName (
,accountNameToAccountOnlyRegex
,accountNameToAccountRegex
,accountNameTreeFrom
,accountRegexToAccountName
,accountSummarisedName
,acctsep
,acctsepchar
@ -48,7 +47,6 @@ import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tree
import Text.Printf
import Hledger.Data.Types
import Hledger.Utils
@ -210,23 +208,17 @@ clipOrEllipsifyAccountName n = clipAccountName n
-- | Escape an AccountName for use within a regular expression.
-- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
-- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
escapeName :: AccountName -> Regexp
escapeName = regexReplaceBy "[[?+|()*\\\\^$]" ("\\" <>)
escapeName :: AccountName -> String
escapeName = replaceAllBy (toRegex' "[[?+|()*\\\\^$]") ("\\" <>) -- PARTIAL: should not happen
. T.unpack
-- | Convert an account name to a regular expression matching it and its subaccounts.
accountNameToAccountRegex :: AccountName -> Regexp
accountNameToAccountRegex "" = ""
accountNameToAccountRegex a = printf "^%s(:|$)" (escapeName a)
accountNameToAccountRegex a = toRegex' $ '^' : escapeName a ++ "(:|$)" -- PARTIAL: Is this safe after escapeName?
-- | Convert an account name to a regular expression matching it but not its subaccounts.
accountNameToAccountOnlyRegex :: AccountName -> Regexp
accountNameToAccountOnlyRegex "" = ""
accountNameToAccountOnlyRegex a = printf "^%s$" $ escapeName a -- XXX pack
-- | Convert an exact account-matching regular expression to a plain account name.
accountRegexToAccountName :: Regexp -> AccountName
accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" -- XXX pack
accountNameToAccountOnlyRegex a = toRegex' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?
-- -- | Does this string look like an exact account-matching regular expression ?
--isAccountRegex :: String -> Bool

51
hledger-lib/Hledger/Data/Journal.hs
View File

@ -74,7 +74,6 @@ module Hledger.Data.Journal (
journalCashAccountQuery,
-- * Misc
canonicalStyleFrom,
matchpats,
nulljournal,
journalCheckBalanceAssertions,
journalNumberAndTieTransactions,
@ -301,7 +300,7 @@ journalAccountNameTree = accountNameTreeFrom . journalAccountNames
-- or otherwise for accounts with names matched by the case-insensitive
-- regular expression @^assets?(:|$)@.
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery j = journalAccountTypeQuery [Asset,Cash] "^assets?(:|$)" j
journalAssetAccountQuery = journalAccountTypeQuery [Asset,Cash] (toRegex' "^assets?(:|$)")
-- | A query for "Cash" (liquid asset) accounts in this journal, ie accounts
-- declared as Cash by account directives, or otherwise with names matched by the
@ -310,43 +309,41 @@ journalAssetAccountQuery j = journalAccountTypeQuery [Asset,Cash] "^assets?(:|$)
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery j =
case M.lookup Cash (jdeclaredaccounttypes j) of
Nothing -> And [ journalAssetAccountQuery j, Not . Acct $ toRegex' "(investment|receivable|:A/R|:fixed)" ]
Just _ -> journalAccountTypeQuery [Cash] notused j
where notused = error' "journalCashAccountQuery: this should not have happened!" -- PARTIAL:
Nothing -> And [journalAssetAccountQuery j
,Not $ Acct "(investment|receivable|:A/R|:fixed)"
]
-- | A query for accounts in this journal which have been
-- declared as Liability by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^(debts?|liabilit(y|ies))(:|$)@.
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] "^(debts?|liabilit(y|ies))(:|$)"
journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] (toRegex' "^(debts?|liabilit(y|ies))(:|$)")
-- | A query for accounts in this journal which have been
-- declared as Equity by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^equity(:|$)@.
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery = journalAccountTypeQuery [Equity] "^equity(:|$)"
journalEquityAccountQuery = journalAccountTypeQuery [Equity] (toRegex' "^equity(:|$)")
-- | A query for accounts in this journal which have been
-- declared as Revenue by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^(income|revenue)s?(:|$)@.
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] "^(income|revenue)s?(:|$)"
journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] (toRegex' "^(income|revenue)s?(:|$)")
-- | A query for accounts in this journal which have been
-- declared as Expense by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^expenses?(:|$)@.
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery = journalAccountTypeQuery [Expense] "^expenses?(:|$)"
journalExpenseAccountQuery = journalAccountTypeQuery [Expense] (toRegex' "^expenses?(:|$)")
-- | A query for Asset, Liability & Equity accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
,journalLiabilityAccountQuery j
,journalEquityAccountQuery j
@ -370,17 +367,16 @@ journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} =
let
declaredacctsoftype :: [AccountName] =
concat $ catMaybes [M.lookup t jdeclaredaccounttypes | t <- atypes]
concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes
in case declaredacctsoftype of
[] -> Acct fallbackregex
as ->
-- XXX Query isn't able to match account type since that requires extra info from the journal.
-- So we do a hacky search by name instead.
And [
Or $ map (Acct . accountNameToAccountRegex) as
,Not $ Or $ map (Acct . accountNameToAccountRegex) differentlytypedsubs
]
as -> And [ Or acctnameRegexes, Not $ Or differentlyTypedRegexes ]
where
-- XXX Query isn't able to match account type since that requires extra info from the journal.
-- So we do a hacky search by name instead.
acctnameRegexes = map (Acct . accountNameToAccountRegex) as
differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs
differentlytypedsubs = concat
[subs | (t,bs) <- M.toList jdeclaredaccounttypes
, not $ t `elem` atypes
@ -1237,25 +1233,6 @@ postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
-- )
-- ]
-- Misc helpers
-- | Check if a set of hledger account/description filter patterns matches the
-- given account name or entry description. Patterns are case-insensitive
-- regular expressions. Prefixed with not:, they become anti-patterns.
matchpats :: [String] -> String -> Bool
matchpats pats str =
(null positives || any match positives) && (null negatives || not (any match negatives))
where
(negatives,positives) = partition isnegativepat pats
match "" = True
match pat = regexMatchesCI (abspat pat) str
negateprefix = "not:"
isnegativepat = (negateprefix `isPrefixOf`)
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
-- debug helpers
-- traceAmountPrecision a = trace (show $ map (precision . acommodity) $ amounts a) a
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . acommodity) . amounts) . pamount) ps) ps

7
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -17,7 +17,6 @@ module Hledger.Data.Ledger (
,ledgerRootAccount
,ledgerTopAccounts
,ledgerLeafAccounts
,ledgerAccountsMatching
,ledgerPostings
,ledgerDateSpan
,ledgerCommodities
@ -26,8 +25,6 @@ module Hledger.Data.Ledger (
where
import qualified Data.Map as M
-- import Data.Text (Text)
import qualified Data.Text as T
import Safe (headDef)
import Text.Printf
@ -90,10 +87,6 @@ ledgerTopAccounts = asubs . head . laccounts
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts = filter (null.asubs) . laccounts
-- | Accounts in ledger whose name matches the pattern, in tree order.
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
ledgerAccountsMatching pats = filter (matchpats pats . T.unpack . aname) . laccounts -- XXX pack
-- | List a ledger's postings, in the order parsed.
ledgerPostings :: Ledger -> [Posting]
ledgerPostings = journalPostings . ljournal

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -315,7 +315,7 @@ aliasReplace (BasicAlias old new) a
Right $ new <> T.drop (T.length old) a
| otherwise = Right a
aliasReplace (RegexAlias re repl) a =
fmap T.pack $ regexReplaceCIMemo_ re repl $ T.unpack a -- XXX
fmap T.pack $ regexReplaceMemo_ re repl $ T.unpack a -- XXX
-- | Apply a specified valuation to this posting's amount, using the
-- provided price oracle, commodity styles, reference dates, and

6
hledger-lib/Hledger/Data/Types.hs
View File

@ -166,7 +166,7 @@ data AccountAlias = BasicAlias AccountName AccountName
| RegexAlias Regexp Replacement
deriving (Eq, Read, Show, Ord, Data, Generic, Typeable)
instance NFData AccountAlias
-- instance NFData AccountAlias
data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data,Generic)
@ -512,13 +512,13 @@ data Journal = Journal {
-- any included journal files. The main file is first,
-- followed by any included files in the order encountered.
,jlastreadtime :: ClockTime -- ^ when this journal was last read from its file(s)
} deriving (Eq, Typeable, Data, Generic)
} deriving (Eq, Generic)
deriving instance Data ClockTime
deriving instance Typeable ClockTime
deriving instance Generic ClockTime
instance NFData ClockTime
instance NFData Journal
-- instance NFData Journal
-- | A journal in the process of being parsed, not yet finalised.
-- The data is partial, and list fields are in reverse order.

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

@ -9,8 +9,11 @@ transactions..) by various criteria, and a SimpleTextParser for query expressio
-- (may hide other deprecation warnings too). https://github.com/ndmitchell/safe/issues/26
{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ViewPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Query (
-- * Query and QueryOpt
@ -42,20 +45,13 @@ module Hledger.Query (
inAccountQuery,
-- * matching
matchesTransaction,
matchesTransaction_,
matchesPosting,
matchesPosting_,
matchesAccount,
matchesAccount_,
matchesMixedAmount,
matchesAmount,
matchesAmount_,
matchesCommodity,
matchesCommodity_,
matchesTags,
matchesTags_,
matchesPriceDirective,
matchesPriceDirective_,
words'',
prefixes,
-- * tests
@ -63,7 +59,7 @@ module Hledger.Query (
)
where
import Control.Arrow ((>>>))
import Control.Applicative ((<|>), liftA2, many, optional)
import Data.Data
import Data.Either
import Data.List
@ -74,7 +70,7 @@ import Data.Monoid ((<>))
import qualified Data.Text as T
import Data.Time.Calendar
import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
import Text.Megaparsec
import Text.Megaparsec (between, noneOf, sepBy)
import Text.Megaparsec.Char
import Hledger.Utils hiding (words')
@ -111,6 +107,14 @@ data Query = Any -- ^ always match
-- matching the regexp if provided, exists
deriving (Eq,Data,Typeable)
-- | Construct a payee tag
payeeTag :: Maybe String -> Either RegexError Query
payeeTag = liftA2 Tag (toRegexCI_ "payee") . maybe (pure Nothing) (fmap Just . toRegexCI_)
-- | Construct a note tag
noteTag :: Maybe String -> Either RegexError Query
noteTag = liftA2 Tag (toRegexCI_ "note") . maybe (pure Nothing) (fmap Just . toRegexCI_)
-- custom Show implementation to show strings more accurately, eg for debugging regexps
instance Show Query where
show Any = "Any"
@ -273,11 +277,11 @@ parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
Right (Left m) -> Right $ Left $ Not m
Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored
Left err -> Left err
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Right $ Left $ Code $ T.unpack s
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Right $ Left $ Desc $ T.unpack s
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Right $ Left $ Tag "payee" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Right $ Left $ Tag "note" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Right $ Left $ Acct $ T.unpack s
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI_ (T.unpack s)
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI_ (T.unpack s)
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s)
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s)
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI_ (T.unpack s)
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Right $ Left $ Date2 span
@ -295,8 +299,8 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| otherwise = Left "depth: should have a positive number"
where n = readDef 0 (T.unpack s)
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Right $ Left $ Sym (T.unpack s) -- support cur: as an alias
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Right $ Left $ Tag n v where (n,v) = parseTag s
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI_ ('^' : T.unpack s ++ "$") -- support cur: as an alias
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
parseQueryTerm _ "" = Right $ Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
@ -344,10 +348,12 @@ parseAmountQueryTerm amtarg =
parse :: T.Text -> T.Text -> Maybe Quantity
parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack
parseTag :: T.Text -> (Regexp, Maybe Regexp)
parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v)
| otherwise = (T.unpack s, Nothing)
where (n,v) = T.break (=='=') s
parseTag :: T.Text -> Either RegexError Query
parseTag s = do
tag <- toRegexCI_ . T.unpack $ if T.null v then s else n
body <- if T.null v then pure Nothing else Just <$> toRegexCI_ (tail $ T.unpack v)
return $ Tag tag body
where (n,v) = T.break (=='=') s
-- | Parse the value part of a "status:" query, or return an error.
parseStatus :: T.Text -> Either String Status
@ -550,8 +556,8 @@ inAccount (QueryOptInAcct a:_) = Just (a,True)
-- Just looks at the first query option.
inAccountQuery :: [QueryOpt] -> Maybe Query
inAccountQuery [] = Nothing
inAccountQuery (QueryOptInAcctOnly a : _) = Just $ Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a : _) = Just $ Acct $ accountNameToAccountRegex a
inAccountQuery (QueryOptInAcctOnly a : _) = Just . Acct $ accountNameToAccountOnlyRegex a
inAccountQuery (QueryOptInAcct a : _) = Just . Acct $ accountNameToAccountRegex a
-- -- | Convert a query to its inverse.
-- negateQuery :: Query -> Query
@ -568,36 +574,38 @@ matchesAccount (None) _ = False
matchesAccount (Not m) a = not $ matchesAccount m a
matchesAccount (Or ms) a = any (`matchesAccount` a) ms
matchesAccount (And ms) a = all (`matchesAccount` a) ms
matchesAccount (Acct r) a = regexMatchesCI r (T.unpack a) -- XXX pack
matchesAccount (Acct r) a = match r (T.unpack a) -- XXX pack
matchesAccount (Depth d) a = accountNameLevel a <= d
matchesAccount (Tag _ _) _ = False
matchesAccount _ _ = True
-- | Total version of matchesAccount, which will return any error
-- arising from a malformed regular expression in the query.
matchesAccount_ :: Query -> AccountName -> Either RegexError Bool
matchesAccount_ (None) _ = Right False
matchesAccount_ (Not m) a = Right $ not $ matchesAccount m a
matchesAccount_ (Or ms) a = sequence (map (`matchesAccount_` a) ms) >>= pure . or
matchesAccount_ (And ms) a = sequence (map (`matchesAccount_` a) ms) >>= pure . and
matchesAccount_ (Acct r) a = regexMatchesCI_ r (T.unpack a) -- XXX pack
matchesAccount_ (Depth d) a = Right $ accountNameLevel a <= d
matchesAccount_ (Tag _ _) _ = Right False
matchesAccount_ _ _ = Right True
-- FIXME: unnecssary
-- matchesAccount_ :: Query -> AccountName -> Either RegexError Bool
-- matchesAccount_ (None) _ = Right False
-- matchesAccount_ (Not m) a = Right $ not $ matchesAccount m a
-- matchesAccount_ (Or ms) a = sequence (map (`matchesAccount_` a) ms) >>= pure . or
-- matchesAccount_ (And ms) a = sequence (map (`matchesAccount_` a) ms) >>= pure . and
-- matchesAccount_ (Acct r) a = match r (T.unpack a) -- XXX pack
-- matchesAccount_ (Depth d) a = Right $ accountNameLevel a <= d
-- matchesAccount_ (Tag _ _) _ = Right False
-- matchesAccount_ _ _ = Right True
matchesMixedAmount :: Query -> MixedAmount -> Bool
matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
matchesCommodity :: Query -> CommoditySymbol -> Bool
matchesCommodity (Sym r) s = regexMatchesCI ("^" ++ r ++ "$") (T.unpack s)
matchesCommodity _ _ = True
matchesCommodity (Sym r) = match r . T.unpack
matchesCommodity _ = const True
-- | Total version of matchesCommodity, which will return any error
-- arising from a malformed regular expression in the query.
matchesCommodity_ :: Query -> CommoditySymbol -> Either RegexError Bool
matchesCommodity_ (Sym r) s = regexMatchesCI_ ("^" ++ r ++ "$") (T.unpack s)
matchesCommodity_ _ _ = Right True
-- FIXME unnecessary
-- matchesCommodity_ :: Query -> CommoditySymbol -> Bool
-- matchesCommodity_ (Sym r) = match r . T.unpack
-- matchesCommodity_ _ = const True
-- | Does the match expression match this (simple) amount ?
matchesAmount :: Query -> Amount -> Bool
@ -612,15 +620,16 @@ matchesAmount _ _ = True
-- | Total version of matchesAmount, returning any error from a
-- malformed regular expression in the query.
matchesAmount_ :: Query -> Amount -> Either RegexError Bool
matchesAmount_ (Not q) a = not <$> q `matchesAmount_` a
matchesAmount_ (Any) _ = Right True
matchesAmount_ (None) _ = Right False
matchesAmount_ (Or qs) a = sequence (map (`matchesAmount_` a) qs) >>= pure . or
matchesAmount_ (And qs) a = sequence (map (`matchesAmount_` a) qs) >>= pure . and
matchesAmount_ (Amt ord n) a = Right $ compareAmount ord n a
matchesAmount_ (Sym r) a = matchesCommodity_ (Sym r) (acommodity a)
matchesAmount_ _ _ = Right True
-- FIXME Unnecessary
-- matchesAmount_ :: Query -> Amount -> Either RegexError Bool
-- matchesAmount_ (Not q) a = not <$> q `matchesAmount_` a
-- matchesAmount_ (Any) _ = Right True
-- matchesAmount_ (None) _ = Right False
-- matchesAmount_ (Or qs) a = sequence (map (`matchesAmount_` a) qs) >>= pure . or
-- matchesAmount_ (And qs) a = sequence (map (`matchesAmount_` a) qs) >>= pure . and
-- matchesAmount_ (Amt ord n) a = Right $ compareAmount ord n a
-- matchesAmount_ (Sym r) a = matchesCommodity_ (Sym r) (acommodity a)
-- matchesAmount_ _ _ = Right True
-- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?
-- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true.
@ -647,10 +656,10 @@ matchesPosting (Any) _ = True
matchesPosting (None) _ = False
matchesPosting (Or qs) p = any (`matchesPosting` p) qs
matchesPosting (And qs) p = all (`matchesPosting` p) qs
matchesPosting (Code r) p = regexMatchesCI r $ maybe "" (T.unpack . tcode) $ ptransaction p
matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" (T.unpack . tdescription) $ ptransaction p
matchesPosting (Code r) p = match r $ maybe "" (T.unpack . tcode) $ ptransaction p
matchesPosting (Desc r) p = match r $ maybe "" (T.unpack . tdescription) $ ptransaction p
matchesPosting (Acct r) p = matches p || matches (originalPosting p)
where matches p = regexMatchesCI r $ T.unpack $ paccount p -- XXX pack
where matches p = match r . T.unpack $ paccount p -- XXX pack
matchesPosting (Date span) p = span `spanContainsDate` postingDate p
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
matchesPosting (StatusQ s) p = postingStatus p == s
@ -663,35 +672,36 @@ matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
-- matchesPosting (Empty True) Posting{pamount=a} = mixedAmountLooksZero a
matchesPosting (Empty _) _ = True
matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as
matchesPosting (Tag n v) p = case (n, v) of
("payee", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionPayee) $ ptransaction p
("note", Just v) -> maybe False (regexMatchesCI v . T.unpack . transactionNote) $ ptransaction p
(n, v) -> matchesTags n v $ postingAllTags p
matchesPosting (Tag n v) p = case (reString n, v) of
("payee", Just v) -> maybe False (match v . T.unpack . transactionPayee) $ ptransaction p
("note", Just v) -> maybe False (match v . T.unpack . transactionNote) $ ptransaction p
(_, v) -> matchesTags n v $ postingAllTags p
-- | Total version of matchesPosting, returning any error from a
-- malformed regular expression in the query.
matchesPosting_ :: Query -> Posting -> Either RegexError Bool
matchesPosting_ (Not q) p = not <$> q `matchesPosting_` p
matchesPosting_ (Any) _ = Right True
matchesPosting_ (None) _ = Right False
matchesPosting_ (Or qs) p = sequence (map (`matchesPosting_` p) qs) >>= pure.or
matchesPosting_ (And qs) p = sequence (map (`matchesPosting_` p) qs) >>= pure.and
matchesPosting_ (Code r) p = regexMatchesCI_ r $ maybe "" (T.unpack . tcode) $ ptransaction p
matchesPosting_ (Desc r) p = regexMatchesCI_ r $ maybe "" (T.unpack . tdescription) $ ptransaction p
matchesPosting_ (Acct r) p = sequence [matches p, matches (originalPosting p)] >>= pure.or
where matches p = regexMatchesCI_ r $ T.unpack $ paccount p -- XXX pack
matchesPosting_ (Date span) p = Right $ span `spanContainsDate` postingDate p
matchesPosting_ (Date2 span) p = Right $ span `spanContainsDate` postingDate2 p
matchesPosting_ (StatusQ s) p = Right $ postingStatus p == s
matchesPosting_ (Real v) p = Right $ v == isReal p
matchesPosting_ q@(Depth _) Posting{paccount=a} = q `matchesAccount_` a
matchesPosting_ q@(Amt _ _) Posting{pamount=amt} = Right $ q `matchesMixedAmount` amt
matchesPosting_ (Empty _) _ = Right True
matchesPosting_ (Sym r) Posting{pamount=Mixed as} = sequence (map (matchesCommodity_ (Sym r)) $ map acommodity as) >>= pure.or
matchesPosting_ (Tag n v) p = case (n, v) of
("payee", Just v) -> maybe (Right False) (T.unpack . transactionPayee >>> regexMatchesCI_ v) $ ptransaction p
("note", Just v) -> maybe (Right False) (T.unpack . transactionNote >>> regexMatchesCI_ v) $ ptransaction p
(n, v) -> matchesTags_ n v $ postingAllTags p
-- -- FIXME: unnecessary
-- matchesPosting_ :: Query -> Posting -> Bool
-- matchesPosting_ (Not q) p = not <$> q `matchesPosting_` p
-- matchesPosting_ (Any) _ = Right True
-- matchesPosting_ (None) _ = Right False
-- matchesPosting_ (Or qs) p = sequence (map (`matchesPosting_` p) qs) >>= pure.or
-- matchesPosting_ (And qs) p = sequence (map (`matchesPosting_` p) qs) >>= pure.and
-- matchesPosting_ (Code r) p = match r $ maybe "" (T.unpack . tcode) $ ptransaction p
-- matchesPosting_ (Desc r) p = match r $ maybe "" (T.unpack . tdescription) $ ptransaction p
-- matchesPosting_ (Acct r) p = sequence [matches p, matches (originalPosting p)] >>= pure.or
-- where matches p = match r $ T.unpack $ paccount p -- XXX pack
-- matchesPosting_ (Date span) p = Right $ span `spanContainsDate` postingDate p
-- matchesPosting_ (Date2 span) p = Right $ span `spanContainsDate` postingDate2 p
-- matchesPosting_ (StatusQ s) p = Right $ postingStatus p == s
-- matchesPosting_ (Real v) p = Right $ v == isReal p
-- matchesPosting_ q@(Depth _) Posting{paccount=a} = q `matchesAccount_` a
-- matchesPosting_ q@(Amt _ _) Posting{pamount=amt} = Right $ q `matchesMixedAmount` amt
-- matchesPosting_ (Empty _) _ = Right True
-- matchesPosting_ (Sym r) Posting{pamount=Mixed as} = sequence (map (matchesCommodity_ (Sym r)) $ map acommodity as) >>= pure.or
-- matchesPosting_ (Tag n v) p = case (n, v) of
-- ("payee", Just v) -> maybe (Right False) (T.unpack . transactionPayee >>> match v) $ ptransaction p
-- ("note", Just v) -> maybe (Right False) (T.unpack . transactionNote >>> match v) $ ptransaction p
-- (n, v) -> matchesTags_ n v $ postingAllTags p
-- | Does the match expression match this transaction ?
matchesTransaction :: Query -> Transaction -> Bool
@ -700,8 +710,8 @@ matchesTransaction (Any) _ = True
matchesTransaction (None) _ = False
matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs
matchesTransaction (And qs) t = all (`matchesTransaction` t) qs
matchesTransaction (Code r) t = regexMatchesCI r $ T.unpack $ tcode t
matchesTransaction (Desc r) t = regexMatchesCI r $ T.unpack $ tdescription t
matchesTransaction (Code r) t = match r $ T.unpack $ tcode t
matchesTransaction (Desc r) t = match r $ T.unpack $ tdescription t
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
@ -711,51 +721,41 @@ matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Empty _) _ = True
matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Tag n v) t = case (n, v) of
("payee", Just v) -> regexMatchesCI v . T.unpack . transactionPayee $ t
("note", Just v) -> regexMatchesCI v . T.unpack . transactionNote $ t
(n, v) -> matchesTags n v $ transactionAllTags t
matchesTransaction (Tag n v) t = case (reString n, v) of
("payee", Just v) -> match v . T.unpack . transactionPayee $ t
("note", Just v) -> match v . T.unpack . transactionNote $ t
(_, v) -> matchesTags n v $ transactionAllTags t
-- | Total version of matchesTransaction, returning any error from a
-- malformed regular expression in the query.
matchesTransaction_ :: Query -> Transaction -> Either RegexError Bool
matchesTransaction_ (Not q) t = not <$> q `matchesTransaction_` t
matchesTransaction_ (Any) _ = Right True
matchesTransaction_ (None) _ = Right False
matchesTransaction_ (Or qs) t = sequence (map (`matchesTransaction_` t) qs) >>= pure.or
matchesTransaction_ (And qs) t = sequence (map (`matchesTransaction_` t) qs) >>= pure.and
matchesTransaction_ (Code r) t = regexMatchesCI_ r $ T.unpack $ tcode t
matchesTransaction_ (Desc r) t = regexMatchesCI_ r $ T.unpack $ tdescription t
matchesTransaction_ q@(Acct _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
matchesTransaction_ (Date span) t = Right $ spanContainsDate span $ tdate t
matchesTransaction_ (Date2 span) t = Right $ spanContainsDate span $ transactionDate2 t
matchesTransaction_ (StatusQ s) t = Right $ tstatus t == s
matchesTransaction_ (Real v) t = Right $ v == hasRealPostings t
matchesTransaction_ q@(Amt _ _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
matchesTransaction_ (Empty _) _ = Right True
matchesTransaction_ (Depth d) t = sequence (map (Depth d `matchesPosting_`) $ tpostings t) >>= pure.or
matchesTransaction_ q@(Sym _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
matchesTransaction_ (Tag n v) t = case (n, v) of
("payee", Just v) -> regexMatchesCI_ v . T.unpack . transactionPayee $ t
("note", Just v) -> regexMatchesCI_ v . T.unpack . transactionNote $ t
(n, v) -> matchesTags_ n v $ transactionAllTags t
-- FIXME: unnecessary
-- matchesTransaction_ :: Query -> Transaction -> Either RegexError Bool
-- matchesTransaction_ (Not q) t = not <$> q `matchesTransaction_` t
-- matchesTransaction_ (Any) _ = Right True
-- matchesTransaction_ (None) _ = Right False
-- matchesTransaction_ (Or qs) t = sequence (map (`matchesTransaction_` t) qs) >>= pure.or
-- matchesTransaction_ (And qs) t = sequence (map (`matchesTransaction_` t) qs) >>= pure.and
-- matchesTransaction_ (Code r) t = match r $ T.unpack $ tcode t
-- matchesTransaction_ (Desc r) t = match r $ T.unpack $ tdescription t
-- matchesTransaction_ q@(Acct _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
-- matchesTransaction_ (Date span) t = Right $ spanContainsDate span $ tdate t
-- matchesTransaction_ (Date2 span) t = Right $ spanContainsDate span $ transactionDate2 t
-- matchesTransaction_ (StatusQ s) t = Right $ tstatus t == s
-- matchesTransaction_ (Real v) t = Right $ v == hasRealPostings t
-- matchesTransaction_ q@(Amt _ _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
-- matchesTransaction_ (Empty _) _ = Right True
-- matchesTransaction_ (Depth d) t = sequence (map (Depth d `matchesPosting_`) $ tpostings t) >>= pure.or
-- matchesTransaction_ q@(Sym _) t = sequence (map (q `matchesPosting_`) $ tpostings t) >>= pure.or
-- matchesTransaction_ (Tag n v) t = case (n, v) of
-- ("payee", Just v) -> match v . T.unpack . transactionPayee $ t
-- ("note", Just v) -> match v . T.unpack . transactionNote $ t
-- (n, v) -> matchesTags_ n v $ transactionAllTags t
-- | Does the query match the name and optionally the value of any of these tags ?
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags namepat valuepat = not . null . filter (match namepat valuepat)
matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)
where
match npat Nothing (n,_) = regexMatchesCI npat (T.unpack n) -- XXX
match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v)
-- | Total version of matchesTags, returning any error from a
-- malformed regular expression in the query.
matchesTags_ :: Regexp -> Maybe Regexp -> [Tag] -> Either RegexError Bool
matchesTags_ namepat valuepat tags =
sequence (map (match namepat valuepat) tags) >>= pure.or
where
match npat Nothing (n,_) = regexMatchesCI_ npat (T.unpack n) -- XXX
match npat (Just vpat) (n,v) =
sequence [regexMatchesCI_ npat (T.unpack n), regexMatchesCI_ vpat (T.unpack v)] >>= pure.and
matches npat vpat (n,v) = match npat (T.unpack n) && maybe (const True) match vpat (T.unpack v)
-- | Does the query match this market price ?
matchesPriceDirective :: Query -> PriceDirective -> Bool
@ -770,38 +770,39 @@ matchesPriceDirective _ _ = True
-- | Total version of matchesPriceDirective, returning any error from
-- a malformed regular expression in the query.
matchesPriceDirective_ :: Query -> PriceDirective -> Either RegexError Bool
matchesPriceDirective_ (None) _ = Right False
matchesPriceDirective_ (Not q) p = not <$> matchesPriceDirective_ q p
matchesPriceDirective_ (Or qs) p = sequence (map (`matchesPriceDirective_` p) qs) >>= pure.or
matchesPriceDirective_ (And qs) p = sequence (map (`matchesPriceDirective_` p) qs) >>= pure.and
matchesPriceDirective_ q@(Amt _ _) p = matchesAmount_ q (pdamount p)
matchesPriceDirective_ q@(Sym _) p = matchesCommodity_ q (pdcommodity p)
matchesPriceDirective_ (Date span) p = Right $ spanContainsDate span (pddate p)
matchesPriceDirective_ _ _ = Right True
-- FIXME unnecessary
-- matchesPriceDirective_ :: Query -> PriceDirective -> Either RegexError Bool
-- matchesPriceDirective_ (None) _ = Right False
-- matchesPriceDirective_ (Not q) p = not <$> matchesPriceDirective_ q p
-- matchesPriceDirective_ (Or qs) p = sequence (map (`matchesPriceDirective_` p) qs) >>= pure.or
-- matchesPriceDirective_ (And qs) p = sequence (map (`matchesPriceDirective_` p) qs) >>= pure.and
-- matchesPriceDirective_ q@(Amt _ _) p = matchesAmount_ q (pdamount p)
-- matchesPriceDirective_ q@(Sym _) p = matchesCommodity_ q (pdcommodity p)
-- matchesPriceDirective_ (Date span) p = Right $ spanContainsDate span (pddate p)
-- matchesPriceDirective_ _ _ = Right True
-- tests
tests_Query = tests "Query" [
test "simplifyQuery" $ do
(simplifyQuery $ Or [Acct "a"]) @?= (Acct "a")
(simplifyQuery $ Or [Acct $ toRegex' "a"]) @?= (Acct $ toRegex' "a")
(simplifyQuery $ Or [Any,None]) @?= (Any)
(simplifyQuery $ And [Any,None]) @?= (None)
(simplifyQuery $ And [Any,Any]) @?= (Any)
(simplifyQuery $ And [Acct "b",Any]) @?= (Acct "b")
(simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b")
(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any)
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)])
@?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
(simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b")
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")
,test "parseQuery" $ do
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct "expenses:autres d\233penses", Desc "b"], [])
parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc "b b", [QueryOptInAcct "a"])
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct $ toRegexCI' "expenses:autres d\233penses", Desc $ toRegexCI' "b"], [])
parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc $ toRegexCI' "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
parseQuery nulldate "desc:'x x'" @?= Right (Desc "x x", [])
parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct "a a",Acct "'b"], [])
parseQuery nulldate "\"" @?= Right (Acct "\"", [])
parseQuery nulldate "desc:'x x'" @?= Right (Desc $ toRegexCI' "x x", [])
parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct $ toRegexCI' "a a",Acct $ toRegexCI' "'b"], [])
parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", [])
,test "words''" $ do
(words'' [] "a b") @?= ["a","b"]
@ -820,23 +821,23 @@ tests_Query = tests "Query" [
filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear
,test "parseQueryTerm" $ do
parseQueryTerm nulldate "a" @?= Right (Left $ Acct "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct "expenses:autres d\233penses")
parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc "a b")
parseQueryTerm nulldate "a" @?= Right (Left $ Acct $ toRegexCI' "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct $ toRegexCI' "expenses:autres d\233penses")
parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc $ toRegexCI' "a b")
parseQueryTerm nulldate "status:1" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:*" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:!" @?= Right (Left $ StatusQ Pending)
parseQueryTerm nulldate "status:0" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "status:" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "payee:x" @?= Right (Left $ Tag "payee" (Just "x"))
parseQueryTerm nulldate "note:x" @?= Right (Left $ Tag "note" (Just "x"))
parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x")
parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x")
parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True)
parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01))
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01))
parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a")
parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag "a" Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag "a" (Just "some value"))
parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value"))
parseQueryTerm nulldate "amt:<0" @?= Right (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1)
@ -869,14 +870,14 @@ tests_Query = tests "Query" [
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing
,test "matchesAccount" $ do
assertBool "" $ (Acct "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct "^a:b") `matchesAccount` "c:a:b"
assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct $ toRegex' "^a:b") `matchesAccount` "c:a:b"
assertBool "" $ Depth 2 `matchesAccount` "a"
assertBool "" $ Depth 2 `matchesAccount` "a:b"
assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c"
assertBool "" $ Date nulldatespan `matchesAccount` "a"
assertBool "" $ Date2 nulldatespan `matchesAccount` "a"
assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a"
,tests "matchesPosting" [
test "positive match on cleared posting status" $
@ -892,32 +893,33 @@ tests_Query = tests "Query" [
,test "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
,test "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
,test "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
,test "acct:" $ assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}
,test "acct:" $ assertBool "" $ (Acct $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
,test "tag:" $ do
assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
assertBool "" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
assertBool "" $ not $ (Tag (toRegex' "a") (Just $ toRegex' "r$")) `matchesPosting` nullposting
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' "foo") (Just $ toRegex' "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' " foo ") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
,test "cur:" $ do
assertBool "" $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol
assertBool "" $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr
assertBool "" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
assertBool "" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr
assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
]
,test "matchesTransaction" $ do
assertBool "" $ Any `matchesTransaction` nulltransaction
assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
-- see posting for more tag tests
assertBool "" $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}
assertBool "" $ (Tag "payee" (Just "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag "note" (Just "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag (toRegex' "foo") (Just $ toRegex' "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}
assertBool "" $ (Tag (toRegex' "payee") (Just $ toRegex' "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
assertBool "" $ (Tag (toRegex' "note") (Just $ toRegex' "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"}
-- a tag match on a transaction also matches posting tags
assertBool "" $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}
assertBool "" $ (Tag (toRegex' "postingtag") Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}
]

2
hledger-lib/Hledger/Read/Common.hs
View File

@ -144,7 +144,7 @@ import Text.Megaparsec.Custom
import Control.Applicative.Permutations
import Hledger.Data
import Hledger.Utils
import Hledger.Utils hiding (match)
--- ** doctest setup
-- $setup

50
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -44,6 +44,7 @@ import "base-compat-batteries" Prelude.Compat hiding (fail)
import Control.Exception (IOException, handle, throw)
import Control.Monad (liftM, unless, when)
import Control.Monad.Except (ExceptT, throwError)
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class (lift)
@ -69,7 +70,7 @@ import qualified Data.Csv.Parser.Megaparsec as CassavaMP
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable
import Text.Megaparsec hiding (parse)
import Text.Megaparsec hiding (match, parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf (printf)
@ -294,17 +295,14 @@ type FieldTemplate = String
-- | A strptime date parsing pattern, as supported by Data.Time.Format.
type DateFormat = String
-- | A regular expression.
type RegexpPattern = String
-- | A prefix for a matcher test, either & or none (implicit or).
data MatcherPrefix = And | None
deriving (Show, Eq)
-- | A single test for matching a CSV record, in one way or another.
data Matcher =
RecordMatcher MatcherPrefix RegexpPattern -- ^ match if this regexp matches the overall CSV record
| FieldMatcher MatcherPrefix CsvFieldReference RegexpPattern -- ^ match if this regexp matches the referenced CSV field's value
RecordMatcher MatcherPrefix Regexp -- ^ match if this regexp matches the overall CSV record
| FieldMatcher MatcherPrefix CsvFieldReference Regexp -- ^ match if this regexp matches the referenced CSV field's value
deriving (Show, Eq)
-- | A conditional block: a set of CSV record matchers, and a sequence
@ -617,9 +615,9 @@ recordmatcherp end = do
-- _ <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)
p <- matcherprefixp
r <- regexp end
return $ RecordMatcher p r
-- when (null ps) $
-- Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"
return $ RecordMatcher p r
<?> "record matcher"
-- | A single matcher for a specific field. A csv field reference
@ -656,13 +654,15 @@ csvfieldreferencep = do
return $ '%' : quoteIfNeeded f
-- A single regular expression
regexp :: CsvRulesParser () -> CsvRulesParser RegexpPattern
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
regexp end = do
lift $ dbgparse 8 "trying regexp"
-- notFollowedBy matchoperatorp
c <- lift nonspace
cs <- anySingle `manyTill` end
return $ strip $ c:cs
case toRegexCI_ . strip $ c:cs of
Left x -> Fail.fail $ "CSV parser: " ++ x
Right x -> return x
-- -- A match operator, indicating the type of match to perform.
-- -- Currently just ~ meaning case insensitive infix regex match.
@ -1181,7 +1181,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
where
-- does this individual matcher match the current csv record ?
matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher _ pat) = regexMatchesCI pat' wholecsvline
matcherMatches (RecordMatcher _ pat) = match pat' wholecsvline
where
pat' = dbg7 "regex" pat
-- A synthetic whole CSV record to match against. Note, this can be
@ -1191,7 +1191,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
-- - and the field separator is always comma
-- which means that a field containing a comma will look like two fields.
wholecsvline = dbg7 "wholecsvline" $ intercalate "," record
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchesCI pat csvfieldvalue
matcherMatches (FieldMatcher _ csvfieldref pat) = match pat csvfieldvalue
where
-- the value of the referenced CSV field to match against.
csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
@ -1199,7 +1199,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
-- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values. Outer whitespace is removed from interpolated values.
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String
renderTemplate rules record t = regexReplaceBy "%[A-z0-9_-]+" (replaceCsvFieldReference rules record) t
renderTemplate rules record t = replaceAllBy (toRegex' "%[A-z0-9_-]+") (replaceCsvFieldReference rules record) t -- PARTIAL: should not happen
-- | Replace something that looks like a reference to a csv field ("%date" or "%1)
-- with that field's value. If it doesn't look like a field reference, or if we
@ -1256,12 +1256,12 @@ tests_CsvReader = tests "CsvReader" [
,test "assignment with empty value" $
parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?=
(Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None "foo"],cbAssignments=[("account2","foo")]}]}))
(Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))
]
,tests "conditionalblockp" [
test "space after conditional" $ -- #1120
parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=
(Right $ CB{cbMatchers=[RecordMatcher None "a"],cbAssignments=[("account2","b")]})
(Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]})
,tests "csvfieldreferencep" [
test "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")
@ -1272,19 +1272,19 @@ tests_CsvReader = tests "CsvReader" [
,tests "matcherp" [
test "recordmatcherp" $
parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None "A A")
parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "A A")
,test "recordmatcherp.starts-with-&" $
parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And "A A")
parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And $ toRegexCI' "A A")
,test "fieldmatcherp.starts-with-%" $
parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None "description A A")
parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "description A A")
,test "fieldmatcherp" $
parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" "A A")
parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" $ toRegexCI' "A A")
,test "fieldmatcherp.starts-with-&" $
parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" "A A")
parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" $ toRegexCI' "A A")
-- ,test "fieldmatcherp with operator" $
-- parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A")
@ -1293,22 +1293,22 @@ tests_CsvReader = tests "CsvReader" [
,tests "getEffectiveAssignment" [
let rules = mkrules $ defrules {rcsvfieldindexes=[("csvdate",1)],rassignments=[("date","%csvdate")]}
in test "toplevel" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" "a"] [("date","%csvdate")]]}
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}
in test "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" "a", FieldMatcher None "%description" "b"] [("date","%csvdate")]]}
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}
in test "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate")
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" "a", FieldMatcher None "%description" "b"] [("date","%csvdate")]]}
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}
in test "conditional-with-or-b" $ getEffectiveAssignment rules ["_", "b"] "date" @?= (Just "%csvdate")
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" "a", FieldMatcher And "%description" "b"] [("date","%csvdate")]]}
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]}
in test "conditional.with-and" $ getEffectiveAssignment rules ["a", "b"] "date" @?= (Just "%csvdate")
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" "a", FieldMatcher And "%description" "b", FieldMatcher None "%description" "c"] [("date","%csvdate")]]}
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher None "%description" $ toRegex' "c"] [("date","%csvdate")]]}
in test "conditional.with-and-or" $ getEffectiveAssignment rules ["_", "c"] "date" @?= (Just "%csvdate")
]

4
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -529,8 +529,8 @@ regexaliasp = do
char '='
skipNonNewlineSpaces
repl <- anySingle `manyTill` eolof
case toRegex_ re of
Right _ -> return $! RegexAlias re repl
case toRegexCI_ re of
Right r -> return $! RegexAlias r repl
Left e -> customFailure $! parseErrorAtRegion off1 off2 e
endaliasesdirectivep :: JournalParser m ()

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

@ -50,7 +50,7 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [
test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) @?= 1
test "not acct" $ (length $ entriesReport defreportopts (Not . Acct $ toRegex' "bank") samplejournal) @?= 1
,test "date" $ (length $ entriesReport defreportopts (Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)) samplejournal) @?= 3
]
]

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

@ -277,13 +277,13 @@ tests_PostingsReport = tests "PostingsReport" [
(Any, samplejournal) `gives` 13
-- register --depth just clips account names
(Depth 2, samplejournal) `gives` 13
(And [Depth 1, StatusQ Cleared, Acct "expenses"], samplejournal) `gives` 2
(And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2
(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 $ snd $ postingsReport defreportopts Any samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) @?= 5
(length $ snd $ postingsReport defreportopts (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)

17
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -346,7 +346,7 @@ forecastPeriodFromRawOpts d opts =
Just str ->
either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $
parsePeriodExpr d $ stripquotes $ T.pack str
-- | Extract the interval from the parsed -p/--period expression.
-- Return Nothing if an interval is not explicitly defined.
extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval
@ -423,10 +423,10 @@ type DisplayExp = String
maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp
maybedisplayopt d rawopts =
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
where
fixbracketeddatestr "" = ""
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
maybe Nothing (Just . replaceAllBy (toRegex' "\\[.+?\\]") fixbracketeddatestr) $ maybestringopt "display" rawopts
where
fixbracketeddatestr "" = ""
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> (Transaction -> Day)
@ -573,12 +573,12 @@ reportPeriodOrJournalLastDay ropts j =
tests_ReportOptions = tests "ReportOptions" [
test "queryFromOpts" $ do
queryFromOpts nulldate defreportopts @?= Any
queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a"
queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a"
queryFromOpts nulldate defreportopts{query_="a"} @?= Acct (toRegexCI' "a")
queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc (toRegexCI' "a a")
queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" }
@?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct "a a", Acct "'b"]
queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct $ toRegexCI' "a a", Acct $ toRegexCI' "'b"]
,test "queryOptsFromOpts" $ do
queryOptsFromOpts nulldate defreportopts @?= []
@ -586,4 +586,3 @@ tests_ReportOptions = tests "ReportOptions" [
queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01)
,query_="date:'to 2013'"} @?= []
]

247
hledger-lib/Hledger/Utils/Regex.hs
View File

@ -1,4 +1,8 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-|
Easy regular expression helpers, currently based on regex-tdfa. These should:
@ -42,48 +46,120 @@ Current limitations:
-}
module Hledger.Utils.Regex (
-- * Regexp type and constructors
Regexp(reString)
,toRegex_
,toRegexCI_
,toRegex'
,toRegexCI'
-- * type aliases
Regexp
,Replacement
,RegexError
-- * partial regex operations (may call error)
,regexMatches
,regexMatchesCI
,regexReplace
,regexReplaceCI
,regexReplaceMemo
,regexReplaceCIMemo
,regexReplaceBy
,regexReplaceByCI
-- ,regexMatches
-- ,regexMatchesCI
-- ,regexReplaceCI
-- ,regexReplaceCIMemo
-- ,regexReplaceByCI
-- * total regex operations
,regexMatches_
,regexMatchesCI_
,regexReplace_
,regexReplaceCI_
,match
,regexReplace
,regexReplaceMemo_
,regexReplaceCIMemo_
,regexReplaceBy_
,regexReplaceByCI_
,toRegex_
-- ,replaceAllBy
-- ,regexMatches_
-- ,regexMatchesCI_
-- ,regexReplace_
-- ,regexReplaceCI_
-- ,regexReplaceMemo_
-- ,regexReplaceCIMemo_
,replaceAllBy
)
where
import Control.Arrow (first)
import Control.Monad (foldM)
import Data.Array
import Data.Char
import Data.Aeson (ToJSON(..), Value(String))
import Data.Array ((!), elems, indices)
import Data.Char (isDigit)
import Data.Data (Data(..), mkNoRepType)
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.MemoUgly (memo)
import qualified Data.Text as T
import Text.Regex.TDFA (
Regex, CompOption(..), ExecOption(..), defaultCompOpt, defaultExecOpt,
makeRegexOptsM, AllMatches(getAllMatches), match, (=~), MatchText
Regex, CompOption(..), defaultCompOpt, defaultExecOpt,
makeRegexOptsM, AllMatches(getAllMatches), match, MatchText,
RegexLike(..), RegexMaker(..), RegexOptions(..), RegexContext(..)
)
import Hledger.Utils.UTF8IOCompat (error')
-- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax.
type Regexp = String
data Regexp
= Regexp { reString :: String, reCompiled :: Regex }
| RegexpCI { reString :: String, reCompiled :: Regex }
instance Eq Regexp where
Regexp s1 _ == Regexp s2 _ = s1 == s2
RegexpCI s1 _ == RegexpCI s2 _ = s1 == s2
_ == _ = False
instance Ord Regexp where
Regexp s1 _ `compare` Regexp s2 _ = s1 `compare` s2
RegexpCI s1 _ `compare` RegexpCI s2 _ = s1 `compare` s2
Regexp _ _ `compare` RegexpCI _ _ = LT
RegexpCI _ _ `compare` Regexp _ _ = GT
instance Show Regexp where
showsPrec d (Regexp s _) = showString "Regexp " . showsPrec d s
showsPrec d (RegexpCI s _) = showString "RegexpCI " . showsPrec d s
instance Read Regexp where
readsPrec d ('R':'e':'g':'e':'x':'p':' ':xs) = map (first toRegex') $ readsPrec d xs
readsPrec d ('R':'e':'g':'e':'x':'p':'C':'I':' ':xs) = map (first toRegexCI') $ readsPrec d xs
readsPrec _ s = error' $ "read: Not a valid regex " ++ s
instance Data Regexp where
toConstr _ = error' "No toConstr for Regex"
gunfold _ _ = error' "No gunfold for Regex"
dataTypeOf _ = mkNoRepType "Hledger.Utils.Regex"
instance ToJSON Regexp where
toJSON (Regexp s _) = String . T.pack $ "Regexp " ++ s
toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s
instance RegexLike Regexp String where
matchOnce = matchOnce . reCompiled
matchAll = matchAll . reCompiled
matchCount = matchCount . reCompiled
matchTest = matchTest . reCompiled
matchAllText = matchAllText . reCompiled
matchOnceText = matchOnceText . reCompiled
instance RegexContext Regexp String String where
match = match . reCompiled
matchM = matchM . reCompiled
-- Convert a Regexp string to a compiled Regex, or return an error message.
toRegex_ :: String -> Either RegexError Regexp
toRegex_ = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)
-- Like toRegex_, but make a case-insensitive Regex.
toRegexCI_ :: String -> Either RegexError Regexp
toRegexCI_ = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)
-- | Make a nice error message for a regexp error.
mkRegexErr :: String -> Maybe a -> Either RegexError a
mkRegexErr s = maybe (Left errmsg) Right
where errmsg = "this regular expression could not be compiled: " ++ s
-- Convert a Regexp string to a compiled Regex, throw an error
toRegex' :: String -> Regexp
toRegex' = either error' id . toRegex_
-- Like toRegex', but make a case-insensitive Regex.
toRegexCI' :: String -> Regexp
toRegexCI' = either error' id . toRegexCI_
-- | A replacement pattern. May include numeric backreferences (\N).
type Replacement = String
@ -91,61 +167,10 @@ type Replacement = String
-- | An regular expression compilation/processing error message.
type RegexError = String
--------------------------------------------------------------------------------
-- old partial functions -- PARTIAL:
-- regexMatch' :: RegexContext Regexp String a => Regexp -> String -> a
-- regexMatch' r s = s =~ (toRegex' r)
regexMatches :: Regexp -> String -> Bool
regexMatches = flip (=~)
regexMatchesCI :: Regexp -> String -> Bool
regexMatchesCI r = match (toRegexCI r)
-- | Replace all occurrences of the regexp with the replacement
-- pattern. The replacement pattern supports numeric backreferences
-- (\N) but no other RE syntax.
regexReplace :: Regexp -> Replacement -> String -> String
regexReplace re = replaceRegex (toRegex re)
regexReplaceCI :: Regexp -> Replacement -> String -> String
regexReplaceCI re = replaceRegex (toRegexCI re)
-- | A memoising version of regexReplace. Caches the result for each
-- search pattern, replacement pattern, target string tuple.
regexReplaceMemo :: Regexp -> Replacement -> String -> String
regexReplaceMemo re repl = memo (regexReplace re repl)
regexReplaceCIMemo :: Regexp -> Replacement -> String -> String
regexReplaceCIMemo re repl = memo (regexReplaceCI re repl)
-- | Replace all occurrences of the regexp, transforming each match with the given function.
regexReplaceBy :: Regexp -> (String -> String) -> String -> String
regexReplaceBy r = replaceAllBy (toRegex r)
regexReplaceByCI :: Regexp -> (String -> String) -> String -> String
regexReplaceByCI r = replaceAllBy (toRegexCI r)
-- helpers
-- | Convert our string-based Regexp to a real Regex.
-- Or if it's not well formed, call error with a "malformed regexp" message.
toRegex :: Regexp -> Regex
toRegex = memo (compileRegex defaultCompOpt defaultExecOpt) -- PARTIAL:
-- | Like toRegex but make a case-insensitive Regex.
toRegexCI :: Regexp -> Regex
toRegexCI = memo (compileRegex defaultCompOpt{caseSensitive=False} defaultExecOpt) -- PARTIAL:
compileRegex :: CompOption -> ExecOption -> Regexp -> Regex
compileRegex compopt execopt r =
fromMaybe
(error $ "this regular expression could not be compiled: " ++ show r) $ -- PARTIAL:
makeRegexOptsM compopt execopt r
replaceRegex :: Regex -> Replacement -> String -> String
replaceRegex re repl s = foldl (replaceMatch repl) s (reverse $ match re s :: [MatchText String])
regexReplace :: Regexp -> Replacement -> String -> String
regexReplace re repl s = foldl (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String])
where
replaceMatch :: Replacement -> String -> MatchText String -> String
replaceMatch replpat s matchgroups = pre ++ repl ++ post
@ -153,7 +178,7 @@ replaceRegex re repl s = foldl (replaceMatch repl) s (reverse $ match re s :: [M
((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match
(pre, post') = splitAt off s
post = drop len post'
repl = replaceAllBy (toRegex "\\\\[0-9]+") (lookupMatchGroup matchgroups) replpat
repl = replaceAllBy backrefRegex (lookupMatchGroup matchgroups) replpat
where
lookupMatchGroup :: MatchText String -> String -> String
lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s =
@ -161,68 +186,22 @@ replaceRegex re repl s = foldl (replaceMatch repl) s (reverse $ match re s :: [M
-- PARTIAL:
_ -> error' $ "no match group exists for backreference \"\\"++s++"\""
lookupMatchGroup _ s = error' $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen"
backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not error happen
--------------------------------------------------------------------------------
-- new total functions
-- | Does this regexp match the given string ?
-- Or return an error if the regexp is malformed.
regexMatches_ :: Regexp -> String -> Either RegexError Bool
regexMatches_ r s = (`match` s) <$> toRegex_ r
-- | Like regexMatches_ but match case-insensitively.
regexMatchesCI_ :: Regexp -> String -> Either RegexError Bool
regexMatchesCI_ r s = (`match` s) <$> toRegexCI_ r
-- | Replace all occurrences of the regexp with the replacement
-- pattern, or return an error message. The replacement pattern
-- supports numeric backreferences (\N) but no other RE syntax.
regexReplace_ :: Regexp -> Replacement -> String -> Either RegexError String
regexReplace_ re repl s = toRegex_ re >>= \rx -> replaceRegex_ rx repl s
-- | Like regexReplace_ but match occurrences case-insensitively.
regexReplaceCI_ :: Regexp -> Replacement -> String -> Either RegexError String
regexReplaceCI_ re repl s = toRegexCI_ re >>= \rx -> replaceRegex_ rx repl s
-- | A memoising version of regexReplace_. Caches the result for each
-- search pattern, replacement pattern, target string tuple.
regexReplaceMemo_ :: Regexp -> Replacement -> String -> Either RegexError String
regexReplaceMemo_ re repl = memo (regexReplace_ re repl)
-- | Like regexReplaceMemo_ but match occurrences case-insensitively.
regexReplaceCIMemo_ :: Regexp -> Replacement -> String -> Either RegexError String
regexReplaceCIMemo_ re repl = memo (regexReplaceCI_ re repl)
-- | Replace all occurrences of the regexp, transforming each match
-- with the given function, or return an error message.
regexReplaceBy_ :: Regexp -> (String -> String) -> String -> Either RegexError String
regexReplaceBy_ r f s = toRegex_ r >>= \rx -> Right $ replaceAllBy rx f s
-- | Like regexReplaceBy_ but match occurrences case-insensitively.
regexReplaceByCI_ :: Regexp -> (String -> String) -> String -> Either RegexError String
regexReplaceByCI_ r f s = toRegexCI_ r >>= \rx -> Right $ replaceAllBy rx f s
regexReplaceMemo_ re repl = memo (replaceRegexUnmemo_ re repl)
-- helpers:
-- Convert a Regexp string to a compiled Regex, or return an error message.
toRegex_ :: Regexp -> Either RegexError Regex
toRegex_ = memo (compileRegex_ defaultCompOpt defaultExecOpt)
-- Like toRegex, but make a case-insensitive Regex.
toRegexCI_ :: Regexp -> Either RegexError Regex
toRegexCI_ = memo (compileRegex_ defaultCompOpt{caseSensitive=False} defaultExecOpt)
-- Compile a Regexp string to a Regex with the given options, or return an
-- error message if this fails.
compileRegex_ :: CompOption -> ExecOption -> Regexp -> Either RegexError Regex
compileRegex_ compopt execopt r =
maybe (Left $ "this regular expression could not be compiled: " ++ show r) Right $
makeRegexOptsM compopt execopt r
-- Replace this regular expression with this replacement pattern in this
-- string, or return an error message.
replaceRegex_ :: Regex -> Replacement -> String -> Either RegexError String
replaceRegex_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match re s :: [MatchText String])
replaceRegexUnmemo_ :: Regexp -> Replacement -> String -> Either RegexError String
replaceRegexUnmemo_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match (reCompiled re) s :: [MatchText String])
where
-- Replace one match within the string with the replacement text
-- appropriate for this match. Or return an error message.
@ -236,7 +215,8 @@ replaceRegex_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match re s ::
-- The replacement text: the replacement pattern with all
-- numeric backreferences replaced by the appropriate groups
-- from this match. Or an error message.
erepl = toRegex_ "\\\\[0-9]+" >>= \rx -> replaceAllByM rx (lookupMatchGroup_ matchgroups) replpat
-- FIXME: Use makeRegex instead of toRegex_
erepl = replaceAllByM backrefRegex (lookupMatchGroup_ matchgroups) replpat
where
-- Given some match groups and a numeric backreference,
-- return the referenced group text, or an error message.
@ -245,6 +225,7 @@ replaceRegex_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match re s ::
case read s of n | n `elem` indices grps -> Right $ fst (grps ! n)
_ -> Left $ "no match group exists for backreference \"\\"++s++"\""
lookupMatchGroup_ _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen"
backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not happen
-- helpers
@ -252,12 +233,12 @@ replaceRegex_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match re s ::
-- Replace all occurrences of a regexp in a string, transforming each match
-- with the given pure function.
replaceAllBy :: Regex -> (String -> String) -> String -> String
replaceAllBy :: Regexp -> (String -> String) -> String -> String
replaceAllBy re transform s = prependdone rest
where
(_, rest, prependdone) = foldl' go (0, s, id) matches
where
matches = getAllMatches $ match re s :: [(Int, Int)] -- offset and length
matches = getAllMatches $ match (reCompiled re) s :: [(Int, Int)] -- offset and length
go :: (Int,String,String->String) -> (Int,Int) -> (Int,String,String->String)
go (pos,todo,prepend) (off,len) =
let (prematch, matchandrest) = splitAt (off - pos) todo
@ -268,11 +249,11 @@ replaceAllBy re transform s = prependdone rest
-- with the given monadic function. Eg if the monad is Either, a Left result
-- from the transform function short-circuits and is returned as the overall
-- result.
replaceAllByM :: forall m. Monad m => Regex -> (String -> m String) -> String -> m String
replaceAllByM :: forall m. Monad m => Regexp -> (String -> m String) -> String -> m String
replaceAllByM re transform s =
foldM go (0, s, id) matches >>= \(_, rest, prependdone) -> pure $ prependdone rest
where
matches = getAllMatches $ match re s :: [(Int, Int)] -- offset and length
matches = getAllMatches $ match (reCompiled re) s :: [(Int, Int)] -- offset and length
go :: (Int,String,String->String) -> (Int,Int) -> m (Int,String,String->String)
go (pos,todo,prepend) (off,len) =
let (prematch, matchandrest) = splitAt (off - pos) todo

6
hledger-lib/Hledger/Utils/String.hs
View File

@ -134,10 +134,10 @@ whitespacechars = " \t\n\r"
redirectchars = "<>"
escapeDoubleQuotes :: String -> String
escapeDoubleQuotes = regexReplace "\"" "\""
escapeDoubleQuotes = id -- regexReplace "\"" "\""
escapeQuotes :: String -> String
escapeQuotes = regexReplace "([\"'])" "\\1"
escapeQuotes = id -- regexReplace "([\"'])" "\\1"
-- | Quote-aware version of words - don't split on spaces which are inside quotes.
-- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails.
@ -346,7 +346,7 @@ strWidth s = maximum $ map (foldr (\a b -> charWidth a + b) 0) $ lines s'
where s' = stripAnsi s
stripAnsi :: String -> String
stripAnsi = regexReplace "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]" ""
stripAnsi = regexReplace (toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]") "" -- PARTIAL: should never happen, no backreferences
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -90,7 +90,7 @@ asInit d reset ui@UIState{
excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction
And [
Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
,Not (Tag "generated-transaction" Nothing)
,Not (Tag (toRegexCI' "generated-transaction") Nothing)
]
-- run the report

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

@ -122,7 +122,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
where
acct = headDef
(error' $ "--register "++apat++" did not match any account") -- PARTIAL:
$ filter (regexMatches apat . T.unpack) $ journalAccountNames j
$ filter (match (toRegexCI' apat) . T.unpack) $ journalAccountNames j
-- Initialising the accounts screen is awkward, requiring
-- another temporary UIState value..
ascr' = aScreen $

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -76,7 +76,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction
And [
Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
,Not (Tag "generated-transaction" Nothing)
,Not (Tag (toRegexCI' "generated-transaction") Nothing)
]
(_label,items) = accountTransactionsReport ropts' j q thisacctq

2
hledger-web/Hledger/Web/Widget/AddForm.hs
View File

@ -115,7 +115,7 @@ addForm j today = identifyForm "add" $ \extra -> do
]
where
-- avoid https://github.com/simonmichael/hledger/issues/236
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>"
escapeJSSpecialChars = regexReplace (toRegexCI' "</script>") "<\\/script>"
validateTransaction ::
FormResult Day

2
hledger-web/Hledger/Web/Widget/Common.hs
View File

@ -72,7 +72,7 @@ writeJournalTextIfValidAndChanged f t = do
-- Ensure unix line endings, since both readJournal (cf
-- formatdirectivep, #1194) writeFileWithBackupIfChanged require them.
-- XXX klunky. Any equivalent of "hSetNewlineMode h universalNewlineMode" for form posts ?
let t' = T.pack $ regexReplace "\r" "" $ T.unpack t
let t' = T.pack $ regexReplace (toRegex' "\r") "" $ T.unpack t
liftIO (readJournal def (Just f) t') >>= \case
Left e -> return (Left e)
Right _ -> do

30
hledger/Hledger/Cli/Commands.hs
View File

@ -61,7 +61,7 @@ import System.Environment (withArgs)
import System.Console.CmdArgs.Explicit as C
import Test.Tasty (defaultMain)
import Hledger
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Version
import Hledger.Cli.Commands.Accounts
@ -137,7 +137,7 @@ builtinCommands = [
-- | The commands list, showing command names, standard aliases,
-- and short descriptions. This is modified at runtime, as follows:
--
-- PROGVERSION is replaced with the program name and version.
-- progversion is the program name and version.
--
-- Lines beginning with a space represent builtin commands, with format:
-- COMMAND (ALIASES) DESCRIPTION
@ -152,10 +152,10 @@ builtinCommands = [
--
-- TODO: generate more of this automatically.
--
commandsList :: String
commandsList = unlines [
commandsList :: String -> [String] -> [String]
commandsList progversion othercmds = [
"-------------------------------------------------------------------------------"
,"PROGVERSION"
,progversion
,"Usage: hledger COMMAND [OPTIONS] [-- ADDONCMDOPTIONS]"
,"Commands (+ addons found in $PATH):"
,""
@ -208,8 +208,10 @@ commandsList = unlines [
,"+api run http api server"
,""
,"Other:"
,"OTHER"
,"Help:"
] ++
othercmds
++
["Help:"
," (no arguments) show this commands list"
," -h show general flags"
," COMMAND -h show flags & docs for COMMAND"
@ -231,25 +233,21 @@ findCommand cmdname = find (elem cmdname . modeNames . fst) builtinCommands
-- | Extract the command names from commandsList: the first word
-- of lines beginning with a space or + sign.
commandsFromCommandsList :: String -> [String]
commandsFromCommandsList :: [String] -> [String]
commandsFromCommandsList s =
[w | c:l <- lines s, c `elem` [' ','+'], let w:_ = words l]
[w | c:l <- s, c `elem` [' ','+'], let w:_ = words l]
knownCommands :: [String]
knownCommands = sort $ commandsFromCommandsList commandsList
knownCommands = sort . commandsFromCommandsList $ commandsList prognameandversion []
-- | Print the commands list, modifying the template above based on
-- the currently available addons. Missing addons will be removed, and
-- extra addons will be added under Misc.
printCommandsList :: [String] -> IO ()
printCommandsList addonsFound =
putStr $
regexReplace "PROGVERSION" (prognameandversion) $
regexReplace "OTHER" (unlines $ (map ('+':) unknownCommandsFound)) $
unlines $ concatMap adjustline $ lines $
cmdlist
putStr . unlines . concatMap adjustline $
commandsList prognameandversion (map ('+':) unknownCommandsFound)
where
cmdlist = commandsList
commandsFound = map (' ':) builtinCommandNames ++ map ('+':) addonsFound
unknownCommandsFound = addonsFound \\ knownCommands

13
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -24,7 +24,9 @@ import Data.Aeson (toJSON)
import Data.Aeson.Text (encodeToLazyText)
import Data.List
import Data.Maybe
-- import Data.Text (Text)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (addDays)
@ -77,8 +79,9 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL:
let
(apat:queryargs) = args'
apatregex = toRegex' apat -- PARTIAL: do better
acct = headDef (error' $ show apat++" did not match any account") $ -- PARTIAL:
filter (regexMatches apat . T.unpack) $ journalAccountNames j
filter (match apatregex . T.unpack) $ journalAccountNames j
-- gather report options
inclusive = True -- tree_ ropts
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
@ -97,7 +100,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
excludeforecastq False = -- not:date:tomorrow- not:tag:generated-transaction
And [
Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
,Not (Tag "generated-transaction" Nothing)
,Not (Tag (toRegex' "generated-transaction") Nothing)
]
-- run the report
-- TODO: need to also pass the queries so we can choose which date to render - move them into the report ?
@ -147,11 +150,11 @@ accountTransactionsReportAsText
itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a
-- show a title indicating which account was picked, which can be confusing otherwise
title = maybe "" (("Transactions in "++).(++" and subaccounts:")) macct
title = T.unpack $ maybe "" (("Transactions in "<>).(<>" and subaccounts:")) macct
where
-- XXX temporary hack ? recover the account name from the query
macct = case filterQuery queryIsAcct thisacctq of
Acct r -> Just $ init $ init $ init $ init $ init $ tail r -- Acct "^JS:expenses(:|$)"
Acct r -> Just . T.drop 1 . T.dropEnd 5 . T.pack $ reString r -- Acct "^JS:expenses(:|$)"
_ -> Nothing -- shouldn't happen
-- | Render one account register report line item as plain text. Layout is like so:

4
hledger/Hledger/Cli/Commands/Files.hs
View File

@ -33,8 +33,8 @@ filesmode = hledgerCommandMode
files :: CliOpts -> Journal -> IO ()
files CliOpts{rawopts_=rawopts} j = do
let args = listofstringopt "args" rawopts
regex = headMay args
files = maybe id (filter . regexMatches) regex
regex <- mapM (either fail pure . toRegex_) $ headMay args
let files = maybe id (filter . match) regex
$ map fst
$ jfiles j
mapM_ putStrLn files

7
hledger/Hledger/Cli/Commands/Tags.hs
View File

@ -7,6 +7,7 @@ module Hledger.Cli.Commands.Tags (
)
where
import qualified Control.Monad.Fail as Fail
import Data.List.Extra (nubSort)
import qualified Data.Text as T
import qualified Data.Text.IO as T
@ -24,11 +25,13 @@ tagsmode = hledgerCommandMode
hiddenflags
([], Just $ argsFlag "[TAGREGEX [QUERY...]]")
tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
let
args = listofstringopt "args" rawopts
mtagpat = headMay args
mtagpat <- mapM (either Fail.fail pure . toRegexCI_) $ headMay args
let
queryargs = drop 1 args
values = boolopt "values" rawopts
parsed = boolopt "parsed" rawopts
@ -39,7 +42,7 @@ tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
(if parsed then id else nubSort)
[ r
| (t,v) <- concatMap transactionAllTags txns
, maybe True (`regexMatchesCI` T.unpack t) mtagpat
, maybe True (`match` T.unpack t) mtagpat
, let r = if values then v else t
, not (values && T.null v && not empty)
]

16
hledger/Hledger/Cli/Main.hs
View File

@ -82,14 +82,14 @@ mainmode addons = defMode {
[detailedversionflag]
-- ++ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND
}
,modeHelpSuffix = map (regexReplace "PROGNAME" progname) [
"Examples:"
,"PROGNAME list commands"
,"PROGNAME CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
,"PROGNAME-CMD [OPTS] [ARGS] or run addon commands directly"
,"PROGNAME -h show general usage"
,"PROGNAME CMD -h show command usage"
,"PROGNAME help [MANUAL] show any of the hledger manuals in various formats"
,modeHelpSuffix = "Examples:" :
map (progname ++) [
" list commands"
," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
,"-CMD [OPTS] [ARGS] or run addon commands directly"
," -h show general usage"
," CMD -h show command usage"
," help [MANUAL] show any of the hledger manuals in various formats"
]
}