module Data.Aztecs.Storage (Storage (..), table, table') where

import Control.Monad (filterM)
import Data.Aztecs.Core
import Data.Functor ((<&>))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List (find)

data Storage a = Storage
  { forall a. Storage a -> IO (Storage a)
empty :: IO (Storage a),
    forall a. Storage a -> Entity -> a -> IO (Storage a)
spawn :: Entity -> a -> IO (Storage a),
    forall a.
Storage a
-> Entity -> IO (Maybe (a, a -> Storage a -> IO (Storage a)))
get :: Entity -> IO (Maybe (a, a -> Storage a -> IO (Storage a))),
    forall a. Storage a -> IO [EntityComponent a]
toList :: IO [EntityComponent a],
    forall a. Storage a -> IO [(EntityComponent a, a -> IO ())]
toList' :: IO [(EntityComponent a, a -> IO ())],
    forall a. Storage a -> Entity -> IO (Storage a)
remove :: Entity -> IO (Storage a)
  }

table' :: [IORef (EntityComponent a)] -> Storage a
table' :: forall a. [IORef (EntityComponent a)] -> Storage a
table' [IORef (EntityComponent a)]
cs =
  Storage
    { empty :: IO (Storage a)
empty = Storage a -> IO (Storage a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Storage a -> IO (Storage a)) -> Storage a -> IO (Storage a)
forall a b. (a -> b) -> a -> b
$ [IORef (EntityComponent a)] -> Storage a
forall a. [IORef (EntityComponent a)] -> Storage a
table' [],
      spawn :: Entity -> a -> IO (Storage a)
spawn = \Entity
e a
a -> do
        IORef (EntityComponent a)
r <- EntityComponent a -> IO (IORef (EntityComponent a))
forall a. a -> IO (IORef a)
newIORef (Entity -> a -> EntityComponent a
forall a. Entity -> a -> EntityComponent a
EntityComponent Entity
e a
a)
        Storage a -> IO (Storage a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Storage a -> IO (Storage a)) -> Storage a -> IO (Storage a)
forall a b. (a -> b) -> a -> b
$ [IORef (EntityComponent a)] -> Storage a
forall a. [IORef (EntityComponent a)] -> Storage a
table' (IORef (EntityComponent a)
r IORef (EntityComponent a)
-> [IORef (EntityComponent a)] -> [IORef (EntityComponent a)]
forall a. a -> [a] -> [a]
: [IORef (EntityComponent a)]
cs),
      get :: Entity -> IO (Maybe (a, a -> Storage a -> IO (Storage a)))
get = \Entity
e -> do
        [(EntityComponent a, IORef (EntityComponent a))]
cs' <-
          (IORef (EntityComponent a)
 -> IO (EntityComponent a, IORef (EntityComponent a)))
-> [IORef (EntityComponent a)]
-> IO [(EntityComponent a, IORef (EntityComponent a))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
            ( \IORef (EntityComponent a)
r -> do
                EntityComponent a
a <- IORef (EntityComponent a) -> IO (EntityComponent a)
forall a. IORef a -> IO a
readIORef IORef (EntityComponent a)
r
                (EntityComponent a, IORef (EntityComponent a))
-> IO (EntityComponent a, IORef (EntityComponent a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityComponent a
a, IORef (EntityComponent a)
r)
            )
            [IORef (EntityComponent a)]
cs
        Maybe (a, a -> Storage a -> IO (Storage a))
-> IO (Maybe (a, a -> Storage a -> IO (Storage a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( ((EntityComponent a, IORef (EntityComponent a)) -> Bool)
-> [(EntityComponent a, IORef (EntityComponent a))]
-> Maybe (EntityComponent a, IORef (EntityComponent a))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(EntityComponent Entity
e' a
_, IORef (EntityComponent a)
_) -> Entity
e Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
e') [(EntityComponent a, IORef (EntityComponent a))]
cs'
              Maybe (EntityComponent a, IORef (EntityComponent a))
-> ((EntityComponent a, IORef (EntityComponent a))
    -> (a, a -> Storage a -> IO (Storage a)))
-> Maybe (a, a -> Storage a -> IO (Storage a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(EntityComponent Entity
_ a
a, IORef (EntityComponent a)
r) ->
                ( a
a,
                  \a
a' Storage a
t -> do
                    IORef (EntityComponent a) -> EntityComponent a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (EntityComponent a)
r (Entity -> a -> EntityComponent a
forall a. Entity -> a -> EntityComponent a
EntityComponent Entity
e a
a')
                    Storage a -> IO (Storage a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Storage a
t
                )
          ),
      toList :: IO [EntityComponent a]
toList = (IORef (EntityComponent a) -> IO (EntityComponent a))
-> [IORef (EntityComponent a)] -> IO [EntityComponent a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM IORef (EntityComponent a) -> IO (EntityComponent a)
forall a. IORef a -> IO a
readIORef [IORef (EntityComponent a)]
cs,
      toList' :: IO [(EntityComponent a, a -> IO ())]
toList' =
        (IORef (EntityComponent a) -> IO (EntityComponent a, a -> IO ()))
-> [IORef (EntityComponent a)]
-> IO [(EntityComponent a, a -> IO ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          ( \IORef (EntityComponent a)
r -> do
              (EntityComponent Entity
e a
a) <- IORef (EntityComponent a) -> IO (EntityComponent a)
forall a. IORef a -> IO a
readIORef IORef (EntityComponent a)
r
              (EntityComponent a, a -> IO ())
-> IO (EntityComponent a, a -> IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
                ( (Entity -> a -> EntityComponent a
forall a. Entity -> a -> EntityComponent a
EntityComponent Entity
e a
a),
                  \a
a' -> IORef (EntityComponent a) -> EntityComponent a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (EntityComponent a)
r (Entity -> a -> EntityComponent a
forall a. Entity -> a -> EntityComponent a
EntityComponent Entity
e a
a')
                )
          )
          [IORef (EntityComponent a)]
cs,
      remove :: Entity -> IO (Storage a)
remove = \Entity
e -> do
        [IORef (EntityComponent a)]
cs' <-
          (IORef (EntityComponent a) -> IO Bool)
-> [IORef (EntityComponent a)] -> IO [IORef (EntityComponent a)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
            ( \IORef (EntityComponent a)
r -> do
                (EntityComponent Entity
e' a
_) <- IORef (EntityComponent a) -> IO (EntityComponent a)
forall a. IORef a -> IO a
readIORef IORef (EntityComponent a)
r
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Entity
e Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
/= Entity
e'
            )
            [IORef (EntityComponent a)]
cs
        Storage a -> IO (Storage a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Storage a -> IO (Storage a)) -> Storage a -> IO (Storage a)
forall a b. (a -> b) -> a -> b
$ [IORef (EntityComponent a)] -> Storage a
forall a. [IORef (EntityComponent a)] -> Storage a
table' [IORef (EntityComponent a)]
cs'
    }

table :: Storage a
table :: forall a. Storage a
table = [IORef (EntityComponent a)] -> Storage a
forall a. [IORef (EntityComponent a)] -> Storage a
table' []