{-# 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
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
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
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
Ord, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
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]
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 {forall w (m :: * -> *) a. SystemT w m a -> ReaderT w m a
unSystem :: ReaderT w m a} deriving (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
<$ :: forall a b. 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 :: forall a b. (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, 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 :: forall a. a -> SystemT w m a
$creturn :: forall w (m :: * -> *) a. Monad m => a -> SystemT w m a
>> :: forall a b. 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
>>= :: forall a 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
Monad, 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
<* :: forall a b. 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
*> :: forall a b. 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 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> SystemT w m a
$cpure :: forall w (m :: * -> *) a. Applicative m => a -> SystemT w m a
Applicative, 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 :: forall (m :: * -> *) a. Monad m => m a -> SystemT w m a
$clift :: forall w (m :: * -> *) a. Monad m => m a -> SystemT w m a
MonadTrans, 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 :: forall a. IO a -> SystemT w m a
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> SystemT w m a
MonadIO, 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 :: forall e a. Exception e => e -> SystemT w m a
$cthrowM :: forall w (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SystemT w m a
MonadThrow, 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 :: forall e a.
Exception e =>
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
MonadCatch, 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 :: 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)
$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 b.
((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 b.
((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
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))