{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Machine.Attoparsec.ByteString
  ( parse
  , many
  ) where

import qualified Data.Attoparsec.ByteString as P
import qualified Data.Attoparsec.Internal.Types as PI
import qualified Data.ByteString as BS
import           Data.Machine
import           Data.Machine.Stack

{- | Parse one 'a' out of a ByteString stream, or an error when a parser fails.
 -   The stack allows one to have a sequence of parsers that pick up where the last left off.
 -}
parse :: forall m a . Monad m => P.Parser a -> MachineT m (Stack BS.ByteString) (Either String a)
parse p = encased $ Await (\b -> if PI.nullChunk b
                                then parse p
                                else feed (P.parse p b)) Pop stopped
  where
    feed :: P.Result a -> MachineT m (Stack BS.ByteString) (Either String a)
    feed (P.Partial c)  = encased $
                          Await (\b -> if PI.nullChunk b
                                      then feed (P.Partial c)
                                      else feed (c b)) Pop (feed $ c mempty)
    feed (P.Done i r)   = encased $
                          Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped
    feed (P.Fail i _ e) = encased $
                          Await (\() -> encased $ Yield (Left  e) stopped) (Push i) stopped
    {-# INLINE feed #-}
{-# INLINE parse #-}

{- | Parse a continuous stream of 'a's out of a ByteStrings stream.
 -}
many :: forall m a. Monad m => P.Parser a -> MachineT m (Stack BS.ByteString) (Either String a)
many p = pp
  where
    pp = encased $ Await (\b -> if PI.nullChunk b
                               then pp
                               else (feed . P.parse p $ b)) Pop stopped
    {-# INLINE pp #-}
    feed :: P.Result a -> MachineT m (Stack BS.ByteString) (Either String a)
    feed (P.Partial c)  = encased $
                          Await (\b -> if PI.nullChunk b
                                      then feed (P.Partial c)
                                      else feed (c b)) Pop (finish $ c mempty)
    feed (P.Done i r)   = encased $
                          Await (\() -> encased $ Yield (Right r) pp) (Push i) stopped
    feed (P.Fail i _ e) = encased $
                          Await (\() -> encased $ Yield (Left  e) pp) (Push i) stopped
    {-# INLINE feed #-}
    finish (P.Partial _)  = stopped
    finish (P.Done i r)   = encased $
                            Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped
    finish (P.Fail i _ e) = encased $
                            Await (\() -> encased $ Yield (Left  e) stopped) (Push i) stopped
    {-# INLINE finish #-}
{-# INLINE many #-}