{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Messages
  ( Message,
    add,
    write,
    read,
  )
where

import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader (..))
import Data.Data (Typeable)
import Data.IORef
import Data.Kind
import Data.Map (Map)
import Data.Map qualified as Map
import Mischief.ECS.App
import Mischief.ECS.App.SystemDef
import Mischief.ECS.App.Systems
import Mischief.ECS.Components
import Mischief.ECS.Log
import Mischief.ECS.Resources
import Mischief.ECS.Tables
import Mischief.ECS.Utils
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Modify
import Mischief.ECS.World.Query (get)
import Mischief.ECS.World.Query.Queryable
import Prelude hiding (read)

-- | Message typeclass.
class (Typeable m) => Message m

-- | Resource for writing and reading messages.
--
-- Internally, this keeps track of which messages each system has already read.
data Messages m = Messages {forall m. Messages m -> [(Frame, Tick, m)]
messages :: [(Frame, Tick, m)], forall m. Messages m -> Map SystemId Reader
readers :: Map SystemId Reader}

newMessages :: forall m. Messages m
newMessages :: forall m. Messages m
newMessages = Messages {messages :: [(Frame, Tick, m)]
messages = [], readers :: Map SystemId Reader
readers = Map SystemId Reader
forall k a. Map k a
Map.empty}

newtype Reader = Reader (IORef Tick)

getReader :: (Message m) => Messages m -> System Reader
getReader :: forall m. Message m => Messages m -> System Reader
getReader !Messages m
m = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  case Map.lookup world.systemId m.readers of
    Just Reader
r -> Reader -> System Reader
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return Reader
r
    Maybe Reader
Nothing -> do
      tick <- IO (IORef Tick) -> System (IORef Tick)
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Tick) -> System (IORef Tick))
-> IO (IORef Tick) -> System (IORef Tick)
forall a b. (a -> b) -> a -> b
$ Tick -> IO (IORef Tick)
forall a. a -> IO (IORef a)
newIORef (Tick -> IO (IORef Tick)) -> Tick -> IO (IORef Tick)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Tick
Tick (Int
0, Int
0)
      insertRes $ (\Messages {[(Frame, Tick, m)]
messages :: forall m. Messages m -> [(Frame, Tick, m)]
messages :: [(Frame, Tick, m)]
messages, Map SystemId Reader
readers :: forall m. Messages m -> Map SystemId Reader
readers :: Map SystemId Reader
readers} -> Messages {[(Frame, Tick, m)]
messages :: [(Frame, Tick, m)]
messages :: [(Frame, Tick, m)]
messages, readers :: Map SystemId Reader
readers = SystemId -> Reader -> Map SystemId Reader -> Map SystemId Reader
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert World
world.systemId (IORef Tick -> Reader
Reader IORef Tick
tick) Map SystemId Reader
readers}) m
      return $ Reader tick

instance (Message m) => Component (Messages m)

-- | Write a message.
write :: forall m. (Message m) => m -> System ()
write :: forall m. Message m => m -> System ()
write !m
message = do
  messages <- Messages m -> System (Result (Messages m))
forall r.
(Component r, Updateable (Result r), Bundle r) =>
r -> System (Result r)
resOrInsert (Messages m -> System (Result (Messages m)))
-> Messages m -> System (Result (Messages m))
forall a b. (a -> b) -> a -> b
$ forall m. Messages m
newMessages @m
  world <- unsafeGetWorld
  frame <- liftIO $ readIORef world.frame

  loc <- self
  Just currentSystemTick <- get (C @SystemTick) loc

  let message' = (Frame
frame, Result SystemTick
currentSystemTick.inner, m
message)
  modify messages (\Messages {[(Frame, Tick, m)]
messages :: forall m. Messages m -> [(Frame, Tick, m)]
messages :: [(Frame, Tick, m)]
messages, Map SystemId Reader
readers :: forall m. Messages m -> Map SystemId Reader
readers :: Map SystemId Reader
readers} -> Messages {messages :: [(Frame, Tick, m)]
messages = (Frame, Tick, m)
message' (Frame, Tick, m) -> [(Frame, Tick, m)] -> [(Frame, Tick, m)]
forall a. a -> [a] -> [a]
: [(Frame, Tick, m)]
messages, Map SystemId Reader
readers :: Map SystemId Reader
readers :: Map SystemId Reader
readers})
  clearOldMessages messages

-- | Read all the messages that haven't been read by the current system.
read :: forall m. (Message m) => System [m]
read :: forall m. Message m => System [m]
read = do
  m <- forall c. QueryType c => System (Maybe c)
res @(Messages m)
  case m of
    Maybe (Messages m)
Nothing -> [m] -> System [m]
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Messages m
m -> do
      Reader tick <- Messages m -> System Reader
forall m. Message m => Messages m -> System Reader
getReader Messages m
m
      readerTick <- liftIO $ readIORef tick

      loc <- self
      Just currentSystemTick <- get (C @SystemTick) loc

      let newMessages = ((Frame, Tick, m) -> m) -> [(Frame, Tick, m)] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map (\(Frame
_, Tick
_, m
x) -> m
x) ([(Frame, Tick, m)] -> [m]) -> [(Frame, Tick, m)] -> [m]
forall a b. (a -> b) -> a -> b
$ ((Frame, Tick, m) -> Bool)
-> [(Frame, Tick, m)] -> [(Frame, Tick, m)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Frame
_, Tick
tick, m
_) -> Tick
tick Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
< Result SystemTick
currentSystemTick.inner Bool -> Bool -> Bool
&& Tick
tick Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
> Tick
readerTick) Messages m
m.messages
      liftIO $ writeIORef tick currentSystemTick.inner

      return newMessages

-- | Register a new message type with the App. This will automatically create a corresponding resource.
add :: forall (m :: Type). (Message m) => System ()
add :: forall m. Message m => System ()
add = Messages m -> System ()
forall r. (Component r, Bundle r) => r -> System ()
insertRes (Messages m -> System ()) -> Messages m -> System ()
forall a b. (a -> b) -> a -> b
$ forall m. Messages m
newMessages @m

clearOldMessages :: (Message m) => Result (Messages m) -> System ()
clearOldMessages :: forall m. Message m => Result (Messages m) -> System ()
clearOldMessages !Result (Messages m)
m = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  frame <- liftIO $ readIORef world.frame
  modify m (\Messages {[(Frame, Tick, m)]
messages :: forall m. Messages m -> [(Frame, Tick, m)]
messages :: [(Frame, Tick, m)]
messages, Map SystemId Reader
readers :: forall m. Messages m -> Map SystemId Reader
readers :: Map SystemId Reader
readers} -> Messages {messages :: [(Frame, Tick, m)]
messages = ((Frame, Tick, m) -> Bool)
-> [(Frame, Tick, m)] -> [(Frame, Tick, m)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Frame Int
x, Tick
_, m
_) -> Int -> Frame
Frame (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Frame -> Frame -> Bool
forall a. Ord a => a -> a -> Bool
>= Frame
frame) [(Frame, Tick, m)]
messages, Map SystemId Reader
readers :: Map SystemId Reader
readers :: Map SystemId Reader
readers})