<commit_before>module RunningWorld
(
  createRunningWorld,
  --sendCommand,
  addPlayer,
  RunningWorld,
) where

import WorldDefinition
import Parser
import Session

import Control.Concurrent
import Control.Monad
import Data.Either
import qualified Data.Map as Map

data RunningWorld = RunningWorld (MVar GameState)
data GenericSuccess = GenericSuccess

data ActiveRoom = ActiveRoom {
  activeRoomCoordinate :: Coordinate,
  activeRoomPlayers :: [PlayerId]
} deriving (Show)

data GameState = GameState {
  gameWorld :: WorldDefinition,
  activeRooms :: Map.Map Coordinate ActiveRoom,
  activePlayers :: Map.Map PlayerId Player
  } deriving (Show)

createRunningWorld :: WorldDefinition -> IO RunningWorld
createRunningWorld world = RunningWorld <$> (newMVar $ (GameState world mempty mempty))

-- This looks something like something...
withStateAndResult :: RunningWorld -> (GameState -> (a, GameState)) -> IO a
withStateAndResult (RunningWorld m) fn = do
  (result, newState) <- fn <$> takeMVar m
  putMVar m newState
  return result

addPlayer :: RunningWorld -> Player -> IO (Either FailFeedback GenericSuccess)
addPlayer world = withStateAndResult world . maybeSetupPlayer

maybeSetupPlayer :: Player -> GameState -> (Either FailFeedback GenericSuccess, GameState)
maybeSetupPlayer player initialState =
  either failure success $ playerIntoWorld player =<< (ensureRoomActive (playerLocation player) initialState) where
    failure reason = (Left reason, initialState)
    success s = (Right GenericSuccess, stateWithPlayer s)
    stateWithPlayer s = s { activePlayers = Map.insert (playerId player) player (activePlayers s) }

ensureRoomActive :: Coordinate -> GameState -> Either FailFeedback GameState
ensureRoomActive coordinate originalState =
  maybe makeRoomActive roomAlreadyActive $ Map.lookup coordinate currentActiveRooms where
    roomAlreadyActive _ = Right originalState
    makeRoomActive = maybe (Left RoomDoesNotExist) amendStateWithRoom $ Map.lookup coordinate (worldRooms (gameWorld originalState))
    amendStateWithRoom room = (Right originalState { activeRooms = Map.insert coordinate newActiveRoom currentActiveRooms })
    newActiveRoom = ActiveRoom coordinate []
    currentActiveRooms = (activeRooms originalState)

playerIntoWorld :: Player -> GameState -> Either FailFeedback GameState
playerIntoWorld player originalState =
  maybe failure success $ Map.lookup coordinate currentActiveRooms where
    failure = Left RoomDoesNotExist
    success room = Right originalState { activeRooms = Map.insert coordinate (updateRoomWithPlayer room player) currentActiveRooms }
    currentActiveRooms = (activeRooms originalState)
    coordinate = (playerLocation player)
    updateRoomWithPlayer room player = room { activeRoomPlayers = (playerId player) : (activeRoomPlayers room) }
<commit_msg>moving towards functionally working at least<commit_after>module RunningWorld
(
  createRunningWorld,
  --sendCommand,
  addPlayer,
  RunningWorld,
) where

import WorldDefinition
import Parser
import Session

import Control.Concurrent
import Control.Monad
import Data.Either
import qualified Data.Map as Map

data RunningWorld = RunningWorld (MVar GameState)
data GenericSuccess = GenericSuccess

data ActiveRoom = ActiveRoom {
  activeRoomCoordinate :: Coordinate,
  activeRoomPlayers :: [PlayerId]
} deriving (Show)

data GameState = GameState {
  gameWorld :: WorldDefinition,
  activeRooms :: Map.Map Coordinate ActiveRoom,
  activePlayers :: Map.Map PlayerId Player
  } deriving (Show)

createRunningWorld :: WorldDefinition -> IO RunningWorld
createRunningWorld world = RunningWorld <$> (newMVar $ (GameState world mempty mempty))

-- This looks something like something...
withStateAndResult :: RunningWorld -> (GameState -> (a, GameState)) -> IO a
withStateAndResult (RunningWorld m) fn = do
  (result, newState) <- fn <$> takeMVar m
  putMVar m newState
  return result

addPlayer :: RunningWorld -> Player -> IO (Either FailFeedback GenericSuccess)
addPlayer world = withStateAndResult world . maybeSetupPlayer

maybeSetupPlayer :: Player -> GameState -> (Either FailFeedback GenericSuccess, GameState)
maybeSetupPlayer player initialState =
  either failure success $ playerIntoWorld player =<< (maybeEnsureRoomActive (playerLocation player) initialState) where
    failure reason = (Left reason, initialState)
    success s = (Right GenericSuccess, stateWithPlayer s)
    stateWithPlayer s = s { activePlayers = Map.insert (playerId player) player (activePlayers s) }

maybeEnsureRoomActive :: Coordinate -> GameState -> Either FailFeedback GameState
maybeEnsureRoomActive coordinate originalState =
  maybe (Left RoomDoesNotExist) setupRoom $ Map.lookup coordinate (worldRooms (gameWorld originalState)) where
    setupRoom definition = Right $ ensureRoomActive definition originalState

ensureRoomActive :: RoomDefinition -> GameState -> GameState
ensureRoomActive room originalState =
  maybe makeRoomActive success $ Map.lookup coordinate currentActiveRooms where
    success _ = originalState
    coordinate = (roomId room)
    makeRoomActive = originalState { activeRooms = Map.insert coordinate newActiveRoom currentActiveRooms }
    currentActiveRooms = (activeRooms originalState)
    newActiveRoom = ActiveRoom coordinate []


playerIntoWorld :: Player -> GameState -> Either FailFeedback GameState
playerIntoWorld player originalState =
  maybe failure success $ Map.lookup coordinate currentActiveRooms where
    failure = Left RoomDoesNotExist
    success room = Right originalState { activeRooms = Map.insert coordinate (updateRoomWithPlayer room player) currentActiveRooms }
    currentActiveRooms = (activeRooms originalState)
    coordinate = (playerLocation player)
    updateRoomWithPlayer room player = room { activeRoomPlayers = (playerId player) : (activeRoomPlayers room) }

sendCommand :: RunningWorld -> PlayerId -> Command -> IO (Either FailFeedback String)
sendCommand world targetPlayerId command = withStateAndResult world $ RunningWorld.processCommand targetPlayerId command

processCommand :: PlayerId -> Command -> GameState -> ((Either FailFeedback String), GameState)
processCommand _ _ s = (Right "god", s)
--processCommand targetPlayerId (Move direction) state =
--  let maybePlayer = Map.lookup targetPlayerId (activePlayers state)
--      maybePlayerLocation = playerLocation <$> maybePlayer
--      maybeNextPlayerLocation = move direction <$> maybePlayerLocation
--      maybeCurrentRoom = ((flip Map.lookup) (activeRooms state)) <$> maybePlayerLocation
--      maybeNextRoom = (flip Map.lookup) (worldRooms (gameWorld state)) <$> maybeNextPlayerLocation
--      stateWithActiveRoom = ensure
--
--processCommand targetPlayerId (Look direction) state = (Right "Woop", state)


{'fraction_non_alphanumeric': 0.07394783639596918, 'fraction_numerical': 0.0, 'mean_word_length': 5.243293246993525, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6845041', 'n_tokens_mistral': 1723, 'n_tokens_neox': 1703, 'n_words': 563}