{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Aztecs.ECS.View
  ( View (..),
    view,
    viewSingle,
    filterView,
    null,
    unview,
    allDyn,
    singleDyn,
    readAllDyn,
  )
where

import Aztecs.ECS.Query.Dynamic (DynamicQuery (..))
import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..), runDynQueryReader)
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Archetypes (ArchetypeID, Archetypes, Node (..))
import qualified Aztecs.ECS.World.Archetypes as AS
import Aztecs.ECS.World.Components (ComponentID)
import Aztecs.ECS.World.Entities (Entities)
import qualified Aztecs.ECS.World.Entities as E
import Data.Foldable (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Prelude hiding (null)

-- | View into a `World`, containing a subset of archetypes.
newtype View = View {View -> Map ArchetypeID Node
viewArchetypes :: Map ArchetypeID Node}
  deriving (Int -> View -> ShowS
[View] -> ShowS
View -> String
(Int -> View -> ShowS)
-> (View -> String) -> ([View] -> ShowS) -> Show View
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> View -> ShowS
showsPrec :: Int -> View -> ShowS
$cshow :: View -> String
show :: View -> String
$cshowList :: [View] -> ShowS
showList :: [View] -> ShowS
Show, NonEmpty View -> View
View -> View -> View
(View -> View -> View)
-> (NonEmpty View -> View)
-> (forall b. Integral b => b -> View -> View)
-> Semigroup View
forall b. Integral b => b -> View -> View
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: View -> View -> View
<> :: View -> View -> View
$csconcat :: NonEmpty View -> View
sconcat :: NonEmpty View -> View
$cstimes :: forall b. Integral b => b -> View -> View
stimes :: forall b. Integral b => b -> View -> View
Semigroup, Semigroup View
View
Semigroup View =>
View -> (View -> View -> View) -> ([View] -> View) -> Monoid View
[View] -> View
View -> View -> View
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: View
mempty :: View
$cmappend :: View -> View -> View
mappend :: View -> View -> View
$cmconcat :: [View] -> View
mconcat :: [View] -> View
Monoid)

-- | View into all archetypes containing the provided component IDs.
view :: Set ComponentID -> Archetypes -> View
view :: Set ComponentID -> Archetypes -> View
view Set ComponentID
cIds Archetypes
as = Map ArchetypeID Node -> View
View (Map ArchetypeID Node -> View) -> Map ArchetypeID Node -> View
forall a b. (a -> b) -> a -> b
$ Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find Set ComponentID
cIds Archetypes
as

viewSingle :: Set ComponentID -> Archetypes -> Maybe View
viewSingle :: Set ComponentID -> Archetypes -> Maybe View
viewSingle Set ComponentID
cIds Archetypes
as = case Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ArchetypeID Node -> [(ArchetypeID, Node)])
-> Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall a b. (a -> b) -> a -> b
$ Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find Set ComponentID
cIds Archetypes
as of
  [(ArchetypeID, Node)
a] -> View -> Maybe View
forall a. a -> Maybe a
Just (View -> Maybe View)
-> (Map ArchetypeID Node -> View)
-> Map ArchetypeID Node
-> Maybe View
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ArchetypeID Node -> View
View (Map ArchetypeID Node -> Maybe View)
-> Map ArchetypeID Node -> Maybe View
forall a b. (a -> b) -> a -> b
$ (ArchetypeID -> Node -> Map ArchetypeID Node)
-> (ArchetypeID, Node) -> Map ArchetypeID Node
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ArchetypeID -> Node -> Map ArchetypeID Node
forall k a. k -> a -> Map k a
Map.singleton (ArchetypeID, Node)
a
  [(ArchetypeID, Node)]
_ -> Maybe View
forall a. Maybe a
Nothing

-- | View into all archetypes containing the provided component IDs and matching the provided predicate.
filterView ::
  Set ComponentID ->
  (Node -> Bool) ->
  Archetypes ->
  View
filterView :: Set ComponentID -> (Node -> Bool) -> Archetypes -> View
filterView Set ComponentID
cIds Node -> Bool
f Archetypes
as = Map ArchetypeID Node -> View
View (Map ArchetypeID Node -> View) -> Map ArchetypeID Node -> View
forall a b. (a -> b) -> a -> b
$ (Node -> Bool) -> Map ArchetypeID Node -> Map ArchetypeID Node
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Node -> Bool
f (Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find Set ComponentID
cIds Archetypes
as)

null :: View -> Bool
null :: View -> Bool
null = Map ArchetypeID Node -> Bool
forall k a. Map k a -> Bool
Map.null (Map ArchetypeID Node -> Bool)
-> (View -> Map ArchetypeID Node) -> View -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View -> Map ArchetypeID Node
viewArchetypes

-- | "Un-view" a `View` back into a `World`.
unview :: View -> Entities -> Entities
unview :: View -> Entities -> Entities
unview View
v Entities
es =
  Entities
es
    { E.archetypes =
        foldl'
          (\Archetypes
as (ArchetypeID
aId, Node
n) -> Archetypes
as {AS.nodes = Map.insert aId n (AS.nodes as)})
          (E.archetypes es)
          (Map.toList $ viewArchetypes v)
    }

-- | Query all matching entities in a `View`.
allDyn :: i -> DynamicQuery i a -> View -> ([a], View)
allDyn :: forall i a. i -> DynamicQuery i a -> View -> ([a], View)
allDyn i
i DynamicQuery i a
q View
v =
  let ([a]
as, Map ArchetypeID Node
arches) =
        (([a], Map ArchetypeID Node)
 -> (ArchetypeID, Node) -> ([a], Map ArchetypeID Node))
-> ([a], Map ArchetypeID Node)
-> [(ArchetypeID, Node)]
-> ([a], Map ArchetypeID Node)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
          ( \([a]
acc, Map ArchetypeID Node
archAcc) (ArchetypeID
aId, Node
n) ->
              let ([a]
as', Archetype
arch') = DynamicQuery i a
-> [i] -> [EntityID] -> Archetype -> ([a], Archetype)
forall i o.
DynamicQuery i o
-> [i] -> [EntityID] -> Archetype -> ([o], Archetype)
runDynQuery DynamicQuery i a
q (i -> [i]
forall a. a -> [a]
repeat i
i) (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID])
-> (Archetype -> Set EntityID) -> Archetype -> [EntityID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetype -> Set EntityID
A.entities (Archetype -> [EntityID]) -> Archetype -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n) (Node -> Archetype
nodeArchetype Node
n)
               in ([a]
as' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc, ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId (Node
n {nodeArchetype = arch'}) Map ArchetypeID Node
archAcc)
          )
          ([], Map ArchetypeID Node
forall k a. Map k a
Map.empty)
          (Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ArchetypeID Node -> [(ArchetypeID, Node)])
-> Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall a b. (a -> b) -> a -> b
$ View -> Map ArchetypeID Node
viewArchetypes View
v)
   in ([a]
as, Map ArchetypeID Node -> View
View Map ArchetypeID Node
arches)

-- | Query all matching entities in a `View`.
singleDyn :: i -> DynamicQuery i a -> View -> (Maybe a, View)
singleDyn :: forall i a. i -> DynamicQuery i a -> View -> (Maybe a, View)
singleDyn i
i DynamicQuery i a
q View
v = case i -> DynamicQuery i a -> View -> ([a], View)
forall i a. i -> DynamicQuery i a -> View -> ([a], View)
allDyn i
i DynamicQuery i a
q View
v of
  -- TODO [a], removing this errors for now
  (a
a : [a]
_, View
v') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, View
v')
  ([a], View)
_ -> (Maybe a
forall a. Maybe a
Nothing, View
v)

-- | Query all matching entities in a `View`.
readAllDyn :: i -> DynamicQueryReader i a -> View -> [a]
readAllDyn :: forall i a. i -> DynamicQueryReader i a -> View -> [a]
readAllDyn i
i DynamicQueryReader i a
q View
v =
  ([a] -> Node -> [a]) -> [a] -> Map ArchetypeID Node -> [a]
forall b a. (b -> a -> b) -> b -> Map ArchetypeID a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ( \[a]
acc Node
n ->
        i -> DynamicQueryReader i a -> [EntityID] -> Archetype -> [a]
forall i o.
i -> DynamicQueryReader i o -> [EntityID] -> Archetype -> [o]
runDynQueryReader i
i DynamicQueryReader i a
q (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID])
-> (Archetype -> Set EntityID) -> Archetype -> [EntityID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetype -> Set EntityID
A.entities (Archetype -> [EntityID]) -> Archetype -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n) (Node -> Archetype
nodeArchetype Node
n) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc
    )
    []
    (View -> Map ArchetypeID Node
viewArchetypes View
v)