{-# 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 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

-- |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 :: (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

-- |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, Nullable s, LL.ListLike s el) =>
  P.Stream Int (Iteratee s 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 :: (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)