{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Apecs.Core where

import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import qualified Data.Vector.Unboxed  as U

-- | An Entity is just an integer, used to index into a component store.
--   In general, use @newEntity@, @cmap@, and component tags instead of manipulating these directly.
--
--   For performance reasons, negative values like (-1) are reserved for stores to represent special values, so avoid using these.
newtype Entity = Entity {Entity -> Int
unEntity :: Int} deriving (Integer -> Entity
Entity -> Entity
Entity -> Entity -> Entity
(Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity)
-> (Entity -> Entity)
-> (Entity -> Entity)
-> (Integer -> Entity)
-> Num Entity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Entity
$cfromInteger :: Integer -> Entity
signum :: Entity -> Entity
$csignum :: Entity -> Entity
abs :: Entity -> Entity
$cabs :: Entity -> Entity
negate :: Entity -> Entity
$cnegate :: Entity -> Entity
* :: Entity -> Entity -> Entity
$c* :: Entity -> Entity -> Entity
- :: Entity -> Entity -> Entity
$c- :: Entity -> Entity -> Entity
+ :: Entity -> Entity -> Entity
$c+ :: Entity -> Entity -> Entity
Num, Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity
-> (Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
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
min :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmax :: Entity -> Entity -> Entity
>= :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c< :: Entity -> Entity -> Bool
compare :: Entity -> Entity -> Ordering
$ccompare :: Entity -> Entity -> Ordering
$cp1Ord :: Eq Entity
Ord, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
Show, Int -> Entity
Entity -> Int
Entity -> [Entity]
Entity -> Entity
Entity -> Entity -> [Entity]
Entity -> Entity -> Entity -> [Entity]
(Entity -> Entity)
-> (Entity -> Entity)
-> (Int -> Entity)
-> (Entity -> Int)
-> (Entity -> [Entity])
-> (Entity -> Entity -> [Entity])
-> (Entity -> Entity -> [Entity])
-> (Entity -> Entity -> Entity -> [Entity])
-> Enum Entity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Entity -> Entity -> Entity -> [Entity]
$cenumFromThenTo :: Entity -> Entity -> Entity -> [Entity]
enumFromTo :: Entity -> Entity -> [Entity]
$cenumFromTo :: Entity -> Entity -> [Entity]
enumFromThen :: Entity -> Entity -> [Entity]
$cenumFromThen :: Entity -> Entity -> [Entity]
enumFrom :: Entity -> [Entity]
$cenumFrom :: Entity -> [Entity]
fromEnum :: Entity -> Int
$cfromEnum :: Entity -> Int
toEnum :: Int -> Entity
$ctoEnum :: Int -> Entity
pred :: Entity -> Entity
$cpred :: Entity -> Entity
succ :: Entity -> Entity
$csucc :: Entity -> Entity
Enum)

-- | A SystemT is a newtype around `ReaderT w m a`, where `w` is the game world variable.
--   Systems serve to
--
--   * Allow type-based lookup of a component's store through @getStore@.
--
--   * Lift side effects into their host Monad.
newtype SystemT w m a = SystemT {SystemT w m a -> ReaderT w m a
unSystem :: ReaderT w m a} deriving (a -> SystemT w m b -> SystemT w m a
(a -> b) -> SystemT w m a -> SystemT w m b
(forall a b. (a -> b) -> SystemT w m a -> SystemT w m b)
-> (forall a b. a -> SystemT w m b -> SystemT w m a)
-> Functor (SystemT w m)
forall a b. a -> SystemT w m b -> SystemT w m a
forall a b. (a -> b) -> SystemT w m a -> SystemT w m b
forall w (m :: * -> *) a b.
Functor m =>
a -> SystemT w m b -> SystemT w m a
forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> SystemT w m a -> SystemT w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SystemT w m b -> SystemT w m a
$c<$ :: forall w (m :: * -> *) a b.
Functor m =>
a -> SystemT w m b -> SystemT w m a
fmap :: (a -> b) -> SystemT w m a -> SystemT w m b
$cfmap :: forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> SystemT w m a -> SystemT w m b
Functor, Applicative (SystemT w m)
a -> SystemT w m a
Applicative (SystemT w m)
-> (forall a b.
    SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b)
-> (forall a b. SystemT w m a -> SystemT w m b -> SystemT w m b)
-> (forall a. a -> SystemT w m a)
-> Monad (SystemT w m)
SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b
SystemT w m a -> SystemT w m b -> SystemT w m b
forall a. a -> SystemT w m a
forall a b. SystemT w m a -> SystemT w m b -> SystemT w m b
forall a b. SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b
forall w (m :: * -> *). Monad m => Applicative (SystemT w m)
forall w (m :: * -> *) a. Monad m => a -> SystemT w m a
forall w (m :: * -> *) a b.
Monad m =>
SystemT w m a -> SystemT w m b -> SystemT w m b
forall w (m :: * -> *) a b.
Monad m =>
SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SystemT w m a
$creturn :: forall w (m :: * -> *) a. Monad m => a -> SystemT w m a
>> :: SystemT w m a -> SystemT w m b -> SystemT w m b
$c>> :: forall w (m :: * -> *) a b.
Monad m =>
SystemT w m a -> SystemT w m b -> SystemT w m b
>>= :: SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b
$c>>= :: forall w (m :: * -> *) a b.
Monad m =>
SystemT w m a -> (a -> SystemT w m b) -> SystemT w m b
$cp1Monad :: forall w (m :: * -> *). Monad m => Applicative (SystemT w m)
Monad, Functor (SystemT w m)
a -> SystemT w m a
Functor (SystemT w m)
-> (forall a. a -> SystemT w m a)
-> (forall a b.
    SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b)
-> (forall a b c.
    (a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c)
-> (forall a b. SystemT w m a -> SystemT w m b -> SystemT w m b)
-> (forall a b. SystemT w m a -> SystemT w m b -> SystemT w m a)
-> Applicative (SystemT w m)
SystemT w m a -> SystemT w m b -> SystemT w m b
SystemT w m a -> SystemT w m b -> SystemT w m a
SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b
(a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c
forall a. a -> SystemT w m a
forall a b. SystemT w m a -> SystemT w m b -> SystemT w m a
forall a b. SystemT w m a -> SystemT w m b -> SystemT w m b
forall a b. SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b
forall a b c.
(a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c
forall w (m :: * -> *). Applicative m => Functor (SystemT w m)
forall w (m :: * -> *) a. Applicative m => a -> SystemT w m a
forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m a -> SystemT w m b -> SystemT w m a
forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m a -> SystemT w m b -> SystemT w m b
forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b
forall w (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SystemT w m a -> SystemT w m b -> SystemT w m a
$c<* :: forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m a -> SystemT w m b -> SystemT w m a
*> :: SystemT w m a -> SystemT w m b -> SystemT w m b
$c*> :: forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m a -> SystemT w m b -> SystemT w m b
liftA2 :: (a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c
$cliftA2 :: forall w (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SystemT w m a -> SystemT w m b -> SystemT w m c
<*> :: SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b
$c<*> :: forall w (m :: * -> *) a b.
Applicative m =>
SystemT w m (a -> b) -> SystemT w m a -> SystemT w m b
pure :: a -> SystemT w m a
$cpure :: forall w (m :: * -> *) a. Applicative m => a -> SystemT w m a
$cp1Applicative :: forall w (m :: * -> *). Applicative m => Functor (SystemT w m)
Applicative, m a -> SystemT w m a
(forall (m :: * -> *) a. Monad m => m a -> SystemT w m a)
-> MonadTrans (SystemT w)
forall w (m :: * -> *) a. Monad m => m a -> SystemT w m a
forall (m :: * -> *) a. Monad m => m a -> SystemT w m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SystemT w m a
$clift :: forall w (m :: * -> *) a. Monad m => m a -> SystemT w m a
MonadTrans, Monad (SystemT w m)
Monad (SystemT w m)
-> (forall a. IO a -> SystemT w m a) -> MonadIO (SystemT w m)
IO a -> SystemT w m a
forall a. IO a -> SystemT w m a
forall w (m :: * -> *). MonadIO m => Monad (SystemT w m)
forall w (m :: * -> *) a. MonadIO m => IO a -> SystemT w m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SystemT w m a
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> SystemT w m a
$cp1MonadIO :: forall w (m :: * -> *). MonadIO m => Monad (SystemT w m)
MonadIO, Monad (SystemT w m)
e -> SystemT w m a
Monad (SystemT w m)
-> (forall e a. Exception e => e -> SystemT w m a)
-> MonadThrow (SystemT w m)
forall e a. Exception e => e -> SystemT w m a
forall w (m :: * -> *). MonadThrow m => Monad (SystemT w m)
forall w (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SystemT w m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SystemT w m a
$cthrowM :: forall w (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SystemT w m a
$cp1MonadThrow :: forall w (m :: * -> *). MonadThrow m => Monad (SystemT w m)
MonadThrow, MonadThrow (SystemT w m)
MonadThrow (SystemT w m)
-> (forall e a.
    Exception e =>
    SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a)
-> MonadCatch (SystemT w m)
SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a
forall e a.
Exception e =>
SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a
forall w (m :: * -> *). MonadCatch m => MonadThrow (SystemT w m)
forall w (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a
$ccatch :: forall w (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SystemT w m a -> (e -> SystemT w m a) -> SystemT w m a
$cp1MonadCatch :: forall w (m :: * -> *). MonadCatch m => MonadThrow (SystemT w m)
MonadCatch, MonadCatch (SystemT w m)
MonadCatch (SystemT w m)
-> (forall b.
    ((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
    -> SystemT w m b)
-> (forall b.
    ((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
    -> SystemT w m b)
-> (forall a b c.
    SystemT w m a
    -> (a -> ExitCase b -> SystemT w m c)
    -> (a -> SystemT w m b)
    -> SystemT w m (b, c))
-> MonadMask (SystemT w m)
SystemT w m a
-> (a -> ExitCase b -> SystemT w m c)
-> (a -> SystemT w m b)
-> SystemT w m (b, c)
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
forall b.
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
forall a b c.
SystemT w m a
-> (a -> ExitCase b -> SystemT w m c)
-> (a -> SystemT w m b)
-> SystemT w m (b, c)
forall w (m :: * -> *). MonadMask m => MonadCatch (SystemT w m)
forall w (m :: * -> *) b.
MonadMask m =>
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
forall w (m :: * -> *) a b c.
MonadMask m =>
SystemT w m a
-> (a -> ExitCase b -> SystemT w m c)
-> (a -> SystemT w m b)
-> SystemT w m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SystemT w m a
-> (a -> ExitCase b -> SystemT w m c)
-> (a -> SystemT w m b)
-> SystemT w m (b, c)
$cgeneralBracket :: forall w (m :: * -> *) a b c.
MonadMask m =>
SystemT w m a
-> (a -> ExitCase b -> SystemT w m c)
-> (a -> SystemT w m b)
-> SystemT w m (b, c)
uninterruptibleMask :: ((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
$cuninterruptibleMask :: forall w (m :: * -> *) b.
MonadMask m =>
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
mask :: ((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
$cmask :: forall w (m :: * -> *) b.
MonadMask m =>
((forall a. SystemT w m a -> SystemT w m a) -> SystemT w m b)
-> SystemT w m b
$cp1MonadMask :: forall w (m :: * -> *). MonadMask m => MonadCatch (SystemT w m)
MonadMask)
type System w a = SystemT w IO a

deriving instance Monad m => MonadReader w (SystemT w m)

-- | A component is defined by specifying how it is stored.
--   The constraint ensures that stores and components are mapped one-to-one.
class (Elem (Storage c) ~ c) => Component c where
  type Storage c

-- | @Has w m c@ means that world @w@ can produce a @Storage c@.
--   It is parameterized over @m@ to allow stores to be foreign.
class (Monad m, Component c) => Has w m c where
  getStore :: SystemT w m (Storage c)

-- | The type of components stored by a store, e.g. @Elem (Map c) = c@.
type family Elem s

-- | Indicates that the store @s@ can be initialized.
--   Generally, \"base\" stores like @Map c@ can be initialized, but composite stores like @MaybeStore s@ cannot.
class ExplInit m s where
  -- | Initialize a new empty store.
  explInit :: m s

-- | Stores that we can read using @explGet@ and @explExists@.
--   For some entity @e@, @eplGet s e@ is only guaranteed to be safe if @explExists s e@ returns @True@.
class Monad m => ExplGet m s where
  -- | Reads a component from the store. What happens if the component does not exist is left undefined, and might not necessarily crash.
  explGet :: s -> Int -> m (Elem s)
  -- | Returns whether there is a component for the given index.
  explExists :: s -> Int -> m Bool

-- | Stores that can be written.
class Monad m => ExplSet m s where
  -- | Writes a component to the store.
  explSet :: s -> Int -> Elem s -> m ()

-- | Stores that components can be removed from.
class Monad m => ExplDestroy m s where
  -- | Destroys the component for a given index.
  explDestroy :: s -> Int -> m ()

-- | Stores that we can request a list of member entities for.
class Monad m => ExplMembers m s where
  -- | Returns an unboxed vector of member indices
  explMembers :: s -> m (U.Vector Int)

type Get     w m c = (Has w m c, ExplGet     m (Storage c))
type Set     w m c = (Has w m c, ExplSet     m (Storage c))
type Members w m c = (Has w m c, ExplMembers m (Storage c))
type Destroy w m c = (Has w m c, ExplDestroy m (Storage c))