module Data.Cache where import Control.Monad.IO.Class import Data.IORef import qualified Data.Map as M import qualified Data.Text as T newtype CacheRegistry v = CacheRegistry { CacheRegistry v -> IORef (Map Text v) getCacheRegistry :: IORef (M.Map T.Text v) } new :: MonadIO m => m (CacheRegistry v) new :: m (CacheRegistry v) new = IO (CacheRegistry v) -> m (CacheRegistry v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (CacheRegistry v) -> m (CacheRegistry v)) -> IO (CacheRegistry v) -> m (CacheRegistry v) forall a b. (a -> b) -> a -> b $ (IORef (Map Text v) -> CacheRegistry v) -> IO (IORef (Map Text v)) -> IO (CacheRegistry v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap IORef (Map Text v) -> CacheRegistry v forall v. IORef (Map Text v) -> CacheRegistry v CacheRegistry (IO (IORef (Map Text v)) -> IO (CacheRegistry v)) -> IO (IORef (Map Text v)) -> IO (CacheRegistry v) forall a b. (a -> b) -> a -> b $ Map Text v -> IO (IORef (Map Text v)) forall a. a -> IO (IORef a) newIORef Map Text v forall k a. Map k a M.empty size :: MonadIO m => CacheRegistry v -> m Int size :: CacheRegistry v -> m Int size (CacheRegistry ref :: IORef (Map Text v) ref) = IO Int -> m Int forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Int -> m Int) -> IO Int -> m Int forall a b. (a -> b) -> a -> b $ (Map Text v -> Int) -> IO (Map Text v) -> IO Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Map Text v -> Int forall k a. Map k a -> Int M.size (IO (Map Text v) -> IO Int) -> IO (Map Text v) -> IO Int forall a b. (a -> b) -> a -> b $ IORef (Map Text v) -> IO (Map Text v) forall a. IORef a -> IO a readIORef IORef (Map Text v) ref register :: MonadIO m => T.Text -> v -> CacheRegistry v -> m () register :: Text -> v -> CacheRegistry v -> m () register t :: Text t v :: v v cache :: CacheRegistry v cache = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ IORef (Map Text v) -> (Map Text v -> Map Text v) -> IO () forall a. IORef a -> (a -> a) -> IO () modifyIORef' (CacheRegistry v -> IORef (Map Text v) forall v. CacheRegistry v -> IORef (Map Text v) getCacheRegistry CacheRegistry v cache) ((Map Text v -> Map Text v) -> IO ()) -> (Map Text v -> Map Text v) -> IO () forall a b. (a -> b) -> a -> b $ Text -> v -> Map Text v -> Map Text v forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert Text t v v lookup :: MonadIO m => T.Text -> CacheRegistry v -> m (Maybe v) lookup :: Text -> CacheRegistry v -> m (Maybe v) lookup t :: Text t cache :: CacheRegistry v cache = IO (Maybe v) -> m (Maybe v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe v) -> m (Maybe v)) -> IO (Maybe v) -> m (Maybe v) forall a b. (a -> b) -> a -> b $ (Map Text v -> Maybe v) -> IO (Map Text v) -> IO (Maybe v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> Map Text v -> Maybe v forall k a. Ord k => k -> Map k a -> Maybe a M.lookup Text t) (IO (Map Text v) -> IO (Maybe v)) -> IO (Map Text v) -> IO (Maybe v) forall a b. (a -> b) -> a -> b $ IORef (Map Text v) -> IO (Map Text v) forall a. IORef a -> IO a readIORef (CacheRegistry v -> IORef (Map Text v) forall v. CacheRegistry v -> IORef (Map Text v) getCacheRegistry CacheRegistry v cache) clear :: MonadIO m => CacheRegistry v -> m (M.Map T.Text v) clear :: CacheRegistry v -> m (Map Text v) clear cache :: CacheRegistry v cache = IO (Map Text v) -> m (Map Text v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Map Text v) -> m (Map Text v)) -> IO (Map Text v) -> m (Map Text v) forall a b. (a -> b) -> a -> b $ do let ref :: IORef (Map Text v) ref = CacheRegistry v -> IORef (Map Text v) forall v. CacheRegistry v -> IORef (Map Text v) getCacheRegistry CacheRegistry v cache Map Text v m <- IORef (Map Text v) -> IO (Map Text v) forall a. IORef a -> IO a readIORef IORef (Map Text v) ref IORef (Map Text v) -> Map Text v -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Map Text v) ref Map Text v forall k a. Map k a M.empty Map Text v -> IO (Map Text v) forall (m :: * -> *) a. Monad m => a -> m a return Map Text v m getOrCreate :: MonadIO m => (T.Text -> m v) -> T.Text -> CacheRegistry v -> m v getOrCreate :: (Text -> m v) -> Text -> CacheRegistry v -> m v getOrCreate alloc :: Text -> m v alloc key :: Text key cache :: CacheRegistry v cache = do Maybe v result <- Text -> CacheRegistry v -> m (Maybe v) forall (m :: * -> *) v. MonadIO m => Text -> CacheRegistry v -> m (Maybe v) Data.Cache.lookup Text key CacheRegistry v cache (\f :: m v f -> m v -> (v -> m v) -> Maybe v -> m v forall b a. b -> (a -> b) -> Maybe a -> b maybe m v f v -> m v forall (m :: * -> *) a. Monad m => a -> m a return Maybe v result) (m v -> m v) -> m v -> m v forall a b. (a -> b) -> a -> b $ do v fig <- Text -> m v alloc Text key Text -> v -> CacheRegistry v -> m () forall (m :: * -> *) v. MonadIO m => Text -> v -> CacheRegistry v -> m () register Text key v fig CacheRegistry v cache v -> m v forall (m :: * -> *) a. Monad m => a -> m a return v fig clearAll :: MonadIO m => (v -> m ()) -> CacheRegistry v -> m () clearAll :: (v -> m ()) -> CacheRegistry v -> m () clearAll free :: v -> m () free cache :: CacheRegistry v cache = do Map Text v m <- CacheRegistry v -> m (Map Text v) forall (m :: * -> *) v. MonadIO m => CacheRegistry v -> m (Map Text v) clear CacheRegistry v cache (v -> m ()) -> [v] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ v -> m () free (Map Text v -> [v] forall k a. Map k a -> [a] M.elems Map Text v m)