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

lib: Improve Read and Show instances for Regexp, get rid of custom show instance for Query.

Browse Source
This commit is contained in:
Stephen Morgan 2020-08-18 11:32:15 +10:00
parent e3b2c94353
commit 01f5a92761
2 changed files with 14 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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