module Text.Parsec.Iteratee.Chunk
(
safeParsecIterateeShort
)
where
import qualified Data.Iteratee as I
import Data.Iteratee.Base (IterateeG (..), StreamG (..), IterGV (..))
import qualified Data.Iteratee.Base.StreamChunk as SC
import Control.Monad
import Control.Applicative
import qualified Data.ListLike as LL
import Data.Monoid
import Text.Parsec
safeParsecIterateeShort
:: (Stream Int (IterateeG s t m) t, Monad m, SC.StreamChunk s t) =>
ParsecT Int u (IterateeG s t m) a
-> u
-> SourceName
-> IterateeG s t m (Either ParseError a)
safeParsecIterateeShort p u sn = do
res <- runParserT ((,) <$> p <*> getInput ) u sn 0
case res of
Right (a, lpos) -> I.drop lpos >> return (Right a)
Left err -> return $ Left err
instance (Monad m, SC.StreamChunk s el) =>
Stream Int (IterateeG s el m) el where
uncons n = (liftM . fmap) (\res -> (res, n+1)) $ peekAt n
peekAt :: (SC.StreamChunk s el, Monad m) => Int -> IterateeG s el m (Maybe el)
peekAt 0 = I.peek
peekAt n = IterateeG step
where
step c@(Chunk xs)
| SC.null xs = return $ Cont (peekAt n) Nothing
| n < SC.length xs = return $ Done (Just $ LL.index xs n) c
| True = return $ Cont (nextChunk xs) Nothing
step str = return $ Done Nothing str
nextChunk xs = IterateeG step2
where
step2 (Chunk xs')
| SC.null xs' = return $ Cont (nextChunk xs) Nothing
| n < (SC.length xs + SC.length xs') =
let nxs = xs `mappend` xs'
in return $ Done (Just $ LL.index nxs n) (Chunk nxs)
| True = let nxs = xs `mappend` xs'
in return $ Cont (nextChunk nxs) Nothing
step2 str = return $ Done Nothing str