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