{-# 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 <http://www.gnu.org/licenses/>.
-}

-- | 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.Applicative
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 :: (Applicative m,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 ((<now).fst) $ avlInorder $ timeTriggersOf ds
      putDungeonState ds{timeTriggersOf=foldr avlRemove (timeTriggersOf ds) $ map fst ts}
      forM_ ts (runHandler . snd)
      r <- liftIO $ tryTakeMVar mv
      case r of
        Just (Just l) -> 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