module Data.Vault.ST (
Vault, Key,
empty, newKey, lookup, insert, adjust, delete, union,
) where
import Prelude hiding (lookup)
import Data.Monoid hiding (Any)
import Data.Functor
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Unique
import Control.Monad.ST
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)
newtype Vault s = Vault (Map Unique Any)
newtype Key s a = Key Unique
instance Monoid (Vault s) where
mempty = empty
mappend = union
empty :: Vault s
empty = Vault Map.empty
newKey :: ST s (Key s a)
newKey = Key <$> unsafeIOToST newUnique
lookup :: Key s a -> Vault s -> Maybe a
lookup (Key k) (Vault m) = unsafeCoerce <$> Map.lookup k m
insert :: Key s a -> a -> Vault s -> Vault s
insert (Key k) x (Vault m) = Vault $ Map.insert k (unsafeCoerce x) m
adjust :: (a -> a) -> Key s a -> Vault s -> Vault s
adjust f (Key k) (Vault m) = Vault $ Map.alter f' k m
where f' = unsafeCoerce . f . unsafeCoerce
delete :: Key s a -> Vault s -> Vault s
delete (Key k) (Vault m) = Vault $ Map.delete k m
union :: Vault s -> Vault s -> Vault s
union (Vault m) (Vault m') = Vault $ Map.union m m'