diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 701cf8069..7968ea85c 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -105,7 +105,7 @@ data Query = Any -- ^ always match -- and sometimes like a query option (for controlling display) | Tag Regexp (Maybe Regexp) -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps -- matching the regexp if provided, exists - deriving (Eq,Data,Typeable) + deriving (Eq,Show,Data,Typeable) -- | Construct a payee tag payeeTag :: Maybe String -> Either RegexError Query @@ -115,26 +115,6 @@ payeeTag = liftA2 Tag (toRegexCI_ "payee") . maybe (pure Nothing) (fmap Just . t 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" - show None = "None" - show (Not q) = "Not (" ++ show q ++ ")" - show (Or qs) = "Or (" ++ show qs ++ ")" - show (And qs) = "And (" ++ show qs ++ ")" - show (Code r) = "Code " ++ show r - show (Desc r) = "Desc " ++ show r - show (Acct r) = "Acct " ++ show r - show (Date ds) = "Date (" ++ show ds ++ ")" - show (Date2 ds) = "Date2 (" ++ show ds ++ ")" - show (StatusQ b) = "StatusQ " ++ show b - show (Real b) = "Real " ++ show b - show (Amt ord qty) = "Amt " ++ show ord ++ " " ++ show qty - show (Sym r) = "Sym " ++ show r - show (Empty b) = "Empty " ++ show b - show (Depth n) = "Depth " ++ show n - show (Tag s ms) = "Tag " ++ show s ++ " (" ++ show ms ++ ")" - -- | A more expressive Ord, used for amt: queries. The Abs* variants -- compare with the absolute value of a number, ignoring sign. data OrdPlus = Lt | LtEq | Gt | GtEq | Eq | AbsLt | AbsLtEq | AbsGt | AbsGtEq | AbsEq @@ -190,11 +170,10 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo -- 4. then all terms are AND'd together -- -- >>> parseQuery nulldate "expenses:dining out" --- Right (Or ([Acct "expenses:dining",Acct "out"]),[]) +-- Right (Or [Acct (RegexpCI "expenses:dining"),Acct (RegexpCI "out")],[]) -- -- >>> parseQuery nulldate "\"expenses:dining out\"" --- Right (Acct "expenses:dining out",[]) --- +-- Right (Acct (RegexpCI "expenses:dining out"),[]) parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt]) parseQuery d s = do let termstrs = words'' prefixes s diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index d21a88358..ba12cb896 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -76,7 +76,6 @@ module Hledger.Utils.Regex ( ) where -import Control.Arrow (first) import Control.Monad (foldM) import Data.Aeson (ToJSON(..), Value(String)) import Data.Array ((!), elems, indices) @@ -111,13 +110,19 @@ instance Ord Regexp where 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 + showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (reString r) + where app_prec = 10 + reCons = case r of Regexp _ _ -> showString "Regexp " + RegexpCI _ _ -> showString "RegexpCI " 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 + readsPrec d r = readParen (d > app_prec) (\r -> [(toRegexCI' m,t) | + ("RegexCI",s) <- lex r, + (m,t) <- readsPrec (app_prec+1) s]) r + ++ readParen (d > app_prec) (\r -> [(toRegex' m, t) | + ("Regex",s) <- lex r, + (m,t) <- readsPrec (app_prec+1) s]) r + where app_prec = 10 instance Data Regexp where toConstr _ = error' "No toConstr for Regex"