{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Apecs.Core where
import Control.Monad.Reader
import Data.Functor.Identity
import qualified Data.Vector.Unboxed as U
import qualified Apecs.THTuples as T
newtype Entity = Entity {unEntity :: Int} deriving (Num, Eq, Ord, Show)
newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)
class (Elem (Storage c) ~ c) => Component c where
type Storage c
class Component c => Has w c where
getStore :: System w (Storage c)
type family Elem s
class ExplInit s where
explInit :: IO s
class ExplGet s where
explGet :: s -> Int -> IO (Elem s)
explExists :: s -> Int -> IO Bool
class ExplSet s where
explSet :: s -> Int -> Elem s -> IO ()
class ExplDestroy s where
explDestroy :: s -> Int -> IO ()
class ExplMembers s where
explMembers :: s -> IO (U.Vector Int)
type Get w c = (Has w c, ExplGet (Storage c))
type Set w c = (Has w c, ExplSet (Storage c))
type Members w c = (Has w c, ExplMembers (Storage c))
type Destroy w c = (Has w c, ExplDestroy (Storage c))
instance Component c => Component (Identity c) where
type Storage (Identity c) = Identity (Storage c)
instance Has w c => Has w (Identity c) where
getStore = Identity <$> getStore
type instance Elem (Identity s) = Identity (Elem s)
instance ExplGet s => ExplGet (Identity s) where
explGet (Identity s) e = Identity <$> explGet s e
explExists (Identity s) = explExists s
instance ExplSet s => ExplSet (Identity s) where
explSet (Identity s) e (Identity x) = explSet s e x
instance ExplMembers s => ExplMembers (Identity s) where
explMembers (Identity s) = explMembers s
instance ExplDestroy s => ExplDestroy (Identity s) where
explDestroy (Identity s) = explDestroy s
T.makeInstances [2..8]
data Not a = Not
newtype NotStore s = NotStore s
instance Component c => Component (Not c) where
type Storage (Not c) = NotStore (Storage c)
instance (Has w c) => Has w (Not c) where
getStore = NotStore <$> getStore
type instance Elem (NotStore s) = Not (Elem s)
instance ExplGet s => ExplGet (NotStore s) where
explGet _ _ = return Not
explExists (NotStore sa) ety = not <$> explExists sa ety
instance ExplDestroy s => ExplSet (NotStore s) where
explSet (NotStore sa) ety _ = explDestroy sa ety
newtype MaybeStore s = MaybeStore s
instance Component c => Component (Maybe c) where
type Storage (Maybe c) = MaybeStore (Storage c)
instance (Has w c) => Has w (Maybe c) where
getStore = MaybeStore <$> getStore
type instance Elem (MaybeStore s) = Maybe (Elem s)
instance ExplGet s => ExplGet (MaybeStore s) where
explGet (MaybeStore sa) ety = do
e <- explExists sa ety
if e then Just <$> explGet sa ety
else return Nothing
explExists _ _ = return True
instance (ExplDestroy s, ExplSet s) => ExplSet (MaybeStore s) where
explSet (MaybeStore sa) ety Nothing = explDestroy sa ety
explSet (MaybeStore sa) ety (Just x) = explSet sa ety x
data Filter c = Filter deriving (Eq, Show)
newtype FilterStore s = FilterStore s
instance Component c => Component (Filter c) where
type Storage (Filter c) = FilterStore (Storage c)
instance Has w c => Has w (Filter c) where
getStore = FilterStore <$> getStore
type instance Elem (FilterStore s) = Filter (Elem s)
instance ExplGet s => ExplGet (FilterStore s) where
explGet _ _ = return Filter
explExists (FilterStore s) ety = explExists s ety
data EntityStore = EntityStore
instance Component Entity where
type Storage Entity = EntityStore
instance (Has w Entity) where
getStore = return EntityStore
type instance Elem EntityStore = Entity
instance ExplGet EntityStore where
explGet _ ety = return $ Entity ety
explExists _ _ = return True