module Game.Antisplice.Monad.Vocab where
import Control.Arrow
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Game.Antisplice.Utils.TST
data Token = Unintellegible String
| Verb String
| Prep String
| Noun String
| Adj String
| Ordn Int String
| Fixe String
| Skilln String
| Nounc [String] (Maybe Int) String
deriving Show
newtype VocabT m a = Vocab { runVocabT :: TST Token -> m (a,TST Token) }
instance Functor m => Functor (VocabT m) where
fmap f a = Vocab $ \s -> fmap (first f) $ runVocabT a s
instance Monad m => Monad (VocabT m) where
return a = Vocab $ \s -> return (a,s)
m >>= f = Vocab $ \s -> do (a,s') <- runVocabT m s; runVocabT (f a) s'
instance MonadTrans VocabT where
lift m = Vocab $ \s -> do a <- m; return (a,s)
instance MonadIO m => MonadIO (VocabT m) where
liftIO = lift . liftIO
class Monad m => MonadVocab m where
lookupVocab :: String -> m Token
insertVocab :: String -> (String -> Token) -> m ()
vocabKnown :: String -> m Bool
instance Monad m => MonadVocab (VocabT m) where
lookupVocab k = Vocab $ \s -> case tstLookup k s of
Just t -> return (t,s)
Nothing -> return (Unintellegible k,s)
insertVocab k tc = Vocab $ \s -> return ((),tstInsert k (tc k) s)
vocabKnown k = Vocab $ \s -> return (tstContains k s,s)