lib: switch parsers to the custom error type
Also add an explicit export list to `hledger-lib/Hledger/Utils/Parse.hs` in order to re-export the custom error type (for convenience).
This commit is contained in:
		
							parent
							
								
									ca201e4618
								
							
						
					
					
						commit
						c5561f25f1
					
				| @ -91,7 +91,6 @@ import Data.Time.Calendar | ||||
| import Data.Time.Calendar.OrdinalDate | ||||
| import Data.Time.Clock | ||||
| import Data.Time.LocalTime | ||||
| import Data.Void (Void) | ||||
| import Safe (headMay, lastMay, readMay) | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| @ -313,7 +312,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 Void) (Interval, DateSpan) | ||||
| parsePeriodExpr :: Day -> Text -> Either (ParseError Char CustomErr) (Interval, DateSpan) | ||||
| parsePeriodExpr refdate s = parsewith (periodexpr refdate <* eof) (T.toLower s) | ||||
| 
 | ||||
| maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan) | ||||
| @ -373,13 +372,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 Void) String) | ||||
|                        $ (fixSmartDateStrEither d s :: Either (ParseError Char CustomErr) String) | ||||
| 
 | ||||
| -- | A safe version of fixSmartDateStr. | ||||
| fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char Void) String | ||||
| fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char CustomErr) String | ||||
| fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d | ||||
| 
 | ||||
| fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char Void) Day | ||||
| fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char CustomErr) Day | ||||
| fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of | ||||
|                                Right sd -> Right $ fixSmartDate d sd | ||||
|                                Left e -> Left e | ||||
|  | ||||
| @ -113,7 +113,6 @@ import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import Data.Time.LocalTime | ||||
| import Data.Void (Void) | ||||
| import System.Time (getClockTime) | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| @ -184,12 +183,12 @@ rawOptsToInputOpts rawopts = InputOpts{ | ||||
| --- * parsing utilities | ||||
| 
 | ||||
| -- | Run a string parser with no state in the identity monad. | ||||
| runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char Void) a | ||||
| runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char CustomErr) a | ||||
| runTextParser p t =  runParser p "" t | ||||
| rtp = runTextParser | ||||
| 
 | ||||
| -- | Run a journal parser with a null journal-parsing state. | ||||
| runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (ParseError Char Void) a) | ||||
| runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (ParseError Char CustomErr) a) | ||||
| runJournalParser p t = runParserT (evalStateT p mempty) "" t | ||||
| rjp = runJournalParser | ||||
| 
 | ||||
| @ -981,7 +980,7 @@ followingcommentandtagsp mdefdate = do | ||||
|       runTextParser (setPosition pos *> parser) txt | ||||
| 
 | ||||
|     tagDate :: (SourcePos, Tag) | ||||
|             -> Either (ParseError Char Void) (TagName, Day) | ||||
|             -> Either (ParseError Char CustomErr) (TagName, Day) | ||||
|     tagDate (pos, (name, value)) = | ||||
|       fmap (name,) $ runTextParserAt (datep' myear) (pos, value) | ||||
|       where myear = fmap (first3 . toGregorian) mdefdate | ||||
|  | ||||
| @ -45,7 +45,6 @@ import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import qualified Data.Text.IO as T | ||||
| import Data.Time.Calendar (Day) | ||||
| import Data.Void (Void) | ||||
| #if MIN_VERSION_time(1,5,0) | ||||
| import Data.Time.Format (parseTimeM, defaultTimeLocale) | ||||
| #else | ||||
| @ -404,7 +403,7 @@ parseAndValidateCsvRules rulesfile s = do | ||||
|     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. | ||||
| parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char Void) CsvRules | ||||
| parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char CustomErr) CsvRules | ||||
| -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s | ||||
| parseCsvRules rulesfile s = | ||||
|   runParser (evalStateT rulesp rules) rulesfile s | ||||
|  | ||||
| @ -84,7 +84,6 @@ import Data.List | ||||
| import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import Data.Time.LocalTime | ||||
| import Data.Void (Void) | ||||
| import Safe | ||||
| import Test.HUnit | ||||
| #ifdef TESTS | ||||
| @ -199,7 +198,7 @@ includedirectivep = do | ||||
|       let curdir = takeDirectory (sourceName parentpos) | ||||
|       filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename) | ||||
|       txt      <- readFilePortably filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath) | ||||
|       (ej1::Either (ParseError Char Void) ParsedJournal) <- | ||||
|       (ej1::Either (ParseError Char CustomErr) ParsedJournal) <- | ||||
|         runParserT | ||||
|            (evalStateT | ||||
|               (choiceInState | ||||
|  | ||||
| @ -1,5 +1,32 @@ | ||||
| {-# LANGUAGE CPP, TypeFamilies #-} | ||||
| module Hledger.Utils.Parse where | ||||
| 
 | ||||
| module Hledger.Utils.Parse ( | ||||
|   SimpleStringParser, | ||||
|   SimpleTextParser, | ||||
|   TextParser, | ||||
|   JournalParser, | ||||
|   ErroringJournalParser, | ||||
| 
 | ||||
|   choice', | ||||
|   choiceInState, | ||||
|   surroundedBy, | ||||
|   parsewith, | ||||
|   parsewithString, | ||||
|   parseWithState, | ||||
|   parseWithState', | ||||
|   fromparse, | ||||
|   parseerror, | ||||
|   showDateParseError, | ||||
|   nonspace, | ||||
|   isNonNewlineSpace, | ||||
|   spacenonewline, | ||||
|   restofline, | ||||
|   eolof, | ||||
| 
 | ||||
|   -- * re-exports | ||||
|   CustomErr | ||||
| ) | ||||
| where | ||||
| 
 | ||||
| import Control.Monad.Except | ||||
| import Control.Monad.State.Strict (StateT, evalStateT) | ||||
| @ -7,7 +34,6 @@ import Data.Char | ||||
| import Data.Functor.Identity (Identity(..)) | ||||
| import Data.List | ||||
| import Data.Text (Text) | ||||
| import Data.Void (Void) | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| import Text.Printf | ||||
| @ -17,19 +43,19 @@ import Hledger.Utils.ParseErrors | ||||
| import Hledger.Utils.UTF8IOCompat (error') | ||||
| 
 | ||||
| -- | A parser of string to some type. | ||||
| type SimpleStringParser a = Parsec Void String a | ||||
| type SimpleStringParser a = Parsec CustomErr String a | ||||
| 
 | ||||
| -- | A parser of strict text to some type. | ||||
| type SimpleTextParser = Parsec Void Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow | ||||
| type SimpleTextParser = Parsec CustomErr Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow | ||||
| 
 | ||||
| -- | A parser of text in some monad. | ||||
| type TextParser m a = ParsecT Void Text m a | ||||
| type TextParser m a = ParsecT CustomErr Text m a | ||||
| 
 | ||||
| -- | A parser of text in some monad, with a journal as state. | ||||
| type JournalParser m a = StateT Journal (ParsecT Void Text m) a | ||||
| type JournalParser m a = StateT Journal (ParsecT CustomErr 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 Void Text (ExceptT String m)) a | ||||
| type ErroringJournalParser m a = StateT Journal (ParsecT CustomErr Text (ExceptT String m)) a | ||||
| 
 | ||||
| -- | Backtracking choice, use this when alternatives share a prefix. | ||||
| -- Consumes no input if all choices fail. | ||||
| @ -38,7 +64,7 @@ choice' = choice . map try | ||||
| 
 | ||||
| -- | Backtracking choice, use this when alternatives share a prefix. | ||||
| -- Consumes no input if all choices fail. | ||||
| choiceInState :: [StateT s (ParsecT Void Text m) a] -> StateT s (ParsecT Void Text m) a | ||||
| choiceInState :: [StateT s (ParsecT CustomErr Text m) a] -> StateT s (ParsecT CustomErr Text m) a | ||||
| choiceInState = choice . map try | ||||
| 
 | ||||
| surroundedBy :: Applicative m => m openclose -> m a -> m a | ||||
| @ -50,7 +76,7 @@ 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 Void Text m) a -> Text -> m (Either (ParseError Char Void) a) | ||||
| parseWithState :: Monad m => st -> StateT st (ParsecT CustomErr Text m) a -> Text -> m (Either (ParseError Char CustomErr) a) | ||||
| parseWithState ctx p s = runParserT (evalStateT p ctx) "" s | ||||
| 
 | ||||
| parseWithState' | ||||
| @ -79,7 +105,7 @@ nonspace = satisfy (not . isSpace) | ||||
| isNonNewlineSpace :: Char -> Bool | ||||
| isNonNewlineSpace c = c /= '\n' && isSpace c | ||||
| 
 | ||||
| spacenonewline :: (Stream s, Char ~ Token s) => ParsecT Void s m Char | ||||
| spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char | ||||
| spacenonewline = satisfy isNonNewlineSpace | ||||
| 
 | ||||
| restofline :: TextParser m String | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user