lib: refactor the account name parser

This commit is contained in:
Alex Chen 2018-05-21 19:09:47 -06:00 committed by Simon Michael
parent b245ec7b3d
commit 558c11596f
2 changed files with 13 additions and 16 deletions

View File

@ -463,21 +463,15 @@ modifiedaccountnamep = do
-- (This parser will also consume one following space, if present.) -- (This parser will also consume one following space, if present.)
accountnamep :: TextParser m AccountName accountnamep :: TextParser m AccountName
accountnamep = do accountnamep = do
astr <- do firstPart <- part
c <- nonspace otherParts <- many $ try $ singleSpace *> part
cs <- striptrailingspace <$> many (nonspace <|> singlespace) let account = T.unwords $ firstPart : otherParts
return $ c:cs when (accountNameFromComponents (accountNameComponents account) /= account)
let a = T.pack astr (fail $ "account name seems ill-formed: " ++ T.unpack account)
when (accountNameFromComponents (accountNameComponents a) /= a) pure account
(fail $ "account name seems ill-formed: "++astr) where
return a part = takeWhile1P Nothing (not . isSpace)
where singleSpace = void spacenonewline *> notFollowedBy spacenonewline
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
striptrailingspace "" = ""
striptrailingspace s = if last s == ' ' then init s else s
-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
-- <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
--- ** amounts --- ** amounts

View File

@ -75,8 +75,11 @@ showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $
nonspace :: TextParser m Char nonspace :: TextParser m Char
nonspace = satisfy (not . isSpace) nonspace = satisfy (not . isSpace)
isNonNewlineSpace :: Char -> Bool
isNonNewlineSpace c = c /= '\n' && isSpace c
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Void s m Char spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Void s m Char
spacenonewline = satisfy (`elem` " \v\f\t") spacenonewline = satisfy isNonNewlineSpace
restofline :: TextParser m String restofline :: TextParser m String
restofline = anyChar `manyTill` newline restofline = anyChar `manyTill` newline