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
data (Monad m, Reference r m, ListLike s el) => NextCursor r m s el
= NextCursor (Cursor r m s el)
| None
| Uneval
data (Monad m, Reference r m) => Cursor r m s el
= Cursor (r (NextCursor r m s el)) s
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
parsecIteratee :: (Monad m, Reference r m, Nullable c, ListLike c el)
=> ParsecT (Cursor r m c el) u (Iteratee c m) a
-> u
-> SourceName
-> 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
safeParsecIteratee :: (Monad m, Reference r m, Nullable c, ListLike c el)
=> ParsecT (Cursor r m c el) u (Iteratee c m) a
-> u
-> SourceName
-> 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