module Control.Foldl.Transduce.Attoparsec (
stripParse
, parses
, ParserInput
, ParsingError
) where
import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.Attoparsec.Types
import Data.Attoparsec.ByteString
import Data.Attoparsec.Text
import Data.Monoid
import qualified Data.Monoid.Null as MN
import qualified Data.Monoid.Factorial as MF
import Control.Monad.Trans.Except
import Control.Foldl.Transduce
data StripState a b
= Parsed b
| Continue (a -> IResult a b)
stripParse :: (ParserInput a,Monad m)
=> Data.Attoparsec.Types.Parser a b
-> TransducerM (ExceptT (ParsingError a) m) a a b
stripParse atto = TransducerM step (initial (_parse atto mempty)) done
where
initial iresult = case iresult of
Fail l es e -> throwE (l,es,e)
Done _ r -> return (Parsed r)
Partial c -> return (Continue c)
step x i
| MN.null i =
return (x,[],[])
| otherwise = case x of
Parsed _ ->
return (x,[i],[])
Continue c ->
case c i of
Fail l es e -> throwE (l,es,e)
Done l r -> return (Parsed r,[l],[])
Partial c' -> return (Continue c',[],[])
done x = case x of
Parsed r -> return (r,[],[])
Continue c -> case c mempty of
Fail l es e -> throwE (l,es,e)
Done l r -> return (r,[l],[])
Partial _ -> error "never happens"
data ParsesState a b
= BetweenParses
| DuringParse (a -> IResult a b)
parses :: (ParserInput a,Monad m)
=> Data.Attoparsec.Types.Parser a b
-> TransducerM (ExceptT (ParsingError a) m) a b ()
parses atto = TransducerM step (return BetweenParses) done
where
step x i = do
(x',rs) <- step' [] x i
return (x',reverse rs,[])
step' acc xx i
| MN.null i =
return (xx,acc)
| otherwise =
case xx of
BetweenParses -> case _parse atto mempty of
Fail l es e -> throwE (l,es,e)
Done _ _ -> throwE (mempty,[],"Parser doesn't consume!")
Partial c -> step' acc (DuringParse c) i
DuringParse c -> case c i of
Fail l es e -> throwE (l,es,e)
Done l r -> step' (r:acc) BetweenParses l
Partial c' -> return (DuringParse c',acc)
done x = case x of
BetweenParses -> return mempty
DuringParse c -> case c mempty of
Fail l es e -> throwE (l,es,e)
Done _ r -> return ((),[r],[])
Partial _ -> error "never happens"
class (Eq a,MF.StableFactorialMonoid a) => ParserInput a where
_parse :: Data.Attoparsec.Types.Parser a b -> a -> IResult a b
instance ParserInput B.ByteString where
_parse = Data.Attoparsec.ByteString.parse
instance ParserInput T.Text where
_parse = Data.Attoparsec.Text.parse
type ParsingError a = (a,[String],String)