{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :  Games.ECS.Prototype
-- Description : Prototype definitions
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- Prototypes are exemplar individuals which form a template.
module Games.ECS.Prototype (module Games.ECS.Prototype, module Games.ECS.Prototype.PrototypeID) where


import Control.Lens

--import Data.Coerce

--import Data.Ix
--import Data.Vector.Unboxed.Deriving
import GHC.Generics
import Games.ECS.Serialisation
import Games.ECS.Prototype.PrototypeID
import Games.ECS.Component.TH
import Games.ECS.Component

-- | A component for denoting that an individual is a prototype, to be instantiated later.
data IsPrototype = IsPrototype
  { -- | The t'PrototypeID'.
    IsPrototype -> PrototypeID
_rawIsPrototypeID :: !PrototypeID,
    -- | Indicates that this extends --- and overrides, in case of conflicting values --- another prototype.
    IsPrototype -> Maybe PrototypeID
_extendsPrototype :: Maybe PrototypeID
  }
  deriving stock (IsPrototype -> IsPrototype -> Bool
(IsPrototype -> IsPrototype -> Bool)
-> (IsPrototype -> IsPrototype -> Bool) -> Eq IsPrototype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsPrototype -> IsPrototype -> Bool
== :: IsPrototype -> IsPrototype -> Bool
$c/= :: IsPrototype -> IsPrototype -> Bool
/= :: IsPrototype -> IsPrototype -> Bool
Eq, (forall x. IsPrototype -> Rep IsPrototype x)
-> (forall x. Rep IsPrototype x -> IsPrototype)
-> Generic IsPrototype
forall x. Rep IsPrototype x -> IsPrototype
forall x. IsPrototype -> Rep IsPrototype x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsPrototype -> Rep IsPrototype x
from :: forall x. IsPrototype -> Rep IsPrototype x
$cto :: forall x. Rep IsPrototype x -> IsPrototype
to :: forall x. Rep IsPrototype x -> IsPrototype
Generic, Int -> IsPrototype -> ShowS
[IsPrototype] -> ShowS
IsPrototype -> String
(Int -> IsPrototype -> ShowS)
-> (IsPrototype -> String)
-> ([IsPrototype] -> ShowS)
-> Show IsPrototype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsPrototype -> ShowS
showsPrec :: Int -> IsPrototype -> ShowS
$cshow :: IsPrototype -> String
show :: IsPrototype -> String
$cshowList :: [IsPrototype] -> ShowS
showList :: [IsPrototype] -> ShowS
Show)

makeLenses ''IsPrototype

instance HasPrototypeID IsPrototype where
  {-# INLINE prototypeID #-}
  prototypeID :: Lens' IsPrototype PrototypeID
prototypeID = (PrototypeID -> f PrototypeID) -> IsPrototype -> f IsPrototype
Lens' IsPrototype PrototypeID
rawIsPrototypeID

instance {-# OVERLAPS #-} XMLPickler [Node] IsPrototype where
  {-# INLINE xpickle #-}
  xpickle :: PU [Node] IsPrototype
xpickle =
    ((PrototypeID, Maybe PrototypeID) -> IsPrototype)
-> (IsPrototype -> (PrototypeID, Maybe PrototypeID))
-> PU [Node] (PrototypeID, Maybe PrototypeID)
-> PU [Node] IsPrototype
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
      (\(PrototypeID
pid, Maybe PrototypeID
epid) -> PrototypeID -> Maybe PrototypeID -> IsPrototype
IsPrototype PrototypeID
pid Maybe PrototypeID
epid)
      (\(IsPrototype PrototypeID
pid Maybe PrototypeID
epid) -> (PrototypeID
pid, Maybe PrototypeID
epid))
      ( Name
-> PU [Attribute] (PrototypeID, Maybe PrototypeID)
-> PU [Node] (PrototypeID, Maybe PrototypeID)
forall b. Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs
          Name
"prototype"
          ( PU [Attribute] PrototypeID
-> PU [Attribute] (Maybe PrototypeID)
-> PU [Attribute] (PrototypeID, Maybe PrototypeID)
forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xpPair
              (Name -> PU [Attribute] PrototypeID
forall a. XMLPickleAsAttribute a => Name -> PU [Attribute] a
pickleAsAttribute Name
"prototypeID")
              (Name -> PU [Attribute] (Maybe PrototypeID)
forall a. XMLPickleAsAttribute a => Name -> PU [Attribute] a
pickleAsAttribute Name
"extends")
          )
      )

instance Component IsPrototype where
  type CanonicalName IsPrototype = "isPrototype"


makeHasComponentClass ''IsPrototype