module SimpleParser.Throw
  ( EmptyParseError (..)
  , runParserThrow
  , runParserEnd
  ) where

import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow (throwM))
import Data.Typeable (Typeable)
import SimpleParser.Input (matchEnd)
import SimpleParser.Parser (Parser, runParser)
import SimpleParser.Result (ParseResult (..), ParseSuccess (..))
import SimpleParser.Stream (Chunk, Stream, Token)

data EmptyParseError = EmptyParseError
  deriving stock (EmptyParseError -> EmptyParseError -> Bool
(EmptyParseError -> EmptyParseError -> Bool)
-> (EmptyParseError -> EmptyParseError -> Bool)
-> Eq EmptyParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyParseError -> EmptyParseError -> Bool
$c/= :: EmptyParseError -> EmptyParseError -> Bool
== :: EmptyParseError -> EmptyParseError -> Bool
$c== :: EmptyParseError -> EmptyParseError -> Bool
Eq, Int -> EmptyParseError -> ShowS
[EmptyParseError] -> ShowS
EmptyParseError -> String
(Int -> EmptyParseError -> ShowS)
-> (EmptyParseError -> String)
-> ([EmptyParseError] -> ShowS)
-> Show EmptyParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyParseError] -> ShowS
$cshowList :: [EmptyParseError] -> ShowS
show :: EmptyParseError -> String
$cshow :: EmptyParseError -> String
showsPrec :: Int -> EmptyParseError -> ShowS
$cshowsPrec :: Int -> EmptyParseError -> ShowS
Show)

instance Exception EmptyParseError

-- | Runs a parser and throws bundled errors / no parse result errors as exceptions.
runParserThrow :: (
  Typeable l, Typeable s, Typeable e, Typeable (Token s), Typeable (Chunk s),
  Show l, Show s, Show e, Show (Token s), Show (Chunk s),
  MonadThrow m) => Parser l s e a -> s -> m (ParseSuccess s a)
runParserThrow :: Parser l s e a -> s -> m (ParseSuccess s a)
runParserThrow Parser l s e a
parser s
s =
  case Parser l s e a -> s -> Maybe (ParseResult l s e a)
forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser Parser l s e a
parser s
s of
    Maybe (ParseResult l s e a)
Nothing -> EmptyParseError -> m (ParseSuccess s a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM EmptyParseError
EmptyParseError
    Just ParseResult l s e a
res ->
      case ParseResult l s e a
res of
        ParseResultError ParseErrorBundle l s e
errs -> ParseErrorBundle l s e -> m (ParseSuccess s a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ParseErrorBundle l s e
errs
        ParseResultSuccess ParseSuccess s a
success -> ParseSuccess s a -> m (ParseSuccess s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParseSuccess s a
success

-- | The easiest way to fully consume input and throw errors.
runParserEnd :: (
  Typeable l, Typeable s, Typeable e, Typeable (Token s), Typeable (Chunk s),
  Show l, Show s, Show e, Show (Token s), Show (Chunk s),
  Stream s, MonadThrow m) => Parser l s e a -> s -> m a
runParserEnd :: Parser l s e a -> s -> m a
runParserEnd Parser l s e a
parser s
s = (ParseSuccess s a -> a) -> m (ParseSuccess s a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseSuccess s a -> a
forall s a. ParseSuccess s a -> a
psValue (Parser l s e a -> s -> m (ParseSuccess s a)
forall l s e (m :: * -> *) a.
(Typeable l, Typeable s, Typeable e, Typeable (Token s),
 Typeable (Chunk s), Show l, Show s, Show e, Show (Token s),
 Show (Chunk s), MonadThrow m) =>
Parser l s e a -> s -> m (ParseSuccess s a)
runParserThrow (Parser l s e a
parser Parser l s e a -> ParserT l s e Identity () -> Parser l s e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l s e Identity ()
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd) s
s)