{-# OPTIONS_GHC "-Wno-orphans" #-}

-- |
-- Module      :  Games.ECS.Component
-- Description : Components and their infrastructure.
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- Components are what hold data in an ECS system.
module Games.ECS.Component where

import Control.Applicative
import Control.Lens
import Data.Coerce
import Data.Foldable qualified as DF
import Data.Kind (Type)
import Data.Maybe qualified as DM
import Data.Proxy
import Data.String
import Data.XML.Types (Element)
import GHC.Generics
import GHC.OverloadedLabels
import GHC.TypeLits
import Games.ECS.Component.Store
import Games.ECS.Entity
import Games.ECS.Serialisation
import Games.ECS.Slot
import Games.ECS.World

class PseudoComponent c

-- type family DefaultStorageForFlags (b :: Bool) where
--     type instance DefaultStorageForFlags False = ComponentStore
--     type instance DefaultStorageForFlags True =

-- | A component represented in the entity component system.
class
  ( AsEmpty (Storage c c),
    KnownSymbol (CanonicalName c),
    At (Storage c c),
    Index (Storage c c) ~ Entity,
    HasEntitySet (Storage c c)
  ) =>
  Component c
  where
  -- | What to name accessors if the type name isn't ergonomic.
  type CanonicalName c :: Symbol

  -- | Is the type a flag component?
  type IsFlag c :: Bool

  type IsFlag c = False

  -- | What datatype to store all instances of a component in. Allows for a generalisation of
  -- "Structure-of-Arrays". Defaults to `Data.HashMap.Strict.HashMap`.
  type Storage c :: Type -> Type

  type Storage c = ComponentStore

  -- | Arity of the component. Defaults to `Normal`.
  type Prop c :: Props

  type Prop c = Normal

  -- | A prism for serialising and deserialising the component as XML.
  _ComponentFromXML :: String -> Prism' Element c
  {-# INLINE _ComponentFromXML #-}
  default _ComponentFromXML :: (XMLSerialise c) => String -> Prism' Element c
  _ComponentFromXML String
name =
    (c -> Element) -> (Element -> Maybe c) -> Prism' Element c
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (String -> c -> Element
forall a. XMLSerialise a => String -> a -> Element
serialise String
name)
      ( \Element
n -> case String -> Element -> Either UnpickleError c
forall a.
XMLSerialise a =>
String -> Element -> Either UnpickleError a
deserialise String
name Element
n of
          Right c
a -> c -> Maybe c
forall a. a -> Maybe a
Just c
a
          Left UnpickleError
_ -> Maybe c
forall a. Maybe a
Nothing
      )

  -- | The collection of entities held in storage.
  {-# INLINE entityKeys #-}
  entityKeys :: Fold (Storage c c) EntitySet
  entityKeys = (EntitySet -> f EntitySet) -> Storage c c -> f (Storage c c)
forall a. HasEntitySet a => Fold a EntitySet
Fold (Storage c c) EntitySet
entitySet

  -- | Construct new storage.
  {-# INLINE emptyStorage #-}
  emptyStorage :: Storage c c
  emptyStorage = AReview (Storage c c) () -> () -> Storage c c
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Storage c c) ()
forall a. AsEmpty a => Prism' a ()
Prism' (Storage c c) ()
_Empty () :: (Storage c c)

  -- | An AffineTraversal lookup of a given `Entity`'s component. This probably should be in `World.hs`.
  entityHasComponent :: Entity -> IndexedTraversal' Entity (Storage c c) c
  default entityHasComponent ::
    (IxValue (Storage c c) ~ c) =>
    Entity ->
    IndexedTraversal' Entity (Storage c c) c
  entityHasComponent Entity
ent = ((p ~ (->)) => (c -> f c) -> Storage c c -> f (Storage c c))
-> (p c (f c) -> Storage c c -> f (Storage c c))
-> p c (f c)
-> Storage c c
-> f (Storage c c)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (Index (Storage c c)
-> Traversal' (Storage c c) (IxValue (Storage c c))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Storage c c)
Entity
ent) (Index (Storage c c)
-> IndexedTraversal'
     (Index (Storage c c)) (Storage c c) (IxValue (Storage c c))
forall m.
Ixed m =>
Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix Index (Storage c c)
Entity
ent)
  {-# INLINE entityHasComponent #-}

  -- | When the component is required, provide a default value.
  defaultValue :: ((Prop c) ~ Required) => c
  defaultValue = String -> c
forall a. HasCallStack => String -> a
error (String
"No default value specified for required component " String -> String -> String
forall a. [a] -> [a] -> [a]
Prelude.++ Proxy (CanonicalName c) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (CanonicalName c)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (CanonicalName c)) String -> String -> String
forall a. [a] -> [a] -> [a]
Prelude.++ String
"!")

type ComponentReference (name :: Symbol) c = (Component c) => TaggedComponent name Entity









-- | A component comprised of multiple other components.
class (Component c) => CompositeComponent c where
  type SubComponentIndex c :: Type

  -- | Look up the entity references of the subcomponents.
  subComponentReferences :: IndexedFold (SubComponentIndex c) c Entity

  {-# INLINE components #-}

  -- | An IndexedTraversal' of the subcomponents of a composite component.
  components ::
    forall p f worldType.
    (World worldType, Indexable (SubComponentIndex c) p, Applicative f) =>
    -- | The composite component
    c ->
    p (worldType Individual) (f (worldType Individual)) ->
    worldType Storing ->
    f (worldType Storing)
  components c
comp = ((p ~ (->)) =>
 (worldType 'Individual -> f (worldType 'Individual))
 -> worldType 'Storing -> f (worldType 'Storing))
-> (p (worldType 'Individual) (f (worldType 'Individual))
    -> worldType 'Storing -> f (worldType 'Storing))
-> p (worldType 'Individual) (f (worldType 'Individual))
-> worldType 'Storing
-> f (worldType 'Storing)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) =>
(worldType 'Individual -> f (worldType 'Individual))
-> worldType 'Storing -> f (worldType 'Storing)
(worldType 'Individual -> f (worldType 'Individual))
-> worldType 'Storing -> f (worldType 'Storing)
normalVer p (worldType 'Individual) (f (worldType 'Individual))
-> worldType 'Storing -> f (worldType 'Storing)
indexedVer
    where
      normalVer :: (worldType 'Individual -> f (worldType 'Individual))
-> worldType 'Storing -> f (worldType 'Storing)
normalVer worldType 'Individual -> f (worldType 'Individual)
prof worldType 'Storing
world = f (worldType 'Storing)
result
        where
          applied :: [f (worldType Individual)]
          applied :: [f (worldType 'Individual)]
applied =
            (worldType 'Individual -> f (worldType 'Individual))
-> [worldType 'Individual] -> [f (worldType 'Individual)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (worldType 'Individual -> f (worldType 'Individual)
prof) ([worldType 'Individual] -> [f (worldType 'Individual)])
-> [worldType 'Individual] -> [f (worldType 'Individual)]
forall a b. (a -> b) -> a -> b
$
              (Entity -> Maybe (worldType 'Individual))
-> [Entity] -> [worldType 'Individual]
forall a b. (a -> Maybe b) -> [a] -> [b]
DM.mapMaybe
                (worldType 'Storing -> Entity -> Maybe (worldType 'Individual)
forall (w :: Access -> *).
World w =>
w 'Storing -> Entity -> Maybe (w 'Individual)
lookupEntity worldType 'Storing
world)
                (c
comp c -> Getting (Endo [Entity]) c Entity -> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Entity]) c Entity
forall c.
CompositeComponent c =>
IndexedFold (SubComponentIndex c) c Entity
IndexedFold (SubComponentIndex c) c Entity
subComponentReferences)

          result :: f (worldType 'Storing)
result = ((worldType 'Storing
  -> worldType 'Individual -> worldType 'Storing)
 -> worldType 'Storing
 -> [worldType 'Individual]
 -> worldType 'Storing)
-> f (worldType 'Storing
      -> worldType 'Individual -> worldType 'Storing)
-> f (worldType 'Storing)
-> f [worldType 'Individual]
-> f (worldType 'Storing)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (worldType 'Storing -> worldType 'Individual -> worldType 'Storing)
-> worldType 'Storing
-> [worldType 'Individual]
-> worldType 'Storing
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
DF.foldl' ((worldType 'Storing -> worldType 'Individual -> worldType 'Storing)
-> f (worldType 'Storing
      -> worldType 'Individual -> worldType 'Storing)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((worldType 'Individual -> worldType 'Storing -> worldType 'Storing)
-> worldType 'Storing
-> worldType 'Individual
-> worldType 'Storing
forall a b c. (a -> b -> c) -> b -> a -> c
flip worldType 'Individual -> worldType 'Storing -> worldType 'Storing
forall (w :: Access -> *).
World w =>
w 'Individual -> w 'Storing -> w 'Storing
storeEntity)) (worldType 'Storing -> f (worldType 'Storing)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure worldType 'Storing
world) ([f (worldType 'Individual)] -> f [worldType 'Individual]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f (worldType 'Individual)]
applied)
      indexedVer :: p (worldType 'Individual) (f (worldType 'Individual))
-> worldType 'Storing -> f (worldType 'Storing)
indexedVer p (worldType 'Individual) (f (worldType 'Individual))
prof worldType 'Storing
world = f (worldType 'Storing)
result
        where
          applied :: [f (worldType Individual)]
          applied :: [f (worldType 'Individual)]
applied =
            ((SubComponentIndex c, worldType 'Individual)
 -> f (worldType 'Individual))
-> [(SubComponentIndex c, worldType 'Individual)]
-> [f (worldType 'Individual)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SubComponentIndex c
 -> worldType 'Individual -> f (worldType 'Individual))
-> (SubComponentIndex c, worldType 'Individual)
-> f (worldType 'Individual)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (p (worldType 'Individual) (f (worldType 'Individual))
-> SubComponentIndex c
-> worldType 'Individual
-> f (worldType 'Individual)
forall a b. p a b -> SubComponentIndex c -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
Control.Lens.indexed p (worldType 'Individual) (f (worldType 'Individual))
prof)) ([(SubComponentIndex c, worldType 'Individual)]
 -> [f (worldType 'Individual)])
-> [(SubComponentIndex c, worldType 'Individual)]
-> [f (worldType 'Individual)]
forall a b. (a -> b) -> a -> b
$
              ((SubComponentIndex c, Entity)
 -> Maybe (SubComponentIndex c, worldType 'Individual))
-> [(SubComponentIndex c, Entity)]
-> [(SubComponentIndex c, worldType 'Individual)]
forall a b. (a -> Maybe b) -> [a] -> [b]
DM.mapMaybe
                ( \(SubComponentIndex c
partName', Entity
ent) -> case worldType 'Storing -> Entity -> Maybe (worldType 'Individual)
forall (w :: Access -> *).
World w =>
w 'Storing -> Entity -> Maybe (w 'Individual)
lookupEntity worldType 'Storing
world Entity
ent of
                    Just worldType 'Individual
partIndividual -> (SubComponentIndex c, worldType 'Individual)
-> Maybe (SubComponentIndex c, worldType 'Individual)
forall a. a -> Maybe a
Just (SubComponentIndex c
partName', worldType 'Individual
partIndividual)
                    Maybe (worldType 'Individual)
Nothing -> Maybe (SubComponentIndex c, worldType 'Individual)
forall a. Maybe a
Nothing
                )
                (c
comp c
-> IndexedGetting
     (SubComponentIndex c)
     (Endo [(SubComponentIndex c, Entity)])
     c
     Entity
-> [(SubComponentIndex c, Entity)]
forall s i a. s -> IndexedGetting i (Endo [(i, a)]) s a -> [(i, a)]
^@.. IndexedGetting
  (SubComponentIndex c)
  (Endo [(SubComponentIndex c, Entity)])
  c
  Entity
forall c.
CompositeComponent c =>
IndexedFold (SubComponentIndex c) c Entity
IndexedFold (SubComponentIndex c) c Entity
subComponentReferences)

          result :: f (worldType 'Storing)
result = ((worldType 'Storing
  -> worldType 'Individual -> worldType 'Storing)
 -> worldType 'Storing
 -> [worldType 'Individual]
 -> worldType 'Storing)
-> f (worldType 'Storing
      -> worldType 'Individual -> worldType 'Storing)
-> f (worldType 'Storing)
-> f [worldType 'Individual]
-> f (worldType 'Storing)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (worldType 'Storing -> worldType 'Individual -> worldType 'Storing)
-> worldType 'Storing
-> [worldType 'Individual]
-> worldType 'Storing
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
DF.foldl' ((worldType 'Storing -> worldType 'Individual -> worldType 'Storing)
-> f (worldType 'Storing
      -> worldType 'Individual -> worldType 'Storing)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((worldType 'Individual -> worldType 'Storing -> worldType 'Storing)
-> worldType 'Storing
-> worldType 'Individual
-> worldType 'Storing
forall a b c. (a -> b -> c) -> b -> a -> c
flip worldType 'Individual -> worldType 'Storing -> worldType 'Storing
forall (w :: Access -> *).
World w =>
w 'Individual -> w 'Storing -> w 'Storing
storeEntity)) (worldType 'Storing -> f (worldType 'Storing)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure worldType 'Storing
world) ([f (worldType 'Individual)] -> f [worldType 'Individual]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f (worldType 'Individual)]
applied)

-- | Indicates a component behaves like a sensor.
class (Component c) => SensoryComponent c

-- sensors :: c -> IndexedTraversal' Entity (worldType Storing) (worldType Individual)

-- | Indicates that a component can perform actions in the world.
class (Component c) => EffectorComponent c

class (Component c) => AttributeComponent c

-- | Indicates whether a component is a simple Boolean flag.
class (Component c) => FlagComponent c

-- | A component representing an /intent/ to do something.
class (Component c) => IntentComponent c

class (Component c) => ReferenceComponent c

-- | A component which indicates an ability to emit intents.
class (IntentComponent (Intent c), Component c) => CapabilityComponent c where
  type Intent c :: Type

-- TODO look at `specs`  storage mechanisms
-- TODO look at unity archetypes (the storage kind)

-- Look at bitsets, hibitsets, bloom filters, slotmaps

-- | Storage for 'Unique' components. As a 'Unique' component will have, at most, a single instance in the world, we only need to store the component and its 'Entity' naively.
newtype UniqueStore a = UniqueStore (Maybe (Entity, a)) deriving (UniqueStore a -> UniqueStore a -> Bool
(UniqueStore a -> UniqueStore a -> Bool)
-> (UniqueStore a -> UniqueStore a -> Bool) -> Eq (UniqueStore a)
forall a. Eq a => UniqueStore a -> UniqueStore a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => UniqueStore a -> UniqueStore a -> Bool
== :: UniqueStore a -> UniqueStore a -> Bool
$c/= :: forall a. Eq a => UniqueStore a -> UniqueStore a -> Bool
/= :: UniqueStore a -> UniqueStore a -> Bool
Eq, Int -> UniqueStore a -> String -> String
[UniqueStore a] -> String -> String
UniqueStore a -> String
(Int -> UniqueStore a -> String -> String)
-> (UniqueStore a -> String)
-> ([UniqueStore a] -> String -> String)
-> Show (UniqueStore a)
forall a. Show a => Int -> UniqueStore a -> String -> String
forall a. Show a => [UniqueStore a] -> String -> String
forall a. Show a => UniqueStore a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> UniqueStore a -> String -> String
showsPrec :: Int -> UniqueStore a -> String -> String
$cshow :: forall a. Show a => UniqueStore a -> String
show :: UniqueStore a -> String
$cshowList :: forall a. Show a => [UniqueStore a] -> String -> String
showList :: [UniqueStore a] -> String -> String
Show, (forall x. UniqueStore a -> Rep (UniqueStore a) x)
-> (forall x. Rep (UniqueStore a) x -> UniqueStore a)
-> Generic (UniqueStore a)
forall x. Rep (UniqueStore a) x -> UniqueStore a
forall x. UniqueStore a -> Rep (UniqueStore a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (UniqueStore a) x -> UniqueStore a
forall a x. UniqueStore a -> Rep (UniqueStore a) x
$cfrom :: forall a x. UniqueStore a -> Rep (UniqueStore a) x
from :: forall x. UniqueStore a -> Rep (UniqueStore a) x
$cto :: forall a x. Rep (UniqueStore a) x -> UniqueStore a
to :: forall x. Rep (UniqueStore a) x -> UniqueStore a
Generic)

instance HasEntitySet (UniqueStore a) where
  {-# INLINE entitySet #-}
  entitySet :: Fold (UniqueStore a) EntitySet
entitySet = (p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
forall {p :: * -> * -> *} {f :: * -> *}.
(Profunctor p, Functor f) =>
p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
coerced :: Iso' (UniqueStore a) (Maybe (Entity, a))) ((Maybe (Entity, a) -> f (Maybe (Entity, a)))
 -> UniqueStore a -> f (UniqueStore a))
-> ((EntitySet -> f EntitySet)
    -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> (EntitySet -> f EntitySet)
-> UniqueStore a
-> f (UniqueStore a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity, a) -> f (Entity, a))
-> Maybe (Entity, a) -> f (Maybe (Entity, a))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Entity, a) -> f (Entity, a))
 -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> ((EntitySet -> f EntitySet) -> (Entity, a) -> f (Entity, a))
-> (EntitySet -> f EntitySet)
-> Maybe (Entity, a)
-> f (Maybe (Entity, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> f Entity) -> (Entity, a) -> f (Entity, a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Entity, a) (Entity, a) Entity Entity
_1 ((Entity -> f Entity) -> (Entity, a) -> f (Entity, a))
-> ((EntitySet -> f EntitySet) -> Entity -> f Entity)
-> (EntitySet -> f EntitySet)
-> (Entity, a)
-> f (Entity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> EntitySet)
-> (EntitySet -> f EntitySet) -> Entity -> f Entity
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Control.Lens.to Entity -> EntitySet
singletonEntitySet

instance AsEmpty (UniqueStore a) where
  {-# INLINE _Empty #-}
  _Empty :: Prism' (UniqueStore a) ()
_Empty = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced @(UniqueStore a) @(UniqueStore a) @(Maybe (Entity, a)) @(Maybe (Entity, a)) (p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
 -> p (UniqueStore a) (f (UniqueStore a)))
-> (p () (f ()) -> p (Maybe (Entity, a)) (f (Maybe (Entity, a))))
-> p () (f ())
-> p (UniqueStore a) (f (UniqueStore a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p () (f ()) -> p (Maybe a) (f (Maybe a))
_Nothing

instance Ixed (UniqueStore a)

type instance Index (UniqueStore a) = Entity

type instance IxValue (UniqueStore a) = a

instance (Index (UniqueStore a) ~ Entity, (IxValue (UniqueStore a)) ~ a) => At (UniqueStore a) where
  {- at ::
     Functor f =>
     Entity ->
     (Maybe a -> f (Maybe a)) ->
     UniqueStore a ->
     f (UniqueStore a)-}
  {-# INLINE at #-}
  at :: Index (UniqueStore a)
-> Lens' (UniqueStore a) (Maybe (IxValue (UniqueStore a)))
at Index (UniqueStore a)
e Maybe (IxValue (UniqueStore a))
-> f (Maybe (IxValue (UniqueStore a)))
f UniqueStore a
us =
    Maybe (IxValue (UniqueStore a))
-> f (Maybe (IxValue (UniqueStore a)))
f Maybe a
Maybe (IxValue (UniqueStore a))
lookedUp f (Maybe a) -> (Maybe a -> UniqueStore a) -> f (UniqueStore a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe a
Nothing -> UniqueStore a -> (a -> UniqueStore a) -> Maybe a -> UniqueStore a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UniqueStore a
us (UniqueStore a -> a -> UniqueStore a
forall a b. a -> b -> a
const (Maybe (Entity, a) -> UniqueStore a
forall a. Maybe (Entity, a) -> UniqueStore a
UniqueStore Maybe (Entity, a)
forall a. Maybe a
Nothing)) Maybe a
lookedUp
      Just a
v' -> Maybe (Entity, a) -> UniqueStore a
forall a. Maybe (Entity, a) -> UniqueStore a
UniqueStore ((Entity, a) -> Maybe (Entity, a)
forall a. a -> Maybe a
Just (Index (UniqueStore a)
Entity
e, a
v'))
    where
      lookedUp :: Maybe a
lookedUp =
        ( case UniqueStore a
us of
            UniqueStore (Just (Entity
ref, a
a)) | Index (UniqueStore a)
Entity
e Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
ref -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
            UniqueStore a
_ -> Maybe a
forall a. Maybe a
Nothing
        )

-- | This is an unlawful instance due to `entityHasComponent` allowing write-back.
-- FIXME: Write a valid definition of entityHasComponent, or make it only a psuedocomponent.
-- instance Component Entity where
--  type Prop Entity = Required

-- Some (future) psuedocomponents?

data Has entity component = Has

type HasA component entity = Has entity component

data Hasn't entity component = Hasn't

-- | Simplified type signature to use in world definitions.
type AComponent name s a = Field name s (Prop a) a

instance ({-HasType (Field name acc p a) (hkd acc), Generic (hkd acc),-} EntityProperty name hkd acc p a, accessorType ~ OpticsFor name hkd acc p a) => IsLabel name accessorType where
  fromLabel :: accessorType
fromLabel = forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
EntityProperty name hkd acc p a =>
OpticsFor name hkd acc p a
accessor @name @hkd @acc @p @a
  {-# INLINE fromLabel #-}

-- instance (HasType (Tagged name a) (hkd Individual), (Tagged name a) ~ (Field name hkd Individual p a), EntityProperty name hkd Individual p a) => HasField name (hkd Individual) a where

--  getField = unTagged . getTyped

-- | A component with an arbitrary name tag.
newtype TaggedComponent name a = Tagged {forall {k} (name :: k) a. TaggedComponent name a -> a
unTagged :: a} deriving newtype (TaggedComponent name a -> TaggedComponent name a -> Bool
(TaggedComponent name a -> TaggedComponent name a -> Bool)
-> (TaggedComponent name a -> TaggedComponent name a -> Bool)
-> Eq (TaggedComponent name a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (name :: k) a.
Eq a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
$c== :: forall k (name :: k) a.
Eq a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
== :: TaggedComponent name a -> TaggedComponent name a -> Bool
$c/= :: forall k (name :: k) a.
Eq a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
/= :: TaggedComponent name a -> TaggedComponent name a -> Bool
Eq, Int -> TaggedComponent name a -> String -> String
[TaggedComponent name a] -> String -> String
TaggedComponent name a -> String
(Int -> TaggedComponent name a -> String -> String)
-> (TaggedComponent name a -> String)
-> ([TaggedComponent name a] -> String -> String)
-> Show (TaggedComponent name a)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall k (name :: k) a.
Show a =>
Int -> TaggedComponent name a -> String -> String
forall k (name :: k) a.
Show a =>
[TaggedComponent name a] -> String -> String
forall k (name :: k) a. Show a => TaggedComponent name a -> String
$cshowsPrec :: forall k (name :: k) a.
Show a =>
Int -> TaggedComponent name a -> String -> String
showsPrec :: Int -> TaggedComponent name a -> String -> String
$cshow :: forall k (name :: k) a. Show a => TaggedComponent name a -> String
show :: TaggedComponent name a -> String
$cshowList :: forall k (name :: k) a.
Show a =>
[TaggedComponent name a] -> String -> String
showList :: [TaggedComponent name a] -> String -> String
Show, Eq (TaggedComponent name a)
Eq (TaggedComponent name a) =>
(TaggedComponent name a -> TaggedComponent name a -> Ordering)
-> (TaggedComponent name a -> TaggedComponent name a -> Bool)
-> (TaggedComponent name a -> TaggedComponent name a -> Bool)
-> (TaggedComponent name a -> TaggedComponent name a -> Bool)
-> (TaggedComponent name a -> TaggedComponent name a -> Bool)
-> (TaggedComponent name a
    -> TaggedComponent name a -> TaggedComponent name a)
-> (TaggedComponent name a
    -> TaggedComponent name a -> TaggedComponent name a)
-> Ord (TaggedComponent name a)
TaggedComponent name a -> TaggedComponent name a -> Bool
TaggedComponent name a -> TaggedComponent name a -> Ordering
TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
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
forall k (name :: k) a. Ord a => Eq (TaggedComponent name a)
forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Ordering
forall k (name :: k) a.
Ord a =>
TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
$ccompare :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Ordering
compare :: TaggedComponent name a -> TaggedComponent name a -> Ordering
$c< :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
< :: TaggedComponent name a -> TaggedComponent name a -> Bool
$c<= :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
<= :: TaggedComponent name a -> TaggedComponent name a -> Bool
$c> :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
> :: TaggedComponent name a -> TaggedComponent name a -> Bool
$c>= :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a -> TaggedComponent name a -> Bool
>= :: TaggedComponent name a -> TaggedComponent name a -> Bool
$cmax :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
max :: TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
$cmin :: forall k (name :: k) a.
Ord a =>
TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
min :: TaggedComponent name a
-> TaggedComponent name a -> TaggedComponent name a
Ord, (forall x.
 TaggedComponent name a -> Rep (TaggedComponent name a) x)
-> (forall x.
    Rep (TaggedComponent name a) x -> TaggedComponent name a)
-> Generic (TaggedComponent name a)
forall x. Rep (TaggedComponent name a) x -> TaggedComponent name a
forall x. TaggedComponent name a -> Rep (TaggedComponent name a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (name :: k) a x.
Generic a =>
Rep (TaggedComponent name a) x -> TaggedComponent name a
forall k (name :: k) a x.
Generic a =>
TaggedComponent name a -> Rep (TaggedComponent name a) x
$cfrom :: forall k (name :: k) a x.
Generic a =>
TaggedComponent name a -> Rep (TaggedComponent name a) x
from :: forall x. TaggedComponent name a -> Rep (TaggedComponent name a) x
$cto :: forall k (name :: k) a x.
Generic a =>
Rep (TaggedComponent name a) x -> TaggedComponent name a
to :: forall x. Rep (TaggedComponent name a) x -> TaggedComponent name a
Generic)

{-# INLINE untag #-}

-- | Get the raw component.
untag :: TaggedComponent name a -> a
untag :: forall {k} (name :: k) a. TaggedComponent name a -> a
untag = TaggedComponent name a -> a
forall {k} (name :: k) a. TaggedComponent name a -> a
unTagged

instance {-# OVERLAPPING #-} (KnownSymbol name, KnownSymbol (AppendSymbol name "TaggedComponent wrapper"), XMLPickler [Node] a) => XMLPickler [Node] (TaggedComponent name a) where
  {-# INLINE xpickle #-}
  xpickle :: PU [Node] (TaggedComponent name a)
xpickle = Name
-> PU [Node] (TaggedComponent name a)
-> PU [Node] (TaggedComponent name a)
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes (String -> Name
forall a. IsString a => String -> a
fromString (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall {k} (t :: k). Proxy t
Proxy :: Proxy name))) (PU [Node] (TaggedComponent name a)
 -> PU [Node] (TaggedComponent name a))
-> PU [Node] (TaggedComponent name a)
-> PU [Node] (TaggedComponent name a)
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy (AppendSymbol name "TaggedComponent wrapper") -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (AppendSymbol name "TaggedComponent wrapper")
forall {k} (t :: k). Proxy t
Proxy :: Proxy (AppendSymbol name "TaggedComponent wrapper"))), Text
"") (Text, Text)
-> PU [Node] (TaggedComponent name a)
-> PU [Node] (TaggedComponent name a)
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ((a -> TaggedComponent name a)
-> (TaggedComponent name a -> a)
-> PU [Node] a
-> PU [Node] (TaggedComponent name a)
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap a -> TaggedComponent name a
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged TaggedComponent name a -> a
forall {k} (name :: k) a. TaggedComponent name a -> a
untag ((Text
"inside Tagged", Text
"") (Text, Text) -> PU [Node] a -> PU [Node] a
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> PU [Node] a
forall t a. XMLPickler t a => PU t a
xpickle))

instance {-# OVERLAPPING #-} (Eq a, KnownSymbol name, KnownSymbol (AppendSymbol name "TaggedComponent wrapper"), XMLPickler [Node] a) => XMLPickler [Node] (TaggedComponent name (Maybe a)) where
  {-# INLINE xpickle #-}
  xpickle :: PU [Node] (TaggedComponent name (Maybe a))
xpickle = TaggedComponent name (Maybe a)
-> PU [Node] (TaggedComponent name (Maybe a))
-> PU [Node] (TaggedComponent name (Maybe a))
forall a t. Eq a => a -> PU [t] a -> PU [t] a
xpDefault (Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged Maybe a
forall a. Maybe a
Nothing) (PU [Node] (TaggedComponent name (Maybe a))
 -> PU [Node] (TaggedComponent name (Maybe a)))
-> PU [Node] (TaggedComponent name (Maybe a))
-> PU [Node] (TaggedComponent name (Maybe a))
forall a b. (a -> b) -> a -> b
$ Name
-> PU [Node] (TaggedComponent name (Maybe a))
-> PU [Node] (TaggedComponent name (Maybe a))
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes (String -> Name
forall a. IsString a => String -> a
fromString (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall {k} (t :: k). Proxy t
Proxy :: Proxy name))) (PU [Node] (TaggedComponent name (Maybe a))
 -> PU [Node] (TaggedComponent name (Maybe a)))
-> PU [Node] (TaggedComponent name (Maybe a))
-> PU [Node] (TaggedComponent name (Maybe a))
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy (AppendSymbol name "TaggedComponent wrapper") -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (AppendSymbol name "TaggedComponent wrapper")
forall {k} (t :: k). Proxy t
Proxy :: Proxy (AppendSymbol name "TaggedComponent wrapper"))), Text
"") (Text, Text)
-> PU [Node] (TaggedComponent name (Maybe a))
-> PU [Node] (TaggedComponent name (Maybe a))
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ((Maybe a -> TaggedComponent name (Maybe a))
-> (TaggedComponent name (Maybe a) -> Maybe a)
-> PU [Node] (Maybe a)
-> PU [Node] (TaggedComponent name (Maybe a))
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
untag ((Text
"inside Tagged", Text
"") (Text, Text) -> PU [Node] (Maybe a) -> PU [Node] (Maybe a)
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> PU [Node] a -> PU [Node] (Maybe a)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption ((Text
"inside option", Text
"") (Text, Text) -> PU [Node] a -> PU [Node] a
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ({-xpMayFail-} PU [Node] a
forall t a. XMLPickler t a => PU t a
xpickle))))

-- | An instance for wrapper components. Don't bother with the wrapper constructor or fieldname; just the wrapped data.
instance {-# OVERLAPPING #-} (KnownSymbol name, XMLPickler [Node] a, Datatype d, ty ~ (M1 D d (M1 C c'' (M1 S c (K1 i a))))) => GXmlPickler [Node] (M1 D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))))) where
  {-# INLINE gxpickleContentsf #-}
  gxpickleContentsf :: forall a.
PU [Node] a
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
gxpickleContentsf PU [Node] a
_ = {-xpElemNodes (fromString . formatElement $ datatypeName (undefined :: ty p))-} Name
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes (String -> Name
forall a. IsString a => String -> a
fromString (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall {k} (t :: k). Proxy t
Proxy :: Proxy name))) (PU
   [Node]
   (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
 -> PU
      [Node]
      (M1
         D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a))
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 D d Any Any -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> String
datatypeName (M1 D d f p
forall {k} {f :: k -> *} {p :: k}. M1 D d f p
forall a. HasCallStack => a
undefined :: M1 D d f p), Text
"") (Text, Text)
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ((Maybe a
 -> M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
-> (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
    -> Maybe a)
-> PU [Node] (Maybe a)
-> PU
     [Node]
     (M1
        D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
 -> M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a)
-> (Maybe a
    -> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a)
-> Maybe a
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S c (K1 i (TaggedComponent name (Maybe a))) a
-> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 S c (K1 i (TaggedComponent name (Maybe a))) a
 -> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a)
-> (Maybe a -> M1 S c (K1 i (TaggedComponent name (Maybe a))) a)
-> Maybe a
-> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i (TaggedComponent name (Maybe a)) a
-> M1 S c (K1 i (TaggedComponent name (Maybe a))) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i (TaggedComponent name (Maybe a)) a
 -> M1 S c (K1 i (TaggedComponent name (Maybe a))) a)
-> (Maybe a -> K1 i (TaggedComponent name (Maybe a)) a)
-> Maybe a
-> M1 S c (K1 i (TaggedComponent name (Maybe a))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedComponent name (Maybe a)
-> K1 i (TaggedComponent name (Maybe a)) a
forall k i c (p :: k). c -> K1 i c p
K1 (TaggedComponent name (Maybe a)
 -> K1 i (TaggedComponent name (Maybe a)) a)
-> (Maybe a -> TaggedComponent name (Maybe a))
-> Maybe a
-> K1 i (TaggedComponent name (Maybe a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged) (TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
unTagged (TaggedComponent name (Maybe a) -> Maybe a)
-> (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
    -> TaggedComponent name (Maybe a))
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i (TaggedComponent name (Maybe a)) a
-> TaggedComponent name (Maybe a)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 i (TaggedComponent name (Maybe a)) a
 -> TaggedComponent name (Maybe a))
-> (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
    -> K1 i (TaggedComponent name (Maybe a)) a)
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
-> TaggedComponent name (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S c (K1 i (TaggedComponent name (Maybe a))) a
-> K1 i (TaggedComponent name (Maybe a)) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S c (K1 i (TaggedComponent name (Maybe a))) a
 -> K1 i (TaggedComponent name (Maybe a)) a)
-> (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
    -> M1 S c (K1 i (TaggedComponent name (Maybe a))) a)
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
-> K1 i (TaggedComponent name (Maybe a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
-> M1 S c (K1 i (TaggedComponent name (Maybe a))) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
 -> M1 S c (K1 i (TaggedComponent name (Maybe a))) a)
-> (M1
      D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
    -> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a)
-> M1
     D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
-> M1 S c (K1 i (TaggedComponent name (Maybe a))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1
  D d (M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a))))) a
-> M1 C c'' (M1 S c (K1 i (TaggedComponent name (Maybe a)))) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) (PU [Node] a -> PU [Node] (Maybe a)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption ({-xpMayFail-} PU [Node] a
forall t a. XMLPickler t a => PU t a
xpickle)))

-- | The core mechanics of the higher-kinded representation for the ECS system.
type family Field (name :: Symbol) (acc :: Access) (p :: Props) (a :: Type) :: Type where
  Field name Individual Required a = TaggedComponent name a
  Field name Individual Normal a = TaggedComponent name (Maybe a)
  Field name Individual Unique a = TaggedComponent name (Maybe a)
  Field name Storing Unique a = TaggedComponent name (UniqueStore a)
  Field name Storing Required a = TaggedComponent name (Storage a a)
  Field name Storing Normal a = TaggedComponent name (Storage a a)

instance {-# OVERLAPS #-} (Show a) => Show (TaggedComponent (name :: Symbol) (Maybe a)) where
  show :: TaggedComponent name (Maybe a) -> String
show (Tagged Maybe a
Nothing) = String
""
  show (Tagged (Just a
a)) = a -> String
forall a. Show a => a -> String
show a
a

-- | Plumbing class for a higher-kinded data representation of a game world.
-- | Generalisation of "Array of Structures" vs "Structure of Arrays".
class {-((CompTypeClass name a {- ,(CompTypeClassFun name a) ~ (CompType' name hkd acc p a)-})) => -} EntityProperty (name :: Symbol) (hkd :: Access -> Type) (acc :: Access) (p :: Props) (a :: Type) where
  accessor :: OpticsFor name hkd acc p a
  injectToField :: (acc ~ Individual) => a -> Field name Individual p a
  maybeGet :: (acc ~ Individual) => Field name Individual p a -> Maybe a
  {-# INLINE CONLIKE injectMaybe #-}
  injectMaybe :: (acc ~ Individual) => Maybe a -> Field name Individual p a
  injectMaybe (Just a
a) = forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Individual) =>
a -> Field name 'Individual p a
injectToField @name @hkd @acc @p @a a
a
  injectMaybe Maybe a
Nothing = forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Individual) =>
Field name 'Individual p a
defaultField @name @hkd @acc @p @a

  defaultField :: (acc ~ Individual) => Field name Individual p a
  defaultStorage :: (acc ~ Storing) => Field name Storing p a
  storage :: (acc ~ Storing) => Lens' (hkd acc) (Storage a a)

instance forall name hkd a. (HasType (Field name Individual Required a) (hkd Individual), World hkd, Component a, Prop a ~ Required) => EntityProperty name hkd Individual Required a where
  {-# INLINE CONLIKE injectToField #-}
  {-# INLINE CONLIKE maybeGet #-}
  {-# INLINE CONLIKE defaultField #-}
  {-# INLINE CONLIKE accessor #-}
  injectToField :: ('Individual ~ 'Individual) =>
a -> Field name 'Individual 'Required a
injectToField = a -> Field name 'Individual 'Required a
a -> TaggedComponent name a
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged
  defaultStorage :: ('Individual ~ 'Storing) => Field name 'Storing 'Required a
defaultStorage = String -> TaggedComponent name (Storage a a)
forall a. HasCallStack => String -> a
error String
"what"
  maybeGet :: ('Individual ~ 'Individual) =>
Field name 'Individual 'Required a -> Maybe a
maybeGet = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> (TaggedComponent name a -> a)
-> TaggedComponent name a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedComponent name a -> a
forall {k} (name :: k) a. TaggedComponent name a -> a
untag
  storage :: ('Individual ~ 'Storing) => Lens' (hkd 'Individual) (Storage a a)
storage = String
-> (Storage a a -> f (Storage a a))
-> hkd 'Individual
-> f (hkd 'Individual)
forall a. HasCallStack => String -> a
error String
"what"
  defaultField :: ('Individual ~ 'Individual) => Field name 'Individual 'Required a
defaultField = forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Individual) =>
a -> Field name 'Individual p a
injectToField @name @hkd @Individual @Required @a a
forall c. (Component c, Prop c ~ 'Required) => c
defaultValue
  accessor :: OpticsFor name hkd 'Individual 'Required a
accessor =
    IndexedLens Entity (hkd 'Individual) (hkd 'Individual) a a
-> ReifiedIndexedLens
     Entity (hkd 'Individual) (hkd 'Individual) a a
forall i s t a b.
IndexedLens i s t a b -> ReifiedIndexedLens i s t a b
IndexedLens
      ( ((p ~ (->)) =>
 (a -> f a) -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a) -> hkd 'Individual -> f (hkd 'Individual))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (((hkd 'Individual -> TaggedComponent name a)
-> (hkd 'Individual -> TaggedComponent name a -> hkd 'Individual)
-> Lens
     (hkd 'Individual)
     (hkd 'Individual)
     (TaggedComponent name a)
     (TaggedComponent name a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name a)) (\(hkd 'Individual
s :: hkd Individual) (TaggedComponent name a
a :: TaggedComponent name a) -> TaggedComponent name a -> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped TaggedComponent name a
a hkd 'Individual
s)) ((TaggedComponent name a -> f (TaggedComponent name a))
 -> hkd 'Individual -> f (hkd 'Individual))
-> ((a -> f a)
    -> TaggedComponent name a -> f (TaggedComponent name a))
-> (a -> f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> TaggedComponent name a -> f (TaggedComponent name a)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (TaggedComponent name a) (TaggedComponent name a) a a
coerced) (((hkd 'Individual -> (Entity, TaggedComponent name a))
-> (hkd 'Individual -> TaggedComponent name a -> hkd 'Individual)
-> IndexedLens
     Entity
     (hkd 'Individual)
     (hkd 'Individual)
     (TaggedComponent name a)
     (TaggedComponent name a)
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b
ilens hkd 'Individual -> (Entity, Field name 'Individual 'Required a)
hkd 'Individual -> (Entity, TaggedComponent name a)
getter (\(hkd 'Individual
s :: hkd Individual) (TaggedComponent name a
a :: TaggedComponent name a) -> TaggedComponent name a -> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped TaggedComponent name a
a hkd 'Individual
s)) (p (TaggedComponent name a) (f (TaggedComponent name a))
 -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a)
    -> p (TaggedComponent name a) (f (TaggedComponent name a)))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a)
-> p (TaggedComponent name a) (f (TaggedComponent name a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (TaggedComponent name a) (TaggedComponent name a) a a
coerced)
      )
    where
      getter :: hkd Individual -> (Entity, Field name Individual Required a)
      getter :: hkd 'Individual -> (Entity, Field name 'Individual 'Required a)
getter hkd 'Individual
s = (hkd 'Individual
s hkd 'Individual
-> Getting Entity (hkd 'Individual) Entity -> Entity
forall s a. s -> Getting a s a -> a
^. Getting Entity (hkd 'Individual) Entity
IndexedGetter Entity (hkd 'Individual) Entity
forall (w :: Access -> *).
World w =>
IndexedGetter Entity (w 'Individual) Entity
entityReference, (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name a)) (hkd 'Individual -> TaggedComponent name a)
-> hkd 'Individual -> TaggedComponent name a
forall a b. (a -> b) -> a -> b
$ hkd 'Individual
s)

{-{-# RULES "component/set . get" forall w. set accessor (view accessor w) w = w #-}

{-# RULES "component/set . get" forall v w. view accessor (set accessor v w) = v #-}-}

instance forall name hkd a. (HasType (Field name Individual Normal a) (hkd Individual), World hkd, Component a) => EntityProperty name hkd Individual Normal a where
  {-# INLINE CONLIKE injectToField #-}
  {-# INLINE CONLIKE maybeGet #-}
  {-# INLINE CONLIKE defaultField #-}
  {-# INLINE CONLIKE accessor #-}
  injectToField :: ('Individual ~ 'Individual) =>
a -> Field name 'Individual 'Normal a
injectToField = Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged (Maybe a -> TaggedComponent name (Maybe a))
-> (a -> Maybe a) -> a -> TaggedComponent name (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
  maybeGet :: ('Individual ~ 'Individual) =>
Field name 'Individual 'Normal a -> Maybe a
maybeGet = Field name 'Individual 'Normal a -> Maybe a
TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
untag
  defaultField :: ('Individual ~ 'Individual) => Field name 'Individual 'Normal a
defaultField = Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged Maybe a
forall a. Maybe a
Nothing
  defaultStorage :: ('Individual ~ 'Storing) => Field name 'Storing 'Normal a
defaultStorage = String -> TaggedComponent name (Storage a a)
forall a. HasCallStack => String -> a
error String
"what"
  storage :: ('Individual ~ 'Storing) => Lens' (hkd 'Individual) (Storage a a)
storage = String
-> (Storage a a -> f (Storage a a))
-> hkd 'Individual
-> f (hkd 'Individual)
forall a. HasCallStack => String -> a
error String
"what"
  accessor :: OpticsFor name hkd 'Individual 'Normal a
accessor =
    IndexedTraversal Entity (hkd 'Individual) (hkd 'Individual) a a
-> ReifiedIndexedTraversal
     Entity (hkd 'Individual) (hkd 'Individual) a a
forall i s t a b.
IndexedTraversal i s t a b -> ReifiedIndexedTraversal i s t a b
IndexedTraversal (IndexedTraversal Entity (hkd 'Individual) (hkd 'Individual) a a
 -> ReifiedIndexedTraversal
      Entity (hkd 'Individual) (hkd 'Individual) a a)
-> IndexedTraversal Entity (hkd 'Individual) (hkd 'Individual) a a
-> ReifiedIndexedTraversal
     Entity (hkd 'Individual) (hkd 'Individual) a a
forall a b. (a -> b) -> a -> b
$
      (((p ~ (->)) =>
 (a -> f a) -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a) -> hkd 'Individual -> f (hkd 'Individual))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (((hkd 'Individual -> Maybe a)
-> (hkd 'Individual -> Maybe a -> hkd 'Individual)
-> Lens (hkd 'Individual) (hkd 'Individual) (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
unTagged (TaggedComponent name (Maybe a) -> Maybe a)
-> (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hkd 'Individual -> Field name 'Individual 'Normal a
hkd 'Individual -> TaggedComponent name (Maybe a)
boringGetter) (\(hkd 'Individual
s :: hkd Individual) (Maybe a
a :: Maybe a) -> TaggedComponent name (Maybe a)
-> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped (forall {k} (name :: k) a. a -> TaggedComponent name a
forall (name :: Symbol) a. a -> TaggedComponent name a
Tagged @name Maybe a
a) hkd 'Individual
s)) ((Maybe a -> f (Maybe a))
 -> hkd 'Individual -> f (hkd 'Individual))
-> ((a -> f a) -> Maybe a -> f (Maybe a))
-> (a -> f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> Maybe a -> f (Maybe a)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (((hkd 'Individual -> (Entity, TaggedComponent name (Maybe a)))
-> (hkd 'Individual
    -> TaggedComponent name (Maybe a) -> hkd 'Individual)
-> IndexedLens
     Entity
     (hkd 'Individual)
     (hkd 'Individual)
     (TaggedComponent name (Maybe a))
     (TaggedComponent name (Maybe a))
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b
ilens hkd 'Individual -> (Entity, Field name 'Individual 'Normal a)
hkd 'Individual -> (Entity, TaggedComponent name (Maybe a))
getter (\(hkd 'Individual
s :: hkd Individual) (TaggedComponent name (Maybe a)
a :: TaggedComponent name (Maybe a)) -> TaggedComponent name (Maybe a)
-> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped TaggedComponent name (Maybe a)
a hkd 'Individual
s)) (p (TaggedComponent name (Maybe a))
   (f (TaggedComponent name (Maybe a)))
 -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a)
    -> p (TaggedComponent name (Maybe a))
         (f (TaggedComponent name (Maybe a))))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p (Maybe a) (f (Maybe a))
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
forall {p :: * -> * -> *} {f :: * -> *}.
(Profunctor p, Functor f) =>
p (Maybe a) (f (Maybe a))
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
coerced :: Iso' (TaggedComponent name (Maybe a)) (Maybe a)) (p (Maybe a) (f (Maybe a))
 -> p (TaggedComponent name (Maybe a))
      (f (TaggedComponent name (Maybe a))))
-> (p a (f a) -> p (Maybe a) (f (Maybe a)))
-> p a (f a)
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a) -> p (Maybe a) (f (Maybe a))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just))
    where
      boringGetter :: hkd Individual -> Field name Individual Normal a
      boringGetter :: hkd 'Individual -> Field name 'Individual 'Normal a
boringGetter hkd 'Individual
s = (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name (Maybe a))) (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual -> TaggedComponent name (Maybe a)
forall a b. (a -> b) -> a -> b
$ hkd 'Individual
s
      getter :: hkd Individual -> (Entity, Field name Individual Normal a)
      getter :: hkd 'Individual -> (Entity, Field name 'Individual 'Normal a)
getter hkd 'Individual
s = (hkd 'Individual
s hkd 'Individual
-> Getting Entity (hkd 'Individual) Entity -> Entity
forall s a. s -> Getting a s a -> a
^. Getting Entity (hkd 'Individual) Entity
IndexedGetter Entity (hkd 'Individual) Entity
forall (w :: Access -> *).
World w =>
IndexedGetter Entity (w 'Individual) Entity
entityReference, (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name (Maybe a))) (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual -> TaggedComponent name (Maybe a)
forall a b. (a -> b) -> a -> b
$ hkd 'Individual
s)

instance forall name hkd a. (HasType (Field name Individual Unique a) (hkd Individual), World hkd, Component a) => EntityProperty name hkd Individual Unique a where
  {-# INLINE CONLIKE injectToField #-}
  {-# INLINE CONLIKE maybeGet #-}
  {-# INLINE CONLIKE defaultField #-}
  {-# INLINE CONLIKE accessor #-}
  injectToField :: ('Individual ~ 'Individual) =>
a -> Field name 'Individual 'Unique a
injectToField = Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged (Maybe a -> TaggedComponent name (Maybe a))
-> (a -> Maybe a) -> a -> TaggedComponent name (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
  maybeGet :: ('Individual ~ 'Individual) =>
Field name 'Individual 'Unique a -> Maybe a
maybeGet = Field name 'Individual 'Unique a -> Maybe a
TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
untag
  storage :: ('Individual ~ 'Storing) => Lens' (hkd 'Individual) (Storage a a)
storage = String
-> (Storage a a -> f (Storage a a))
-> hkd 'Individual
-> f (hkd 'Individual)
forall a. HasCallStack => String -> a
error String
"what"
  defaultStorage :: ('Individual ~ 'Storing) => Field name 'Storing 'Unique a
defaultStorage = String -> TaggedComponent name (UniqueStore a)
forall a. HasCallStack => String -> a
error String
"what"
  defaultField :: ('Individual ~ 'Individual) => Field name 'Individual 'Unique a
defaultField = Maybe a -> TaggedComponent name (Maybe a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged Maybe a
forall a. Maybe a
Nothing
  accessor :: OpticsFor name hkd 'Individual 'Unique a
accessor =
    IndexedTraversal Entity (hkd 'Individual) (hkd 'Individual) a a
-> ReifiedIndexedTraversal
     Entity (hkd 'Individual) (hkd 'Individual) a a
forall i s t a b.
IndexedTraversal i s t a b -> ReifiedIndexedTraversal i s t a b
IndexedTraversal
      (((p ~ (->)) =>
 (a -> f a) -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a) -> hkd 'Individual -> f (hkd 'Individual))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (((hkd 'Individual -> Maybe a)
-> (hkd 'Individual -> Maybe a -> hkd 'Individual)
-> Lens (hkd 'Individual) (hkd 'Individual) (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (TaggedComponent name (Maybe a) -> Maybe a
forall {k} (name :: k) a. TaggedComponent name a -> a
unTagged (TaggedComponent name (Maybe a) -> Maybe a)
-> (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hkd 'Individual -> Field name 'Individual 'Normal a
hkd 'Individual -> TaggedComponent name (Maybe a)
boringGetter) (\(hkd 'Individual
s :: hkd Individual) (Maybe a
a :: Maybe a) -> TaggedComponent name (Maybe a)
-> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped (forall {k} (name :: k) a. a -> TaggedComponent name a
forall (name :: Symbol) a. a -> TaggedComponent name a
Tagged @name Maybe a
a) hkd 'Individual
s)) ((Maybe a -> f (Maybe a))
 -> hkd 'Individual -> f (hkd 'Individual))
-> ((a -> f a) -> Maybe a -> f (Maybe a))
-> (a -> f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> Maybe a -> f (Maybe a)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (((hkd 'Individual -> (Entity, TaggedComponent name (Maybe a)))
-> (hkd 'Individual
    -> TaggedComponent name (Maybe a) -> hkd 'Individual)
-> IndexedLens
     Entity
     (hkd 'Individual)
     (hkd 'Individual)
     (TaggedComponent name (Maybe a))
     (TaggedComponent name (Maybe a))
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b
ilens hkd 'Individual -> (Entity, Field name 'Individual 'Unique a)
hkd 'Individual -> (Entity, TaggedComponent name (Maybe a))
getter (\(hkd 'Individual
s :: hkd Individual) (TaggedComponent name (Maybe a)
a :: TaggedComponent name (Maybe a)) -> TaggedComponent name (Maybe a)
-> hkd 'Individual -> hkd 'Individual
forall a s. HasType a s => a -> s -> s
setTyped TaggedComponent name (Maybe a)
a hkd 'Individual
s)) (p (TaggedComponent name (Maybe a))
   (f (TaggedComponent name (Maybe a)))
 -> hkd 'Individual -> f (hkd 'Individual))
-> (p a (f a)
    -> p (TaggedComponent name (Maybe a))
         (f (TaggedComponent name (Maybe a))))
-> p a (f a)
-> hkd 'Individual
-> f (hkd 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p (Maybe a) (f (Maybe a))
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
forall {p :: * -> * -> *} {f :: * -> *}.
(Profunctor p, Functor f) =>
p (Maybe a) (f (Maybe a))
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
coerced :: Iso' (TaggedComponent name (Maybe a)) (Maybe a)) (p (Maybe a) (f (Maybe a))
 -> p (TaggedComponent name (Maybe a))
      (f (TaggedComponent name (Maybe a))))
-> (p a (f a) -> p (Maybe a) (f (Maybe a)))
-> p a (f a)
-> p (TaggedComponent name (Maybe a))
     (f (TaggedComponent name (Maybe a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a) -> p (Maybe a) (f (Maybe a))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just))
    where
      getter :: hkd Individual -> (Entity, Field name Individual Unique a)
      getter :: hkd 'Individual -> (Entity, Field name 'Individual 'Unique a)
getter hkd 'Individual
s = (hkd 'Individual
s hkd 'Individual
-> Getting Entity (hkd 'Individual) Entity -> Entity
forall s a. s -> Getting a s a -> a
^. Getting Entity (hkd 'Individual) Entity
IndexedGetter Entity (hkd 'Individual) Entity
forall (w :: Access -> *).
World w =>
IndexedGetter Entity (w 'Individual) Entity
entityReference, (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name (Maybe a))) (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual -> TaggedComponent name (Maybe a)
forall a b. (a -> b) -> a -> b
$ hkd 'Individual
s)
      boringGetter :: hkd Individual -> Field name Individual Normal a
      boringGetter :: hkd 'Individual -> Field name 'Individual 'Normal a
boringGetter hkd 'Individual
s = (forall a s. HasType a s => s -> a
getTyped @(TaggedComponent name (Maybe a))) (hkd 'Individual -> TaggedComponent name (Maybe a))
-> hkd 'Individual -> TaggedComponent name (Maybe a)
forall a b. (a -> b) -> a -> b
$ hkd 'Individual
s

instance
  {-# OVERLAPPABLE #-}
  ( OpticsFor name hkd 'Storing prop a
      ~ ReifiedIndexedTraversal' Entity (hkd 'Storing) a,
    HasType (Field name Storing prop a) (hkd Storing),
    EntityIndexedTraversable (Storage a) a,
    World hkd,
    Component a,
    Coercible (Field name 'Storing prop a) (Storage a a),
    (Field name 'Storing prop a ~ TaggedComponent name (Storage a a))
  ) =>
  EntityProperty name hkd Storing prop a
  where
  {-# INLINE CONLIKE injectToField #-}
  {-# INLINE CONLIKE accessor #-}
  {-# INLINE CONLIKE storage #-}
  injectToField :: ('Storing ~ 'Individual) => a -> Field name 'Individual prop a
injectToField = String -> a -> Field name 'Individual prop a
forall a. HasCallStack => String -> a
error String
"what"
  maybeGet :: ('Storing ~ 'Individual) =>
Field name 'Individual prop a -> Maybe a
maybeGet = String -> Field name 'Individual prop a -> Maybe a
forall a. HasCallStack => String -> a
error String
"what"
  defaultField :: ('Storing ~ 'Individual) => Field name 'Individual prop a
defaultField = String -> Field name 'Individual prop a
forall a. HasCallStack => String -> a
error String
"what"
  defaultStorage :: ('Storing ~ 'Storing) => Field name 'Storing prop a
defaultStorage = Storage a a -> TaggedComponent name (Storage a a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged (forall c. Component c => Storage c c
emptyStorage @a) :: TaggedComponent name ((Storage a) a)
  storage :: ('Storing ~ 'Storing) => Lens' (hkd 'Storing) (Storage a a)
storage = (Storage a a -> f (Storage a a))
-> hkd 'Storing -> f (hkd 'Storing)
Lens' (hkd 'Storing) (Storage a a)
unwrappedField
    where
      taggedStorageField :: Lens' (hkd Storing) (Field name Storing prop a)
      taggedStorageField :: Lens' (hkd 'Storing) (Field name 'Storing prop a)
taggedStorageField = (forall a s. HasType a s => Lens' s a
typed @(Field name Storing prop a) @(hkd Storing))
      unwrappedField :: Lens' (hkd Storing) (Storage a a)
      unwrappedField :: Lens' (hkd 'Storing) (Storage a a)
unwrappedField = ((Field name 'Storing prop a -> f (Field name 'Storing prop a))
-> hkd 'Storing -> f (hkd 'Storing)
(TaggedComponent name (Storage a a)
 -> f (TaggedComponent name (Storage a a)))
-> hkd 'Storing -> f (hkd 'Storing)
Lens' (hkd 'Storing) (Field name 'Storing prop a)
taggedStorageField ((TaggedComponent name (Storage a a)
  -> f (TaggedComponent name (Storage a a)))
 -> hkd 'Storing -> f (hkd 'Storing))
-> ((Storage a a -> f (Storage a a))
    -> TaggedComponent name (Storage a a)
    -> f (TaggedComponent name (Storage a a)))
-> (Storage a a -> f (Storage a a))
-> hkd 'Storing
-> f (hkd 'Storing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Storage a a -> f (Storage a a))
-> TaggedComponent name (Storage a a)
-> f (TaggedComponent name (Storage a a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso
  (TaggedComponent name (Storage a a))
  (TaggedComponent name (Storage a a))
  (Storage a a)
  (Storage a a)
coerced)
  accessor :: OpticsFor name hkd 'Storing prop a
accessor = forall i s t a b.
IndexedTraversal i s t a b -> ReifiedIndexedTraversal i s t a b
IndexedTraversal @Entity (forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Storing) =>
Lens' (hkd acc) (Storage a a)
storage @name @hkd @Storing @prop @a ((Storage a a -> f (Storage a a))
 -> hkd 'Storing -> f (hkd 'Storing))
-> (p a (f a) -> Storage a a -> f (Storage a a))
-> p a (f a)
-> hkd 'Storing
-> f (hkd 'Storing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.> p a (f a) -> Storage a a -> f (Storage a a)
forall (t :: * -> *) c.
EntityIndexedTraversable t c =>
IndexedTraversal' Entity (t c) c
IndexedTraversal' Entity (Storage a a) a
entitiesTraversed)

instance {-# OVERLAPPING #-} (Storage a a ~ UniqueStore a, HasType (Field name Storing Unique a) (hkd Storing), World hkd, Component a) => EntityProperty name hkd Storing Unique a where
  {-# INLINE CONLIKE injectToField #-}
  {-# INLINE CONLIKE accessor #-}
  {-# INLINE CONLIKE storage #-}
  injectToField :: ('Storing ~ 'Individual) => a -> Field name 'Individual 'Unique a
injectToField = String -> a -> TaggedComponent name (Maybe a)
forall a. HasCallStack => String -> a
error String
"what"
  maybeGet :: ('Storing ~ 'Individual) =>
Field name 'Individual 'Unique a -> Maybe a
maybeGet = String -> TaggedComponent name (Maybe a) -> Maybe a
forall a. HasCallStack => String -> a
error String
"what"
  defaultField :: ('Storing ~ 'Individual) => Field name 'Individual 'Unique a
defaultField = String -> TaggedComponent name (Maybe a)
forall a. HasCallStack => String -> a
error String
"what"
  defaultStorage :: ('Storing ~ 'Storing) => Field name 'Storing 'Unique a
defaultStorage = UniqueStore a -> TaggedComponent name (UniqueStore a)
forall {k} (name :: k) a. a -> TaggedComponent name a
Tagged (Maybe (Entity, a) -> UniqueStore a
forall a. Maybe (Entity, a) -> UniqueStore a
UniqueStore Maybe (Entity, a)
forall a. Maybe a
Nothing)
  storage :: ('Storing ~ 'Storing) => Lens' (hkd 'Storing) (Storage a a)
storage = (UniqueStore a -> f (UniqueStore a))
-> hkd 'Storing -> f (hkd 'Storing)
(Storage a a -> f (Storage a a))
-> hkd 'Storing -> f (hkd 'Storing)
Lens' (hkd 'Storing) (UniqueStore a)
unwrappedField
    where
      taggedStorageField :: Lens' (hkd Storing) (Field name Storing Unique a)
      taggedStorageField :: Lens' (hkd 'Storing) (Field name 'Storing 'Unique a)
taggedStorageField = (forall a s. HasType a s => Lens' s a
typed @(Field name Storing Unique a) @(hkd Storing))
      unwrappedField :: Lens' (hkd Storing) (UniqueStore a)
      unwrappedField :: Lens' (hkd 'Storing) (UniqueStore a)
unwrappedField = ((Field name 'Storing 'Unique a
 -> f (Field name 'Storing 'Unique a))
-> hkd 'Storing -> f (hkd 'Storing)
(TaggedComponent name (UniqueStore a)
 -> f (TaggedComponent name (UniqueStore a)))
-> hkd 'Storing -> f (hkd 'Storing)
Lens' (hkd 'Storing) (Field name 'Storing 'Unique a)
taggedStorageField ((TaggedComponent name (UniqueStore a)
  -> f (TaggedComponent name (UniqueStore a)))
 -> hkd 'Storing -> f (hkd 'Storing))
-> ((UniqueStore a -> f (UniqueStore a))
    -> TaggedComponent name (UniqueStore a)
    -> f (TaggedComponent name (UniqueStore a)))
-> (UniqueStore a -> f (UniqueStore a))
-> hkd 'Storing
-> f (hkd 'Storing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueStore a -> f (UniqueStore a))
-> TaggedComponent name (UniqueStore a)
-> f (TaggedComponent name (UniqueStore a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso
  (TaggedComponent name (UniqueStore a))
  (TaggedComponent name (UniqueStore a))
  (UniqueStore a)
  (UniqueStore a)
coerced)
  accessor :: OpticsFor name hkd 'Storing 'Unique a
accessor =
    forall i s t a b.
IndexedTraversal i s t a b -> ReifiedIndexedTraversal i s t a b
IndexedTraversal @Entity
      ( ((p ~ (->)) => (a -> f a) -> hkd 'Storing -> f (hkd 'Storing))
-> (p a (f a) -> hkd 'Storing -> f (hkd 'Storing))
-> p a (f a)
-> hkd 'Storing
-> f (hkd 'Storing)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
forall (q :: * -> * -> *) a b r.
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
          (forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Storing) =>
Lens' (hkd acc) (Storage a a)
storage @name @hkd @Storing @Unique @a ((UniqueStore a -> f (UniqueStore a))
 -> hkd 'Storing -> f (hkd 'Storing))
-> ((a -> f a) -> UniqueStore a -> f (UniqueStore a))
-> (a -> f a)
-> hkd 'Storing
-> f (hkd 'Storing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
forall {p :: * -> * -> *} {f :: * -> *}.
(Profunctor p, Functor f) =>
p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
coerced :: Iso' (UniqueStore a) (Maybe (Entity, a))) ((Maybe (Entity, a) -> f (Maybe (Entity, a)))
 -> UniqueStore a -> f (UniqueStore a))
-> ((a -> f a) -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> (a -> f a)
-> UniqueStore a
-> f (UniqueStore a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity, a) -> f (Entity, a))
-> Maybe (Entity, a) -> f (Maybe (Entity, a))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Entity, a) -> f (Entity, a))
 -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> ((a -> f a) -> (Entity, a) -> f (Entity, a))
-> (a -> f a)
-> Maybe (Entity, a)
-> f (Maybe (Entity, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (Entity, a) -> f (Entity, a)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal Int (Entity, a) (Entity, a) a a
traversed)
          ((forall (name :: Symbol) (hkd :: Access -> *) (acc :: Access)
       (p :: Props) a.
(EntityProperty name hkd acc p a, acc ~ 'Storing) =>
Lens' (hkd acc) (Storage a a)
storage @name @hkd @Storing @Unique @a :: Lens' (hkd Storing) (UniqueStore a)) ((UniqueStore a -> f (UniqueStore a))
 -> hkd 'Storing -> f (hkd 'Storing))
-> (p a (f a) -> UniqueStore a -> f (UniqueStore a))
-> p a (f a)
-> hkd 'Storing
-> f (hkd 'Storing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
forall {p :: * -> * -> *} {f :: * -> *}.
(Profunctor p, Functor f) =>
p (Maybe (Entity, a)) (f (Maybe (Entity, a)))
-> p (UniqueStore a) (f (UniqueStore a))
coerced :: Iso' (UniqueStore a) (Maybe (Entity, a))) ((Maybe (Entity, a) -> f (Maybe (Entity, a)))
 -> UniqueStore a -> f (UniqueStore a))
-> (p a (f a) -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> p a (f a)
-> UniqueStore a
-> f (UniqueStore a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity, a) -> f (Entity, a))
-> Maybe (Entity, a) -> f (Maybe (Entity, a))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Entity, a) -> f (Entity, a))
 -> Maybe (Entity, a) -> f (Maybe (Entity, a)))
-> (p a (f a) -> (Entity, a) -> f (Entity, a))
-> p a (f a)
-> Maybe (Entity, a)
-> f (Maybe (Entity, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.> p a (f a) -> (Entity, a) -> f (Entity, a)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
IndexedTraversal Entity (Entity, a) (Entity, a) a a
itraversed)
      )