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.Log
import Mischief.ECS.Resources
import Mischief.ECS.World
import Mischief.ECS.World.Modify
import Mischief.ECS.World.Query
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
Set DefaultComponentType
Hooks ScheduleLabel
IsExclusive (RelExclusivity ScheduleLabel)
(Typeable ScheduleLabel,
 IsExclusive (RelExclusivity ScheduleLabel)) =>
Set DefaultComponentType
-> Hooks ScheduleLabel -> Component ScheduleLabel
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks ScheduleLabel
hooks :: Hooks ScheduleLabel
Component)

class (Typeable s) => Schedule s

data Init = 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 = PreStartup deriving (Typeable PreStartup
Typeable PreStartup => Schedule PreStartup
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data Startup = 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 = PostStartup deriving (Typeable PostStartup
Typeable PostStartup => Schedule PostStartup
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data First = 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 = 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 = PreUpdate deriving (Typeable PreUpdate
Typeable PreUpdate => Schedule PreUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

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

data StartupSchedule = StartupSchedule deriving (Typeable StartupSchedule
Set DefaultComponentType
Hooks StartupSchedule
IsExclusive (RelExclusivity StartupSchedule)
(Typeable StartupSchedule,
 IsExclusive (RelExclusivity StartupSchedule)) =>
Set DefaultComponentType
-> Hooks StartupSchedule -> Component StartupSchedule
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks StartupSchedule
hooks :: Hooks StartupSchedule
Component)

data UpdateSchedule = UpdateSchedule deriving (Typeable UpdateSchedule
Set DefaultComponentType
Hooks UpdateSchedule
IsExclusive (RelExclusivity UpdateSchedule)
(Typeable UpdateSchedule,
 IsExclusive (RelExclusivity UpdateSchedule)) =>
Set DefaultComponentType
-> Hooks UpdateSchedule -> Component UpdateSchedule
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks UpdateSchedule
hooks :: Hooks 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
Set DefaultComponentType
Hooks Schedules
IsExclusive (RelExclusivity Schedules)
(Typeable Schedules, IsExclusive (RelExclusivity Schedules)) =>
Set DefaultComponentType -> Hooks Schedules -> Component Schedules
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks Schedules
hooks :: Hooks 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. QueryType 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 :: (Schedule sch) => sch -> System Entity
scheduleEntity :: forall sch. Schedule sch => sch -> System Entity
scheduleEntity sch
sch = 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
$ sch -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf sch
sch
  return id

-- runSystemsIn :: (Schedule sch) => sch -> System ()