From c5561f25f162f31d9a5258703da4e5952d84af92 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Tue, 5 Jun 2018 14:23:47 -0600 Subject: [PATCH] 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). --- hledger-lib/Hledger/Data/Dates.hs | 9 ++--- hledger-lib/Hledger/Read/Common.hs | 7 ++-- hledger-lib/Hledger/Read/CsvReader.hs | 3 +- hledger-lib/Hledger/Read/JournalReader.hs | 3 +- hledger-lib/Hledger/Utils/Parse.hs | 46 ++++++++++++++++++----- 5 files changed, 45 insertions(+), 23 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 0925d12c1..0e2337821 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 427a1ec54..f9a5e2add 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 8d301f585..a17c066ff 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index a357761b7..378c78e08 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index 03f7312c0..6dac13069 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -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