module Text.Chatty.Scanner.Buffered where
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.Trans.Class
import Text.Chatty.Scanner
class MonadScanner m => BufferedScanner m where
mpeek1 :: m Char
mprepend :: String -> m ()
instance Monad m => BufferedScanner (StateT String m) where
mpeek1 = gets head
mprepend s = modify (s++)
instance Monad m => BufferedScanner (HereStringT m) where
mpeek1 = HereString $ \ss -> return (head ss, ss)
mprepend s = HereString $ \ss -> return ((), s++ss)
newtype ScannerBufferT m a = ScannerBuffer { runScannerBufferT :: String -> m (a,String) }
instance Monad m => Monad (ScannerBufferT m) where
return a = ScannerBuffer $ \s -> return (a,s)
(ScannerBuffer c) >>= f = ScannerBuffer $ \s -> do (a,s') <- c s; runScannerBufferT (f a) s'
instance MonadTrans ScannerBufferT where
lift m = ScannerBuffer $ \s -> do a <- m; return (a,s)
instance Monad m => Functor (ScannerBufferT m) where
fmap = liftM
instance MonadScanner m => MonadScanner (ScannerBufferT m) where
mscan1 = ScannerBuffer $ \ss -> (if null ss then do s <- mscan1; return (s,[]) else return (head ss,tail ss))
mscanL = ScannerBuffer $ \ss -> do l <- mscanL; return (ss++l, [])
mscannable = ScannerBuffer $ \ss -> (if null ss then do b <- mscannable; return (b,[]) else return (True,ss))
mscanh = return Nothing
mready = ScannerBuffer $ \ss -> (if null ss then do b <- mready; return (b,[]) else return (True,ss))
instance MonadIO m => MonadIO (ScannerBufferT m) where
liftIO = lift . liftIO
instance MonadScanner m => BufferedScanner (ScannerBufferT m) where
mpeek1 = ScannerBuffer $ \ss -> (if null ss then do s <- mscan1; return (s,[s]) else return (head ss,ss))
mprepend s = ScannerBuffer $ \ss -> return ((),s++ss)