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).
2024-11-07 21:15:19 +03:00 · 2017-07-27 04:59:55 -07:00 · 2017-07-27 04:59:55 -07:00 · d7d5f8a064
commit d7d5f8a064
parent dccfa6a512
23 changed files with 301 additions and 213 deletions
--- a/bin/hledger-check.hs
+++ b/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
--- a/hledger-lib/Hledger/Data/Dates.hs
+++ b/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
-              return $ intcons 1,
-           do string "every"
-              many spacenonewline
-              string singular
-              return $ intcons 1,
-           do string "every"
-              many spacenonewline
-              n <- fmap read $ some digitChar
-              many spacenonewline
-              string plural
-              return $ intcons n
-           ]
-          where plural = singular ++ "s"
+        choice' [
+          do mptext compact'
+             return $ intcons 1,
+          do mptext "every"
+             many spacenonewline
+             mptext singular'
+             return $ intcons 1,
+          do mptext "every"
+             many spacenonewline
+             n <- fmap read $ some digitChar
+             many spacenonewline
+             mptext plural'
+             return $ intcons n
+          ]
+        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
--- a/hledger-lib/Hledger/Data/StringFormat.hs
+++ b/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)
--- a/hledger-lib/Hledger/Query.hs
+++ b/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
-                         | otherwise = prefixes ++ [""]
-        next <- fmap T.pack $ choice' $ map (string . T.unpack) allowednexts
+        not' <- fromMaybe "" `fmap` (optional $ mptext "not:")
+        let allowednexts | T.null not' = prefixes
+                         | otherwise   = prefixes ++ [""]
+        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'' = [
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/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
--- a/hledger-lib/Hledger/Read/CsvReader.hs
+++ b/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,13 +131,15 @@ 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))
-                     (initialPos parsecfilename) records
+                   (\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.
    -- First, reverse them to get same-date transactions 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
  ["~"
  -- ,"!~"
  -- ,"="
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/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)
--- a/hledger-lib/Hledger/Read/TimeclockReader.hs
+++ b/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])
--- a/hledger-lib/Hledger/Read/TimedotReader.hs
+++ b/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
--- a/hledger-lib/Hledger/Utils/Parse.hs
+++ b/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
--- a/hledger-lib/Hledger/Utils/String.hs
+++ b/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
--- a/hledger-lib/Text/Megaparsec/Compat.hs
+++ b/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
--- a/hledger-lib/hledger-lib.cabal
+++ b/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
--- a/hledger-lib/package.yaml
+++ b/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:
--- a/hledger-ui/hledger-ui.cabal
+++ b/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
--- a/hledger-ui/package.yaml
+++ b/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
--- a/hledger-web/hledger-web.cabal
+++ b/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
--- a/hledger-web/package.yaml
+++ b/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))
--- a/hledger/Hledger/Cli/Add.hs
+++ b/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)
--- a/hledger/Hledger/Cli/CliOptions.hs
+++ b/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
--- a/hledger/hledger.cabal
+++ b/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
--- a/hledger/package.yaml
+++ b/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
--- a/stack.yaml
+++ b/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