module Control.Proxy.Attoparsec.Control
( skipMalformedChunks
, retryLeftovers
, throwParsingErrors
, limitInputLength
) where
import Control.Proxy
import Control.Proxy.Attoparsec.Types
import qualified Control.Proxy.Trans.Either as PE
import Prelude hiding (drop, null)
skipMalformedChunks
:: (Monad m, Proxy p, AttoparsecInput a)
=> ParserStatus a
-> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r
skipMalformedChunks = runIdentityK . foreverK $ go
where go x@(Failed _ _) = request x >>= \(_,a) -> respond (Start, a)
go x = request x >>= respond
retryLeftovers
:: (Monad m, Proxy p, AttoparsecInput a)
=> ParserStatus a
-> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r
retryLeftovers = runIdentityK . foreverK $ go
where
go s@(Failed _ _) = retry s >>= moreSupply >>= respond
go s = request s >>= respond
retry s@(Failed rest _) = do
s' <- respond (Start, rest)
if s' == s then return s
else retry s'
retry s = return s
moreSupply s@(Failed rest _) = do
let rest' = drop 1 rest
if null rest'
then request s
else return (Start, rest')
moreSupply s = request s
throwParsingErrors
:: (Monad m, Proxy p, AttoparsecInput a)
=> ParserStatus a
-> PE.EitherP BadInput p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r
throwParsingErrors = foreverK go
where go (Failed _ e) = PE.throw $ MalformedInput e
go x = request x >>= respond
limitInputLength
:: (Monad m, Proxy p, AttoparsecInput a)
=> Int
-> ParserStatus a
-> PE.EitherP BadInput p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r
limitInputLength n = foreverK go
where go (Parsing m) | m >= n = PE.throw $ InputTooLong m
go x = request x >>= respond