mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib: remove the ErroringJournalParser
type
This commit is contained in:
parent
39e7ef0311
commit
ff2b042c7e
@ -29,8 +29,6 @@ module Hledger.Read.Common (
|
||||
rtp,
|
||||
runJournalParser,
|
||||
rjp,
|
||||
runErroringJournalParser,
|
||||
rejp,
|
||||
genericSourcePos,
|
||||
journalSourcePos,
|
||||
generateAutomaticPostings,
|
||||
@ -95,7 +93,7 @@ where
|
||||
import Prelude ()
|
||||
import "base-compat-batteries" Prelude.Compat hiding (readFile)
|
||||
import "base-compat-batteries" Control.Monad.Compat
|
||||
import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError)
|
||||
import Control.Monad.Except (ExceptT(..), throwError)
|
||||
import Control.Monad.State.Strict
|
||||
import Data.Bifunctor (bimap, second)
|
||||
import Data.Char
|
||||
@ -192,12 +190,6 @@ runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (Pars
|
||||
runJournalParser p t = runParserT (evalStateT p mempty) "" t
|
||||
rjp = runJournalParser
|
||||
|
||||
-- | Run an error-raising journal parser with a null journal-parsing state.
|
||||
runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a)
|
||||
runErroringJournalParser p t = runExceptT $
|
||||
runJournalParser p t >>= either (throwError . parseErrorPretty) return
|
||||
rejp = runErroringJournalParser
|
||||
|
||||
genericSourcePos :: SourcePos -> GenericSourcePos
|
||||
genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
|
||||
|
||||
|
@ -42,8 +42,6 @@ module Hledger.Read.JournalReader (
|
||||
parseAndFinaliseJournal,
|
||||
runJournalParser,
|
||||
rjp,
|
||||
runErroringJournalParser,
|
||||
rejp,
|
||||
|
||||
-- * Parsers used elsewhere
|
||||
getParentAccount,
|
||||
@ -136,7 +134,7 @@ aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++qu
|
||||
-- | A journal parser. Accumulates and returns a "ParsedJournal",
|
||||
-- which should be finalised/validated before use.
|
||||
--
|
||||
-- >>> rejp (journalp <* eof) "2015/1/1\n a 0\n"
|
||||
-- >>> rjp (journalp <* eof) "2015/1/1\n a 0\n"
|
||||
-- Right Journal with 1 transactions, 1 accounts
|
||||
--
|
||||
journalp :: MonadIO m => JournalParser m ParsedJournal
|
||||
@ -262,17 +260,17 @@ indentedlinep = lift (skipSome spacenonewline) >> (rstrip <$> lift restofline)
|
||||
|
||||
-- | Parse a one-line or multi-line commodity directive.
|
||||
--
|
||||
-- >>> Right _ <- rejp commoditydirectivep "commodity $1.00"
|
||||
-- >>> Right _ <- rejp commoditydirectivep "commodity $\n format $1.00"
|
||||
-- >>> Right _ <- rejp commoditydirectivep "commodity $\n\n" -- a commodity with no format
|
||||
-- >>> Right _ <- rejp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ?
|
||||
-- >>> Right _ <- rjp commoditydirectivep "commodity $1.00"
|
||||
-- >>> Right _ <- rjp commoditydirectivep "commodity $\n format $1.00"
|
||||
-- >>> Right _ <- rjp commoditydirectivep "commodity $\n\n" -- a commodity with no format
|
||||
-- >>> Right _ <- rjp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ?
|
||||
commoditydirectivep :: JournalParser m ()
|
||||
commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemultilinep
|
||||
|
||||
-- | Parse a one-line commodity directive.
|
||||
--
|
||||
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00"
|
||||
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
|
||||
-- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00"
|
||||
-- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
|
||||
commoditydirectiveonelinep :: JournalParser m ()
|
||||
commoditydirectiveonelinep = do
|
||||
string "commodity"
|
||||
@ -291,7 +289,7 @@ pleaseincludedecimalpoint = "to avoid ambiguity, please include a decimal point
|
||||
|
||||
-- | Parse a multi-line commodity directive, containing 0 or more format subdirectives.
|
||||
--
|
||||
-- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah"
|
||||
-- >>> Right _ <- rjp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah"
|
||||
commoditydirectivemultilinep :: JournalParser m ()
|
||||
commoditydirectivemultilinep = do
|
||||
string "commodity"
|
||||
|
@ -5,7 +5,6 @@ module Hledger.Utils.Parse (
|
||||
SimpleTextParser,
|
||||
TextParser,
|
||||
JournalParser,
|
||||
ErroringJournalParser,
|
||||
|
||||
choice',
|
||||
choiceInState,
|
||||
@ -28,7 +27,6 @@ module Hledger.Utils.Parse (
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.State.Strict (StateT, evalStateT)
|
||||
import Data.Char
|
||||
import Data.Functor.Identity (Identity(..))
|
||||
@ -54,9 +52,6 @@ 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 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 CustomErr Text (ExceptT String m)) a
|
||||
|
||||
-- | Backtracking choice, use this when alternatives share a prefix.
|
||||
-- Consumes no input if all choices fail.
|
||||
choice' :: [TextParser m a] -> TextParser m a
|
||||
|
@ -175,8 +175,8 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = d
|
||||
outputFromOpts rawopts opts{reportopts_=ropts{query_=""}} j j'
|
||||
|
||||
postingp' :: T.Text -> IO Posting
|
||||
postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case
|
||||
Left err -> fail err
|
||||
postingp' t = runJournalParser (postingp Nothing <* eof) t' >>= \case
|
||||
Left err -> fail $ parseErrorPretty' t' err
|
||||
Right p -> return p
|
||||
where t' = " " <> t <> "\n" -- inject space and newline for proper parsing
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user