module Text.Parsec.Iteratee.Chunk
(
safeParsecIterateeShort
)
where
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Iteratee as I
import qualified Data.ListLike as LL
import Data.Monoid
import Data.Typeable
import Text.Parsec hiding (Stream)
import qualified Text.Parsec as P
safeParsecIterateeShort :: (Monad m, Nullable s, LL.ListLike s t)
=> ParsecT Int u (Iteratee s m) a
-> u
-> SourceName
-> Iteratee s 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, Nullable s, LL.ListLike s el) =>
P.Stream Int (Iteratee s m) el where
uncons n = (liftM . fmap) (\res -> (res, n+1)) $ peekAt n
peekAt :: (LL.ListLike s el, Nullable s, Monad m)
=> Int -> Iteratee s m (Maybe el)
peekAt 0 = I.peek
peekAt n = liftI step
where step c@(Chunk xs)
| LL.null xs = liftI step
| n < LL.length xs = idone (Just $ LL.index xs n) c
| otherwise = liftI (nextChunk xs)
step (EOF Nothing) = return Nothing
step (EOF (Just se@(SomeException e)))
| typeOf e == seekType = throwErr $ unhandled e
| otherwise = throwRecoverableErr se step
nextChunk xs (Chunk xs')
| LL.null xs' = liftI (nextChunk xs)
| n < LL.length nxs = idone (Just $ LL.index nxs n) (Chunk nxs)
| otherwise = liftI (nextChunk nxs)
where nxs = xs `mappend` xs'
nextChunk xs (EOF Nothing) = idone Nothing (Chunk xs)
nextChunk xs (EOF (Just se@(SomeException e)))
| typeOf e == seekType = throwErr $ unhandled e
| otherwise = throwRecoverableErr se (nextChunk xs)
seekType = typeOf (undefined :: SeekException)
unhandled e
= SomeException $! EnumUnhandledIterException (IterException e)