lib: remove the megaparsec compatability module
This commit is contained in:
		
							parent
							
								
									c4ba7542d7
								
							
						
					
					
						commit
						b245ec7b3d
					
				| @ -103,7 +103,8 @@ import qualified Hledger.Utils.Parse as H | |||||||
| import Options.Applicative | import Options.Applicative | ||||||
| import System.Exit (exitFailure) | import System.Exit (exitFailure) | ||||||
| import System.FilePath (FilePath) | import System.FilePath (FilePath) | ||||||
| import qualified Text.Megaparsec.Compat as P | import qualified Text.Megaparsec as P | ||||||
|  | import qualified Text.Megaparsec.Char as P | ||||||
| 
 | 
 | ||||||
| main :: IO () | main :: IO () | ||||||
| main = do | main = do | ||||||
|  | |||||||
| @ -89,8 +89,10 @@ import Data.Time.Calendar | |||||||
| import Data.Time.Calendar.OrdinalDate | import Data.Time.Calendar.OrdinalDate | ||||||
| import Data.Time.Clock | import Data.Time.Clock | ||||||
| import Data.Time.LocalTime | import Data.Time.LocalTime | ||||||
|  | import Data.Void (Void) | ||||||
| import Safe (headMay, lastMay, readMay) | import Safe (headMay, lastMay, readMay) | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import Text.Megaparsec.Perm | import Text.Megaparsec.Perm | ||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| @ -309,7 +311,7 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2 | |||||||
| 
 | 
 | ||||||
| -- | Parse a period expression to an Interval and overall DateSpan using | -- | Parse a period expression to an Interval and overall DateSpan using | ||||||
| -- the provided reference date, or return a parse error. | -- the provided reference date, or return a parse error. | ||||||
| parsePeriodExpr :: Day -> Text -> Either (ParseError Char MPErr) (Interval, DateSpan) | parsePeriodExpr :: Day -> Text -> Either (ParseError Char Void) (Interval, DateSpan) | ||||||
| parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s) | parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s) | ||||||
| 
 | 
 | ||||||
| maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan) | maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan) | ||||||
| @ -369,13 +371,13 @@ fixSmartDateStr :: Day -> Text -> String | |||||||
| fixSmartDateStr d s = either | fixSmartDateStr d s = either | ||||||
|                        (\e->error' $ printf "could not parse date %s %s" (show s) (show e)) |                        (\e->error' $ printf "could not parse date %s %s" (show s) (show e)) | ||||||
|                        id |                        id | ||||||
|                        $ (fixSmartDateStrEither d s :: Either (ParseError Char MPErr) String) |                        $ (fixSmartDateStrEither d s :: Either (ParseError Char Void) String) | ||||||
| 
 | 
 | ||||||
| -- | A safe version of fixSmartDateStr. | -- | A safe version of fixSmartDateStr. | ||||||
| fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char MPErr) String | fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char Void) String | ||||||
| fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d | fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d | ||||||
| 
 | 
 | ||||||
| fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char MPErr) Day | fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char Void) Day | ||||||
| fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of | fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of | ||||||
|                                Right sd -> Right $ fixSmartDate d sd |                                Right sd -> Right $ fixSmartDate d sd | ||||||
|                                Left e -> Left e |                                Left e -> Left e | ||||||
| @ -841,13 +843,13 @@ tomorrow  = string "tomorrow"  >> return ("","","tomorrow") | |||||||
| 
 | 
 | ||||||
| lastthisnextthing :: SimpleTextParser SmartDate | lastthisnextthing :: SimpleTextParser SmartDate | ||||||
| lastthisnextthing = do | lastthisnextthing = do | ||||||
|   r <- choice $ map mptext [ |   r <- choice $ map string [ | ||||||
|         "last" |         "last" | ||||||
|        ,"this" |        ,"this" | ||||||
|        ,"next" |        ,"next" | ||||||
|       ] |       ] | ||||||
|   skipMany spacenonewline  -- make the space optional for easier scripting |   skipMany spacenonewline  -- make the space optional for easier scripting | ||||||
|   p <- choice $ map mptext [ |   p <- choice $ map string [ | ||||||
|         "day" |         "day" | ||||||
|        ,"week" |        ,"week" | ||||||
|        ,"month" |        ,"month" | ||||||
| @ -982,17 +984,17 @@ reportinginterval = choice' [ | |||||||
|       tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval |       tryinterval :: String -> String -> (Int -> Interval) -> SimpleTextParser Interval | ||||||
|       tryinterval singular compact intcons = |       tryinterval singular compact intcons = | ||||||
|         choice' [ |         choice' [ | ||||||
|           do mptext compact' |           do string compact' | ||||||
|              return $ intcons 1, |              return $ intcons 1, | ||||||
|           do mptext "every" |           do string "every" | ||||||
|              skipMany spacenonewline |              skipMany spacenonewline | ||||||
|              mptext singular' |              string singular' | ||||||
|              return $ intcons 1, |              return $ intcons 1, | ||||||
|           do mptext "every" |           do string "every" | ||||||
|              skipMany spacenonewline |              skipMany spacenonewline | ||||||
|              n <- fmap read $ some digitChar |              n <- fmap read $ some digitChar | ||||||
|              skipMany spacenonewline |              skipMany spacenonewline | ||||||
|              mptext plural' |              string plural' | ||||||
|              return $ intcons n |              return $ intcons n | ||||||
|           ] |           ] | ||||||
|         where |         where | ||||||
|  | |||||||
| @ -19,7 +19,8 @@ import Numeric | |||||||
| import Data.Char (isPrint) | import Data.Char (isPrint) | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils.Parse | import Hledger.Utils.Parse | ||||||
| import Hledger.Utils.String (formatString) | import Hledger.Utils.String (formatString) | ||||||
|  | |||||||
| @ -58,7 +58,8 @@ import qualified Data.Text as T | |||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Safe (readDef, headDef) | import Safe (readDef, headDef) | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (words') | import Hledger.Utils hiding (words') | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| @ -191,10 +192,10 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX | |||||||
|       maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline |       maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline | ||||||
|       prefixedQuotedPattern :: SimpleTextParser T.Text |       prefixedQuotedPattern :: SimpleTextParser T.Text | ||||||
|       prefixedQuotedPattern = do |       prefixedQuotedPattern = do | ||||||
|         not' <- fromMaybe "" `fmap` (optional $ mptext "not:") |         not' <- fromMaybe "" `fmap` (optional $ string "not:") | ||||||
|         let allowednexts | T.null not' = prefixes |         let allowednexts | T.null not' = prefixes | ||||||
|                          | otherwise   = prefixes ++ [""] |                          | otherwise   = prefixes ++ [""] | ||||||
|         next <- choice' $ map mptext allowednexts |         next <- choice' $ map string allowednexts | ||||||
|         let prefix :: T.Text |         let prefix :: T.Text | ||||||
|             prefix = not' <> next |             prefix = not' <> next | ||||||
|         p <- singleQuotedPattern <|> doubleQuotedPattern |         p <- singleQuotedPattern <|> doubleQuotedPattern | ||||||
|  | |||||||
| @ -112,9 +112,10 @@ import Data.Text (Text) | |||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Data.Time.LocalTime | import Data.Time.LocalTime | ||||||
|  | import Data.Void (Void) | ||||||
| import System.Time (getClockTime) | import System.Time (getClockTime) | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
| import Control.Applicative.Combinators (skipManyTill) | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| @ -181,13 +182,13 @@ rawOptsToInputOpts rawopts = InputOpts{ | |||||||
| --- * parsing utilities | --- * parsing utilities | ||||||
| 
 | 
 | ||||||
| -- | Run a string parser with no state in the identity monad. | -- | Run a string parser with no state in the identity monad. | ||||||
| runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char MPErr) a | runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char Void) a | ||||||
| runTextParser p t =  runParser p "" t | runTextParser p t =  runParser p "" t | ||||||
| rtp = runTextParser | rtp = runTextParser | ||||||
| 
 | 
 | ||||||
| -- XXX odd, why doesn't this take a JournalParser ? | -- XXX odd, why doesn't this take a JournalParser ? | ||||||
| -- | Run a journal parser with a null journal-parsing state. | -- | Run a journal parser with a null journal-parsing state. | ||||||
| runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char MPErr) a) | runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char Void) a) | ||||||
| runJournalParser p t = runParserT p "" t | runJournalParser p t = runParserT p "" t | ||||||
| rjp = runJournalParser | rjp = runJournalParser | ||||||
| 
 | 
 | ||||||
| @ -913,7 +914,7 @@ followingcommentandtagsp mdefdate = do | |||||||
|       runTextParser (setPosition pos *> parser) txt |       runTextParser (setPosition pos *> parser) txt | ||||||
| 
 | 
 | ||||||
|     tagDate :: (SourcePos, Tag) |     tagDate :: (SourcePos, Tag) | ||||||
|             -> Either (ParseError Char MPErr) (TagName, Day) |             -> Either (ParseError Char Void) (TagName, Day) | ||||||
|     tagDate (pos, (name, value)) = |     tagDate (pos, (name, value)) = | ||||||
|       fmap (name,) $ runTextParserAt (datep' myear) (pos, value) |       fmap (name,) $ runTextParserAt (datep' myear) (pos, value) | ||||||
|       where myear = fmap (first3 . toGregorian) mdefdate |       where myear = fmap (first3 . toGregorian) mdefdate | ||||||
|  | |||||||
| @ -36,12 +36,15 @@ import Control.Monad.State.Strict (StateT, get, modify', evalStateT) | |||||||
| -- import Test.HUnit | -- import Test.HUnit | ||||||
| import Data.Char (toLower, isDigit, isSpace) | import Data.Char (toLower, isDigit, isSpace) | ||||||
| import Data.List.Compat | import Data.List.Compat | ||||||
|  | import Data.List.NonEmpty (fromList) | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import Data.Ord | import Data.Ord | ||||||
|  | import qualified Data.Set as S | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import qualified Data.Text.IO as T | import qualified Data.Text.IO as T | ||||||
| import Data.Time.Calendar (Day) | import Data.Time.Calendar (Day) | ||||||
|  | import Data.Void (Void) | ||||||
| #if MIN_VERSION_time(1,5,0) | #if MIN_VERSION_time(1,5,0) | ||||||
| import Data.Time.Format (parseTimeM, defaultTimeLocale) | import Data.Time.Format (parseTimeM, defaultTimeLocale) | ||||||
| #else | #else | ||||||
| @ -53,7 +56,8 @@ import System.Directory (doesFileExist) | |||||||
| import System.FilePath | import System.FilePath | ||||||
| import Test.HUnit hiding (State) | import Test.HUnit hiding (State) | ||||||
| import Text.CSV (parseCSV, CSV) | import Text.CSV (parseCSV, CSV) | ||||||
| import Text.Megaparsec.Compat hiding (parse) | import Text.Megaparsec hiding (parse) | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import qualified Text.Parsec as Parsec | import qualified Text.Parsec as Parsec | ||||||
| import Text.Printf (printf) | import Text.Printf (printf) | ||||||
| 
 | 
 | ||||||
| @ -135,7 +139,7 @@ readJournalFromCsv mrulesfile csvfile csvdata = | |||||||
|                    (\pos r ->  |                    (\pos r ->  | ||||||
|                       let |                       let | ||||||
|                         SourcePos name line col = pos |                         SourcePos name line col = pos | ||||||
|                         line' = (mpMkPos . (+1) . mpUnPos) line |                         line' = (mkPos . (+1) . unPos) line | ||||||
|                         pos' = SourcePos name line' col |                         pos' = SourcePos name line' col | ||||||
|                       in |                       in | ||||||
|                         (pos, transactionFromCsvRecord pos' rules r) |                         (pos, transactionFromCsvRecord pos' rules r) | ||||||
| @ -391,11 +395,15 @@ parseAndValidateCsvRules rulesfile s = do | |||||||
|     Right r -> do |     Right r -> do | ||||||
|                r_ <- liftIO $ runExceptT $ validateRules r |                r_ <- liftIO $ runExceptT $ validateRules r | ||||||
|                ExceptT $ case r_ of |                ExceptT $ case r_ of | ||||||
|                  Left  s -> return $ Left $ parseErrorPretty $ mpMkParseError rulesfile s |                  Left  s -> return $ Left $ parseErrorPretty $ makeParseError rulesfile s | ||||||
|                  Right r -> return $ Right r |                  Right r -> return $ Right r | ||||||
| 
 | 
 | ||||||
|  |   where | ||||||
|  |     makeParseError :: FilePath -> String -> ParseError Char String | ||||||
|  |     makeParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s) | ||||||
|  | 
 | ||||||
| -- | Parse this text as CSV conversion rules. The file path is for error messages. | -- | Parse this text as CSV conversion rules. The file path is for error messages. | ||||||
| parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char MPErr) CsvRules | parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char Void) CsvRules | ||||||
| -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s | -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s | ||||||
| parseCsvRules rulesfile s = | parseCsvRules rulesfile s = | ||||||
|   runParser (evalStateT rulesp rules) rulesfile s |   runParser (evalStateT rulesp rules) rulesfile s | ||||||
| @ -447,7 +455,7 @@ commentcharp = oneOf (";#*" :: [Char]) | |||||||
| directivep :: CsvRulesParser (DirectiveName, String) | directivep :: CsvRulesParser (DirectiveName, String) | ||||||
| directivep = (do | directivep = (do | ||||||
|   lift $ pdbg 3 "trying directive" |   lift $ pdbg 3 "trying directive" | ||||||
|   d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives |   d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives | ||||||
|   v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) |   v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) | ||||||
|        <|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "") |        <|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "") | ||||||
|   return (d, v) |   return (d, v) | ||||||
| @ -505,7 +513,7 @@ fieldassignmentp = do | |||||||
| journalfieldnamep :: CsvRulesParser String | journalfieldnamep :: CsvRulesParser String | ||||||
| journalfieldnamep = do | journalfieldnamep = do | ||||||
|   lift (pdbg 2 "trying journalfieldnamep") |   lift (pdbg 2 "trying journalfieldnamep") | ||||||
|   T.unpack <$> choiceInState (map (lift . mptext . T.pack) journalfieldnames) |   T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) | ||||||
| 
 | 
 | ||||||
| -- Transaction fields and pseudo fields for CSV conversion.  | -- Transaction fields and pseudo fields for CSV conversion.  | ||||||
| -- Names must precede any other name they contain, for the parser  | -- Names must precede any other name they contain, for the parser  | ||||||
| @ -565,7 +573,7 @@ recordmatcherp = do | |||||||
|   <?> "record matcher" |   <?> "record matcher" | ||||||
| 
 | 
 | ||||||
| matchoperatorp :: CsvRulesParser String | matchoperatorp :: CsvRulesParser String | ||||||
| matchoperatorp = fmap T.unpack $ choiceInState $ map mptext | matchoperatorp = fmap T.unpack $ choiceInState $ map string | ||||||
|   ["~" |   ["~" | ||||||
|   -- ,"!~" |   -- ,"!~" | ||||||
|   -- ,"=" |   -- ,"=" | ||||||
|  | |||||||
| @ -87,13 +87,15 @@ import Data.List | |||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Data.Time.LocalTime | import Data.Time.LocalTime | ||||||
|  | import Data.Void (Void) | ||||||
| import Safe | import Safe | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| #ifdef TESTS | #ifdef TESTS | ||||||
| import Test.Framework | import Test.Framework | ||||||
| import Text.Megaparsec.Error | import Text.Megaparsec.Error | ||||||
| #endif | #endif | ||||||
| import Text.Megaparsec.Compat hiding (parse) | import Text.Megaparsec hiding (parse) | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import Text.Printf | import Text.Printf | ||||||
| import System.FilePath | import System.FilePath | ||||||
| 
 | 
 | ||||||
| @ -200,7 +202,7 @@ includedirectivep = do | |||||||
|       let curdir = takeDirectory (sourceName parentpos) |       let curdir = takeDirectory (sourceName parentpos) | ||||||
|       filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename) |       filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename) | ||||||
|       txt      <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) |       txt      <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) | ||||||
|       (ej1::Either (ParseError Char MPErr) ParsedJournal) <- |       (ej1::Either (ParseError Char Void) ParsedJournal) <- | ||||||
|         runParserT |         runParserT | ||||||
|            (evalStateT |            (evalStateT | ||||||
|               (choiceInState |               (choiceInState | ||||||
|  | |||||||
| @ -60,7 +60,8 @@ import           Data.Maybe (fromMaybe) | |||||||
| import           Data.Text (Text) | import           Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import           Test.HUnit | import           Test.HUnit | ||||||
| import           Text.Megaparsec.Compat hiding (parse) | import           Text.Megaparsec hiding (parse) | ||||||
|  | import           Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import           Hledger.Data | import           Hledger.Data | ||||||
| -- XXX too much reuse ? | -- XXX too much reuse ? | ||||||
|  | |||||||
| @ -44,7 +44,8 @@ import Data.List (foldl') | |||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Megaparsec.Compat hiding (parse) | import Text.Megaparsec hiding (parse) | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Read.Common | import Hledger.Read.Common | ||||||
|  | |||||||
| @ -7,26 +7,28 @@ import Data.Char | |||||||
| import Data.Functor.Identity (Identity(..)) | import Data.Functor.Identity (Identity(..)) | ||||||
| import Data.List | import Data.List | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import Text.Megaparsec.Compat | import Data.Void (Void) | ||||||
|  | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Utils.UTF8IOCompat (error') | import Hledger.Utils.UTF8IOCompat (error') | ||||||
| 
 | 
 | ||||||
| -- | A parser of string to some type. | -- | A parser of string to some type. | ||||||
| type SimpleStringParser a = Parsec MPErr String a | type SimpleStringParser a = Parsec Void String a | ||||||
| 
 | 
 | ||||||
| -- | A parser of strict text to some type. | -- | A parser of strict text to some type. | ||||||
| type SimpleTextParser = Parsec MPErr Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow | type SimpleTextParser = Parsec Void Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow | ||||||
| 
 | 
 | ||||||
| -- | A parser of text in some monad. | -- | A parser of text in some monad. | ||||||
| type TextParser m a = ParsecT MPErr Text m a | type TextParser m a = ParsecT Void Text m a | ||||||
| 
 | 
 | ||||||
| -- | A parser of text in some monad, with a journal as state. | -- | A parser of text in some monad, with a journal as state. | ||||||
| type JournalParser m a = StateT Journal (ParsecT MPErr Text m) a | type JournalParser m a = StateT Journal (ParsecT Void Text m) a | ||||||
| 
 | 
 | ||||||
| -- | A parser of text in some monad, with a journal as state, that can throw an error string mid-parse. | -- | 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 | type ErroringJournalParser m a = StateT Journal (ParsecT Void Text (ExceptT String m)) a | ||||||
| 
 | 
 | ||||||
| -- | Backtracking choice, use this when alternatives share a prefix. | -- | Backtracking choice, use this when alternatives share a prefix. | ||||||
| -- Consumes no input if all choices fail. | -- Consumes no input if all choices fail. | ||||||
| @ -35,7 +37,7 @@ choice' = choice . map try | |||||||
| 
 | 
 | ||||||
| -- | Backtracking choice, use this when alternatives share a prefix. | -- | Backtracking choice, use this when alternatives share a prefix. | ||||||
| -- Consumes no input if all choices fail. | -- Consumes no input if all choices fail. | ||||||
| choiceInState :: [StateT s (ParsecT MPErr Text m) a] -> StateT s (ParsecT MPErr Text m) a | choiceInState :: [StateT s (ParsecT Void Text m) a] -> StateT s (ParsecT Void Text m) a | ||||||
| choiceInState = choice . map try | choiceInState = choice . map try | ||||||
| 
 | 
 | ||||||
| surroundedBy :: Applicative m => m openclose -> m a -> m a | surroundedBy :: Applicative m => m openclose -> m a -> m a | ||||||
| @ -47,7 +49,7 @@ parsewith p = runParser p "" | |||||||
| parsewithString :: Parsec e String a -> String -> Either (ParseError Char e) a | parsewithString :: Parsec e String a -> String -> Either (ParseError Char e) a | ||||||
| parsewithString p = runParser p "" | parsewithString p = runParser p "" | ||||||
| 
 | 
 | ||||||
| parseWithState :: Monad m => st -> StateT st (ParsecT MPErr Text m) a -> Text -> m (Either (ParseError Char MPErr) a) | parseWithState :: Monad m => st -> StateT st (ParsecT Void Text m) a -> Text -> m (Either (ParseError Char Void) a) | ||||||
| parseWithState ctx p s = runParserT (evalStateT p ctx) "" s | parseWithState ctx p s = runParserT (evalStateT p ctx) "" s | ||||||
| 
 | 
 | ||||||
| parseWithState' :: ( | parseWithState' :: ( | ||||||
| @ -73,7 +75,7 @@ showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ | |||||||
| nonspace :: TextParser m Char | nonspace :: TextParser m Char | ||||||
| nonspace = satisfy (not . isSpace) | nonspace = satisfy (not . isSpace) | ||||||
| 
 | 
 | ||||||
| spacenonewline :: (Stream s, Char ~ Token s) => ParsecT MPErr s m Char | spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Void s m Char | ||||||
| spacenonewline = satisfy (`elem` " \v\f\t") | spacenonewline = satisfy (`elem` " \v\f\t") | ||||||
| 
 | 
 | ||||||
| restofline :: TextParser m String | restofline :: TextParser m String | ||||||
|  | |||||||
| @ -49,7 +49,8 @@ module Hledger.Utils.String ( | |||||||
| 
 | 
 | ||||||
| import Data.Char | import Data.Char | ||||||
| import Data.List | import Data.List | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import Text.Printf (printf) | import Text.Printf (printf) | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils.Parse | import Hledger.Utils.Parse | ||||||
|  | |||||||
| @ -1,74 +0,0 @@ | |||||||
| -- | Paper over some differences between megaparsec 5 and 6, |  | ||||||
| -- making it possible to write code that supports both. |  | ||||||
| 
 |  | ||||||
| {-# 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 |  | ||||||
| 
 |  | ||||||
| #if MIN_VERSION_megaparsec(6,0,0) |  | ||||||
| 
 |  | ||||||
| import Text.Megaparsec hiding (skipManyTill) |  | ||||||
| import Text.Megaparsec.Char |  | ||||||
| import Data.List.NonEmpty (fromList) |  | ||||||
| import Data.Void (Void) |  | ||||||
| 
 |  | ||||||
| -- | A basic parse error type. |  | ||||||
| type MPErr = Void |  | ||||||
| 
 |  | ||||||
| -- | Make a simple parse error. |  | ||||||
| mpMkParseError :: FilePath -> String -> ParseError Char String |  | ||||||
| mpMkParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s) |  | ||||||
| 
 |  | ||||||
| -- | Make a Pos. With a negative argument, throws InvalidPosException (megaparsec >= 6) |  | ||||||
| -- or calls error (megaparsec < 6). |  | ||||||
| mpMkPos :: Int -> Pos |  | ||||||
| mpMkPos = mkPos  |  | ||||||
| 
 |  | ||||||
| -- | Unmake a Pos. |  | ||||||
| mpUnPos :: Pos -> Int |  | ||||||
| mpUnPos = unPos |  | ||||||
| 
 |  | ||||||
| -- | Parse and return some Text.   |  | ||||||
| mptext :: MonadParsec e Text m => Tokens Text -> m (Tokens Text)  |  | ||||||
| mptext = string |  | ||||||
| 
 |  | ||||||
| #else |  | ||||||
| 
 |  | ||||||
| import Text.Megaparsec |  | ||||||
| import Text.Megaparsec.Prim (MonadParsec) |  | ||||||
| 
 |  | ||||||
| -- | A basic parse error type. |  | ||||||
| type MPErr = Dec |  | ||||||
| 
 |  | ||||||
| -- | Make a simple parse error. |  | ||||||
| mpMkParseError :: FilePath -> String -> ParseError Char String |  | ||||||
| mpMkParseError f s = (mempty :: ParseError Char String){errorCustom = S.singleton $ f ++ ": " ++ s} |  | ||||||
| 
 |  | ||||||
| -- | Make a Pos. With a negative argument, throws InvalidPosException (megaparsec >= 6) |  | ||||||
| -- or calls error (megaparsec < 6). |  | ||||||
| mpMkPos :: Int -> Pos |  | ||||||
| mpMkPos = unsafePos . fromIntegral  |  | ||||||
| 
 |  | ||||||
| -- | Unmake a Pos. |  | ||||||
| mpUnPos :: Pos -> Int |  | ||||||
| mpUnPos = fromIntegral . unPos  |  | ||||||
| 
 |  | ||||||
| -- | Parse and return some Text.   |  | ||||||
| mptext :: MonadParsec e Text m => Text -> m Text |  | ||||||
| mptext = fmap pack . string . unpack |  | ||||||
| 
 |  | ||||||
| #endif |  | ||||||
| @ -2,7 +2,7 @@ | |||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: 5fde68eeaac8c1e790c207a8db26776e8659d7058fb3215c3c9678641d406a97 | -- hash: 22b7806755a6e3d8afa63a7e941273b64188b90a6695b78fa7f59dcb150e19f7 | ||||||
| 
 | 
 | ||||||
| name:           hledger-lib | name:           hledger-lib | ||||||
| version:        1.9.99 | version:        1.9.99 | ||||||
| @ -93,7 +93,6 @@ library | |||||||
|       Hledger.Utils.Text |       Hledger.Utils.Text | ||||||
|       Hledger.Utils.Tree |       Hledger.Utils.Tree | ||||||
|       Hledger.Utils.UTF8IOCompat |       Hledger.Utils.UTF8IOCompat | ||||||
|       Text.Megaparsec.Compat |  | ||||||
|       Text.Tabular.AsciiWide |       Text.Tabular.AsciiWide | ||||||
|   other-modules: |   other-modules: | ||||||
|       Paths_hledger_lib |       Paths_hledger_lib | ||||||
| @ -188,7 +187,6 @@ test-suite doctests | |||||||
|       Hledger.Utils.Text |       Hledger.Utils.Text | ||||||
|       Hledger.Utils.Tree |       Hledger.Utils.Tree | ||||||
|       Hledger.Utils.UTF8IOCompat |       Hledger.Utils.UTF8IOCompat | ||||||
|       Text.Megaparsec.Compat |  | ||||||
|       Text.Tabular.AsciiWide |       Text.Tabular.AsciiWide | ||||||
|       Paths_hledger_lib |       Paths_hledger_lib | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
| @ -287,7 +285,6 @@ test-suite easytests | |||||||
|       Hledger.Utils.Text |       Hledger.Utils.Text | ||||||
|       Hledger.Utils.Tree |       Hledger.Utils.Tree | ||||||
|       Hledger.Utils.UTF8IOCompat |       Hledger.Utils.UTF8IOCompat | ||||||
|       Text.Megaparsec.Compat |  | ||||||
|       Text.Tabular.AsciiWide |       Text.Tabular.AsciiWide | ||||||
|       Paths_hledger_lib |       Paths_hledger_lib | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
| @ -384,7 +381,6 @@ test-suite hunittests | |||||||
|       Hledger.Utils.Text |       Hledger.Utils.Text | ||||||
|       Hledger.Utils.Tree |       Hledger.Utils.Tree | ||||||
|       Hledger.Utils.UTF8IOCompat |       Hledger.Utils.UTF8IOCompat | ||||||
|       Text.Megaparsec.Compat |  | ||||||
|       Text.Tabular.AsciiWide |       Text.Tabular.AsciiWide | ||||||
|       Paths_hledger_lib |       Paths_hledger_lib | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
|  | |||||||
| @ -142,7 +142,6 @@ library: | |||||||
|   - Hledger.Utils.Text |   - Hledger.Utils.Text | ||||||
|   - Hledger.Utils.Tree |   - Hledger.Utils.Tree | ||||||
|   - Hledger.Utils.UTF8IOCompat |   - Hledger.Utils.UTF8IOCompat | ||||||
|   - Text.Megaparsec.Compat |  | ||||||
|   - Text.Tabular.AsciiWide |   - Text.Tabular.AsciiWide | ||||||
| #  other-modules: | #  other-modules: | ||||||
| #  - Ledger.Parser.Text | #  - Ledger.Parser.Text | ||||||
|  | |||||||
| @ -19,8 +19,10 @@ import Control.Monad.IO.Class (liftIO) | |||||||
| import Data.Monoid | import Data.Monoid | ||||||
| #endif | #endif | ||||||
| import Data.Time.Calendar (Day) | import Data.Time.Calendar (Day) | ||||||
|  | import Data.Void (Void) | ||||||
| import Graphics.Vty (Event(..),Key(..)) | import Graphics.Vty (Event(..),Key(..)) | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Cli hiding (progname,prognameandversion) | import Hledger.Cli hiding (progname,prognameandversion) | ||||||
| import Hledger.UI.UIOptions | import Hledger.UI.UIOptions | ||||||
| @ -108,7 +110,7 @@ esHandle _ _ = error "event handler called with wrong screen type, should not ha | |||||||
| 
 | 
 | ||||||
| -- | Parse the file name, line and column number from a hledger parse error message, if possible. | -- | Parse the file name, line and column number from a hledger parse error message, if possible. | ||||||
| -- Temporary, we should keep the original parse error location. XXX | -- Temporary, we should keep the original parse error location. XXX | ||||||
| hledgerparseerrorpositionp :: ParsecT MPErr String t (String, Int, Int) | hledgerparseerrorpositionp :: ParsecT Void String t (String, Int, Int) | ||||||
| hledgerparseerrorpositionp = do | hledgerparseerrorpositionp = do | ||||||
|   anyChar `manyTill` char '"' |   anyChar `manyTill` char '"' | ||||||
|   f <- anyChar `manyTill` (oneOf ['"','\n']) |   f <- anyChar `manyTill` (oneOf ['"','\n']) | ||||||
|  | |||||||
| @ -17,7 +17,9 @@ import qualified Data.List as L (head) -- qualified keeps dev & prod builds warn | |||||||
| import Data.Text (append, pack, unpack) | import Data.Text (append, pack, unpack) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Text.Megaparsec.Compat (digitChar, eof, some, string, runParser, ParseError, MPErr) | import Data.Void (Void) | ||||||
|  | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| @ -83,7 +85,7 @@ postAddForm = do | |||||||
|       let numberedParams s = |       let numberedParams s = | ||||||
|             reverse $ dropWhile (T.null . snd) $ reverse $ sort |             reverse $ dropWhile (T.null . snd) $ reverse $ sort | ||||||
|             [ (n,v) | (k,v) <- params |             [ (n,v) | (k,v) <- params | ||||||
|                     , let en = parsewith (paramnamep s) k :: Either (ParseError Char MPErr) Int |                     , let en = parsewith (paramnamep s) k :: Either (ParseError Char Void) Int | ||||||
|                     , isRight en |                     , isRight en | ||||||
|                     , let Right n = en |                     , let Right n = en | ||||||
|                     ] |                     ] | ||||||
|  | |||||||
| @ -87,6 +87,7 @@ import Data.Maybe | |||||||
| --import Data.String.Here | --import Data.String.Here | ||||||
| -- import Data.Text (Text) | -- import Data.Text (Text) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
|  | import Data.Void (Void) | ||||||
| import Safe | import Safe | ||||||
| import System.Console.CmdArgs hiding (Default,def) | import System.Console.CmdArgs hiding (Default,def) | ||||||
| import System.Console.CmdArgs.Explicit | import System.Console.CmdArgs.Explicit | ||||||
| @ -99,7 +100,8 @@ import System.Environment | |||||||
| import System.Exit (exitSuccess) | import System.Exit (exitSuccess) | ||||||
| import System.FilePath | import System.FilePath | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
| import Hledger.Cli.DocFiles | import Hledger.Cli.DocFiles | ||||||
| @ -554,7 +556,7 @@ rulesFilePathFromOpts opts = do | |||||||
| widthFromOpts :: CliOpts -> Int | widthFromOpts :: CliOpts -> Int | ||||||
| widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w | widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w | ||||||
| widthFromOpts CliOpts{width_=Just s}  = | widthFromOpts CliOpts{width_=Just s}  = | ||||||
|     case runParser (read `fmap` some digitChar <* eof :: ParsecT MPErr String Identity Int) "(unknown)" s of |     case runParser (read `fmap` some digitChar <* eof :: ParsecT Void String Identity Int) "(unknown)" s of | ||||||
|         Left e   -> usageError $ "could not parse width option: "++show e |         Left e   -> usageError $ "could not parse width option: "++show e | ||||||
|         Right w  -> w |         Right w  -> w | ||||||
| 
 | 
 | ||||||
| @ -576,7 +578,7 @@ registerWidthsFromOpts CliOpts{width_=Just s}  = | |||||||
|         Left e   -> usageError $ "could not parse width option: "++show e |         Left e   -> usageError $ "could not parse width option: "++show e | ||||||
|         Right ws -> ws |         Right ws -> ws | ||||||
|     where |     where | ||||||
|         registerwidthp :: (Stream s, Char ~ Token s) => ParsecT MPErr s m (Int, Maybe Int) |         registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Void s m (Int, Maybe Int) | ||||||
|         registerwidthp = do |         registerwidthp = do | ||||||
|           totalwidth <- read `fmap` some digitChar |           totalwidth <- read `fmap` some digitChar | ||||||
|           descwidth <- optional (char ',' >> read `fmap` some digitChar) |           descwidth <- optional (char ',' >> read `fmap` some digitChar) | ||||||
| @ -665,10 +667,10 @@ isHledgerExeName :: String -> Bool | |||||||
| isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack | isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack | ||||||
|     where |     where | ||||||
|       hledgerexenamep = do |       hledgerexenamep = do | ||||||
|         _ <- mptext $ T.pack progname |         _ <- string $ T.pack progname | ||||||
|         _ <- char '-' |         _ <- char '-' | ||||||
|         _ <- some $ noneOf ['.'] |         _ <- some $ noneOf ['.'] | ||||||
|         optional (string "." >> choice' (map (mptext . T.pack) addonExtensions)) |         optional (string "." >> choice' (map (string . T.pack) addonExtensions)) | ||||||
|         eof |         eof | ||||||
| 
 | 
 | ||||||
| stripAddonExtension :: String -> String | stripAddonExtension :: String -> String | ||||||
|  | |||||||
| @ -37,7 +37,8 @@ import System.Console.Haskeline.Completion | |||||||
| import System.Console.Wizard | import System.Console.Wizard | ||||||
| import System.Console.Wizard.Haskeline | import System.Console.Wizard.Haskeline | ||||||
| import System.IO ( stderr, hPutStr, hPutStrLn ) | import System.IO ( stderr, hPutStr, hPutStrLn ) | ||||||
| import Text.Megaparsec.Compat | import Text.Megaparsec | ||||||
|  | import Text.Megaparsec.Char | ||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user