lib: change some parsers to use takeWhileP

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

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)

hledger-lib/Hledger/Read/Common.hs

@@ -345,11 +345,14 @@ statusp =
     ]
     <?> "cleared status"
 
-codep :: TextParser m String
+codep :: TextParser m Text
-codep = try (do { skipSome spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
+codep = try codep' <|> pure "" where
+  codep' = do
+    skipSome spacenonewline
+    between (char '(' <?> "codep") (char ')') $ takeWhileP Nothing (/= ')')
 
-descriptionp :: JournalParser m String
+descriptionp :: JournalParser m Text
-descriptionp = many (noneOf (";\n" :: [Char]))
+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
+quotedcommoditysymbolp =
-  char '"'
+  between (char '"') (char '"') $
-  s <- some $ noneOf (";\n\"" :: [Char])
+    takeWhile1P Nothing $ \c -> c /= ';' && c /= '\n' && c /= '\"'
-  char '"'
-  return $ T.pack s
 
 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 ()
+    isBreak :: Char -> Bool
-    break = void spaceChar <|> void (char ':') <|> eof
+    isBreak c = isSpace c || c == ':'
 
     tillNextBreak :: SimpleTextParser Text
-    tillNextBreak = T.pack <$> anyChar `manyTill` lookAhead break
+    tillNextBreak = takeWhileP Nothing (not . isBreak)
 
     tagValue :: SimpleTextParser Text
-    tagValue =
+    tagValue = T.strip <$> takeWhileP Nothing (not . commaOrNewline)
-      T.strip . T.pack <$> anyChar `manyTill` (void (char ',') <|> eolof)
+      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 ['['])
+               (skipMany $ notChar '[')
-  -- using noneOf ['['] in place of notChar '[' for backwards compatibility
 
 --- ** bracketed dates
 
@@ -1054,8 +1054,8 @@ bracketeddatetagsp mdefdate = do
   try $ do
     s <- lookAhead
        $ between (char '[') (char ']')
-       $ some $ digitChar <|> datesepchar <|> char '='
+       $ takeWhile1P Nothing isBracketedDateChar
-    unless (any isDigit s && any (`elem` datesepchars) s) $
+    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 == '='

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"
+  code <- lift codep <?> "transaction code"
-  description <- T.pack . strip <$> descriptionp
+  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 ""
 

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' :: (
+parseWithState'
-  Stream s 
+  :: (Stream s)
-#if !MIN_VERSION_megaparsec(6,0,0)
+  => st
-  ,ErrorComponent e
+  -> StateT st (ParsecT e s Identity) a
-#endif
+  -> s
-  ) => st -> StateT st (ParsecT e s Identity) a -> s -> (Either (ParseError (Token s) e) a)
+  -> (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

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