module Text.HTML.Tagchup.Parser.Status where

import qualified Text.HTML.Tagchup.Parser.Stream as Stream
import qualified Text.XML.Basic.Position as Position

import Control.Monad.Trans.State (StateT(..), )


data T stream =
   Cons {
      forall stream. T stream -> T
sourcePos :: Position.T,
      forall stream. T stream -> stream
source    :: stream
   }
   deriving Int -> T stream -> ShowS
forall stream. Show stream => Int -> T stream -> ShowS
forall stream. Show stream => [T stream] -> ShowS
forall stream. Show stream => T stream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T stream] -> ShowS
$cshowList :: forall stream. Show stream => [T stream] -> ShowS
show :: T stream -> String
$cshow :: forall stream. Show stream => T stream -> String
showsPrec :: Int -> T stream -> ShowS
$cshowsPrec :: forall stream. Show stream => Int -> T stream -> ShowS
Show


instance Stream.C input => Stream.C (T input) where
   getChar :: StateT (T input) Maybe Char
getChar =
      forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \ (Cons T
pos input
str) ->
         do (Char
c,input
cs) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall stream. C stream => StateT stream Maybe Char
Stream.getChar input
str
            forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c, forall stream. T -> stream -> T stream
Cons (Char -> T -> T
Position.updateOnChar Char
c T
pos) input
cs)