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.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 | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | 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 | -- | 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 Void) (Interval, DateSpan) | parsePeriodExpr :: Day -> Text -> Either (ParseError Char CustomErr) (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) | ||||||
| @ -373,13 +372,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 Void) String) |                        $ (fixSmartDateStrEither d s :: Either (ParseError Char CustomErr) String) | ||||||
| 
 | 
 | ||||||
| -- | A safe version of fixSmartDateStr. | -- | 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 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 | 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 | ||||||
|  | |||||||
| @ -113,7 +113,6 @@ 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 | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | import Text.Megaparsec.Char | ||||||
| @ -184,12 +183,12 @@ 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 Void) a | runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char CustomErr) a | ||||||
| runTextParser p t =  runParser p "" t | runTextParser p t =  runParser p "" t | ||||||
| rtp = runTextParser | rtp = runTextParser | ||||||
| 
 | 
 | ||||||
| -- | Run a journal parser with a null journal-parsing state. | -- | 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 | runJournalParser p t = runParserT (evalStateT p mempty) "" t | ||||||
| rjp = runJournalParser | rjp = runJournalParser | ||||||
| 
 | 
 | ||||||
| @ -981,7 +980,7 @@ followingcommentandtagsp mdefdate = do | |||||||
|       runTextParser (setPosition pos *> parser) txt |       runTextParser (setPosition pos *> parser) txt | ||||||
| 
 | 
 | ||||||
|     tagDate :: (SourcePos, Tag) |     tagDate :: (SourcePos, Tag) | ||||||
|             -> Either (ParseError Char Void) (TagName, Day) |             -> Either (ParseError Char CustomErr) (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 | ||||||
|  | |||||||
| @ -45,7 +45,6 @@ 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 | ||||||
| @ -404,7 +403,7 @@ parseAndValidateCsvRules rulesfile s = do | |||||||
|     makeParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s) |     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 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 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 | ||||||
|  | |||||||
| @ -84,7 +84,6 @@ 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 | ||||||
| @ -199,7 +198,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 Void) ParsedJournal) <- |       (ej1::Either (ParseError Char CustomErr) ParsedJournal) <- | ||||||
|         runParserT |         runParserT | ||||||
|            (evalStateT |            (evalStateT | ||||||
|               (choiceInState |               (choiceInState | ||||||
|  | |||||||
| @ -1,5 +1,32 @@ | |||||||
| {-# LANGUAGE CPP, TypeFamilies #-} | {-# 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.Except | ||||||
| import Control.Monad.State.Strict (StateT, evalStateT) | import Control.Monad.State.Strict (StateT, evalStateT) | ||||||
| @ -7,7 +34,6 @@ 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 Data.Void (Void) |  | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | import Text.Megaparsec.Char | ||||||
| import Text.Printf | import Text.Printf | ||||||
| @ -17,19 +43,19 @@ import Hledger.Utils.ParseErrors | |||||||
| 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 Void String a | type SimpleStringParser a = Parsec CustomErr String a | ||||||
| 
 | 
 | ||||||
| -- | A parser of strict text to some type. | -- | 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. | -- | 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. | -- | 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. | -- | 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. | -- | Backtracking choice, use this when alternatives share a prefix. | ||||||
| -- Consumes no input if all choices fail. | -- Consumes no input if all choices fail. | ||||||
| @ -38,7 +64,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 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 | choiceInState = choice . map try | ||||||
| 
 | 
 | ||||||
| surroundedBy :: Applicative m => m openclose -> m a -> m a | 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 :: 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 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 ctx p s = runParserT (evalStateT p ctx) "" s | ||||||
| 
 | 
 | ||||||
| parseWithState' | parseWithState' | ||||||
| @ -79,7 +105,7 @@ nonspace = satisfy (not . isSpace) | |||||||
| isNonNewlineSpace :: Char -> Bool | isNonNewlineSpace :: Char -> Bool | ||||||
| isNonNewlineSpace c = c /= '\n' && isSpace c | 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 | spacenonewline = satisfy isNonNewlineSpace | ||||||
| 
 | 
 | ||||||
| restofline :: TextParser m String | restofline :: TextParser m String | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user