{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.World.Query.QueryFilter where

import Data.Data
import Data.Maybe
import GHC.Base (eqWord#, isTrue#)
import Mischief.ECS.Components
import Mischief.ECS.Entities
import Mischief.ECS.World
import Mischief.ECS.World.Query.Markers

-- import Mischief.ECS.World.Query.Queryable

-- newtype QueryFilters = QueryFilters [QueryFilter] deriving newtype (Semigroup)

qfChangedF :: ComponentTicks -> Tick -> Tick -> Bool
qfChangedF :: ComponentTicks -> Tick -> Tick -> Bool
qfChangedF ComponentTicks
ticks Tick
lastSystemTick Tick
currentSystemTick = ComponentTicks
ticks.changed Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
>= Tick
lastSystemTick Bool -> Bool -> Bool
&& ComponentTicks
ticks.changed Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
< Tick
currentSystemTick

qfAddedF :: ComponentTicks -> Tick -> Tick -> Bool
qfAddedF :: ComponentTicks -> Tick -> Tick -> Bool
qfAddedF ComponentTicks
ticks Tick
lastSystemTick Tick
currentSystemTick = ComponentTicks
ticks.added Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
>= Tick
lastSystemTick Bool -> Bool -> Bool
&& ComponentTicks
ticks.added Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
< Tick
currentSystemTick

data FilterType = ArchetypeFilter | EntityFilter

data QueryFilter (f :: FilterType) where
  NoFilter :: QueryFilter f
  With :: (ToFilterComponent a) => a -> QueryFilter f
  Without :: (ToFilterComponent a) => a -> QueryFilter f
  Changed :: (ToFilterComponent a) => a -> QueryFilter EntityFilter
  Added :: (ToFilterComponent a) => a -> QueryFilter EntityFilter
  Not :: QueryFilter f -> QueryFilter f
  And :: QueryFilter f -> QueryFilter f -> QueryFilter f
  Or :: QueryFilter f -> QueryFilter f -> QueryFilter f

newtype FilterComponent = FilterComponent {FilterComponent -> (TypeRep, Maybe Entity, Maybe Any)
inner :: (TypeRep, Maybe Entity, Maybe Any)}

class ToFilterComponent a where
  toFilterComponent :: a -> FilterComponent

instance (Component c) => ToFilterComponent (C c) where
  toFilterComponent :: C c -> FilterComponent
toFilterComponent C c
_ = (TypeRep, Maybe Entity, Maybe Any) -> FilterComponent
FilterComponent (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, Maybe Entity
forall a. Maybe a
Nothing, Maybe Any
forall a. Maybe a
Nothing)

instance (Component c) => ToFilterComponent (R c Entity) where
  toFilterComponent :: R c Entity -> FilterComponent
toFilterComponent (R Entity
entity) = (TypeRep, Maybe Entity, Maybe Any) -> FilterComponent
FilterComponent (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
entity, Maybe Any
forall a. Maybe a
Nothing)

instance (Component c) => ToFilterComponent (R c Any) where
  toFilterComponent :: R c Any -> FilterComponent
toFilterComponent R c Any
_ = (TypeRep, Maybe Entity, Maybe Any) -> FilterComponent
FilterComponent (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, Maybe Entity
forall a. Maybe a
Nothing, Any -> Maybe Any
forall a. a -> Maybe a
Just Any
Any)

instance Semigroup (QueryFilter f) where
  (<>) :: QueryFilter f -> QueryFilter f -> QueryFilter f
  <> :: QueryFilter f -> QueryFilter f -> QueryFilter f
(<>) = QueryFilter f -> QueryFilter f -> QueryFilter f
forall (f :: FilterType).
QueryFilter f -> QueryFilter f -> QueryFilter f
And

filterArchetype' :: FilterComponent -> World -> [ComponentId] -> IO Bool
filterArchetype' :: FilterComponent -> World -> [ComponentId] -> IO Bool
filterArchetype' (FilterComponent (TypeRep
c, Maybe Entity
entity, Maybe Any
Nothing)) World
world [ComponentId]
components = do
  component <- (ComponentId -> ComponentId)
-> Maybe ComponentId -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget Maybe Entity
entity) (Maybe ComponentId -> Maybe ComponentId)
-> IO (Maybe ComponentId) -> IO (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
  return $ case component of
    Maybe ComponentId
Nothing -> Bool
False
    Just ComponentId
component -> ComponentId
component ComponentId -> [ComponentId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ComponentId]
components
filterArchetype' (FilterComponent (TypeRep
c, Maybe Entity
_, Just Any
_)) World
world [ComponentId]
components = do
  component <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
  case component of
    Maybe ComponentId
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Just (ComponentId (# Word#
id, Maybe Entity
_ #)) -> do
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (ComponentId -> Bool) -> [ComponentId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ComponentId (# Word#
id', Maybe Entity
a #)) -> Maybe Entity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Entity
a Bool -> Bool -> Bool
&& Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# Word#
id' Word#
id)) [ComponentId]
components

filterArchetype :: QueryFilter ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype :: QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
NoFilter World
_ [ComponentId]
_ = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
filterArchetype (With a
a) World
b [ComponentId]
c = FilterComponent -> World -> [ComponentId] -> IO Bool
filterArchetype' (a -> FilterComponent
forall a. ToFilterComponent a => a -> FilterComponent
toFilterComponent a
a) World
b [ComponentId]
c
filterArchetype (Without a
a) World
b [ComponentId]
c = Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilterComponent -> World -> [ComponentId] -> IO Bool
filterArchetype' (a -> FilterComponent
forall a. ToFilterComponent a => a -> FilterComponent
toFilterComponent a
a) World
b [ComponentId]
c
filterArchetype (Not QueryFilter 'ArchetypeFilter
a) World
b [ComponentId]
c = Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
a World
b [ComponentId]
c
filterArchetype (And QueryFilter 'ArchetypeFilter
a0 QueryFilter 'ArchetypeFilter
a1) World
b [ComponentId]
c = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
a0 World
b [ComponentId]
c IO (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
a1 World
b [ComponentId]
c
filterArchetype (Or QueryFilter 'ArchetypeFilter
a0 QueryFilter 'ArchetypeFilter
a1) World
b [ComponentId]
c = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
a0 World
b [ComponentId]
c IO (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QueryFilter 'ArchetypeFilter -> World -> [ComponentId] -> IO Bool
filterArchetype QueryFilter 'ArchetypeFilter
a1 World
b [ComponentId]
c

preprocessFilter :: QueryFilter f -> QueryFilter f
preprocessFilter :: forall (f :: FilterType). QueryFilter f -> QueryFilter f
preprocessFilter = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot

propagateQFNot :: QueryFilter f -> QueryFilter f
propagateQFNot :: forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot (Not QueryFilter f
NoFilter) = QueryFilter f
forall (f :: FilterType). QueryFilter f
NoFilter
propagateQFNot (Not (Not QueryFilter f
a)) = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot QueryFilter f
a
propagateQFNot (Not (QueryFilter f
a `And` QueryFilter f
b)) = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot (QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
Not QueryFilter f
a) QueryFilter f -> QueryFilter f -> QueryFilter f
forall (f :: FilterType).
QueryFilter f -> QueryFilter f -> QueryFilter f
`Or` QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot (QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
Not QueryFilter f
b)
propagateQFNot (Not (QueryFilter f
a `Or` QueryFilter f
b)) = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot (QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
Not QueryFilter f
a) QueryFilter f -> QueryFilter f -> QueryFilter f
forall (f :: FilterType).
QueryFilter f -> QueryFilter f -> QueryFilter f
`And` QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot (QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
Not QueryFilter f
b)
propagateQFNot (QueryFilter f
a `And` QueryFilter f
b) = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot QueryFilter f
a QueryFilter f -> QueryFilter f -> QueryFilter f
forall (f :: FilterType).
QueryFilter f -> QueryFilter f -> QueryFilter f
`And` QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot QueryFilter f
b
propagateQFNot (QueryFilter f
a `Or` QueryFilter f
b) = QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot QueryFilter f
a QueryFilter f -> QueryFilter f -> QueryFilter f
forall (f :: FilterType).
QueryFilter f -> QueryFilter f -> QueryFilter f
`Or` QueryFilter f -> QueryFilter f
forall (f :: FilterType). QueryFilter f -> QueryFilter f
propagateQFNot QueryFilter f
b
propagateQFNot QueryFilter f
x = QueryFilter f
x