{- HLINT ignore "Use newtype instead of data" -}
module Mischief.ECS.App.Plugins where

import Data.Foldable
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Typeable
import Mischief.ECS.Collectable
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Common
import Mischief.ECS.World
import Unsafe.Coerce

class (Typeable p, Eq p) => Plugin p where
  plugins :: p -> Plugins
  plugins p
_ = () -> Plugins
forall v storage. Collectable v storage => v -> storage
collect ()

  init :: p -> System ()
  init p
_ = () -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data ErasedPlugin where
  ErasedPlugin :: (Plugin p, Eq p) => p -> ErasedPlugin

getInit :: ErasedPlugin -> System ()
getInit :: ErasedPlugin -> System ()
getInit (ErasedPlugin p
p) = p -> System ()
forall p. Plugin p => p -> System ()
Mischief.ECS.App.Plugins.init p
p

newtype Plugins = Plugins {Plugins -> [ErasedPlugin]
inner :: [ErasedPlugin]} deriving newtype (NonEmpty Plugins -> Plugins
Plugins -> Plugins -> Plugins
(Plugins -> Plugins -> Plugins)
-> (NonEmpty Plugins -> Plugins)
-> (forall b. Integral b => b -> Plugins -> Plugins)
-> Semigroup Plugins
forall b. Integral b => b -> Plugins -> Plugins
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Plugins -> Plugins -> Plugins
<> :: Plugins -> Plugins -> Plugins
$csconcat :: NonEmpty Plugins -> Plugins
sconcat :: NonEmpty Plugins -> Plugins
$cstimes :: forall b. Integral b => b -> Plugins -> Plugins
stimes :: forall b. Integral b => b -> Plugins -> Plugins
Semigroup, Semigroup Plugins
Plugins
Semigroup Plugins =>
Plugins
-> (Plugins -> Plugins -> Plugins)
-> ([Plugins] -> Plugins)
-> Monoid Plugins
[Plugins] -> Plugins
Plugins -> Plugins -> Plugins
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Plugins
mempty :: Plugins
$cmappend :: Plugins -> Plugins -> Plugins
mappend :: Plugins -> Plugins -> Plugins
$cmconcat :: [Plugins] -> Plugins
mconcat :: [Plugins] -> Plugins
Monoid)

instance (Plugin p) => EraseIntoStorage p Plugins where
  erase :: p -> Plugins
erase p
p = [ErasedPlugin] -> Plugins
Plugins [p -> ErasedPlugin
forall p. (Plugin p, Eq p) => p -> ErasedPlugin
ErasedPlugin p
p]

instance {-# OVERLAPPING #-} EraseIntoStorage () Plugins where
  erase :: () -> Plugins
erase ()
_ = [ErasedPlugin] -> Plugins
Plugins []

newtype PluginData = PluginData {PluginData -> Map TypeRep ErasedPlugin
inner :: Map TypeRep ErasedPlugin}

instance Show PluginData where
  show :: PluginData -> String
show PluginData
p = [TypeRep] -> String
forall a. Show a => a -> String
show ([TypeRep] -> String) -> [TypeRep] -> String
forall a b. (a -> b) -> a -> b
$ ((TypeRep, ErasedPlugin) -> TypeRep)
-> [(TypeRep, ErasedPlugin)] -> [TypeRep]
forall a b. (a -> b) -> [a] -> [b]
map (TypeRep, ErasedPlugin) -> TypeRep
forall a b. (a, b) -> a
fst ([(TypeRep, ErasedPlugin)] -> [TypeRep])
-> [(TypeRep, ErasedPlugin)] -> [TypeRep]
forall a b. (a -> b) -> a -> b
$ Map TypeRep ErasedPlugin -> [(TypeRep, ErasedPlugin)]
forall k a. Map k a -> [(k, a)]
Map.toList PluginData
p.inner

plug :: (Collectable p Plugins) => p -> Plugins
plug :: forall p. Collectable p Plugins => p -> Plugins
plug = p -> Plugins
forall v storage. Collectable v storage => v -> storage
collect

addErasedRec :: ErasedPlugin -> PluginData -> PluginData
addErasedRec :: ErasedPlugin -> PluginData -> PluginData
addErasedRec (ErasedPlugin (p
plugin :: p)) PluginData
d =
  case TypeRep -> Map TypeRep ErasedPlugin -> Maybe ErasedPlugin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf p
plugin) PluginData
d.inner of
    Maybe ErasedPlugin
Nothing -> (ErasedPlugin -> PluginData -> PluginData)
-> PluginData -> [ErasedPlugin] -> PluginData
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ErasedPlugin -> PluginData -> PluginData
addErasedRec (Map TypeRep ErasedPlugin -> PluginData
PluginData (Map TypeRep ErasedPlugin -> PluginData)
-> Map TypeRep ErasedPlugin -> PluginData
forall a b. (a -> b) -> a -> b
$ TypeRep
-> ErasedPlugin
-> Map TypeRep ErasedPlugin
-> Map TypeRep ErasedPlugin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf p
plugin) (p -> ErasedPlugin
forall p. (Plugin p, Eq p) => p -> ErasedPlugin
ErasedPlugin p
plugin) PluginData
d.inner) (p -> Plugins
forall p. Plugin p => p -> Plugins
plugins p
plugin).inner
    Just ErasedPlugin
other ->
      if p
plugin p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== ErasedPlugin -> p
forall a b. a -> b
unsafeCoerce ErasedPlugin
other
        then PluginData
d
        else PluginData
forall a. HasCallStack => a
undefined

plugAll :: (Plugin p) => p -> PluginData
plugAll :: forall p. Plugin p => p -> PluginData
plugAll p
p = ErasedPlugin -> PluginData -> PluginData
addErasedRec (p -> ErasedPlugin
forall p. (Plugin p, Eq p) => p -> ErasedPlugin
ErasedPlugin p
p) (Map TypeRep ErasedPlugin -> PluginData
PluginData Map TypeRep ErasedPlugin
forall k a. Map k a
Map.empty)

runPluginRec :: (Plugin p) => p -> System ()
runPluginRec :: forall p. Plugin p => p -> System ()
runPluginRec p
p = [ErasedPlugin] -> (ErasedPlugin -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (((TypeRep, ErasedPlugin) -> ErasedPlugin)
-> [(TypeRep, ErasedPlugin)] -> [ErasedPlugin]
forall a b. (a -> b) -> [a] -> [b]
map (TypeRep, ErasedPlugin) -> ErasedPlugin
forall a b. (a, b) -> b
snd ([(TypeRep, ErasedPlugin)] -> [ErasedPlugin])
-> [(TypeRep, ErasedPlugin)] -> [ErasedPlugin]
forall a b. (a -> b) -> a -> b
$ Map TypeRep ErasedPlugin -> [(TypeRep, ErasedPlugin)]
forall k a. Map k a -> [(k, a)]
Map.toList (p -> PluginData
forall p. Plugin p => p -> PluginData
plugAll p
p).inner) ErasedPlugin -> System ()
getInit