module Control.Foldl.Transduce.Attoparsec (
        stripParse
    ,   parses
    ,   ParserInput
    ,   ParsingError
    ) where

import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.Attoparsec.Types
import Data.Attoparsec.ByteString
import Data.Attoparsec.Text
import Data.Monoid
import qualified Data.Monoid.Null as MN
import qualified Data.Monoid.Factorial as MF
import Control.Monad.Trans.Except

import Control.Foldl.Transduce

{- $setup

>>> import qualified Control.Foldl as L
>>> import qualified Data.Text as T
>>> import Data.Functor
>>> import Control.Foldl.Transduce
>>> import Control.Foldl.Transduce.Attoparsec
>>> import qualified Data.Attoparsec.Text as A
>>> import Control.Applicative
>>> import Control.Monad.Trans.Except

-}

data StripState a b 
    = Parsed b
    | Continue (a -> IResult a b)

{-| Strips from the stream the prefix that matches the parser.		

    The parsed value becomes the return value of the 'TransducerM'.


>>> runExcept $ L.foldM (transduceM (void (stripParse (many (A.char 'a')))) (L.generalize L.mconcat)) (map T.pack ["aa","bb"])
Right "bb"

>>> runExcept $ L.foldM (transduceM' (stripParse (many (A.char 'a'))) (L.generalize L.mconcat)) (map T.pack ["aa","aa","bb"])
Right ("aaaa","bb")

>>> runExcept $ L.foldM (transduceM' (stripParse (A.char 'z')) (L.generalize L.mconcat)) (map T.pack ["aa","aa","bb"])
Left ("aa",["'z'"],"Failed reading: satisfy")
-}
stripParse :: (ParserInput a,Monad m) 
           => Data.Attoparsec.Types.Parser a b
           -> TransducerM (ExceptT (ParsingError a) m) a a b 
stripParse atto = TransducerM step (initial (_parse atto mempty)) done
    where
    initial iresult = case iresult of
        Fail l es e -> throwE (l,es,e)
        Done _ r -> return (Parsed r) -- there can't be leftovers here!
        Partial c -> return (Continue c)

    step x i 
        | MN.null i =
            return (x,[],[])
        | otherwise = case x of
            Parsed _ -> 
                return (x,[i],[])
            Continue c -> 
                case c i of
                    Fail l es e -> throwE (l,es,e)
                    Done l r -> return (Parsed r,[l],[]) 
                    Partial c' -> return (Continue c',[],[])

    done x = case x of
        Parsed r -> return (r,[],[])
        Continue c -> case c mempty of
            Fail l es e -> throwE (l,es,e)
            Done l r -> return (r,[l],[]) 
            Partial _ -> error "never happens"


data ParsesState a b 
    = BetweenParses
    | DuringParse (a -> IResult a b)

{-| Feeds a 'FoldM' with the results of repeatedly applying a parser.		


>>> runExcept $ L.foldM (transduceM (parses (A.decimal <* A.char ' ')) (L.generalize L.list)) (map T.pack ["1 1","1 3 77 "])
Right [1,11,3,77]

-}
parses :: (ParserInput a,Monad m) 
       => Data.Attoparsec.Types.Parser a b
       -> TransducerM (ExceptT (ParsingError a) m) a b ()
parses atto = TransducerM step (return BetweenParses) done
    where 
    step x i = do
        (x',rs) <- step' [] x i
        return (x',reverse rs,[])
        
    step' acc xx i 
        | MN.null i =
            return (xx,acc)
        | otherwise =
           case xx of
               BetweenParses -> case _parse atto mempty of
                   Fail l es e -> throwE (l,es,e)
                   Done _ _ -> throwE (mempty,[],"Parser doesn't consume!")
                   Partial c -> step' acc (DuringParse c) i

               DuringParse c -> case c i of 
                   Fail l es e -> throwE (l,es,e)
                   Done l r -> step' (r:acc) BetweenParses l
                   Partial c' -> return (DuringParse c',acc)

    done x = case x of
        BetweenParses -> return mempty
        DuringParse c -> case c mempty of 
            Fail l es e -> throwE (l,es,e)
            Done _ r -> return ((),[r],[]) -- there shouldn't be leftovers, I think.
            Partial _ -> error "never happens"

-- From the attoparsec docs:
-- http://hackage.haskell.org/package/attoparsec-0.13.0.1/docs/Data-Attoparsec-Text.html
-- "To indicate that you have no more input, supply the Partial continuation with an empty Text."

class (Eq a,MF.StableFactorialMonoid a) => ParserInput a where
    _parse :: Data.Attoparsec.Types.Parser a b -> a -> IResult a b

instance ParserInput B.ByteString where
    _parse  = Data.Attoparsec.ByteString.parse
    {-# INLINE _parse #-}

-- | Strict 'Text'.
instance ParserInput T.Text where
    _parse  = Data.Attoparsec.Text.parse
    {-# INLINE _parse #-}

{-| A triplet of (leftovers,error contexts,error message)

-}
type ParsingError a = (a,[String],String)