Chunk.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{- |
Module      : $Header$
Description : Module providing simple implementation based on accumulating
              chunks.
Copyright   : (c) John Lato
License     : Public domain

Maintainer  : uzytkownik2@gmail.com
Stability   : none
Portability : portable

Module providing simple implementation based on accumulating chunks.
It is optimised for short parsers.
-}
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

-- |Create an Iteratee from a ParsecT parser.
-- This is most efficient for relatively smaller parsers (< 1e5 chars),
-- and becomes increasingly inefficient as the parser size increases.
-- If the parse fails, no input is consumed.  If the parse succeeds,
-- any data remaining after the parse is available to the iteratee.
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

-- |Make an Iteratee instance of Parsec's Stream class.
-- This is only efficient for relatively small parsers (on order of 1e5 chars).
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


-- |Peek @n@ points ahead into the stream.  This will force chunks if
-- necessary.
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