Memory.hs

{-# LANGUAGE ScopedTypeVariables, ImpredicativeTypes, RankNTypes #-}
module Linden.Store.Memory (
   memStore
 ) where

import Data.UUID (UUID)
import Data.Random
import Control.Concurrent.MVar
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap

import Linden.Types

memStore :: IO GardenStore
memStore = do
    ms <- newMVar HMap.empty
    return $ GardenStore (memSave ms) (memCAS ms) (memExists ms)
  where
    memSave :: MVar (HashMap UUID (MVar LState)) -> GardenSave
    memSave ms lcs = do
      nmv <- newMVar lcs
      modifyMVar_ ms (return . HMap.insert (lsGarden lcs) nmv)

    memCAS :: MVar (HashMap UUID (MVar LState)) -> GardenCAS
    memCAS ms = \u mut -> do
      mm <- (HMap.lookup u) <$> readMVar ms
      case mm of
        Nothing -> return Nothing
        Just m -> modifyMVar m $ \lcs -> do
          (mlcs', a) <- runRVar (mut lcs) StdRandom
          case mlcs' of
            Nothing -> return (lcs, Just a)
            Just lcs' -> return (lcs', Just a)

    memExists :: MVar (HashMap UUID (MVar LState)) -> GardenExists
    memExists ms u =
      (maybe False (const True) . HMap.lookup u) <$> takeMVar ms