{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{- |
Module      : $Header$
Description : Module providing simple implementation based on mutable linked
              list.
Copyright   : (c) Maciej Piechotka
License     : MIT

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

Module providing simple implementation based on mutable linked list.
It is optimised for longer parsers.
-}
module Text.Parsec.Iteratee.LinkedList
  (
    Reference(..),
    Cursor,
    NextCursor,
    mkCursor,
    parsecIteratee,
    safeParsecIteratee,
  )
where
import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class
import Data.Monoid
import Data.Iteratee
import Data.ListLike as LL
import Data.Reference
import Data.Typeable
import Text.Parsec hiding (Stream)
import qualified Text.Parsec as P

-- | Specify the 3 possible states of next cursor - existence, non-existence
-- and not being evaluated
data (Monad m, Reference r m, ListLike s el) => NextCursor r m s el
    -- | Points to next cursor
    = NextCursor (Cursor r m s el)
    -- | States that next cursor does not exists
    | None
    -- | Next cursor is not evaluated
    | Uneval

-- | Cursor holds current value and reference to possible next cursor
data (Monad m, Reference r m) => Cursor r m s el
    = Cursor (r (NextCursor r m s el)) s

-- | Creates new cursor
mkCursor :: (Monad m, Reference r m, ListLike s el) => m (Cursor r m s el)
mkCursor = (\r -> return $! Cursor r LL.empty) =<< newRef Uneval

instance (Monad m, Nullable s, Reference r m, ListLike s el) =>
         P.Stream (Cursor r m s el) (Iteratee s m) el where
  uncons = unconsStream

unconsStream :: (Monad m, Nullable s, Reference r m, ListLike s el)
             => Cursor r m s el
             -> Iteratee s m (Maybe (el, Cursor r m s el))
unconsStream p@(Cursor r c)
    | LL.null c = unconsCursor r =<< lift (readRef r)
    | otherwise = return $! unconsChunk p

unconsCursor :: (Monad m, Nullable s, Reference r m, ListLike s el)
             => r (NextCursor r m s el)
             -> NextCursor r m s el
             -> Iteratee s m (Maybe (el, Cursor r m s el))
unconsCursor _ (NextCursor c) = return $! unconsChunk c
unconsCursor _  None          = return $! Nothing
unconsCursor r  Uneval        = icont (extendCursor r) Nothing

insertCursor :: (Monad m, Reference r m, ListLike s el)
             => r (NextCursor r m s el)
             -> s
             -> m (Cursor r m s el)
insertCursor r s = do
    r' <- newRef Uneval
    let c = Cursor r' s
    writeRef r (NextCursor c)
    return c

extendCursor :: (Monad m, Nullable s, Reference r m, ListLike s el)
             => r (NextCursor r m s el)
             -> Stream s
             -> Iteratee s m (Maybe (el, Cursor r m s el))
extendCursor r (Chunk s)
    | LL.null s = liftI (extendCursor r)
    | otherwise = return . unconsChunk =<< lift (insertCursor r s)
extendCursor r (EOF Nothing)
    = const (return Nothing) =<< lift (writeRef r None)
extendCursor r (EOF (Just se@(SomeException e)))
    | typeOf e == seekType = throwErr $ unhandled
    | otherwise = throwRecoverableErr se (extendCursor r)
    where seekType = typeOf (undefined :: SeekException)
          unhandled
              = SomeException $! EnumUnhandledIterException (IterException e)

unconsChunk :: (Monad m, Reference r m, ListLike s el)
            => Cursor r m s el -> Maybe (el, Cursor r m s el)
unconsChunk (Cursor r s) = Just (LL.head s, Cursor r $ LL.tail s)

concatCursor :: (Monad m, Reference r m, ListLike s el)
             => Cursor r m s el -> m s
concatCursor (Cursor r s) = liftM (s `mappend`) (concatCursor' =<< readRef r)

concatCursor' :: (Monad m, Reference r m, ListLike s el)
              => NextCursor r m s el -> m s
concatCursor' (NextCursor n) = concatCursor n
concatCursor' _              = return $! mempty

-- | Runs parser. If it suceed the remaining part of stream stands in stream,
-- however if it fails the stream is not in defined state.
parsecIteratee :: (Monad m, Reference r m, Nullable c, ListLike c el)
               => ParsecT (Cursor r m c el) u (Iteratee c m) a
                  -- ^ Parser to run
               -> u -- ^ A user state
               -> SourceName -- ^ Source name
               -> Iteratee c m (Either ParseError a)
parsecIteratee p u sn = do
   c <- lift mkCursor
   res <- runParserT (liftM2 (,) p getInput) u sn c
   case res of
     Right (a, c') -> do sc <- lift $ concatCursor c'
                         idone (Right a) (Chunk sc)
     Left   err   -> return $! Left err

-- | Runs parser. If it suceed the remaining part of stream stands in stream,
-- however if it fails everything stands in stream.
safeParsecIteratee :: (Monad m, Reference r m, Nullable c, ListLike c el)
                   => ParsecT (Cursor r m c el) u (Iteratee c m) a
                      -- ^ Parser to run
                   -> u -- ^ A user state
                   -> SourceName -- ^ Source name
                   -> Iteratee c m (Either ParseError a)
safeParsecIteratee p u sn = do
    c <- lift mkCursor
    Right (c', res) <- runParserT (parsecSafe p) u sn c
    sc <- lift $ concatCursor c'
    idone res (Chunk sc)

parsecSafe :: Monad m
           => ParsecT s u m a
           -> ParsecT s u m (s, Either ParseError a)
parsecSafe p = mkPT $ \s -> do
    r <- unConsume =<< runParsecT p s
    case r of
      Error pe  -> let rp = Ok (stateInput s,  Left pe) s  (unknownError s)
                  in return $! Empty $ return $! rp
      Ok v s' _ -> let rp = Ok (stateInput s', Right v) s' (unknownError s')
                  in return $! Consumed $! return $! rp
    where unConsume (Consumed x) = x
          unConsume (Empty    x) = x