{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.App.Schedules where

import Data.Data
import Data.Default
import Data.Map (Map)
import Data.Map qualified as Map
import GHC.Generics
import Mischief.ECS.Components
import Mischief.ECS.Entities
import Mischief.ECS.Resources
import Mischief.ECS.World
import Mischief.ECS.World.Spawn

newtype ScheduleLabel = ScheduleLabel {ScheduleLabel -> TypeRep
rep :: TypeRep}
  deriving stock (ScheduleLabel -> ScheduleLabel -> Bool
(ScheduleLabel -> ScheduleLabel -> Bool)
-> (ScheduleLabel -> ScheduleLabel -> Bool) -> Eq ScheduleLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleLabel -> ScheduleLabel -> Bool
== :: ScheduleLabel -> ScheduleLabel -> Bool
$c/= :: ScheduleLabel -> ScheduleLabel -> Bool
/= :: ScheduleLabel -> ScheduleLabel -> Bool
Eq, Eq ScheduleLabel
Eq ScheduleLabel =>
(ScheduleLabel -> ScheduleLabel -> Ordering)
-> (ScheduleLabel -> ScheduleLabel -> Bool)
-> (ScheduleLabel -> ScheduleLabel -> Bool)
-> (ScheduleLabel -> ScheduleLabel -> Bool)
-> (ScheduleLabel -> ScheduleLabel -> Bool)
-> (ScheduleLabel -> ScheduleLabel -> ScheduleLabel)
-> (ScheduleLabel -> ScheduleLabel -> ScheduleLabel)
-> Ord ScheduleLabel
ScheduleLabel -> ScheduleLabel -> Bool
ScheduleLabel -> ScheduleLabel -> Ordering
ScheduleLabel -> ScheduleLabel -> ScheduleLabel
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
$ccompare :: ScheduleLabel -> ScheduleLabel -> Ordering
compare :: ScheduleLabel -> ScheduleLabel -> Ordering
$c< :: ScheduleLabel -> ScheduleLabel -> Bool
< :: ScheduleLabel -> ScheduleLabel -> Bool
$c<= :: ScheduleLabel -> ScheduleLabel -> Bool
<= :: ScheduleLabel -> ScheduleLabel -> Bool
$c> :: ScheduleLabel -> ScheduleLabel -> Bool
> :: ScheduleLabel -> ScheduleLabel -> Bool
$c>= :: ScheduleLabel -> ScheduleLabel -> Bool
>= :: ScheduleLabel -> ScheduleLabel -> Bool
$cmax :: ScheduleLabel -> ScheduleLabel -> ScheduleLabel
max :: ScheduleLabel -> ScheduleLabel -> ScheduleLabel
$cmin :: ScheduleLabel -> ScheduleLabel -> ScheduleLabel
min :: ScheduleLabel -> ScheduleLabel -> ScheduleLabel
Ord, Int -> ScheduleLabel -> ShowS
[ScheduleLabel] -> ShowS
ScheduleLabel -> String
(Int -> ScheduleLabel -> ShowS)
-> (ScheduleLabel -> String)
-> ([ScheduleLabel] -> ShowS)
-> Show ScheduleLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleLabel -> ShowS
showsPrec :: Int -> ScheduleLabel -> ShowS
$cshow :: ScheduleLabel -> String
show :: ScheduleLabel -> String
$cshowList :: [ScheduleLabel] -> ShowS
showList :: [ScheduleLabel] -> ShowS
Show)
  deriving anyclass (Typeable ScheduleLabel
[HookRel ScheduleLabel]
[Hook ScheduleLabel]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ScheduleLabel)
(Typeable ScheduleLabel,
 IsExclusive (IsExclusiveRel ScheduleLabel)) =>
Set DefaultComponentType
-> [Hook ScheduleLabel]
-> [Hook ScheduleLabel]
-> [Hook ScheduleLabel]
-> [HookRel ScheduleLabel]
-> [HookRel ScheduleLabel]
-> [HookRel ScheduleLabel]
-> Component ScheduleLabel
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook ScheduleLabel]
onAdd :: [Hook ScheduleLabel]
$conSet :: [Hook ScheduleLabel]
onSet :: [Hook ScheduleLabel]
$conRemove :: [Hook ScheduleLabel]
onRemove :: [Hook ScheduleLabel]
$conAddRel :: [HookRel ScheduleLabel]
onAddRel :: [HookRel ScheduleLabel]
$conSetRel :: [HookRel ScheduleLabel]
onSetRel :: [HookRel ScheduleLabel]
$conRemoveRel :: [HookRel ScheduleLabel]
onRemoveRel :: [HookRel ScheduleLabel]
Component)

class (Typeable s) => Schedule s

data Init deriving (Typeable Init
Typeable Init => Schedule Init
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> Init -> ShowS
[Init] -> ShowS
Init -> String
(Int -> Init -> ShowS)
-> (Init -> String) -> ([Init] -> ShowS) -> Show Init
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Init -> ShowS
showsPrec :: Int -> Init -> ShowS
$cshow :: Init -> String
show :: Init -> String
$cshowList :: [Init] -> ShowS
showList :: [Init] -> ShowS
Show)

data PreStartup deriving (Typeable PreStartup
Typeable PreStartup => Schedule PreStartup
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data Startup deriving (Typeable Startup
Typeable Startup => Schedule Startup
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> Startup -> ShowS
[Startup] -> ShowS
Startup -> String
(Int -> Startup -> ShowS)
-> (Startup -> String) -> ([Startup] -> ShowS) -> Show Startup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Startup -> ShowS
showsPrec :: Int -> Startup -> ShowS
$cshow :: Startup -> String
show :: Startup -> String
$cshowList :: [Startup] -> ShowS
showList :: [Startup] -> ShowS
Show)

data PostStartup deriving (Typeable PostStartup
Typeable PostStartup => Schedule PostStartup
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data First deriving (Typeable First
Typeable First => Schedule First
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> First -> ShowS
[First] -> ShowS
First -> String
(Int -> First -> ShowS)
-> (First -> String) -> ([First] -> ShowS) -> Show First
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> First -> ShowS
showsPrec :: Int -> First -> ShowS
$cshow :: First -> String
show :: First -> String
$cshowList :: [First] -> ShowS
showList :: [First] -> ShowS
Show)

data Update deriving (Typeable Update
Typeable Update => Schedule Update
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
(Int -> Update -> ShowS)
-> (Update -> String) -> ([Update] -> ShowS) -> Show Update
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Update -> ShowS
showsPrec :: Int -> Update -> ShowS
$cshow :: Update -> String
show :: Update -> String
$cshowList :: [Update] -> ShowS
showList :: [Update] -> ShowS
Show)

data PreUpdate deriving (Typeable PreUpdate
Typeable PreUpdate => Schedule PreUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data PostUpdate deriving (Typeable PostUpdate
Typeable PostUpdate => Schedule PostUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data Last deriving (Typeable Last
Typeable Last => Schedule Last
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data StartupSchedule = StartupSchedule deriving (Typeable StartupSchedule
[HookRel StartupSchedule]
[Hook StartupSchedule]
Set DefaultComponentType
IsExclusive (IsExclusiveRel StartupSchedule)
(Typeable StartupSchedule,
 IsExclusive (IsExclusiveRel StartupSchedule)) =>
Set DefaultComponentType
-> [Hook StartupSchedule]
-> [Hook StartupSchedule]
-> [Hook StartupSchedule]
-> [HookRel StartupSchedule]
-> [HookRel StartupSchedule]
-> [HookRel StartupSchedule]
-> Component StartupSchedule
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook StartupSchedule]
onAdd :: [Hook StartupSchedule]
$conSet :: [Hook StartupSchedule]
onSet :: [Hook StartupSchedule]
$conRemove :: [Hook StartupSchedule]
onRemove :: [Hook StartupSchedule]
$conAddRel :: [HookRel StartupSchedule]
onAddRel :: [HookRel StartupSchedule]
$conSetRel :: [HookRel StartupSchedule]
onSetRel :: [HookRel StartupSchedule]
$conRemoveRel :: [HookRel StartupSchedule]
onRemoveRel :: [HookRel StartupSchedule]
Component)

data UpdateSchedule = UpdateSchedule deriving (Typeable UpdateSchedule
[HookRel UpdateSchedule]
[Hook UpdateSchedule]
Set DefaultComponentType
IsExclusive (IsExclusiveRel UpdateSchedule)
(Typeable UpdateSchedule,
 IsExclusive (IsExclusiveRel UpdateSchedule)) =>
Set DefaultComponentType
-> [Hook UpdateSchedule]
-> [Hook UpdateSchedule]
-> [Hook UpdateSchedule]
-> [HookRel UpdateSchedule]
-> [HookRel UpdateSchedule]
-> [HookRel UpdateSchedule]
-> Component UpdateSchedule
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook UpdateSchedule]
onAdd :: [Hook UpdateSchedule]
$conSet :: [Hook UpdateSchedule]
onSet :: [Hook UpdateSchedule]
$conRemove :: [Hook UpdateSchedule]
onRemove :: [Hook UpdateSchedule]
$conAddRel :: [HookRel UpdateSchedule]
onAddRel :: [HookRel UpdateSchedule]
$conSetRel :: [HookRel UpdateSchedule]
onSetRel :: [HookRel UpdateSchedule]
$conRemoveRel :: [HookRel UpdateSchedule]
onRemoveRel :: [HookRel UpdateSchedule]
Component)

newtype ScheduleId = ScheduleId {ScheduleId -> Entity
id :: Entity} deriving (Eq ScheduleId
Eq ScheduleId =>
(ScheduleId -> ScheduleId -> Ordering)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> ScheduleId)
-> (ScheduleId -> ScheduleId -> ScheduleId)
-> Ord ScheduleId
ScheduleId -> ScheduleId -> Bool
ScheduleId -> ScheduleId -> Ordering
ScheduleId -> ScheduleId -> ScheduleId
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
$ccompare :: ScheduleId -> ScheduleId -> Ordering
compare :: ScheduleId -> ScheduleId -> Ordering
$c< :: ScheduleId -> ScheduleId -> Bool
< :: ScheduleId -> ScheduleId -> Bool
$c<= :: ScheduleId -> ScheduleId -> Bool
<= :: ScheduleId -> ScheduleId -> Bool
$c> :: ScheduleId -> ScheduleId -> Bool
> :: ScheduleId -> ScheduleId -> Bool
$c>= :: ScheduleId -> ScheduleId -> Bool
>= :: ScheduleId -> ScheduleId -> Bool
$cmax :: ScheduleId -> ScheduleId -> ScheduleId
max :: ScheduleId -> ScheduleId -> ScheduleId
$cmin :: ScheduleId -> ScheduleId -> ScheduleId
min :: ScheduleId -> ScheduleId -> ScheduleId
Ord, ScheduleId -> ScheduleId -> Bool
(ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool) -> Eq ScheduleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleId -> ScheduleId -> Bool
== :: ScheduleId -> ScheduleId -> Bool
$c/= :: ScheduleId -> ScheduleId -> Bool
/= :: ScheduleId -> ScheduleId -> Bool
Eq, Int -> ScheduleId -> ShowS
[ScheduleId] -> ShowS
ScheduleId -> String
(Int -> ScheduleId -> ShowS)
-> (ScheduleId -> String)
-> ([ScheduleId] -> ShowS)
-> Show ScheduleId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleId -> ShowS
showsPrec :: Int -> ScheduleId -> ShowS
$cshow :: ScheduleId -> String
show :: ScheduleId -> String
$cshowList :: [ScheduleId] -> ShowS
showList :: [ScheduleId] -> ShowS
Show)

newtype Schedules = Schedules {Schedules -> Map TypeRep ScheduleId
inner :: Map TypeRep ScheduleId}
  deriving stock ((forall x. Schedules -> Rep Schedules x)
-> (forall x. Rep Schedules x -> Schedules) -> Generic Schedules
forall x. Rep Schedules x -> Schedules
forall x. Schedules -> Rep Schedules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Schedules -> Rep Schedules x
from :: forall x. Schedules -> Rep Schedules x
$cto :: forall x. Rep Schedules x -> Schedules
to :: forall x. Rep Schedules x -> Schedules
Generic)
  deriving anyclass (Typeable Schedules
[HookRel Schedules]
[Hook Schedules]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Schedules)
(Typeable Schedules, IsExclusive (IsExclusiveRel Schedules)) =>
Set DefaultComponentType
-> [Hook Schedules]
-> [Hook Schedules]
-> [Hook Schedules]
-> [HookRel Schedules]
-> [HookRel Schedules]
-> [HookRel Schedules]
-> Component Schedules
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Schedules]
onAdd :: [Hook Schedules]
$conSet :: [Hook Schedules]
onSet :: [Hook Schedules]
$conRemove :: [Hook Schedules]
onRemove :: [Hook Schedules]
$conAddRel :: [HookRel Schedules]
onAddRel :: [HookRel Schedules]
$conSetRel :: [HookRel Schedules]
onSetRel :: [HookRel Schedules]
$conRemoveRel :: [HookRel Schedules]
onRemoveRel :: [HookRel Schedules]
Component, Schedules
Schedules -> Default Schedules
forall a. a -> Default a
$cdef :: Schedules
def :: Schedules
Default)

getScheduleId :: ScheduleLabel -> System ScheduleId
getScheduleId :: ScheduleLabel -> System ScheduleId
getScheduleId ScheduleLabel
sch = do
  Just schedules <- forall c. Component c => System (Maybe c)
res @Schedules
  case Map.lookup sch.rep schedules.inner of
    Just ScheduleId
x -> ScheduleId -> System ScheduleId
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ScheduleId
x
    Maybe ScheduleId
Nothing -> do
      e <- ScheduleLabel -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn ScheduleLabel
sch
      insertRes $ Schedules $ Map.insert sch.rep (ScheduleId e) schedules.inner
      return $ ScheduleId e

scheduleEntity :: forall sch. (Schedule sch) => System Entity
scheduleEntity :: forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity = do
  ScheduleId id <- ScheduleLabel -> System ScheduleId
getScheduleId (ScheduleLabel -> System ScheduleId)
-> ScheduleLabel -> System ScheduleId
forall a b. (a -> b) -> a -> b
$ TypeRep -> ScheduleLabel
ScheduleLabel (TypeRep -> ScheduleLabel) -> TypeRep -> ScheduleLabel
forall a b. (a -> b) -> a -> b
$ Proxy sch -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @sch)
  return id