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 ChScanner m => ChBufferedScanner m where
mpeek1 :: m Char
mprepend :: String -> m ()
class ChBufferedScanner m => ChStackBufferedScanner m where
mpush :: m ()
mpop :: m ()
instance Monad m => ChBufferedScanner (StateT String m) where
mpeek1 = gets head
mprepend s = modify (s++)
instance Monad m => ChBufferedScanner (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 ChScanner m => ChScanner (ScannerBufferT m) where
mscan1 = ScannerBuffer $ \(ss:sx) -> (if null ss then do s <- mscan1; return (s,[]:map (s:) sx) else return (head ss,tail ss:map (head ss:) sx))
mscanL = ScannerBuffer $ \(ss:sx) -> do l <- mscanL; return (ss++l, []:map (++l) sx)
mscannable = ScannerBuffer $ \(ss:sx) -> (if null ss then do b <- mscannable; return (b,[]:sx) else return (True,ss:sx))
mscanh = return Nothing
mready = ScannerBuffer $ \(ss:sx) -> (if null ss then do b <- mready; return (b,[]:sx) else return (True,ss:sx))
instance MonadIO m => MonadIO (ScannerBufferT m) where
liftIO = lift . liftIO
instance ChScanner m => ChBufferedScanner (ScannerBufferT m) where
mpeek1 = ScannerBuffer $ \(ss:sx) -> (if null ss then do s <- mscan1; return (s,[s]:sx) else return (head ss,ss:sx))
mprepend s = ScannerBuffer $ \(ss:sx) -> return ((),(s++ss):sx)
instance ChScanner m => ChStackBufferedScanner (ScannerBufferT m) where
mpush = ScannerBuffer $ \(ss:sx) -> return ((),ss:[]:sx)
mpop = ScannerBuffer $ \(_:sx) -> return ((),sx)