-- | Basic client monad and related operations.
module Game.LambdaHack.Client.MonadClient
  ( -- * Basic client monads
    MonadClientRead ( getsClient
                    , liftIO  -- exposed only to be implemented, not used
                    )
  , MonadClient(modifyClient)
    -- * Assorted primitives
  , getClient, putClient
  , debugPossiblyPrint, createTabBFS, dumpTextFile, rndToAction
  , condInMeleeM, insertInMeleeM
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Control.Exception as Ex
import           Control.Monad.ST.Strict (stToIO)
import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumSet as ES
import qualified Data.Primitive.PrimArray as PA
import qualified Data.Text.IO as T
import           System.Directory
import           System.FilePath
import           System.IO (hFlush, stdout)

import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.File
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Core.Random

-- | Monad for reading client state.
class MonadStateRead m => MonadClientRead m where
  getsClient :: (StateClient -> a) -> m a
  -- We do not provide a MonadIO instance, so that outside
  -- nobody can subvert the action monads by invoking arbitrary IO.
  liftIO :: IO a -> m a

-- | Monad for writing to client state.
class MonadClientRead m => MonadClient m where
  modifyClient :: (StateClient -> StateClient) -> m ()

getClient :: MonadClientRead m => m StateClient
getClient :: forall (m :: * -> *). MonadClientRead m => m StateClient
getClient = (StateClient -> StateClient) -> m StateClient
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> StateClient
forall a. a -> a
id

putClient :: MonadClient m => StateClient -> m ()
putClient :: forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
s = (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient (StateClient -> StateClient -> StateClient
forall a b. a -> b -> a
const StateClient
s)

debugPossiblyPrint :: MonadClient m => Text -> m ()
debugPossiblyPrint :: forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint Text
t = do
  sdbgMsgCli <- (StateClient -> Bool) -> m Bool
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sdbgMsgCli (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  when sdbgMsgCli $ liftIO $ do
    T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough
    hFlush stdout

createTabBFS :: MonadClient m => m (PA.PrimArray PointI)
createTabBFS :: forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS = do
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  liftIO $ stToIO $ do
    tabAMutable <- PA.newPrimArray (rWidthMax * rHeightMax)  -- always enough
    PA.unsafeFreezePrimArray tabAMutable

dumpTextFile :: MonadClientRead m => Text -> FilePath -> m FilePath
dumpTextFile :: forall (m :: * -> *).
MonadClientRead m =>
Text -> String -> m String
dumpTextFile Text
t String
filename = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
  dataDir <- IO String
appDataDir
  tryCreateDir dataDir
  let path = String
dataDir String -> String -> String
</> String
filename
  Ex.handle (\(IOException
_ :: Ex.IOException) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $
    removeFile path
  tryWriteFile path t
  return path

-- | Invoke pseudo-random computation with the generator kept in the state.
rndToAction :: MonadClient m => Rnd a -> m a
rndToAction :: forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction Rnd a
r = do
  gen1 <- (StateClient -> SMGen) -> m SMGen
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> SMGen
srandom
  let (a, gen2) = St.runState r gen1
  modifyClient $ \StateClient
cli -> StateClient
cli {srandom = gen2}
  return a

condInMeleeM :: MonadClientRead m => LevelId -> m Bool
condInMeleeM :: forall (m :: * -> *). MonadClientRead m => LevelId -> m Bool
condInMeleeM LevelId
lid = do
  condInMelee <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
scondInMelee
  return $! lid `ES.member` condInMelee

insertInMeleeM :: MonadClient m => LevelId -> m ()
insertInMeleeM :: forall (m :: * -> *). MonadClient m => LevelId -> m ()
insertInMeleeM LevelId
lid = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  actorMaxSkills <- getsState sactorMaxSkills
  inM <- getsState $ inMelee actorMaxSkills side lid
  modifyClient $ \StateClient
cli ->
--    cli {scondInMelee = ES.alterF (const inM) lid $ scondInMelee cli}
    StateClient
cli {scondInMelee = if inM
                        then ES.insert lid $ scondInMelee cli
                        else ES.delete lid $ scondInMelee cli}