{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Aztecs.ECS.World.Storage.Dynamic
-- Copyright   : (c) Matt Hunzinger, 2025
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Aztecs.ECS.World.Storage.Dynamic
  ( DynamicStorage (..),
    dynStorage,
    singletonDyn,
    fromAscListDyn,
    toAscListDyn,
  )
where

import qualified Aztecs.ECS.World.Storage as S
import Control.DeepSeq
import Data.Dynamic
import Data.Maybe

-- | Dynamic storage of components.
--
-- @since 0.9
data DynamicStorage = DynamicStorage
  { -- | Dynamic storage.
    --
    -- @since 0.9
    DynamicStorage -> Dynamic
storageDyn :: !Dynamic,
    -- | Singleton storage.
    --
    -- @since 0.9
    DynamicStorage -> Dynamic -> Dynamic
singletonDyn' :: !(Dynamic -> Dynamic),
    -- | Convert this storage to an ascending list.
    --
    -- @since 0.9
    DynamicStorage -> Dynamic -> [Dynamic]
toAscListDyn' :: !(Dynamic -> [Dynamic]),
    -- | Convert from an ascending list.
    --
    -- @since 0.9
    DynamicStorage -> [Dynamic] -> Dynamic
fromAscListDyn' :: !([Dynamic] -> Dynamic),
    -- | Reduce this storage to normal form.
    --
    -- @since 0.9
    DynamicStorage -> Dynamic -> ()
storageRnf :: !(Dynamic -> ())
  }

-- | @since 0.9
instance Show DynamicStorage where
  show :: DynamicStorage -> String
show DynamicStorage
s = String
"DynamicStorage " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dynamic -> String
forall a. Show a => a -> String
show (DynamicStorage -> Dynamic
storageDyn DynamicStorage
s)

-- | @since 0.9
instance NFData DynamicStorage where
  rnf :: DynamicStorage -> ()
rnf DynamicStorage
s = DynamicStorage -> Dynamic -> ()
storageRnf DynamicStorage
s (DynamicStorage -> Dynamic
storageDyn DynamicStorage
s)

-- | Create a dynamic storage from a storage.
--
-- @since 0.9
{-# INLINE dynStorage #-}
dynStorage :: forall a s. (S.Storage a s) => s -> DynamicStorage
dynStorage :: forall a s. Storage a s => s -> DynamicStorage
dynStorage s
s =
  DynamicStorage
    { storageDyn :: Dynamic
storageDyn = s -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn s
s,
      singletonDyn' :: Dynamic -> Dynamic
singletonDyn' = s -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (s -> Dynamic) -> (Dynamic -> s) -> Dynamic -> Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Storage a s => a -> s
S.singleton @a @s (a -> s) -> (Dynamic -> a) -> Dynamic -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"TODO") (Maybe a -> a) -> (Dynamic -> Maybe a) -> Dynamic -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic,
      toAscListDyn' :: Dynamic -> [Dynamic]
toAscListDyn' = \Dynamic
d -> (a -> Dynamic) -> [a] -> [Dynamic]
forall a b. (a -> b) -> [a] -> [b]
map a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (forall a s. Storage a s => s -> [a]
S.toAscList @a @s (s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe (String -> s
forall a. HasCallStack => String -> a
error String
"TODO") (Maybe s -> s) -> Maybe s -> s
forall a b. (a -> b) -> a -> b
$ Dynamic -> Maybe s
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
d)),
      fromAscListDyn' :: [Dynamic] -> Dynamic
fromAscListDyn' = s -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (s -> Dynamic) -> ([Dynamic] -> s) -> [Dynamic] -> Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Storage a s => [a] -> s
S.fromAscList @a @s ([a] -> s) -> ([Dynamic] -> [a]) -> [Dynamic] -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dynamic -> a) -> [Dynamic] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"TODO") (Maybe a -> a) -> (Dynamic -> Maybe a) -> Dynamic -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic),
      storageRnf :: Dynamic -> ()
storageRnf = () -> (s -> ()) -> Maybe s -> ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe () s -> ()
forall a. NFData a => a -> ()
rnf (Maybe s -> ()) -> (Dynamic -> Maybe s) -> Dynamic -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => Dynamic -> Maybe a
fromDynamic @s
    }

-- | Singleton dynamic storage.
--
-- @since 0.9
singletonDyn :: Dynamic -> DynamicStorage -> DynamicStorage
singletonDyn :: Dynamic -> DynamicStorage -> DynamicStorage
singletonDyn Dynamic
dyn DynamicStorage
s = DynamicStorage
s {storageDyn = singletonDyn' s dyn}

-- | Convert from an ascending list.
--
-- @since 0.9
fromAscListDyn :: [Dynamic] -> DynamicStorage -> DynamicStorage
fromAscListDyn :: [Dynamic] -> DynamicStorage -> DynamicStorage
fromAscListDyn [Dynamic]
dyns DynamicStorage
s = DynamicStorage
s {storageDyn = fromAscListDyn' s dyns}

-- | Convert this storage to an ascending list.
--
-- @since 0.9
toAscListDyn :: DynamicStorage -> [Dynamic]
toAscListDyn :: DynamicStorage -> [Dynamic]
toAscListDyn = DynamicStorage -> Dynamic -> [Dynamic]
toAscListDyn' (DynamicStorage -> Dynamic -> [Dynamic])
-> (DynamicStorage -> Dynamic) -> DynamicStorage -> [Dynamic]
forall a b.
(DynamicStorage -> a -> b)
-> (DynamicStorage -> a) -> DynamicStorage -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynamicStorage -> Dynamic
storageDyn