module Bluefin.Internal.Vault
  ( module Bluefin.Internal.Vault,
    Vault,
    Vault.empty,
  )
where

import Data.Kind (Type)
import Data.Vault.Strict (Vault)
import Data.Vault.Strict qualified as Vault
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)

-- Vault.Key doesn't have representational role for its "value"
-- argument. I think it should. We hack it.
--
--     https://github.com/HeinrichApfelmus/vault/issues/56
type Key :: Type -> Type
newtype Key a = MkKey (Vault.Key Any)

fromMine :: Key a -> Vault.Key a
fromMine :: forall a. Key a -> Key a
fromMine (MkKey Key Any
k) = Key Any -> Key a
forall a b. a -> b
unsafeCoerce Key Any
k

toMine :: Vault.Key a -> Key a
toMine :: forall a. Key a -> Key a
toMine Key a
k = Key Any -> Key a
forall a. Key Any -> Key a
MkKey (Key a -> Key Any
forall a b. a -> b
unsafeCoerce Key a
k)

lookup :: Key a -> Vault -> Maybe a
lookup :: forall a. Key a -> Vault -> Maybe a
lookup = Key a -> Vault -> Maybe a
forall a. Key a -> Vault -> Maybe a
Vault.lookup (Key a -> Vault -> Maybe a)
-> (Key a -> Key a) -> Key a -> Vault -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> Key a
forall a. Key a -> Key a
fromMine

adjust :: (a -> a) -> Key a -> Vault -> Vault
adjust :: forall a. (a -> a) -> Key a -> Vault -> Vault
adjust a -> a
f = (a -> a) -> Key a -> Vault -> Vault
forall a. (a -> a) -> Key a -> Vault -> Vault
Vault.adjust a -> a
f (Key a -> Vault -> Vault)
-> (Key a -> Key a) -> Key a -> Vault -> Vault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> Key a
forall a. Key a -> Key a
fromMine

newKey :: IO (Key a)
newKey :: forall a. IO (Key a)
newKey = (Key a -> Key a) -> IO (Key a) -> IO (Key a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key a -> Key a
forall a. Key a -> Key a
toMine IO (Key a)
forall a. IO (Key a)
Vault.newKey

insert :: Key a -> a -> Vault -> Vault
insert :: forall a. Key a -> a -> Vault -> Vault
insert = Key a -> a -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert (Key a -> a -> Vault -> Vault)
-> (Key a -> Key a) -> Key a -> a -> Vault -> Vault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> Key a
forall a. Key a -> Key a
fromMine