{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Aztecs.Core
  ( EntityID (..),
    Component (..),
    ComponentID (..),
    Components (..),
    emptyComponents,
    insertComponentId,
    lookupComponentId,
  )
where

import Data.Aztecs.Storage (Storage)
import Data.IntMap (IntMap)
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Typeable (Proxy (..), TypeRep, Typeable, typeOf)

newtype EntityID = EntityID {EntityID -> Int
unEntityId :: Int}
  deriving (EntityID -> EntityID -> Bool
(EntityID -> EntityID -> Bool)
-> (EntityID -> EntityID -> Bool) -> Eq EntityID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityID -> EntityID -> Bool
== :: EntityID -> EntityID -> Bool
$c/= :: EntityID -> EntityID -> Bool
/= :: EntityID -> EntityID -> Bool
Eq, Eq EntityID
Eq EntityID =>
(EntityID -> EntityID -> Ordering)
-> (EntityID -> EntityID -> Bool)
-> (EntityID -> EntityID -> Bool)
-> (EntityID -> EntityID -> Bool)
-> (EntityID -> EntityID -> Bool)
-> (EntityID -> EntityID -> EntityID)
-> (EntityID -> EntityID -> EntityID)
-> Ord EntityID
EntityID -> EntityID -> Bool
EntityID -> EntityID -> Ordering
EntityID -> EntityID -> EntityID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntityID -> EntityID -> Ordering
compare :: EntityID -> EntityID -> Ordering
$c< :: EntityID -> EntityID -> Bool
< :: EntityID -> EntityID -> Bool
$c<= :: EntityID -> EntityID -> Bool
<= :: EntityID -> EntityID -> Bool
$c> :: EntityID -> EntityID -> Bool
> :: EntityID -> EntityID -> Bool
$c>= :: EntityID -> EntityID -> Bool
>= :: EntityID -> EntityID -> Bool
$cmax :: EntityID -> EntityID -> EntityID
max :: EntityID -> EntityID -> EntityID
$cmin :: EntityID -> EntityID -> EntityID
min :: EntityID -> EntityID -> EntityID
Ord, Int -> EntityID -> ShowS
[EntityID] -> ShowS
EntityID -> String
(Int -> EntityID -> ShowS)
-> (EntityID -> String) -> ([EntityID] -> ShowS) -> Show EntityID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityID -> ShowS
showsPrec :: Int -> EntityID -> ShowS
$cshow :: EntityID -> String
show :: EntityID -> String
$cshowList :: [EntityID] -> ShowS
showList :: [EntityID] -> ShowS
Show)

newtype ComponentID = ComponentID {ComponentID -> Int
unComponentId :: Int}
  deriving (ComponentID -> ComponentID -> Bool
(ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool) -> Eq ComponentID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentID -> ComponentID -> Bool
== :: ComponentID -> ComponentID -> Bool
$c/= :: ComponentID -> ComponentID -> Bool
/= :: ComponentID -> ComponentID -> Bool
Eq, Eq ComponentID
Eq ComponentID =>
(ComponentID -> ComponentID -> Ordering)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> ComponentID)
-> (ComponentID -> ComponentID -> ComponentID)
-> Ord ComponentID
ComponentID -> ComponentID -> Bool
ComponentID -> ComponentID -> Ordering
ComponentID -> ComponentID -> ComponentID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ComponentID -> ComponentID -> Ordering
compare :: ComponentID -> ComponentID -> Ordering
$c< :: ComponentID -> ComponentID -> Bool
< :: ComponentID -> ComponentID -> Bool
$c<= :: ComponentID -> ComponentID -> Bool
<= :: ComponentID -> ComponentID -> Bool
$c> :: ComponentID -> ComponentID -> Bool
> :: ComponentID -> ComponentID -> Bool
$c>= :: ComponentID -> ComponentID -> Bool
>= :: ComponentID -> ComponentID -> Bool
$cmax :: ComponentID -> ComponentID -> ComponentID
max :: ComponentID -> ComponentID -> ComponentID
$cmin :: ComponentID -> ComponentID -> ComponentID
min :: ComponentID -> ComponentID -> ComponentID
Ord, Int -> ComponentID -> ShowS
[ComponentID] -> ShowS
ComponentID -> String
(Int -> ComponentID -> ShowS)
-> (ComponentID -> String)
-> ([ComponentID] -> ShowS)
-> Show ComponentID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentID -> ShowS
showsPrec :: Int -> ComponentID -> ShowS
$cshow :: ComponentID -> String
show :: ComponentID -> String
$cshowList :: [ComponentID] -> ShowS
showList :: [ComponentID] -> ShowS
Show)

class (Typeable a, Storage (StorageT a) a) => Component a where
  type StorageT a :: Type -> Type
  type StorageT a = IntMap

data Components = Components
  { Components -> Map TypeRep ComponentID
componentIds :: Map TypeRep ComponentID,
    Components -> ComponentID
nextComponentId :: ComponentID
  }
  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)

emptyComponents :: Components
emptyComponents :: Components
emptyComponents =
  Components
    { componentIds :: Map TypeRep ComponentID
componentIds = Map TypeRep ComponentID
forall a. Monoid a => a
mempty,
      nextComponentId :: ComponentID
nextComponentId = Int -> ComponentID
ComponentID Int
0
    }

lookupComponentId :: forall a. (Typeable a) => Components -> Maybe ComponentID
lookupComponentId :: forall a. Typeable a => Components -> Maybe ComponentID
lookupComponentId Components
cs = TypeRep -> Map TypeRep ComponentID -> Maybe ComponentID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Proxy a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Components -> Map TypeRep ComponentID
componentIds Components
cs)

insertComponentId :: forall c. (Component c) => Components -> (ComponentID, Components)
insertComponentId :: forall c. Component c => Components -> (ComponentID, Components)
insertComponentId Components
cs =
  let cId :: ComponentID
cId = Components -> ComponentID
nextComponentId Components
cs
   in ( ComponentID
cId,
        Components
cs
          { componentIds = Map.insert (typeOf (Proxy @c)) cId (componentIds cs),
            nextComponentId = ComponentID (unComponentId cId + 1)
          }
      )