content: {-|
  Stability : experimental
  
  This module is experimental, and its API might change between point releases. Use at your own risk.
  
  Adds the @Reactive r s@ store, which when wrapped around store @s@, will call the @react@ on its @r@.
  
  @Show c => Reactive (Printer c) (Map c)@ will print a message every time a @c@ value is set.
  
  @Enum c => Reactive (EnumMap c) (Map c)@ allows you to look up entities by component value.
  Use e.g. @withReactive $ enumLookup True@ to retrieve a list of entities that have a @True@ component.
  
  @Reactive (ComponentCounter c) (Map c)@ tracks the current and max counts of entities with a particular
  component. Among other things, the max count can be useful in deciding on @Cache@ sizing and the current
  count can be useful for debugging entity lifecycles. To retrieve the counts, use
  @withReactive readComponentCount@.
  
  -}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RankNTypes            #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  
  module Apecs.Experimental.Reactive
    ( Reacts (..), Reactive, withReactive
    , Printer
    , EnumMap, enumLookup
    , OrdMap, ordLookup
    , IxMap, ixLookup
    , ComponentCounter, readComponentCount, ComponentCount(..)
    ) where
  
  import           Control.Monad
  import           Control.Monad.IO.Class
  import           Control.Monad.Reader
  import qualified Data.Array.IO        as A
  import qualified Data.IntMap.Strict   as IM
  import qualified Data.IntSet          as S
  import           Data.IORef
  import           Data.Ix
  import qualified Data.Map.Strict      as M
  
  import           Apecs.Components
  import           Apecs.Core
  
  -- | Class required by @Reactive@.
  --   Given some @r@ and update information about some component, will run a side-effect in monad @m@.
  --   Note that there are also instances for @(,)@.
  class Monad m => Reacts m r where
    rempty :: m r
    react  :: Entity -> Maybe (Elem r) -> Maybe (Elem r) -> r -> m ()
  
  -- | Wrapper for reactivity around some store s.
  data Reactive r s = Reactive r s
  
  type instance Elem (Reactive r s) = Elem s
  
  -- | Performs an action with a reactive state token.
  withReactive :: forall w m r s a.
               ( Component (Elem r)
               , Has w m (Elem r)
               , Storage (Elem r) ~ Reactive r s
               ) => (r -> m a) -> SystemT w m a
  withReactive f = do
    Reactive r (_ :: s) <- getStore
    lift$ f r
  
  instance (Reacts m r, ExplInit m s) => ExplInit m (Reactive r s) where
    explInit = liftM2 Reactive rempty explInit
  
  instance (Reacts m r, ExplSet m s, ExplGet m s, Elem s ~ Elem r)
    => ExplSet m (Reactive r s) where
    {-# INLINE explSet #-}
    explSet (Reactive r s) ety c = do
      old <- explGet (MaybeStore s) ety
      react (Entity ety) old (Just c) r
      explSet s ety c
  
  instance (Reacts m r, ExplDestroy m s, ExplGet m s, Elem s ~ Elem r)
    => ExplDestroy m (Reactive r s) where
    {-# INLINE explDestroy #-}
    explDestroy (Reactive r s) ety = do
      old <- explGet (MaybeStore s) ety
      react (Entity ety) old Nothing r
      explDestroy s ety
  
  instance ExplGet m s => ExplGet m (Reactive r s) where
    {-# INLINE explExists #-}
    explExists (Reactive _ s) = explExists s
    {-# INLINE explGet    #-}
    explGet    (Reactive _ s) = explGet    s
  
  instance ExplMembers m s => ExplMembers m (Reactive r s) where
    {-# INLINE explMembers #-}
    explMembers (Reactive _ s) = explMembers s
  
  -- | Prints a message to stdout every time a component is updated.
  data Printer c = Printer
  type instance Elem (Printer c) = c
  
  instance (MonadIO m, Show c) => Reacts m (Printer c) where
    {-# INLINE rempty #-}
    rempty = return Printer
    {-# INLINE react #-}
    react (Entity ety) (Just c) Nothing _ = liftIO$
      putStrLn $ "Entity " ++ show ety ++ ": destroyed component " ++ show c
    react (Entity ety) Nothing (Just c) _ = liftIO$
      putStrLn $ "Entity " ++ show ety ++ ": created component " ++ show c
    react (Entity ety) (Just old) (Just new) _ = liftIO$
      putStrLn $ "Entity " ++ show ety ++ ": update component " ++ show old ++ " to " ++ show new
    react _ _ _ _ = return ()
  
  -- | Allows you to look up entities by component value.
  --   Use e.g. @withReactive $ enumLookup True@ to retrieve a list of entities that have a @True@ component.
  --   Based on an @IntMap IntSet@ internally.
  newtype EnumMap c = EnumMap (IORef (IM.IntMap S.IntSet))
  
  type instance Elem (EnumMap c) = c
  instance (MonadIO m, Enum c) => Reacts m (EnumMap c) where
    {-# INLINE rempty #-}
    rempty = liftIO$ EnumMap <$> newIORef mempty
    {-# INLINE react #-}
    react _ Nothing Nothing _ = return ()
    react (Entity ety) (Just c) Nothing (EnumMap ref) = liftIO$
      modifyIORef' ref (IM.adjust (S.delete ety) (fromEnum c))
    react (Entity ety) Nothing (Just c) (EnumMap ref) = liftIO$
      modifyIORef' ref (IM.insertWith mappend (fromEnum c) (S.singleton ety))
    react (Entity ety) (Just old) (Just new) (EnumMap ref) = liftIO$ do
      modifyIORef' ref (IM.adjust (S.delete ety) (fromEnum old))
      modifyIORef' ref (IM.insertWith mappend (fromEnum new) (S.singleton ety))
  
  {-# INLINE enumLookup #-}
  enumLookup :: (MonadIO m, Enum c) => c -> EnumMap c -> m [Entity]
  enumLookup c = \(EnumMap ref) -> do
    emap <- liftIO $ readIORef ref
    return $ maybe [] (fmap Entity . S.toList) (IM.lookup (fromEnum c) emap)
  
  -- | Allows you to look up entities by component value.
  --   Based on a @Map c IntSet@ internally
  newtype OrdMap c = OrdMap (IORef (M.Map c S.IntSet))
  
  type instance Elem (OrdMap c) = c
  instance (MonadIO m, Ord c) => Reacts m (OrdMap c) where
    {-# INLINE rempty #-}
    rempty = liftIO$ OrdMap <$> newIORef mempty
    {-# INLINE react #-}
    react _ Nothing Nothing _ = return ()
    react (Entity ety) (Just c) Nothing (OrdMap ref) = liftIO$
      modifyIORef' ref (M.adjust (S.delete ety) c)
    react (Entity ety) Nothing (Just c) (OrdMap ref) = liftIO$
      modifyIORef' ref (M.insertWith mappend c (S.singleton ety))
    react (Entity ety) (Just old) (Just new) (OrdMap ref) = liftIO$ do
      modifyIORef' ref (M.adjust (S.delete ety) old)
      modifyIORef' ref (M.insertWith mappend new (S.singleton ety))
  
  {-# INLINE ordLookup #-}
  ordLookup :: (MonadIO m, Ord c) => c -> OrdMap c -> m [Entity]
  ordLookup c = \(OrdMap ref) -> do
    emap <- liftIO $ readIORef ref
    return $ maybe [] (fmap Entity . S.toList) (M.lookup c emap)
  
  -- | Allows you to look up entities by component value.
  --   Based on an @IOArray c IntSet@ internally
  newtype IxMap c = IxMap (A.IOArray c S.IntSet)
  
  {-# INLINE modifyArray #-}
  modifyArray :: Ix i => A.IOArray i a -> i -> (a -> a) -> IO ()
  modifyArray ref ix f = A.readArray ref ix >>= A.writeArray ref ix . f
  
  type instance Elem (IxMap c) = c
  instance (MonadIO m, Ix c, Bounded c) => Reacts m (IxMap c) where
    {-# INLINE rempty #-}
    rempty = liftIO$ IxMap <$> A.newArray (minBound, maxBound) mempty
    {-# INLINE react #-}
    react _ Nothing Nothing _ = return ()
    react (Entity ety) (Just c) Nothing (IxMap ref) = liftIO$
      modifyArray ref c (S.delete ety)
    react (Entity ety) Nothing (Just c) (IxMap ref) = liftIO$
      modifyArray ref c (S.insert ety)
    react (Entity ety) (Just old) (Just new) (IxMap ref) = liftIO$ do
      modifyArray ref old (S.delete ety)
      modifyArray ref new (S.insert ety)
  
  {-# INLINE ixLookup #-}
  ixLookup :: (MonadIO m, Ix c) => c -> IxMap c -> m [Entity]
  ixLookup c = \(IxMap ref) -> do
    liftIO $ fmap Entity . S.toList <$> A.readArray ref c
  
  -- | Tracks current and max counts of entities with a particular 'Component'.
  --
  -- Note that if this is used in conjunction with a @Global@ store, produced
  -- counts will always be 0.
  newtype ComponentCounter c = ComponentCounter (IORef (ComponentCount c))
  
  type instance Elem (ComponentCounter c) = c
  
  -- | A snapshot of the current and max counts of entities with a particular
  -- 'Component'.
  --
  -- Produced via 'readComponentCount'.
  data ComponentCount c = ComponentCount
    { componentCountCurrent :: !Int
      -- ^ Represents how many entities existed with the 'Component' assigned at
      -- the time the snapshot was produced.
    , componentCountMax :: !Int
      -- ^ Represents the max number of entities with the 'Component' assigned
      -- that coexisted, as observed at any point between system initialization
      -- and the time the snapshot was produced.
    } deriving (Eq, Show)
  
  instance MonadIO m => Reacts m (ComponentCounter c) where
    {-# INLINE rempty #-}
    rempty = liftIO $ ComponentCounter <$> newIORef ComponentCount
      { componentCountCurrent = 0
      , componentCountMax = 0
      }
  
    {-# INLINE react #-}
    react _ent mOld mNew (ComponentCounter ref) =
      case (mOld, mNew) of
        (Nothing, Just {}) -> go 1
        (Just {}, Nothing) -> go (-1)
        _ignored -> pure ()
      where
      go :: Int -> m ()
      go i =
        liftIO $ atomicModifyIORef' ref $ \cc ->
          let cur = componentCountCurrent cc + i
           in ( cc
                  { componentCountCurrent = cur
                  , componentCountMax = max cur $ componentCountMax cc
                  }
              , ()
              )
  
  {-# INLINE readComponentCount #-}
  readComponentCount
    :: forall c m
     . MonadIO m
    => ComponentCounter c
    -> m (ComponentCount c)
  readComponentCount (ComponentCounter ref) = liftIO $ readIORef ref
  