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

-- |

-- Module      : Aztecs.ECS.View

-- Copyright   : (c) Matt Hunzinger, 2025

-- License     : BSD-style (see the LICENSE file in the distribution)

--

-- Maintainer  : matt@hunzinger.me

-- Stability   : provisional

-- Portability : non-portable (GHC extensions)

module Aztecs.ECS.View
  ( View (..),
    view,
    viewSingle,
    null,
    unview,
    allDyn,
    singleDyn,
    mapDyn,
    mapSingleDyn,
  )
where

import Aztecs.ECS.Query.Dynamic
import Aztecs.ECS.World.Archetypes
import qualified Aztecs.ECS.World.Archetypes as AS
import Aztecs.ECS.World.Entities (Entities)
import qualified Aztecs.ECS.World.Entities as E
import Data.Foldable (foldl', foldlM)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Prelude hiding (null)

-- | View into a `World`, containing a subset of archetypes.

--

-- @since 0.9

newtype View = View
  { -- | Archetypes contained in this view.

    --

    -- @since 0.9

    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.

--

-- @since 0.9

view :: QueryFilter -> Archetypes -> View
view :: QueryFilter -> Archetypes -> View
view QueryFilter
qf Archetypes
as = Map ArchetypeID Node -> View
View (Map ArchetypeID Node -> View) -> Map ArchetypeID Node -> View
forall a b. (a -> b) -> a -> b
$ Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) Archetypes
as

-- | View into a single archetype containing the provided component IDs.

--

-- @since 0.9

viewSingle :: QueryFilter -> Archetypes -> Maybe View
viewSingle :: QueryFilter -> Archetypes -> Maybe View
viewSingle QueryFilter
qf 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
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) 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

-- | @True@ if the `View` is empty.

--

-- @since 0.9

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`.

--

-- @since 0.9

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`.

--

-- @since 0.9

allDyn :: (Monad m) => DynamicQueryT m a -> View -> m [a]
allDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m [a]
allDyn DynamicQueryT m a
q View
v =
  ([a] -> Node -> m [a]) -> [a] -> Map ArchetypeID Node -> m [a]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
    ( \[a]
acc Node
n -> do
        [a]
as <- DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n
        [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc
    )
    []
    (View -> Map ArchetypeID Node
viewArchetypes View
v)

-- | Query all matching entities in a `View`.

--

-- @since 0.9

singleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a)
singleDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m (Maybe a)
singleDyn DynamicQueryT m a
q View
v = do
  [a]
as <- DynamicQueryT m a -> View -> m [a]
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m [a]
allDyn DynamicQueryT m a
q View
v
  Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case [a]
as of
    [a
a] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    [a]
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Map all matching entities in a `View`.

--

-- @since 0.9

mapDyn :: (Monad m) => DynamicQueryT m a -> View -> m ([a], View)
mapDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m ([a], View)
mapDyn DynamicQueryT m a
q View
v = do
  ([a]
as, Map ArchetypeID Node
arches) <-
    (([a], Map ArchetypeID Node)
 -> (ArchetypeID, Node) -> m ([a], Map ArchetypeID Node))
-> ([a], Map ArchetypeID Node)
-> [(ArchetypeID, Node)]
-> m ([a], Map ArchetypeID Node)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
      ( \([a]
acc, Map ArchetypeID Node
archAcc) (ArchetypeID
aId, Node
n) -> do
          ([a]
as', Archetype
arch') <- DynamicQueryT m a -> Archetype -> m ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT m a
q (Archetype -> m ([a], Archetype))
-> Archetype -> m ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n
          ([a], Map ArchetypeID Node) -> m ([a], Map ArchetypeID Node)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([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)
  ([a], View) -> m ([a], View)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as, Map ArchetypeID Node -> View
View Map ArchetypeID Node
arches)

-- | Map a single matching entity in a `View`.

--

-- @since 0.9

mapSingleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a, View)
mapSingleDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m (Maybe a, View)
mapSingleDyn DynamicQueryT m a
q View
v = do
  ([a]
as, View
arches) <- DynamicQueryT m a -> View -> m ([a], View)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m ([a], View)
mapDyn DynamicQueryT m a
q View
v
  (Maybe a, View) -> m (Maybe a, View)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, View) -> m (Maybe a, View))
-> (Maybe a, View) -> m (Maybe a, View)
forall a b. (a -> b) -> a -> b
$ case [a]
as of
    [a
a] -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, View
arches)
    [a]
_ -> (Maybe a
forall a. Maybe a
Nothing, View
arches)