module Raehik.Compat.FlatParse.Basic.CutWithPos where

import FlatParse.Basic ( ParserT, Pos, getPos, cut, err )

-- | Convert a parsing failure to an error, which also receives the parser
--   position (as a 'Pos', from the end of input).
cut' :: ParserT st e a -> (Pos -> e) -> ParserT st e a
cut' :: forall (st :: ZeroBitType) e a.
ParserT st e a -> (Pos -> e) -> ParserT st e a
cut' ParserT st e a
p Pos -> e
e = ParserT st e Pos
forall (st :: ZeroBitType) e. ParserT st e Pos
getPos ParserT st e Pos -> (Pos -> ParserT st e a) -> ParserT st e a
forall a b.
ParserT st e a -> (a -> ParserT st e b) -> ParserT st e b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pos
pos -> ParserT st e a -> e -> ParserT st e a
forall (st :: ZeroBitType) e a.
ParserT st e a -> e -> ParserT st e a
cut ParserT st e a
p (Pos -> e
e Pos
pos)
{-# inline cut' #-}

-- | Throw a parsing error, which also receives the parser position (as a 'Pos',
--   from the end of input).
err' :: (Pos -> e) -> ParserT st e a
err' :: forall e (st :: ZeroBitType) a. (Pos -> e) -> ParserT st e a
err' Pos -> e
e = ParserT st e Pos
forall (st :: ZeroBitType) e. ParserT st e Pos
getPos ParserT st e Pos -> (Pos -> ParserT st e a) -> ParserT st e a
forall a b.
ParserT st e a -> (a -> ParserT st e b) -> ParserT st e b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pos
pos -> e -> ParserT st e a
forall e (st :: ZeroBitType) a. e -> ParserT st e a
err (Pos -> e
e Pos
pos)
{-# inline err' #-}