{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |

-- Module      : Aztecs.ECS.World

-- Copyright   : (c) Matt Hunzinger, 2025

-- License     : BSD-style (see the LICENSE file in the distribution)

--

-- Maintainer  : matt@hunzinger.me

-- Stability   : provisional

-- Portability : non-portable (GHC extensions)

module Aztecs.ECS.World
  ( World (..),
    empty,
    spawn,
    spawnEmpty,
    insert,
    lookup,
    remove,
    removeWithId,
    despawn,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Bundle
import Aztecs.ECS.World.Entities (Entities)
import qualified Aztecs.ECS.World.Entities as E
import Control.DeepSeq
import Data.Dynamic
import Data.IntMap (IntMap)
import GHC.Generics
import Prelude hiding (lookup)

-- | World of entities and their components.

--

-- @since 0.9

data World = World
  { -- | Entities and their components.

    --

    -- @since 0.9

    World -> Entities
entities :: !Entities,
    -- | Next unique entity identifier.

    --

    -- @since 0.9

    World -> EntityID
nextEntityId :: !EntityID
  }
  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, (forall x. World -> Rep World x)
-> (forall x. Rep World x -> World) -> Generic World
forall x. Rep World x -> World
forall x. World -> Rep World x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. World -> Rep World x
from :: forall x. World -> Rep World x
$cto :: forall x. Rep World x -> World
to :: forall x. Rep World x -> World
Generic, World -> ()
(World -> ()) -> NFData World
forall a. (a -> ()) -> NFData a
$crnf :: World -> ()
rnf :: World -> ()
NFData)

-- | Empty `World`.

--

-- @since 0.9

empty :: World
empty :: World
empty =
  World
    { entities :: Entities
entities = Entities
E.empty,
      nextEntityId :: EntityID
nextEntityId = Int -> EntityID
EntityID Int
0
    }

-- | Spawn a `Bundle` into the `World`.

--

-- @since 0.9

spawn :: Bundle -> World -> (EntityID, World)
spawn :: Bundle -> World -> (EntityID, World)
spawn Bundle
b World
w =
  let e :: EntityID
e = World -> EntityID
nextEntityId World
w
   in (EntityID
e, World
w {entities = E.spawn e b $ entities w, nextEntityId = EntityID $ unEntityId e + 1})

-- | Spawn an empty entity.

--

-- @since 0.9

spawnEmpty :: World -> (EntityID, World)
spawnEmpty :: World -> (EntityID, World)
spawnEmpty World
w = let e :: EntityID
e = World -> EntityID
nextEntityId World
w in (EntityID
e, World
w {nextEntityId = EntityID $ unEntityId e + 1})

-- | Insert a `Bundle` into an entity.

--

-- @since 0.9

insert :: EntityID -> Bundle -> World -> World
insert :: EntityID -> Bundle -> World -> World
insert EntityID
e Bundle
c World
w = World
w {entities = E.insert e c (entities w)}

-- | Lookup a component in an entity.

--

-- @since 0.9

lookup :: forall a. (Component a) => EntityID -> World -> Maybe a
lookup :: forall a. Component a => EntityID -> World -> Maybe a
lookup EntityID
e World
w = EntityID -> Entities -> Maybe a
forall a. Component a => EntityID -> Entities -> Maybe a
E.lookup EntityID
e (Entities -> Maybe a) -> Entities -> Maybe a
forall a b. (a -> b) -> a -> b
$ World -> Entities
entities World
w

-- | Remove a component from an entity.

--

-- @since 0.9

remove :: forall a. (Component a) => EntityID -> World -> (Maybe a, World)
remove :: forall a. Component a => EntityID -> World -> (Maybe a, World)
remove EntityID
e World
w = let (Maybe a
a, Entities
es) = EntityID -> Entities -> (Maybe a, Entities)
forall a.
Component a =>
EntityID -> Entities -> (Maybe a, Entities)
E.remove EntityID
e (World -> Entities
entities World
w) in (Maybe a
a, World
w {entities = es})

-- | Remove a component from an entity with its `ComponentID`.

--

-- @since 0.9

removeWithId :: forall a. (Component a) => EntityID -> ComponentID -> World -> (Maybe a, World)
removeWithId :: forall a.
Component a =>
EntityID -> ComponentID -> World -> (Maybe a, World)
removeWithId EntityID
e ComponentID
cId World
w = let (Maybe a
a, Entities
es) = EntityID -> ComponentID -> Entities -> (Maybe a, Entities)
forall a.
Component a =>
EntityID -> ComponentID -> Entities -> (Maybe a, Entities)
E.removeWithId EntityID
e ComponentID
cId (World -> Entities
entities World
w) in (Maybe a
a, World
w {entities = es})

-- | Despawn an entity, returning its components.

despawn :: EntityID -> World -> (IntMap Dynamic, World)
despawn :: EntityID -> World -> (IntMap Dynamic, World)
despawn EntityID
e World
w = let (IntMap Dynamic
a, Entities
es) = EntityID -> Entities -> (IntMap Dynamic, Entities)
E.despawn EntityID
e (World -> Entities
entities World
w) in (IntMap Dynamic
a, World
w {entities = es})