imp: better error messages for type:'s argument

This commit is contained in:
Simon Michael 2022-01-30 09:32:52 -10:00
parent 9c872c2d9c
commit a22068a556

View File

@ -70,7 +70,7 @@ where
import Control.Applicative ((<|>), many, optional) import Control.Applicative ((<|>), many, optional)
import Data.Default (Default(..)) import Data.Default (Default(..))
import Data.Either (fromLeft, partitionEithers) import Data.Either (fromLeft, partitionEithers)
import Data.List (partition) import Data.List (partition, intercalate)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
@ -296,7 +296,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
parseQueryTerm _ (T.stripPrefix "type:" -> Just s) = Left <$> parseType s parseQueryTerm _ (T.stripPrefix "type:" -> Just s) = Left <$> parseTypeCodes s
parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm _ "" = Right $ Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
@ -350,39 +350,44 @@ parseTag s = do
return $ Tag tag body return $ Tag tag body
where (n,v) = T.break (=='=') s where (n,v) = T.break (=='=') s
parseType :: T.Text -> Either String Query -- | Parse one or more account type code letters to a query matching any of those types.
parseType s = parseTypeCodes :: T.Text -> Either String Query
parseTypeCodes s =
case partitionEithers $ map (parseAccountType False . T.singleton) $ T.unpack s of case partitionEithers $ map (parseAccountType False . T.singleton) $ T.unpack s of
((e:_),_) -> Left $ "could not parse " <> show e <> " as an account type code.\n" <> help
([],[]) -> Left help
([],ts) -> Right $ Type ts ([],ts) -> Right $ Type ts
((e:_),_) -> Left e where
help = "type:'s argument should be one or more of " ++ accountTypeChoices False ++ " (case insensitive)."
-- Not a great place for this, but avoids an import cycle. accountTypeChoices :: Bool -> String
-- | Case-insensitively parse a single-letter code, or a full word if permitted, as an account type. accountTypeChoices allowlongform =
intercalate ", "
-- keep synced with parseAccountType
$ ["A","L","E","R","X","C","V"]
++ if allowlongform then ["Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] else []
-- | Case-insensitively parse one single-letter code, or one long-form word if permitted, to an account type.
-- On failure, returns the unparseable text.
parseAccountType :: Bool -> Text -> Either String AccountType parseAccountType :: Bool -> Text -> Either String AccountType
parseAccountType allowlongform s = parseAccountType allowlongform s =
case T.toLower s of case T.toLower s of
"asset" | allowlongform -> Right Asset -- keep synced with accountTypeChoices
"a" -> Right Asset "a" -> Right Asset
"liability" | allowlongform -> Right Liability
"l" -> Right Liability "l" -> Right Liability
"equity" | allowlongform -> Right Equity
"e" -> Right Equity "e" -> Right Equity
"revenue" | allowlongform -> Right Revenue
"r" -> Right Revenue "r" -> Right Revenue
"expense" | allowlongform -> Right Expense
"x" -> Right Expense "x" -> Right Expense
"cash" | allowlongform -> Right Cash
"c" -> Right Cash "c" -> Right Cash
"conversion" | allowlongform -> Right Conversion
"v" -> Right Conversion "v" -> Right Conversion
_ -> Left err "asset" | allowlongform -> Right Asset
where "liability" | allowlongform -> Right Liability
err = T.unpack $ "invalid account type " <> s <> ", should be one of " <> "equity" | allowlongform -> Right Equity
(T.intercalate ", " $ "revenue" | allowlongform -> Right Revenue
["A","L","E","R","X","C","V"] "expense" | allowlongform -> Right Expense
++ if allowlongform "cash" | allowlongform -> Right Cash
then ["Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] "conversion" | allowlongform -> Right Conversion
else []) _ -> Left $ T.unpack s
-- | Parse the value part of a "status:" query, or return an error. -- | Parse the value part of a "status:" query, or return an error.
parseStatus :: T.Text -> Either String Status parseStatus :: T.Text -> Either String Status