{-# LANGUAGE FlexibleContexts #-}
{-
This module is part of Antisplice.
Copyleft (c) 2014 Marvin Cohrs
All wrongs reversed. Sharing is an act of love, not crime.
Please share Antisplice with everyone you like.
Antisplice is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Antisplice is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with Antisplice. If not, see .
-}
-- | Provides a haskeline-based Read Eval Print Loop.
module Game.Antisplice.Terminal.Repl where
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Text.Chatty.Interactor
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import Text.Chatty.Expansion.History
import Text.Chatty.Extended.Printer
import Text.Chatty.Channel.Broadcast
import System.Chatty.Misc
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Monad.Vocab
import Game.Antisplice.Monad
import Game.Antisplice.Errors
import Game.Antisplice.Lang
import Data.Chatty.Fail
import Data.Chatty.Counter
import Data.Chatty.AVL
import Data.Chatty.BST
import Data.Chatty.Atoms
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad.Error.Class
import Control.Monad.IO.Class
import Data.Time.Clock
import System.Console.Haskeline
import System.Console.Haskeline.History
-- | Read Eval Print Loop for Antisplice.
repl :: (ChExtendedPrinter m,ChScanner m,MonadError SplErr m,MonadIO m,ChExpand m,ChExpanderEnv m,MonadDungeon m,ChAtoms m,MonadRoom m,ChClock m,MonadVocab m,ChHistoryEnv m,ChRandom m,ChBroadcaster PlayerId m) => m ()
repl = do
mv <- liftIO (newEmptyMVar :: IO (MVar (Maybe String)))
cont <- liftIO (newEmptyMVar :: IO (MVar String))
thr <- liftIO $ forkOS $ runInputT defaultSettings{autoAddHistory=True} $ forever $ do
liftIO . putMVar mv =<< getInputLine =<< liftIO (takeMVar cont)
liftIO . putMVar cont =<< expand =<< expand "$prompt"
forever $ do
e <- runFailT $ forever $ do
ds <- getDungeonState
now <- mgetstamp
let ts = takeWhile (( do
l' <- expand l
mputh l'
e <- runFailT (act l')
let erprintLn = eprintLn $ Vivid Red
case e of
Right _ -> return ()
Left VerbMustFirstError -> erprintLn "Please start with a verb."
Left UnintellegibleError -> erprintLn "I don't understand that."
Left CantWalkThereError -> erprintLn "I can't walk there."
Left WhichOneError -> erprintLn "Which one do you mean?"
Left CantSeeOneError -> erprintLn "I can't see one here."
Left DontCarryOneError -> erprintLn "You don't carry one."
Left CantEquipThatError -> erprintLn "I can't equip that."
Left CantEquipThatThereError -> erprintLn "I can't wear that there. You might want to try some other place?"
Left WhereToEquipError -> erprintLn "Where?"
Left CantCastThatNowError -> erprintLn "Sorry, I can't cast that now. Check your health, mana and cooldowns."
Left WontHitThatError -> erprintLn "I won't hit that."
Left CantAcquireThatError -> erprintLn "I can't take that."
Left (ReError (Unint i e)) -> erprintLn e
Left (ReError (Uncon e)) -> erprintLn e
Left e -> throwError e
throwError DoneError
Just Nothing -> liftIO (killThread thr) >> mprintLn "quit" >> throwError QuitError
Nothing -> liftIO $ threadDelay 100
case e of
Left DoneError -> do
pr <- expand =<< expand "$prompt"
liftIO $ putMVar cont pr
Left e -> throwError e