diff --git a/hledger-lib/Hledger/Data/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 519fa199a..c82d690c2 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -12,6 +12,7 @@ are thousands separated by comma, significant decimal places and so on. module Hledger.Data.Commodity where +import Data.Char (isDigit) import Data.List import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) @@ -28,7 +29,13 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] -quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) (T.unpack s) = "\"" <> s <> "\"" +isNonsimpleCommodityChar :: Char -> Bool +isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars + where + otherChars = "-+.@*;\n \"{}=" :: T.Text + textElem = T.any . (==) + +quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\"" | otherwise = s commodity = "" diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 9a16aa741..fcbe69b34 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -50,6 +50,7 @@ module Hledger.Data.Dates ( failIfInvalidDay, datesepchar, datesepchars, + isDateSepChar, spanStart, spanEnd, spansSpan, @@ -738,8 +739,12 @@ smartdateonly = do datesepchars :: [Char] datesepchars = "/-." + datesepchar :: TextParser m Char -datesepchar = oneOf datesepchars +datesepchar = satisfy isDateSepChar + +isDateSepChar :: Char -> Bool +isDateSepChar c = c == '/' || c == '-' || c == '.' validYear, validMonth, validDay :: String -> Bool validYear s = length s >= 4 && isJust (readMay s :: Maybe Year) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 332d88734..61836ee0d 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -345,11 +345,14 @@ statusp = ] "cleared status" -codep :: TextParser m String -codep = try (do { skipSome spacenonewline; char '(' "codep"; anyChar `manyTill` char ')' } ) <|> return "" +codep :: TextParser m Text +codep = try codep' <|> pure "" where + codep' = do + skipSome spacenonewline + between (char '(' "codep") (char ')') $ takeWhileP Nothing (/= ')') -descriptionp :: JournalParser m String -descriptionp = many (noneOf (";\n" :: [Char])) +descriptionp :: JournalParser m Text +descriptionp = takeWhileP Nothing $ \c -> c /= ';' && c /= '\n' --- ** dates @@ -467,7 +470,7 @@ accountnamep = do otherParts <- many $ try $ singleSpace *> part let account = T.unwords $ firstPart : otherParts when (accountNameFromComponents (accountNameComponents account) /= account) - (fail $ "account name seems ill-formed: " ++ T.unpack account) + (fail $ "account name seems ill-formed: " ++ T.unpack account) pure account where part = takeWhile1P Nothing (not . isSpace) @@ -602,14 +605,12 @@ commoditysymbolp :: TextParser m CommoditySymbol commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) "commodity symbol" quotedcommoditysymbolp :: TextParser m CommoditySymbol -quotedcommoditysymbolp = do - char '"' - s <- some $ noneOf (";\n\"" :: [Char]) - char '"' - return $ T.pack s +quotedcommoditysymbolp = + between (char '"') (char '"') $ + takeWhile1P Nothing $ \c -> c /= ';' && c /= '\n' && c /= '\"' simplecommoditysymbolp :: TextParser m CommoditySymbol -simplecommoditysymbolp = T.pack <$> some (noneOf nonsimplecommoditychars) +simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) priceamountp :: Monad m => JournalParser m Price priceamountp = @@ -816,7 +817,7 @@ multilinecommentp = startComment *> anyLine `skipManyTill` endComment endComment = eof <|> (string "end comment" >> emptyLine) emptyLine = void $ skipMany spacenonewline *> newline - anyLine = anyChar `manyTill` newline + anyLine = takeWhileP Nothing (\c -> c /= '\n') *> newline emptyorcommentlinep :: TextParser m () emptyorcommentlinep = do @@ -933,7 +934,7 @@ commentStartingWithp f = do satisfy f skipMany spacenonewline startPos <- getPosition - content <- T.pack <$> anyChar `manyTill` eolof + content <- takeWhileP Nothing (\c -> c /= '\n') optional newline return (startPos, content) @@ -977,15 +978,15 @@ tagswithvaluepositions = do where - break :: SimpleTextParser () - break = void spaceChar <|> void (char ':') <|> eof + isBreak :: Char -> Bool + isBreak c = isSpace c || c == ':' tillNextBreak :: SimpleTextParser Text - tillNextBreak = T.pack <$> anyChar `manyTill` lookAhead break + tillNextBreak = takeWhileP Nothing (not . isBreak) tagValue :: SimpleTextParser Text - tagValue = - T.strip . T.pack <$> anyChar `manyTill` (void (char ',') <|> eolof) + tagValue = T.strip <$> takeWhileP Nothing (not . commaOrNewline) + where commaOrNewline c = c == ',' || c == '\n' atSpaceChar :: SimpleTextParser [(SourcePos, Tag)] atSpaceChar = skipSome spaceChar *> tagswithvaluepositions @@ -1014,11 +1015,10 @@ tagswithvaluepositions = do bracketedpostingdatesp :: Maybe Day -> SimpleTextParser [(TagName,Day)] bracketedpostingdatesp mdefdate = do -- pdbg 0 $ "bracketedpostingdatesp" - skipMany $ noneOf ['['] + skipMany $ notChar '[' fmap concat $ sepEndBy (bracketeddatetagsp mdefdate <|> char '[' *> pure []) - (skipMany $ noneOf ['[']) - -- using noneOf ['['] in place of notChar '[' for backwards compatibility + (skipMany $ notChar '[') --- ** bracketed dates @@ -1054,8 +1054,8 @@ bracketeddatetagsp mdefdate = do try $ do s <- lookAhead $ between (char '[') (char ']') - $ some $ digitChar <|> datesepchar <|> char '=' - unless (any isDigit s && any (`elem` datesepchars) s) $ + $ takeWhile1P Nothing isBracketedDateChar + unless (T.any isDigit s && T.any isDateSepChar s) $ fail "not a bracketed date" -- Looks sufficiently like a bracketed date to commit to parsing a date @@ -1064,8 +1064,10 @@ bracketeddatetagsp mdefdate = do md1 <- optional $ datep' myear1 let myear2 = fmap readYear md1 <|> myear1 - md2 <- optional $ char '=' *> (datep' myear2) + md2 <- optional $ char '=' *> datep' myear2 pure $ catMaybes [("date",) <$> md1, ("date2",) <$> md2] - where readYear = first3 . toGregorian + where + readYear = first3 . toGregorian + isBracketedDateChar c = isDigit c || isDateSepChar c || c == '=' diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index ff1a1686a..e106d8f14 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -464,7 +464,7 @@ periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp = do char '~' "periodic transaction" lift (skipMany spacenonewline) - periodexpr <- T.pack . strip <$> descriptionp + periodexpr <- T.strip <$> descriptionp _ <- lift followingcommentp postings <- postingsp Nothing return $ PeriodicTransaction periodexpr postings @@ -478,12 +478,12 @@ transactionp = do edate <- optional (secondarydatep date) "secondary date" lookAhead (lift spacenonewline <|> newline) "whitespace or newline" status <- lift statusp "cleared status" - code <- T.pack <$> lift codep "transaction code" - description <- T.pack . strip <$> descriptionp + code <- lift codep "transaction code" + description <- T.strip <$> descriptionp comment <- lift followingcommentp let tags = commentTags comment postings <- postingsp (Just date) - pos' <- getPosition + pos' <- getPosition let sourcepos = journalSourcePos pos pos' return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings "" diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index c920683b1..62a9fed94 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -52,12 +52,12 @@ parsewithString p = runParser p "" parseWithState :: Monad m => st -> StateT st (ParsecT Void Text m) a -> Text -> m (Either (ParseError Char Void) a) parseWithState ctx p s = runParserT (evalStateT p ctx) "" s -parseWithState' :: ( - Stream s -#if !MIN_VERSION_megaparsec(6,0,0) - ,ErrorComponent e -#endif - ) => st -> StateT st (ParsecT e s Identity) a -> s -> (Either (ParseError (Token s) e) a) +parseWithState' + :: (Stream s) + => st + -> StateT st (ParsecT e s Identity) a + -> s + -> (Either (ParseError (Token s) e) a) parseWithState' ctx p s = runParser (evalStateT p ctx) "" s fromparse :: (Show t, Show e) => Either (ParseError t e) a -> a diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 61ad4e278..3af5ca493 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -200,7 +200,7 @@ dateAndCodeWizard EntryState{..} = do c <- optional codep skipMany spacenonewline eof - return (d, T.pack $ fromMaybe "" c) + return (d, fromMaybe "" c) -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate -- datestr = showDate $ fixSmartDate defday smtdate