{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}

{-|
Stability : experimental

This module is experimental, and its API might change between point releases. Use at your own risk.
--}
module Apecs.Experimental.Components
  ( Redirect (..)
  , Head (..)
  ) where

import qualified Data.Vector.Unboxed as U

import Apecs.Core

-- | Pseudocomponent that when written to, actually writes @c@ to its entity argument.
--   Can be used to write to other entities in a 'cmap'.
data Redirect c = Redirect Entity c deriving (Redirect c -> Redirect c -> Bool
forall c. Eq c => Redirect c -> Redirect c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Redirect c -> Redirect c -> Bool
$c/= :: forall c. Eq c => Redirect c -> Redirect c -> Bool
== :: Redirect c -> Redirect c -> Bool
$c== :: forall c. Eq c => Redirect c -> Redirect c -> Bool
Eq, Int -> Redirect c -> ShowS
forall c. Show c => Int -> Redirect c -> ShowS
forall c. Show c => [Redirect c] -> ShowS
forall c. Show c => Redirect c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Redirect c] -> ShowS
$cshowList :: forall c. Show c => [Redirect c] -> ShowS
show :: Redirect c -> String
$cshow :: forall c. Show c => Redirect c -> String
showsPrec :: Int -> Redirect c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> Redirect c -> ShowS
Show)
instance Component c => Component (Redirect c) where
  type Storage (Redirect c) = RedirectStore (Storage c)

newtype RedirectStore s = RedirectStore s
type instance Elem (RedirectStore s) = Redirect (Elem s)

instance Has w m c => Has w m (Redirect c) where
  getStore :: SystemT w m (Storage (Redirect c))
getStore = forall s. s -> RedirectStore s
RedirectStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance (ExplSet m s) => ExplSet m (RedirectStore s) where
  explSet :: RedirectStore s -> Int -> Elem (RedirectStore s) -> m ()
explSet (RedirectStore s
s) Int
_ (Redirect (Entity Int
ety) Elem s
c) = forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s
s Int
ety Elem s
c


-- | Pseudocomponent that can be read like any other component, but will only
--   yield a single member when iterated over. Intended to be used as
--   @cmap $ Head (...) -> ...@
newtype Head c = Head c deriving (Head c -> Head c -> Bool
forall c. Eq c => Head c -> Head c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Head c -> Head c -> Bool
$c/= :: forall c. Eq c => Head c -> Head c -> Bool
== :: Head c -> Head c -> Bool
$c== :: forall c. Eq c => Head c -> Head c -> Bool
Eq, Int -> Head c -> ShowS
forall c. Show c => Int -> Head c -> ShowS
forall c. Show c => [Head c] -> ShowS
forall c. Show c => Head c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Head c] -> ShowS
$cshowList :: forall c. Show c => [Head c] -> ShowS
show :: Head c -> String
$cshow :: forall c. Show c => Head c -> String
showsPrec :: Int -> Head c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> Head c -> ShowS
Show)
instance Component c => Component (Head c) where
  type Storage (Head c) = HeadStore (Storage c)

newtype HeadStore s = HeadStore s
type instance Elem (HeadStore s) = Head (Elem s)

instance Has w m c => Has w m (Head c) where
  getStore :: SystemT w m (Storage (Head c))
getStore = forall s. s -> HeadStore s
HeadStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance (ExplGet m s) => ExplGet m (HeadStore s) where
  explExists :: HeadStore s -> Int -> m Bool
explExists (HeadStore s
s) Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists s
s Int
ety
  explGet :: HeadStore s -> Int -> m (Elem (HeadStore s))
explGet (HeadStore s
s) Int
ety = forall c. c -> Head c
Head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet s
s Int
ety

instance (ExplMembers m s) => ExplMembers m (HeadStore s) where
  explMembers :: HeadStore s -> m (Vector Int)
explMembers (HeadStore s
s) = forall a. Unbox a => Int -> Vector a -> Vector a
U.take Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers s
s