add support for megaparsec 6 (fixes #594)

Older megaparsec is still supported.
Also cleans up our custom parser types,
and some text (un)packing is done in different places
(possible performance impact).

bin/hledger-check.hs

@@ -98,8 +98,7 @@ import qualified Hledger.Utils.Parse as H
 import Options.Applicative
 import System.Exit (exitFailure)
 import System.FilePath (FilePath)
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Text as P
+import qualified Text.Megaparsec.Compat as P
 
 main :: IO ()
 main = do
@@ -391,7 +390,7 @@ args = info (helper <*> parser) $ mconcat
 
     -- Turn a Parsec parser into a ReadM parser that also returns the
     -- input.
-    readParsec :: H.JournalStateParser ReadM a -> ReadM (String, a)
+    readParsec :: H.JournalParser ReadM a -> ReadM (String, a)
     readParsec p = do
       s <- str
       parsed <- P.runParserT (runStateT p H.nulljournal) "" (pack s)
@@ -418,7 +417,7 @@ data Predicate
   deriving (Eq, Ord, Show)
 
 -- | Parse a 'Predicate'.
-predicatep :: Monad m => H.JournalStateParser m Predicate
+predicatep :: Monad m => H.JournalParser m Predicate
 predicatep = wrap predparensp <|> wrap predcomparep <|> wrap prednotp where
     predparensp  = P.char '(' *> spaces *> predicatep <* spaces <* P.char ')'
     predcomparep = Compare <$> valuep <*> (spaces *> lift comparep <* spaces) <*> valuep
@@ -434,7 +433,7 @@ data Value = Account H.AccountName | AccountNested H.AccountName | Amount H.Amou
   deriving (Eq, Ord, Show)
 
 -- | Parse a 'Value'.
-valuep :: Monad m => H.JournalStateParser m Value
+valuep :: Monad m => H.JournalParser m Value
 -- Account name parser has to come last because they eat everything.
 valuep = valueamountp <|> valueaccountnestedp <|> valueaccountp where
     valueamountp  = Amount  <$> H.amountp

hledger-lib/Hledger/Data/Dates.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-|
 
 Date parsing and utilities for hledger.
@@ -86,8 +87,7 @@ import Data.Time.Calendar.OrdinalDate
 import Data.Time.Clock
 import Data.Time.LocalTime
 import Safe (headMay, lastMay, readMay)
-import Text.Megaparsec
-import Text.Megaparsec.Text
+import Text.Megaparsec.Compat
 import Text.Printf
 
 import Hledger.Data.Types
@@ -256,7 +256,7 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
 
 -- | Parse a period expression to an Interval and overall DateSpan using
 -- the provided reference date, or return a parse error.
-parsePeriodExpr :: Day -> Text -> Either (ParseError Char Dec) (Interval, DateSpan)
+parsePeriodExpr :: Day -> Text -> Either (ParseError Char MPErr) (Interval, DateSpan)
 parsePeriodExpr refdate = parsewith (periodexpr refdate <* eof)
 
 maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
@@ -316,13 +316,13 @@ fixSmartDateStr :: Day -> Text -> String
 fixSmartDateStr d s = either
                        (\e->error' $ printf "could not parse date %s %s" (show s) (show e))
                        id
-                       $ (fixSmartDateStrEither d s :: Either (ParseError Char Dec) String)
+                       $ (fixSmartDateStrEither d s :: Either (ParseError Char MPErr) String)
 
 -- | A safe version of fixSmartDateStr.
-fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char Dec) String
+fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char MPErr) String
 fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d
 
-fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char Dec) Day
+fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char MPErr) Day
 fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
                                Right sd -> Right $ fixSmartDate d sd
                                Left e -> Left e
@@ -550,14 +550,14 @@ and maybe some others:
 Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
 Assumes any text in the parse stream has been lowercased.
 -}
-smartdate :: Parser SmartDate
+smartdate :: SimpleTextParser SmartDate
 smartdate = do
   -- XXX maybe obscures date errors ? see ledgerdate
   (y,m,d) <- choice' [yyyymmdd, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow, lastthisnextthing]
   return (y,m,d)
 
 -- | Like smartdate, but there must be nothing other than whitespace after the date.
-smartdateonly :: Parser SmartDate
+smartdateonly :: SimpleTextParser SmartDate
 smartdateonly = do
   d <- smartdate
   many spacenonewline
@@ -579,7 +579,7 @@ failIfInvalidYear s  = unless (validYear s)  $ fail $ "bad year number: " ++ s
 failIfInvalidMonth s = unless (validMonth s) $ fail $ "bad month number: " ++ s
 failIfInvalidDay s   = unless (validDay s)   $ fail $ "bad day number: " ++ s
 
-yyyymmdd :: Parser SmartDate
+yyyymmdd :: SimpleTextParser SmartDate
 yyyymmdd = do
   y <- count 4 digitChar
   m <- count 2 digitChar
@@ -588,7 +588,7 @@ yyyymmdd = do
   failIfInvalidDay d
   return (y,m,d)
 
-ymd :: Parser SmartDate
+ymd :: SimpleTextParser SmartDate
 ymd = do
   y <- some digitChar
   failIfInvalidYear y
@@ -600,7 +600,7 @@ ymd = do
   failIfInvalidDay d
   return $ (y,m,d)
 
-ym :: Parser SmartDate
+ym :: SimpleTextParser SmartDate
 ym = do
   y <- some digitChar
   failIfInvalidYear y
@@ -609,19 +609,19 @@ ym = do
   failIfInvalidMonth m
   return (y,m,"")
 
-y :: Parser SmartDate
+y :: SimpleTextParser SmartDate
 y = do
   y <- some digitChar
   failIfInvalidYear y
   return (y,"","")
 
-d :: Parser SmartDate
+d :: SimpleTextParser SmartDate
 d = do
   d <- some digitChar
   failIfInvalidDay d
   return ("","",d)
 
-md :: Parser SmartDate
+md :: SimpleTextParser SmartDate
 md = do
   m <- some digitChar
   failIfInvalidMonth m
@@ -636,48 +636,54 @@ monthabbrevs   = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","n
 -- weekdays       = ["monday","tuesday","wednesday","thursday","friday","saturday","sunday"]
 -- weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"]
 
-monthIndex s = maybe 0 (+1) $ lowercase s `elemIndex` months
-monIndex s   = maybe 0 (+1) $ lowercase s `elemIndex` monthabbrevs
+#if MIN_VERSION_megaparsec(6,0,0)
+lc = T.toLower
+#else
+lc = lowercase
+#endif
 
-month :: Parser SmartDate
+monthIndex t = maybe 0 (+1) $ lc t `elemIndex` months
+monIndex t   = maybe 0 (+1) $ lc t `elemIndex` monthabbrevs
+
+month :: SimpleTextParser SmartDate
 month = do
   m <- choice $ map (try . string) months
   let i = monthIndex m
   return ("",show i,"")
 
-mon :: Parser SmartDate
+mon :: SimpleTextParser SmartDate
 mon = do
   m <- choice $ map (try . string) monthabbrevs
   let i = monIndex m
   return ("",show i,"")
 
-today,yesterday,tomorrow :: Parser SmartDate
+today,yesterday,tomorrow :: SimpleTextParser SmartDate
 today     = string "today"     >> return ("","","today")
 yesterday = string "yesterday" >> return ("","","yesterday")
 tomorrow  = string "tomorrow"  >> return ("","","tomorrow")
 
-lastthisnextthing :: Parser SmartDate
+lastthisnextthing :: SimpleTextParser SmartDate
 lastthisnextthing = do
-  r <- choice [
-        string "last"
-       ,string "this"
-       ,string "next"
+  r <- choice $ map mptext [
+        "last"
+       ,"this"
+       ,"next"
       ]
   many spacenonewline  -- make the space optional for easier scripting
-  p <- choice [
-        string "day"
-       ,string "week"
-       ,string "month"
-       ,string "quarter"
-       ,string "year"
+  p <- choice $ map mptext [
+        "day"
+       ,"week"
+       ,"month"
+       ,"quarter"
+       ,"year"
       ]
 -- XXX support these in fixSmartDate
 --       ++ (map string $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs)
 
-  return ("",r,p)
+  return ("", T.unpack r, T.unpack p)
 
 -- |
--- >>> let p = parsewith (periodexpr (parsedate "2008/11/26")) :: T.Text -> Either (ParseError Char Dec) (Interval, DateSpan)
+-- >>> let p = parsewith (periodexpr (parsedate "2008/11/26")) :: T.Text -> Either (ParseError Char MPErr) (Interval, DateSpan)
 -- >>> p "from aug to oct"
 -- Right (NoInterval,DateSpan 2008/08/01-2008/09/30)
 -- >>> p "aug to oct"
@@ -688,7 +694,7 @@ lastthisnextthing = do
 -- Right (Days 1,DateSpan 2008/08/01-)
 -- >>> p "every week to 2009"
 -- Right (Weeks 1,DateSpan -2008/12/31)
-periodexpr :: Day -> Parser (Interval, DateSpan)
+periodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
 periodexpr rdate = choice $ map try [
                     intervalanddateperiodexpr rdate,
                     intervalperiodexpr,
@@ -696,7 +702,7 @@ periodexpr rdate = choice $ map try [
                     (return (NoInterval,DateSpan Nothing Nothing))
                    ]
 
-intervalanddateperiodexpr :: Day -> Parser (Interval, DateSpan)
+intervalanddateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
 intervalanddateperiodexpr rdate = do
   many spacenonewline
   i <- reportinginterval
@@ -704,20 +710,20 @@ intervalanddateperiodexpr rdate = do
   s <- periodexprdatespan rdate
   return (i,s)
 
-intervalperiodexpr :: Parser (Interval, DateSpan)
+intervalperiodexpr :: SimpleTextParser (Interval, DateSpan)
 intervalperiodexpr = do
   many spacenonewline
   i <- reportinginterval
   return (i, DateSpan Nothing Nothing)
 
-dateperiodexpr :: Day -> Parser (Interval, DateSpan)
+dateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
 dateperiodexpr rdate = do
   many spacenonewline
   s <- periodexprdatespan rdate
   return (NoInterval, s)
 
 -- Parse a reporting interval.
-reportinginterval :: Parser Interval
+reportinginterval :: SimpleTextParser Interval
 reportinginterval = choice' [
                        tryinterval "day"     "daily"     Days,
                        tryinterval "week"    "weekly"    Weeks,
@@ -757,25 +763,28 @@ reportinginterval = choice' [
       thsuffix = choice' $ map string ["st","nd","rd","th"]
 
       -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
-      tryinterval :: String -> String -> (Int -> Interval) -> Parser Interval
+      tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval
       tryinterval singular compact intcons =
         choice' [
-           do string compact
+          do mptext compact'
              return $ intcons 1,
-           do string "every"
+          do mptext "every"
              many spacenonewline
-              string singular
+             mptext singular'
              return $ intcons 1,
-           do string "every"
+          do mptext "every"
              many spacenonewline
              n <- fmap read $ some digitChar
              many spacenonewline
-              string plural
+             mptext plural'
              return $ intcons n
           ]
-          where plural = singular ++ "s"
+        where
+          compact'  = T.pack compact
+          singular' = T.pack singular
+          plural'   = T.pack $ singular ++ "s"
 
-periodexprdatespan :: Day -> Parser DateSpan
+periodexprdatespan :: Day -> SimpleTextParser DateSpan
 periodexprdatespan rdate = choice $ map try [
                             doubledatespan rdate,
                             fromdatespan rdate,
@@ -783,7 +792,7 @@ periodexprdatespan rdate = choice $ map try [
                             justdatespan rdate
                            ]
 
-doubledatespan :: Day -> Parser DateSpan
+doubledatespan :: Day -> SimpleTextParser DateSpan
 doubledatespan rdate = do
   optional (string "from" >> many spacenonewline)
   b <- smartdate
@@ -792,7 +801,7 @@ doubledatespan rdate = do
   e <- smartdate
   return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
 
-fromdatespan :: Day -> Parser DateSpan
+fromdatespan :: Day -> SimpleTextParser DateSpan
 fromdatespan rdate = do
   b <- choice [
     do
@@ -806,13 +815,13 @@ fromdatespan rdate = do
     ]
   return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
 
-todatespan :: Day -> Parser DateSpan
+todatespan :: Day -> SimpleTextParser DateSpan
 todatespan rdate = do
   choice [string "to", string "-"] >> many spacenonewline
   e <- smartdate
   return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
 
-justdatespan :: Day -> Parser DateSpan
+justdatespan :: Day -> SimpleTextParser DateSpan
 justdatespan rdate = do
   optional (string "in" >> many spacenonewline)
   d <- smartdate

hledger-lib/Hledger/Data/StringFormat.hs

@@ -19,9 +19,9 @@ import Numeric
 import Data.Char (isPrint)
 import Data.Maybe
 import Test.HUnit
-import Text.Megaparsec
-import Text.Megaparsec.String
+import Text.Megaparsec.Compat
 
+import Hledger.Utils.Parse
 import Hledger.Utils.String (formatString)
 
 -- | A format specification/template to use when rendering a report line item as text.
@@ -86,7 +86,7 @@ parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") in
 
 defaultStringFormatStyle = BottomAligned
 
-stringformatp :: Parser StringFormat
+stringformatp :: SimpleStringParser StringFormat
 stringformatp = do
   alignspec <- optional (try $ char '%' >> oneOf "^_,")
   let constructor =
@@ -97,10 +97,10 @@ stringformatp = do
           _        -> defaultStringFormatStyle
   constructor <$> many componentp
 
-componentp :: Parser StringFormatComponent
+componentp :: SimpleStringParser StringFormatComponent
 componentp = formatliteralp <|> formatfieldp
 
-formatliteralp :: Parser StringFormatComponent
+formatliteralp :: SimpleStringParser StringFormatComponent
 formatliteralp = do
     s <- some c
     return $ FormatLiteral s
@@ -109,7 +109,7 @@ formatliteralp = do
       c =     (satisfy isPrintableButNotPercentage <?> "printable character")
           <|> try (string "%%" >> return '%')
 
-formatfieldp :: Parser StringFormatComponent
+formatfieldp :: SimpleStringParser StringFormatComponent
 formatfieldp = do
     char '%'
     leftJustified <- optional (char '-')
@@ -124,7 +124,7 @@ formatfieldp = do
         Just text -> Just m where ((m,_):_) = readDec text
         _ -> Nothing
 
-fieldp :: Parser ReportItemField
+fieldp :: SimpleStringParser ReportItemField
 fieldp = do
         try (string "account" >> return AccountField)
     <|> try (string "depth_spacer" >> return DepthSpacerField)

hledger-lib/Hledger/Query.hs

@@ -1,7 +1,7 @@
 {-|
 
 A general query system for matching things (accounts, postings,
-transactions..)  by various criteria, and a parser for query expressions.
+transactions..)  by various criteria, and a SimpleTextParser for query expressions.
 
 -}
 
@@ -55,8 +55,7 @@ import qualified Data.Text as T
 import Data.Time.Calendar
 import Safe (readDef, headDef)
 import Test.HUnit
-import Text.Megaparsec
-import Text.Megaparsec.Text
+import Text.Megaparsec.Compat
 
 import Hledger.Utils hiding (words')
 import Hledger.Data.Types
@@ -185,23 +184,23 @@ tests_parseQuery = [
 words'' :: [T.Text] -> T.Text -> [T.Text]
 words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
     where
-      maybeprefixedquotedphrases :: Parser [T.Text]
+      maybeprefixedquotedphrases :: SimpleTextParser [T.Text]
       maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` some spacenonewline
-      prefixedQuotedPattern :: Parser T.Text
+      prefixedQuotedPattern :: SimpleTextParser T.Text
       prefixedQuotedPattern = do
-        not' <- fromMaybe "" `fmap` (optional $ string "not:")
-        let allowednexts | null not' = prefixes
+        not' <- fromMaybe "" `fmap` (optional $ mptext "not:")
+        let allowednexts | T.null not' = prefixes
                          | otherwise   = prefixes ++ [""]
-        next <- fmap T.pack $ choice' $ map (string . T.unpack) allowednexts
+        next <- choice' $ map mptext allowednexts
         let prefix :: T.Text
-            prefix = T.pack not' <> next
+            prefix = not' <> next
         p <- singleQuotedPattern <|> doubleQuotedPattern
         return $ prefix <> stripquotes p
-      singleQuotedPattern :: Parser T.Text
+      singleQuotedPattern :: SimpleTextParser T.Text
       singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])) >>= return . stripquotes . T.pack
-      doubleQuotedPattern :: Parser T.Text
+      doubleQuotedPattern :: SimpleTextParser T.Text
       doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])) >>= return . stripquotes . T.pack
-      pattern :: Parser T.Text
+      pattern :: SimpleTextParser T.Text
       pattern = fmap T.pack $ many (noneOf (" \n\r" :: [Char]))
 
 tests_words'' = [

hledger-lib/Hledger/Read/Common.hs

@@ -36,8 +36,7 @@ import Data.Time.Calendar
 import Data.Time.LocalTime
 import Safe
 import System.Time (getClockTime)
-import Text.Megaparsec hiding (parse,State)
-import Text.Megaparsec.Text
+import Text.Megaparsec.Compat
 
 import Hledger.Data
 import Hledger.Utils
@@ -47,12 +46,12 @@ import Hledger.Utils
 --- * parsing utils
 
 -- | Run a string parser with no state in the identity monad.
-runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char Dec) a
+runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char MPErr) a
 runTextParser p t =  runParser p "" t
 rtp = runTextParser
 
 -- | Run a journal parser with a null journal-parsing state.
-runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char Dec) a)
+runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char MPErr) a)
 runJournalParser p t = runParserT p "" t
 rjp = runJournalParser
 
@@ -89,7 +88,7 @@ parseAndFinaliseJournal parser assrt f txt = do
                         Left e  -> throwError e
     Left e   -> throwError $ parseErrorPretty e
 
-parseAndFinaliseJournal' :: JournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
+parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
 parseAndFinaliseJournal' parser assrt f txt = do
   t <- liftIO getClockTime
   y <- liftIO getCurrentYear
@@ -100,32 +99,32 @@ parseAndFinaliseJournal' parser assrt f txt = do
                         Left e  -> throwError e
     Left e   -> throwError $ parseErrorPretty e
 
-setYear :: Year -> JournalStateParser m ()
+setYear :: Year -> JournalParser m ()
 setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
 
-getYear :: JournalStateParser m (Maybe Year)
+getYear :: JournalParser m (Maybe Year)
 getYear = fmap jparsedefaultyear get
 
-setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalStateParser m ()
+setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()
 setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs})
 
-getDefaultCommodityAndStyle :: JournalStateParser m (Maybe (CommoditySymbol,AmountStyle))
+getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle))
 getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get
 
-pushAccount :: AccountName -> JournalStateParser m ()
+pushAccount :: AccountName -> JournalParser m ()
 pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j})
 
-pushParentAccount :: AccountName -> JournalStateParser m ()
+pushParentAccount :: AccountName -> JournalParser m ()
 pushParentAccount acct = modify' (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j})
 
-popParentAccount :: JournalStateParser m ()
+popParentAccount :: JournalParser m ()
 popParentAccount = do
   j <- get
   case jparseparentaccounts j of
     []       -> unexpected (Tokens ('E' :| "nd of apply account block with no beginning"))
     (_:rest) -> put j{jparseparentaccounts=rest}
 
-getParentAccount :: JournalStateParser m AccountName
+getParentAccount :: JournalParser m AccountName
 getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) get
 
 addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
@@ -181,7 +180,7 @@ statusp =
 codep :: TextParser m String
 codep = try (do { some spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
 
-descriptionp :: JournalStateParser m String
+descriptionp :: JournalParser m String
 descriptionp = many (noneOf (";\n" :: [Char]))
 
 --- ** dates
@@ -190,7 +189,7 @@ descriptionp = many (noneOf (";\n" :: [Char]))
 -- Hyphen (-) and period (.) are also allowed as separators.
 -- The year may be omitted if a default year has been set.
 -- Leading zeroes may be omitted.
-datep :: JournalStateParser m Day
+datep :: JournalParser m Day
 datep = do
   -- hacky: try to ensure precise errors for invalid dates
   -- XXX reported error position is not too good
@@ -220,7 +219,7 @@ datep = do
 -- Seconds are optional.
 -- The timezone is optional and ignored (the time is always interpreted as a local time).
 -- Leading zeroes may be omitted (except in a timezone).
-datetimep :: JournalStateParser m LocalTime
+datetimep :: JournalParser m LocalTime
 datetimep = do
   day <- datep
   lift $ some spacenonewline
@@ -248,7 +247,7 @@ datetimep = do
   -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
   return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
 
-secondarydatep :: Day -> JournalStateParser m Day
+secondarydatep :: Day -> JournalParser m Day
 secondarydatep primarydate = do
   char '='
   -- kludgy way to use primary date for default year
@@ -274,7 +273,7 @@ secondarydatep primarydate = do
 --- ** account names
 
 -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
-modifiedaccountnamep :: JournalStateParser m AccountName
+modifiedaccountnamep :: JournalParser m AccountName
 modifiedaccountnamep = do
   parent <- getParentAccount
   aliases <- getAccountAliases
@@ -313,7 +312,7 @@ accountnamep = do
 -- | Parse whitespace then an amount, with an optional left or right
 -- currency symbol and optional price, or return the special
 -- "missing" marker amount.
-spaceandamountormissingp :: Monad m => JournalStateParser m MixedAmount
+spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
 spaceandamountormissingp =
   try (do
         lift $ some spacenonewline
@@ -337,7 +336,7 @@ test_spaceandamountormissingp = do
 -- | Parse a single-commodity amount, with optional symbol on the left or
 -- right, optional unit or total price, and optional (ignored)
 -- ledger-style balance assertion or fixed lot price declaration.
-amountp :: Monad m => JournalStateParser m Amount
+amountp :: Monad m => JournalParser m Amount
 amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
 
 #ifdef TESTS
@@ -377,7 +376,7 @@ multiplierp = do
   return $ case multiplier of Just '*' -> True
                               _        -> False
 
-leftsymbolamountp :: Monad m => JournalStateParser m Amount
+leftsymbolamountp :: Monad m => JournalParser m Amount
 leftsymbolamountp = do
   sign <- lift signp
   m <- lift multiplierp
@@ -390,7 +389,7 @@ leftsymbolamountp = do
   return $ applysign $ Amount c q p s m
   <?> "left-symbol amount"
 
-rightsymbolamountp :: Monad m => JournalStateParser m Amount
+rightsymbolamountp :: Monad m => JournalParser m Amount
 rightsymbolamountp = do
   m <- lift multiplierp
   (q,prec,mdec,mgrps) <- lift numberp
@@ -401,7 +400,7 @@ rightsymbolamountp = do
   return $ Amount c q p s m
   <?> "right-symbol amount"
 
-nosymbolamountp :: Monad m => JournalStateParser m Amount
+nosymbolamountp :: Monad m => JournalParser m Amount
 nosymbolamountp = do
   m <- lift multiplierp
   (q,prec,mdec,mgrps) <- lift numberp
@@ -427,7 +426,7 @@ quotedcommoditysymbolp = do
 simplecommoditysymbolp :: TextParser m CommoditySymbol
 simplecommoditysymbolp = T.pack <$> some (noneOf nonsimplecommoditychars)
 
-priceamountp :: Monad m => JournalStateParser m Price
+priceamountp :: Monad m => JournalParser m Price
 priceamountp =
     try (do
           lift (many spacenonewline)
@@ -443,7 +442,7 @@ priceamountp =
             return $ UnitPrice a))
          <|> return NoPrice
 
-partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe Amount)
+partialbalanceassertionp :: Monad m => JournalParser m (Maybe Amount)
 partialbalanceassertionp =
     try (do
           lift (many spacenonewline)
@@ -464,7 +463,7 @@ partialbalanceassertionp =
 --          <|> return Nothing
 
 -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
-fixedlotpricep :: Monad m => JournalStateParser m (Maybe Amount)
+fixedlotpricep :: Monad m => JournalParser m (Maybe Amount)
 fixedlotpricep =
     try (do
           lift (many spacenonewline)
@@ -564,7 +563,7 @@ numberp = do
 
 --- ** comments
 
-multilinecommentp :: JournalStateParser m ()
+multilinecommentp :: JournalParser m ()
 multilinecommentp = do
   string "comment" >> lift (many spacenonewline) >> newline
   go
@@ -573,13 +572,13 @@ multilinecommentp = do
          <|> (anyLine >> go)
     anyLine = anyChar `manyTill` newline
 
-emptyorcommentlinep :: JournalStateParser m ()
+emptyorcommentlinep :: JournalParser m ()
 emptyorcommentlinep = do
   lift (many spacenonewline) >> (commentp <|> (lift (many spacenonewline) >> newline >> return ""))
   return ()
 
 -- | Parse a possibly multi-line comment following a semicolon.
-followingcommentp :: JournalStateParser m Text
+followingcommentp :: JournalParser m Text
 followingcommentp =
   -- ptrace "followingcommentp"
   do samelinecomment <- lift (many spacenonewline) >> (try semicoloncommentp <|> (newline >> return ""))
@@ -641,16 +640,16 @@ followingcommentandtagsp mdefdate = do
 
   return (comment, tags, mdate, mdate2)
 
-commentp :: JournalStateParser m Text
+commentp :: JournalParser m Text
 commentp = commentStartingWithp commentchars
 
 commentchars :: [Char]
 commentchars = "#;*"
 
-semicoloncommentp :: JournalStateParser m Text
+semicoloncommentp :: JournalParser m Text
 semicoloncommentp = commentStartingWithp ";"
 
-commentStartingWithp :: [Char] -> JournalStateParser m Text
+commentStartingWithp :: [Char] -> JournalParser m Text
 commentStartingWithp cs = do
   -- ptrace "commentStartingWith"
   oneOf cs
@@ -681,7 +680,7 @@ commentTags s =
     Left _  -> [] -- shouldn't happen
 
 -- | Parse all tags found in a string.
-tagsp :: Parser [Tag]
+tagsp :: SimpleTextParser [Tag]
 tagsp = -- do
   -- pdbg 0 $ "tagsp"
   many (try (nontagp >> tagp))
@@ -690,7 +689,7 @@ tagsp = -- do
 --
 -- >>> rtp nontagp "\na b:, \nd:e, f"
 -- Right "\na "
-nontagp :: Parser String
+nontagp :: SimpleTextParser String
 nontagp = -- do
   -- pdbg 0 "nontagp"
   -- anyChar `manyTill` (lookAhead (try (tagorbracketeddatetagsp Nothing >> return ()) <|> eof))
@@ -704,7 +703,7 @@ nontagp = -- do
 -- >>> rtp tagp "a:b b , c AuxDate: 4/2"
 -- Right ("a","b b")
 --
-tagp :: Parser Tag
+tagp :: SimpleTextParser Tag
 tagp = do
   -- pdbg 0 "tagp"
   n <- tagnamep
@@ -714,7 +713,7 @@ tagp = do
 -- |
 -- >>> rtp tagnamep "a:"
 -- Right "a"
-tagnamep :: Parser Text
+tagnamep :: SimpleTextParser Text
 tagnamep = -- do
   -- pdbg 0 "tagnamep"
   T.pack <$> some (noneOf (": \t\n" :: [Char])) <* char ':'
@@ -761,13 +760,13 @@ datetagp :: Monad m => Maybe Day -> ErroringJournalParser m (TagName,Day)
 datetagp mdefdate = do
   -- pdbg 0 "datetagp"
   string "date"
-  n <- T.pack . fromMaybe "" <$> optional (string "2")
+  n <- fromMaybe "" <$> optional (mptext "2")
   char ':'
   startpos <- getPosition
   v <- lift tagvaluep
   -- re-parse value as a date.
   j <- get
-  let ep :: Either (ParseError Char Dec) Day
+  let ep :: Either (ParseError Char MPErr) Day
       ep = parseWithState'
              j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
              -- The value extends to a comma, newline, or end of file.
@@ -827,7 +826,7 @@ bracketeddatetagsp mdefdate = do
   -- looks sufficiently like a bracketed date, now we
   -- re-parse as dates and throw any errors
   j <- get
-  let ep :: Either (ParseError Char Dec) (Maybe Day, Maybe Day)
+  let ep :: Either (ParseError Char MPErr) (Maybe Day, Maybe Day)
       ep = parseWithState'
              j{jparsedefaultyear=first3.toGregorian <$> mdefdate}
              (do

hledger-lib/Hledger/Read/CsvReader.hs

@@ -38,7 +38,6 @@ import Data.Char (toLower, isDigit, isSpace)
 import Data.List.Compat
 import Data.Maybe
 import Data.Ord
-import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -54,8 +53,7 @@ import System.Directory (doesFileExist)
 import System.FilePath
 import Test.HUnit hiding (State)
 import Text.CSV (parseCSV, CSV)
-import Text.Megaparsec hiding (parse, State)
-import Text.Megaparsec.Text
+import Text.Megaparsec.Compat hiding (parse)
 import qualified Text.Parsec as Parsec
 import Text.Printf (printf)
 
@@ -133,12 +131,14 @@ readJournalFromCsv mrulesfile csvfile csvdata =
   let 
     -- convert CSV records to transactions
     txns = snd $ mapAccumL
-                     (\pos r -> (pos,
-                                 transactionFromCsvRecord
-                                   (let SourcePos name line col =  pos in
-                                    SourcePos name (unsafePos $ unPos line + 1) col)
-                                   rules
-                                    r))
+                   (\pos r -> 
+                      let
+                        SourcePos name line col = pos
+                        line' = (mpMkPos . (+1) . mpUnPos) line
+                        pos' = SourcePos name line' col
+                      in
+                        (pos, transactionFromCsvRecord pos' rules r)
+                   )
                    (initialPos parsecfilename) records
 
     -- Ensure transactions are ordered chronologically.
@@ -312,7 +312,7 @@ data CsvRules = CsvRules {
   rconditionalblocks :: [ConditionalBlock]
 } deriving (Show, Eq)
 
-type CsvRulesParser a = StateT CsvRules Parser a
+type CsvRulesParser a = StateT CsvRules SimpleTextParser a
 
 type DirectiveName    = String
 type CsvFieldName     = String
@@ -390,14 +390,11 @@ parseAndValidateCsvRules rulesfile s = do
     Right r -> do
                r_ <- liftIO $ runExceptT $ validateRules r
                ExceptT $ case r_ of
-                 Left e -> return $ Left $ parseErrorPretty $ toParseError e
+                 Left  s -> return $ Left $ parseErrorPretty $ mpMkParseError rulesfile s
                  Right r -> return $ Right r
-  where
-    toParseError :: forall s. Ord s => s -> ParseError Char s
-    toParseError s = (mempty :: ParseError Char s) { errorCustom = S.singleton s}
 
 -- | Parse this text as CSV conversion rules. The file path is for error messages.
-parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char Dec) CsvRules
+parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char MPErr) CsvRules
 -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
 parseCsvRules rulesfile s =
   runParser (evalStateT rulesp rules) rulesfile s
@@ -449,10 +446,10 @@ commentcharp = oneOf (";#*" :: [Char])
 directivep :: CsvRulesParser (DirectiveName, String)
 directivep = (do
   lift $ pdbg 3 "trying directive"
-  d <- choiceInState $ map string directives
+  d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives
   v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
        <|> (optional (char ':') >> lift (many spacenonewline) >> lift eolof >> return "")
-  return (d,v)
+  return (d, v)
   ) <?> "directive"
 
 directives =
@@ -505,7 +502,9 @@ fieldassignmentp = do
   <?> "field assignment"
 
 journalfieldnamep :: CsvRulesParser String
-journalfieldnamep = lift (pdbg 2 "trying journalfieldnamep") >> choiceInState (map string journalfieldnames)
+journalfieldnamep = do
+  lift (pdbg 2 "trying journalfieldnamep")
+  T.unpack <$> choiceInState (map (lift . mptext . T.pack) journalfieldnames)
 
 -- Transaction fields and pseudo fields for CSV conversion. 
 -- Names must precede any other name they contain, for the parser 
@@ -565,7 +564,7 @@ recordmatcherp = do
   <?> "record matcher"
 
 matchoperatorp :: CsvRulesParser String
-matchoperatorp = choiceInState $ map string
+matchoperatorp = fmap T.unpack $ choiceInState $ map mptext
   ["~"
   -- ,"!~"
   -- ,"="

hledger-lib/Hledger/Read/JournalReader.hs

@@ -90,7 +90,7 @@ import Test.HUnit
 import Test.Framework
 import Text.Megaparsec.Error
 #endif
-import Text.Megaparsec hiding (parse)
+import Text.Megaparsec.Compat hiding (parse)
 import Text.Printf
 import System.FilePath
 
@@ -187,7 +187,7 @@ includedirectivep = do
       let curdir = takeDirectory (sourceName parentpos)
       filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename)
       txt      <- readFileAnyLineEnding filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
-      (ej1::Either (ParseError Char Dec) ParsedJournal) <-
+      (ej1::Either (ParseError Char MPErr) ParsedJournal) <-
         runParserT
            (evalStateT
               (choiceInState
@@ -227,7 +227,7 @@ orRethrowIOError io msg =
     (Right <$> io)
     `C.catch` \(e::C.IOException) -> return $ Left $ printf "%s:\n%s" msg (show e)
 
-accountdirectivep :: JournalStateParser m ()
+accountdirectivep :: JournalParser m ()
 accountdirectivep = do
   string "account"
   lift (some spacenonewline)
@@ -237,7 +237,7 @@ accountdirectivep = do
   modify' (\j -> j{jaccounts = acct : jaccounts j})
 
 
-indentedlinep :: JournalStateParser m String
+indentedlinep :: JournalParser m String
 indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline)
 
 -- | Parse a one-line or multi-line commodity directive.
@@ -253,7 +253,7 @@ commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemulti
 --
 -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00"
 -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
-commoditydirectiveonelinep :: Monad m => JournalStateParser m ()
+commoditydirectiveonelinep :: Monad m => JournalParser m ()
 commoditydirectiveonelinep = do
   string "commodity"
   lift (some spacenonewline)
@@ -292,7 +292,7 @@ formatdirectivep expectedsym = do
     else parserErrorAt pos $
          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
 
-applyaccountdirectivep :: JournalStateParser m ()
+applyaccountdirectivep :: JournalParser m ()
 applyaccountdirectivep = do
   string "apply" >> lift (some spacenonewline) >> string "account"
   lift (some spacenonewline)
@@ -300,12 +300,12 @@ applyaccountdirectivep = do
   newline
   pushParentAccount parent
 
-endapplyaccountdirectivep :: JournalStateParser m ()
+endapplyaccountdirectivep :: JournalParser m ()
 endapplyaccountdirectivep = do
   string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account"
   popParentAccount
 
-aliasdirectivep :: JournalStateParser m ()
+aliasdirectivep :: JournalParser m ()
 aliasdirectivep = do
   string "alias"
   lift (some spacenonewline)
@@ -336,12 +336,12 @@ regexaliasp = do
   repl <- rstrip <$> anyChar `manyTill` eolof
   return $ RegexAlias re repl
 
-endaliasesdirectivep :: JournalStateParser m ()
+endaliasesdirectivep :: JournalParser m ()
 endaliasesdirectivep = do
   string "end aliases"
   clearAccountAliases
 
-tagdirectivep :: JournalStateParser m ()
+tagdirectivep :: JournalParser m ()
 tagdirectivep = do
   string "tag" <?> "tag directive"
   lift (some spacenonewline)
@@ -349,13 +349,13 @@ tagdirectivep = do
   lift restofline
   return ()
 
-endtagdirectivep :: JournalStateParser m ()
+endtagdirectivep :: JournalParser m ()
 endtagdirectivep = do
   (string "end tag" <|> string "pop") <?> "end tag or pop directive"
   lift restofline
   return ()
 
-defaultyeardirectivep :: JournalStateParser m ()
+defaultyeardirectivep :: JournalParser m ()
 defaultyeardirectivep = do
   char 'Y' <?> "default year"
   lift (many spacenonewline)
@@ -364,7 +364,7 @@ defaultyeardirectivep = do
   failIfInvalidYear y
   setYear y'
 
-defaultcommoditydirectivep :: Monad m => JournalStateParser m ()
+defaultcommoditydirectivep :: Monad m => JournalParser m ()
 defaultcommoditydirectivep = do
   char 'D' <?> "default commodity"
   lift (some spacenonewline)
@@ -372,7 +372,7 @@ defaultcommoditydirectivep = do
   lift restofline
   setDefaultCommodityAndStyle (acommodity, astyle)
 
-marketpricedirectivep :: Monad m => JournalStateParser m MarketPrice
+marketpricedirectivep :: Monad m => JournalParser m MarketPrice
 marketpricedirectivep = do
   char 'P' <?> "market price"
   lift (many spacenonewline)
@@ -384,7 +384,7 @@ marketpricedirectivep = do
   lift restofline
   return $ MarketPrice date symbol price
 
-ignoredpricecommoditydirectivep :: JournalStateParser m ()
+ignoredpricecommoditydirectivep :: JournalParser m ()
 ignoredpricecommoditydirectivep = do
   char 'N' <?> "ignored-price commodity"
   lift (some spacenonewline)
@@ -392,7 +392,7 @@ ignoredpricecommoditydirectivep = do
   lift restofline
   return ()
 
-commodityconversiondirectivep :: Monad m => JournalStateParser m ()
+commodityconversiondirectivep :: Monad m => JournalParser m ()
 commodityconversiondirectivep = do
   char 'C' <?> "commodity conversion"
   lift (some spacenonewline)

hledger-lib/Hledger/Read/TimeclockReader.hs

@@ -60,7 +60,7 @@ import           Data.Maybe (fromMaybe)
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Test.HUnit
-import           Text.Megaparsec hiding (parse)
+import           Text.Megaparsec.Compat hiding (parse)
 
 import           Hledger.Data
 -- XXX too much reuse ?
@@ -105,7 +105,7 @@ timeclockfilep = do many timeclockitemp
                           ] <?> "timeclock entry, or default year or historical price directive"
 
 -- | Parse a timeclock entry.
-timeclockentryp :: JournalStateParser m TimeclockEntry
+timeclockentryp :: JournalParser m TimeclockEntry
 timeclockentryp = do
   sourcepos <- genericSourcePos <$> lift getPosition
   code <- oneOf ("bhioO" :: [Char])

hledger-lib/Hledger/Read/TimedotReader.hs

@@ -42,7 +42,7 @@ import Data.List (foldl')
 import Data.Maybe
 import Data.Text (Text)
 import Test.HUnit
-import Text.Megaparsec hiding (parse)
+import Text.Megaparsec.Compat hiding (parse)
 
 import Hledger.Data
 import Hledger.Read.Common
@@ -66,12 +66,12 @@ reader = Reader
 parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
 parse _ = parseAndFinaliseJournal timedotfilep
 
-timedotfilep :: JournalStateParser m ParsedJournal
+timedotfilep :: JournalParser m ParsedJournal
 timedotfilep = do many timedotfileitemp
                   eof
                   get
     where
-      timedotfileitemp :: JournalStateParser m ()
+      timedotfileitemp :: JournalParser m ()
       timedotfileitemp = do
         ptrace "timedotfileitemp"
         choice [
@@ -89,7 +89,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts)
 -- biz.research .
 -- inc.client1  .... .... .... .... .... ....
 -- @
-timedotdayp :: JournalStateParser m [Transaction]
+timedotdayp :: JournalParser m [Transaction]
 timedotdayp = do
   ptrace " timedotdayp"
   d <- datep <* lift eolof
@@ -101,7 +101,7 @@ timedotdayp = do
 -- @
 -- fos.haskell  .... ..
 -- @
-timedotentryp :: JournalStateParser m Transaction
+timedotentryp :: JournalParser m Transaction
 timedotentryp = do
   ptrace "  timedotentryp"
   pos <- genericSourcePos <$> getPosition
@@ -125,14 +125,14 @@ timedotentryp = do
         }
   return t
 
-timedotdurationp :: JournalStateParser m Quantity
+timedotdurationp :: JournalParser m Quantity
 timedotdurationp = try timedotnumberp <|> timedotdotsp
 
 -- | Parse a duration written as a decimal number of hours (optionally followed by the letter h).
 -- @
 -- 1.5h
 -- @
-timedotnumberp :: JournalStateParser m Quantity
+timedotnumberp :: JournalParser m Quantity
 timedotnumberp = do
    (q, _, _, _) <- lift numberp
    lift (many spacenonewline)
@@ -144,7 +144,7 @@ timedotnumberp = do
 -- @
 -- .... ..
 -- @
-timedotdotsp :: JournalStateParser m Quantity
+timedotdotsp :: JournalParser m Quantity
 timedotdotsp = do
   dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
   return $ (/4) $ fromIntegral $ length dots

hledger-lib/Hledger/Utils/Parse.hs

@@ -1,38 +1,42 @@
-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE CPP, TypeFamilies #-}
 module Hledger.Utils.Parse where
 
 import Control.Monad.Except
+import Control.Monad.State.Strict (StateT, evalStateT)
 import Data.Char
+import Data.Functor.Identity (Identity(..))
 import Data.List
 import Data.Text (Text)
-import Text.Megaparsec hiding (State)
-import Data.Functor.Identity (Identity(..))
+import Text.Megaparsec.Compat
 import Text.Printf
 
-import Control.Monad.State.Strict (StateT, evalStateT)
-
 import Hledger.Data.Types
 import Hledger.Utils.UTF8IOCompat (error')
 
--- | A parser of strict text with generic user state, monad and return type.
-type TextParser m a = ParsecT Dec Text m a
+-- | A parser of string to some type.
+type SimpleStringParser a = Parsec MPErr String a
 
-type JournalStateParser m a = StateT Journal (ParsecT Dec Text m) a
+-- | A parser of strict text to some type.
+type SimpleTextParser = Parsec MPErr Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow
 
-type JournalParser a = StateT Journal (ParsecT Dec Text Identity) a
+-- | A parser of text in some monad.
+type TextParser m a = ParsecT MPErr Text m a
 
--- | A journal parser that runs in IO and can throw an error mid-parse.
-type ErroringJournalParser m a = StateT Journal (ParsecT Dec Text (ExceptT String m)) a
+-- | A parser of text in some monad, with a journal as state.
+type JournalParser m a = StateT Journal (ParsecT MPErr Text m) a
+
+-- | A parser of text in some monad, with a journal as state, that can throw an error string mid-parse.
+type ErroringJournalParser m a = StateT Journal (ParsecT MPErr Text (ExceptT String m)) a
 
 -- | Backtracking choice, use this when alternatives share a prefix.
 -- Consumes no input if all choices fail.
 choice' :: [TextParser m a] -> TextParser m a
-choice' = choice . map Text.Megaparsec.try
+choice' = choice . map try
 
 -- | Backtracking choice, use this when alternatives share a prefix.
 -- Consumes no input if all choices fail.
-choiceInState :: [StateT s (ParsecT Dec Text m) a] -> StateT s (ParsecT Dec Text m) a
-choiceInState = choice . map Text.Megaparsec.try
+choiceInState :: [StateT s (ParsecT MPErr Text m) a] -> StateT s (ParsecT MPErr Text m) a
+choiceInState = choice . map try
 
 parsewith :: Parsec e Text a -> Text -> Either (ParseError Char e) a
 parsewith p = runParser p ""
@@ -40,10 +44,15 @@ parsewith p = runParser p ""
 parsewithString :: Parsec e String a -> String -> Either (ParseError Char e) a
 parsewithString p = runParser p ""
 
-parseWithState :: Monad m => st -> StateT st (ParsecT Dec Text m) a -> Text -> m (Either (ParseError Char Dec) a)
+parseWithState :: Monad m => st -> StateT st (ParsecT MPErr Text m) a -> Text -> m (Either (ParseError Char MPErr) a)
 parseWithState ctx p s = runParserT (evalStateT p ctx) "" s
 
-parseWithState' :: (Stream s, ErrorComponent e) => st -> StateT st (ParsecT e s Identity) a -> s -> (Either (ParseError (Token s) e) a)
+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' ctx p s = runParser (evalStateT p ctx) "" s
 
 fromparse :: (Show t, Show e) => Either (ParseError t e) a -> a
@@ -61,7 +70,7 @@ showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $
 nonspace :: TextParser m Char
 nonspace = satisfy (not . isSpace)
 
-spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Dec s m Char
+spacenonewline :: (Stream s, Char ~ Token s) => ParsecT MPErr s m Char
 spacenonewline = satisfy (`elem` " \v\f\t")
 
 restofline :: TextParser m String

hledger-lib/Hledger/Utils/String.hs

@@ -49,7 +49,7 @@ module Hledger.Utils.String (
 
 import Data.Char
 import Data.List
-import Text.Megaparsec
+import Text.Megaparsec.Compat
 import Text.Printf (printf)
 
 import Hledger.Utils.Parse

hledger-lib/Text/Megaparsec/Compat.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE CPP, FlexibleContexts #-}
+
+module Text.Megaparsec.Compat
+(module Text.Megaparsec
+#if MIN_VERSION_megaparsec(6,0,0)
+,module Text.Megaparsec.Char
+#endif
+,MPErr
+,mptext
+,mpMkPos
+,mpUnPos
+,mpMkParseError
+)
+where
+
+import qualified Data.Set as S
+import Data.Text
+import Text.Megaparsec
+
+#if MIN_VERSION_megaparsec(6,0,0)
+
+import Text.Megaparsec.Char
+import Data.List.NonEmpty (fromList)
+import Data.Void (Void)
+
+-- | A basic parse error type.
+type MPErr = ErrorFancy Void
+
+-- | Parse and return some Text.  
+mptext :: MonadParsec e Text m => Tokens Text -> m (Tokens Text) 
+mptext = string
+
+#else
+
+import Text.Megaparsec.Prim (MonadParsec)
+
+type MPErr = Dec
+
+mptext :: MonadParsec e Text m => Text -> m Text
+mptext = fmap pack . string . unpack
+
+#endif
+
+mpMkPos :: Int -> Pos
+mpMkPos = 
+#if MIN_VERSION_megaparsec(6,0,0)
+            mkPos
+#else
+            unsafePos . fromIntegral 
+#endif
+
+mpUnPos :: Pos -> Int
+mpUnPos = 
+#if MIN_VERSION_megaparsec(6,0,0)
+            unPos
+#else
+            fromIntegral . unPos 
+#endif
+
+mpMkParseError :: FilePath -> String -> ParseError Char String
+mpMkParseError f s = 
+#if MIN_VERSION_megaparsec(6,0,0)
+  FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s)
+#else
+  (mempty :: ParseError Char String){errorCustom = S.singleton $ f ++ ": " ++ s}
+#endif

hledger-lib/hledger-lib.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.17.0.
+-- This file has been generated from package.yaml by hpack version 0.17.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -72,7 +72,7 @@ library
     , directory
     , filepath
     , hashtables >= 1.2
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , mtl
     , mtl-compat
     , old-time
@@ -141,6 +141,7 @@ library
       Hledger.Utils.Text
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
+      Text.Megaparsec.Compat
   other-modules:
       Paths_hledger_lib
   default-language: Haskell2010
@@ -168,7 +169,7 @@ test-suite doctests
     , directory
     , filepath
     , hashtables >= 1.2
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , mtl
     , mtl-compat
     , old-time
@@ -230,6 +231,7 @@ test-suite doctests
       Hledger.Utils.Text
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
+      Text.Megaparsec.Compat
   default-language: Haskell2010
 
 test-suite hunittests
@@ -255,7 +257,7 @@ test-suite hunittests
     , directory
     , filepath
     , hashtables >= 1.2
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , mtl
     , mtl-compat
     , old-time
@@ -326,4 +328,5 @@ test-suite hunittests
       Hledger.Utils.Text
       Hledger.Utils.Tree
       Hledger.Utils.UTF8IOCompat
+      Text.Megaparsec.Compat
   default-language: Haskell2010

hledger-lib/package.yaml

@@ -54,7 +54,7 @@ dependencies:
 - directory
 - filepath
 - hashtables >= 1.2
-- megaparsec >=5.0 && < 5.4
+- megaparsec >=5.0 && < 6.1
 - mtl
 - mtl-compat
 - old-time
@@ -127,6 +127,7 @@ library:
   - Hledger.Utils.Text
   - Hledger.Utils.Tree
   - Hledger.Utils.UTF8IOCompat
+  - Text.Megaparsec.Compat
 #  other-modules:
 #  - Ledger.Parser.Text
   dependencies:

hledger-ui/hledger-ui.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.17.0.
+-- This file has been generated from package.yaml by hpack version 0.17.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -72,7 +72,7 @@ executable hledger-ui
     , HUnit
     , microlens >= 0.4 && < 0.5
     , microlens-platform >= 0.2.3.1 && < 0.4
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , pretty-show >=1.6.4
     , process >= 1.2
     , safe >= 0.2

hledger-ui/package.yaml

@@ -63,7 +63,7 @@ executables:
       - HUnit
       - microlens >= 0.4 && < 0.5
       - microlens-platform >= 0.2.3.1 && < 0.4
-      - megaparsec >=5.0 && < 5.4
+      - megaparsec >=5.0 && < 6.1
       - pretty-show >=1.6.4
       - process >= 1.2
       - safe >= 0.2

hledger-web/hledger-web.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.17.0.
+-- This file has been generated from package.yaml by hpack version 0.17.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -159,7 +159,7 @@ library
     , yesod-form
     , yesod-static
     , json
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , mtl
   if (flag(dev)) || (flag(library-only))
     cpp-options: -DDEVELOPMENT

hledger-web/package.yaml

@@ -119,7 +119,7 @@ library:
   - Settings.Development
   - Settings.StaticFiles
   dependencies:
-  - megaparsec >=5.0 && < 5.4
+  - megaparsec >=5.0 && < 6.1
   - mtl
   when:
   - condition: (flag(dev)) || (flag(library-only))

hledger/Hledger/Cli/Add.hs

@@ -3,7 +3,7 @@ A history-aware add command to help with data entry.
 |-}
 
 {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
-{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-}
 
 module Hledger.Cli.Add
 where
@@ -16,6 +16,7 @@ import Control.Monad.Trans.Class
 import Control.Monad.State.Strict (evalState, evalStateT)
 import Control.Monad.Trans (liftIO)
 import Data.Char (toUpper, toLower)
+import Data.Functor.Identity (Identity(..))
 import Data.List.Compat
 import qualified Data.Set as S
 import Data.Maybe
@@ -30,8 +31,7 @@ import System.Console.Haskeline.Completion
 import System.Console.Wizard
 import System.Console.Wizard.Haskeline
 import System.IO ( stderr, hPutStr, hPutStrLn )
-import Text.Megaparsec
-import Text.Megaparsec.Text
+import Text.Megaparsec.Compat
 import Text.Printf
 
 import Hledger
@@ -187,7 +187,7 @@ dateAndCodeWizard EntryState{..} = do
       parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc
           where
             edc = runParser (dateandcodep <* eof) "" $ T.pack $ lowercase s
-            dateandcodep :: Parser (SmartDate, Text)
+            dateandcodep :: SimpleTextParser (SmartDate, Text)
             dateandcodep = do
                 d <- smartdate
                 c <- optional codep
@@ -285,7 +285,7 @@ amountAndCommentWizard EntryState{..} = do
                                   ""
                                   (T.pack s)
       nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing}
-      amountandcommentp :: JournalParser (Amount, Text)
+      amountandcommentp :: JournalParser Identity (Amount, Text)
       amountandcommentp = do
         a <- amountp
         lift (many spacenonewline)

hledger/Hledger/Cli/CliOptions.hs

@@ -5,7 +5,7 @@ related utilities used by hledger commands.
 
 -}
 
-{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TypeFamilies, OverloadedStrings #-}
 
 module Hledger.Cli.CliOptions (
 
@@ -94,7 +94,7 @@ import System.Environment
 import System.Exit (exitSuccess)
 import System.FilePath
 import Test.HUnit
-import Text.Megaparsec
+import Text.Megaparsec.Compat
 
 import Hledger
 import Hledger.Cli.DocFiles
@@ -549,7 +549,7 @@ rulesFilePathFromOpts opts = do
 widthFromOpts :: CliOpts -> Int
 widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
 widthFromOpts CliOpts{width_=Just s}  =
-    case runParser (read `fmap` some digitChar <* eof :: ParsecT Dec String Identity Int) "(unknown)" s of
+    case runParser (read `fmap` some digitChar <* eof :: ParsecT MPErr String Identity Int) "(unknown)" s of
         Left e   -> usageError $ "could not parse width option: "++show e
         Right w  -> w
 
@@ -571,7 +571,7 @@ registerWidthsFromOpts CliOpts{width_=Just s}  =
         Left e   -> usageError $ "could not parse width option: "++show e
         Right ws -> ws
     where
-        registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Dec s m (Int, Maybe Int)
+        registerwidthp :: (Stream s, Char ~ Token s) => ParsecT MPErr s m (Int, Maybe Int)
         registerwidthp = do
           totalwidth <- read `fmap` some digitChar
           descwidth <- optional (char ',' >> read `fmap` some digitChar)
@@ -665,10 +665,10 @@ isHledgerExeName :: String -> Bool
 isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
     where
       hledgerexenamep = do
-        _ <- string progname
+        _ <- mptext $ T.pack progname
         _ <- char '-'
-        _ <- some (noneOf ".")
-        optional (string "." >> choice' (map string addonExtensions))
+        _ <- some $ noneOf ['.']
+        optional (string "." >> choice' (map (mptext . T.pack) addonExtensions))
         eof
 
 stripAddonExtension :: String -> String

hledger/hledger.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.17.0.
+-- This file has been generated from package.yaml by hpack version 0.17.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -106,7 +106,7 @@ library
     , mtl
     , mtl-compat
     , old-time
-    , megaparsec >=5.0 && < 5.4
+    , megaparsec >=5.0 && < 6.1
     , regex-tdfa
     , safe >=0.2
     , split >=0.1 && <0.3

hledger/package.yaml

@@ -120,7 +120,7 @@ library:
   - mtl
   - mtl-compat
   - old-time
-  - megaparsec >=5.0 && < 5.4
+  - megaparsec >=5.0 && < 6.1
   - regex-tdfa
   - safe >=0.2
   - split >=0.1 && <0.3

stack.yaml

@@ -3,7 +3,11 @@
 
 resolver: lts-8.23
 
-extra-deps: []
+extra-deps:
+ []
+#megaparsec >=6: 
+#- megaparsec-6.0.0
+#- parser-combinators-0.1.0
 
 packages:
 - hledger-lib