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

module Data.Aztecs.World
  ( Entity,
    EntityComponent (..),
    Component (..),
    World (..),
    union,
    spawn,
    insert,
    get,
    getRow,
    newWorld,
    setRow,
    remove,
  )
where

import Data.Aztecs.Core
import Data.Aztecs.Storage (Storage)
import Data.Aztecs.World.Archetypes (Archetypes, newArchetypes)
import qualified Data.Aztecs.World.Archetypes as A
import Data.Aztecs.World.Components (Component, Components, newComponents)
import qualified Data.Aztecs.World.Components as C
import Data.Typeable
import Prelude hiding (read)

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

newWorld :: World
newWorld :: World
newWorld = Components -> Archetypes -> World
World Components
newComponents Archetypes
newArchetypes

union :: World -> World -> World
union :: World -> World -> World
union (World Components
cs Archetypes
as) (World Components
cs' Archetypes
_) = Components -> Archetypes -> World
World (Components -> Components -> Components
C.union Components
cs Components
cs') Archetypes
as

spawn :: forall c. (Component c) => c -> World -> IO (Entity, World)
spawn :: forall c. Component c => c -> World -> IO (Entity, World)
spawn c
c (World Components
cs Archetypes
as) = do
  (Entity
e, Components
cs') <- c -> Components -> IO (Entity, Components)
forall c. Component c => c -> Components -> IO (Entity, Components)
C.spawn c
c Components
cs 
  (Entity, World) -> IO (Entity, World)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entity
e, Components -> Archetypes -> World
World Components
cs' Archetypes
as)

insert :: forall c. (Component c) => Entity -> c -> World -> IO World
insert :: forall c. Component c => Entity -> c -> World -> IO World
insert Entity
e c
c (World Components
cs Archetypes
as) = do
  Components
cs' <- Entity -> c -> Components -> IO Components
forall c. Component c => Entity -> c -> Components -> IO Components
C.insert Entity
e c
c Components
cs
  World -> IO World
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (World -> IO World) -> World -> IO World
forall a b. (a -> b) -> a -> b
$ Components -> Archetypes -> World
World Components
cs' (forall c.
Component c =>
Entity -> Components -> Archetypes -> Archetypes
A.insert @c Entity
e Components
cs' Archetypes
as)

getRow :: (Component c) => Proxy c -> World -> Maybe (Storage c)
getRow :: forall c. Component c => Proxy c -> World -> Maybe (Storage c)
getRow Proxy c
p (World Components
cs Archetypes
_) = Proxy c -> Components -> Maybe (Storage c)
forall c. Component c => Proxy c -> Components -> Maybe (Storage c)
C.getRow Proxy c
p Components
cs

get :: forall c. (Component c) => Entity -> World -> IO (Maybe (c, c -> World -> IO World))
get :: forall c.
Component c =>
Entity -> World -> IO (Maybe (c, c -> World -> IO World))
get Entity
e (World Components
cs Archetypes
_) = do
  Maybe (c, c -> Components -> IO Components)
res <- Entity
-> Components -> IO (Maybe (c, c -> Components -> IO Components))
forall c.
Component c =>
Entity
-> Components -> IO (Maybe (c, c -> Components -> IO Components))
C.get Entity
e Components
cs
  case Maybe (c, c -> Components -> IO Components)
res of
    Just (c
c, c -> Components -> IO Components
f) ->
      Maybe (c, c -> World -> IO World)
-> IO (Maybe (c, c -> World -> IO World))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (c, c -> World -> IO World)
 -> IO (Maybe (c, c -> World -> IO World)))
-> Maybe (c, c -> World -> IO World)
-> IO (Maybe (c, c -> World -> IO World))
forall a b. (a -> b) -> a -> b
$
        (c, c -> World -> IO World) -> Maybe (c, c -> World -> IO World)
forall a. a -> Maybe a
Just
          ( c
c,
            \c
c' (World Components
cs' Archetypes
as) -> do
              Components
cs'' <- c -> Components -> IO Components
f c
c' Components
cs'
              World -> IO World
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (World -> IO World) -> World -> IO World
forall a b. (a -> b) -> a -> b
$ Components -> Archetypes -> World
World Components
cs'' Archetypes
as
          )
    Maybe (c, c -> Components -> IO Components)
Nothing -> Maybe (c, c -> World -> IO World)
-> IO (Maybe (c, c -> World -> IO World))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, c -> World -> IO World)
forall a. Maybe a
Nothing

setRow :: forall c. (Component c) => Storage c -> World -> World
setRow :: forall c. Component c => Storage c -> World -> World
setRow Storage c
row (World Components
cs Archetypes
as) = Components -> Archetypes -> World
World (Storage c -> Components -> Components
forall c. Component c => Storage c -> Components -> Components
C.setRow Storage c
row Components
cs) Archetypes
as

remove :: forall c. (Component c) => Entity -> World -> World
remove :: forall c. Component c => Entity -> World -> World
remove Entity
e (World Components
cs Archetypes
as) = Components -> Archetypes -> World
World (forall c. Component c => Entity -> Components -> Components
C.remove @c Entity
e Components
cs) Archetypes
as