{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Data.Aztecs.World.Components
  ( Component (..),
    Components,
    union,
    spawn,
    insert,
    adjust,
    get,
    getRow,
    newComponents,
    setRow,
    remove,
  )
where

import Data.Aztecs.Core
import Data.Aztecs.Storage (Storage, table)
import qualified Data.Aztecs.Storage as S
import Data.Dynamic (Dynamic, fromDynamic, toDyn)
import Data.Map (Map, alter, empty, lookup)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Typeable
import Prelude hiding (read)

class (Typeable a) => Component a where
  storage :: Storage a
  storage = Storage a
forall a. Storage a
table

data Components = Components (Map TypeRep Dynamic) Entity deriving (Int -> Components -> ShowS
[Components] -> ShowS
Components -> String
(Int -> Components -> ShowS)
-> (Components -> String)
-> ([Components] -> ShowS)
-> Show Components
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Components -> ShowS
showsPrec :: Int -> Components -> ShowS
$cshow :: Components -> String
show :: Components -> String
$cshowList :: [Components] -> ShowS
showList :: [Components] -> ShowS
Show)

newComponents :: Components
newComponents :: Components
newComponents = Map TypeRep Dynamic -> Entity -> Components
Components Map TypeRep Dynamic
forall k a. Map k a
empty (Int -> Entity
Entity Int
0)

union :: Components -> Components -> Components
union :: Components -> Components -> Components
union (Components Map TypeRep Dynamic
a Entity
e) (Components Map TypeRep Dynamic
b Entity
_) = Map TypeRep Dynamic -> Entity -> Components
Components (Map TypeRep Dynamic -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map TypeRep Dynamic
a Map TypeRep Dynamic
b) Entity
e

spawn :: forall c. (Component c) => c -> Components -> IO (Entity, Components)
spawn :: forall c. Component c => c -> Components -> IO (Entity, Components)
spawn c
c (Components Map TypeRep Dynamic
w (Entity Int
e)) = do
  Components
w' <- Entity -> c -> Components -> IO Components
forall c. Component c => Entity -> c -> Components -> IO Components
insert (Int -> Entity
Entity Int
e) c
c (Map TypeRep Dynamic -> Entity -> Components
Components Map TypeRep Dynamic
w (Int -> Entity
Entity (Int -> Entity) -> Int -> Entity
forall a b. (a -> b) -> a -> b
$ Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  (Entity, Components) -> IO (Entity, Components)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Entity
Entity Int
e, Components
w')

insert :: forall c. (Component c) => Entity -> c -> Components -> IO Components
insert :: forall c. Component c => Entity -> c -> Components -> IO Components
insert Entity
e c
c (Components Map TypeRep Dynamic
w Entity
e') = do
  Map TypeRep Dynamic
w' <-
    (Maybe Dynamic -> IO (Maybe Dynamic))
-> TypeRep -> Map TypeRep Dynamic -> IO (Map TypeRep Dynamic)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
      ( \Maybe Dynamic
maybeRow -> do
          Storage c
s <- Storage c -> Entity -> c -> IO (Storage c)
forall a. Storage a -> Entity -> a -> IO (Storage a)
S.spawn (Storage c -> Maybe (Storage c) -> Storage c
forall a. a -> Maybe a -> a
fromMaybe Storage c
forall a. Component a => Storage a
storage (Maybe Dynamic
maybeRow Maybe Dynamic
-> (Dynamic -> Maybe (Storage c)) -> Maybe (Storage c)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe (Storage c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic)) Entity
e c
c
          Maybe Dynamic -> IO (Maybe Dynamic)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Dynamic -> IO (Maybe Dynamic))
-> (Dynamic -> Maybe Dynamic) -> Dynamic -> IO (Maybe Dynamic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Maybe Dynamic
forall a. a -> Maybe a
Just (Dynamic -> IO (Maybe Dynamic)) -> Dynamic -> IO (Maybe Dynamic)
forall a b. (a -> b) -> a -> b
$ Storage c -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Storage c
s
      )
      (Proxy c -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c))
      Map TypeRep Dynamic
w
  Components -> IO Components
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Components -> IO Components) -> Components -> IO Components
forall a b. (a -> b) -> a -> b
$ Map TypeRep Dynamic -> Entity -> Components
Components Map TypeRep Dynamic
w' Entity
e'

adjust :: (Component c) => c -> (c -> c) -> Entity -> Components -> IO Components
adjust :: forall c.
Component c =>
c -> (c -> c) -> Entity -> Components -> IO Components
adjust c
a c -> c
f Entity
w = Entity -> c -> Components -> IO Components
forall c. Component c => Entity -> c -> Components -> IO Components
insert Entity
w (c -> c
f c
a)

getRow :: (Component c) => Proxy c -> Components -> Maybe (Storage c)
getRow :: forall c. Component c => Proxy c -> Components -> Maybe (Storage c)
getRow Proxy c
p (Components Map TypeRep Dynamic
w Entity
_) = TypeRep -> Map TypeRep Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup (Proxy c -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Proxy c
p) Map TypeRep Dynamic
w Maybe Dynamic
-> (Dynamic -> Maybe (Storage c)) -> Maybe (Storage c)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe (Storage c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic

get :: forall c. (Component c) => Entity -> Components -> IO (Maybe (c, c -> Components -> IO Components))
get :: forall c.
Component c =>
Entity
-> Components -> IO (Maybe (c, c -> Components -> IO Components))
get Entity
e (Components Map TypeRep Dynamic
w Entity
_) = case TypeRep -> Map TypeRep Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup (forall a. Typeable a => a -> TypeRep
typeOf @(Proxy c) Proxy c
forall {k} (t :: k). Proxy t
Proxy) Map TypeRep Dynamic
w Maybe Dynamic
-> (Dynamic -> Maybe (Storage c)) -> Maybe (Storage c)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe (Storage c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic of
  Just Storage c
s -> do
    Maybe (c, c -> Storage c -> IO (Storage c))
res <- Storage c
-> Entity -> IO (Maybe (c, c -> Storage c -> IO (Storage c)))
forall a.
Storage a
-> Entity -> IO (Maybe (a, a -> Storage a -> IO (Storage a)))
S.get Storage c
s Entity
e
    case Maybe (c, c -> Storage c -> IO (Storage c))
res of
      Just (c
c, c -> Storage c -> IO (Storage c)
f) ->
        Maybe (c, c -> Components -> IO Components)
-> IO (Maybe (c, c -> Components -> IO Components))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (c, c -> Components -> IO Components)
 -> IO (Maybe (c, c -> Components -> IO Components)))
-> Maybe (c, c -> Components -> IO Components)
-> IO (Maybe (c, c -> Components -> IO Components))
forall a b. (a -> b) -> a -> b
$
          (c, c -> Components -> IO Components)
-> Maybe (c, c -> Components -> IO Components)
forall a. a -> Maybe a
Just
            ( c
c,
              \c
c' (Components Map TypeRep Dynamic
w' Entity
e') ->
                Components -> IO Components
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Components -> IO Components) -> Components -> IO Components
forall a b. (a -> b) -> a -> b
$ Map TypeRep Dynamic -> Entity -> Components
Components ((Maybe Dynamic -> Maybe Dynamic)
-> TypeRep -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (\Maybe Dynamic
row -> Dynamic -> Maybe Dynamic
forall a. a -> Maybe a
Just (Dynamic -> Maybe Dynamic)
-> (IO (Storage c) -> Dynamic) -> IO (Storage c) -> Maybe Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Storage c) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (IO (Storage c) -> Maybe Dynamic)
-> IO (Storage c) -> Maybe Dynamic
forall a b. (a -> b) -> a -> b
$ c -> Storage c -> IO (Storage c)
f c
c' (Storage c -> Maybe (Storage c) -> Storage c
forall a. a -> Maybe a -> a
fromMaybe Storage c
forall a. Component a => Storage a
storage (Maybe Dynamic
row Maybe Dynamic
-> (Dynamic -> Maybe (Storage c)) -> Maybe (Storage c)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe (Storage c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic))) (forall a. Typeable a => a -> TypeRep
typeOf @(Proxy c) Proxy c
forall {k} (t :: k). Proxy t
Proxy) Map TypeRep Dynamic
w') Entity
e'
            )
      Maybe (c, c -> Storage c -> IO (Storage c))
Nothing -> Maybe (c, c -> Components -> IO Components)
-> IO (Maybe (c, c -> Components -> IO Components))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, c -> Components -> IO Components)
forall a. Maybe a
Nothing
  Maybe (Storage c)
Nothing -> Maybe (c, c -> Components -> IO Components)
-> IO (Maybe (c, c -> Components -> IO Components))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, c -> Components -> IO Components)
forall a. Maybe a
Nothing

setRow :: forall c. (Component c) => Storage c -> Components -> Components
setRow :: forall c. Component c => Storage c -> Components -> Components
setRow Storage c
cs (Components Map TypeRep Dynamic
w Entity
e') = Map TypeRep Dynamic -> Entity -> Components
Components (TypeRep -> Dynamic -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. Typeable a => a -> TypeRep
typeOf @(Proxy c) Proxy c
forall {k} (t :: k). Proxy t
Proxy) (Storage c -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Storage c
cs) Map TypeRep Dynamic
w) Entity
e'

remove :: forall c. (Component c) => Entity -> Components -> Components
remove :: forall c. Component c => Entity -> Components -> Components
remove Entity
e (Components Map TypeRep Dynamic
w Entity
e') = Map TypeRep Dynamic -> Entity -> Components
Components ((Maybe Dynamic -> Maybe Dynamic)
-> TypeRep -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (\Maybe Dynamic
row -> Maybe Dynamic
row Maybe Dynamic -> (Dynamic -> Maybe Dynamic) -> Maybe Dynamic
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe Dynamic
f) (forall a. Typeable a => a -> TypeRep
typeOf @(Proxy c) Proxy c
forall {k} (t :: k). Proxy t
Proxy) Map TypeRep Dynamic
w) Entity
e'
  where
    f :: Dynamic -> Maybe Dynamic
f Dynamic
row = (Storage c -> Dynamic) -> Maybe (Storage c) -> Maybe Dynamic
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Storage c
row' -> IO (Storage c) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (IO (Storage c) -> Dynamic) -> IO (Storage c) -> Dynamic
forall a b. (a -> b) -> a -> b
$ forall a. Storage a -> Entity -> IO (Storage a)
S.remove @c Storage c
row' Entity
e) (Dynamic -> Maybe (Storage c)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
row)