{-# LANGUAGE ScopedTypeVariables #-}

-- | This module provides a simple caching implementation based on the
-- LRU caching strategy.  The cache is implemented via software
-- transactional memory, which means that you can use the cache from
-- different threads.
module SDL.Data.Cache
    (
      Cacheable (..)
    , Cache
    , newCache
    , throughCache
    , emptyCache
    )
where

import           Data.Cache.LRU (insertInforming, newLRU, maxSize, toList)
import           Data.Cache.LRU.IO (newAtomicLRU,lookup)
import           Data.Cache.LRU.IO.Internal (AtomicLRU(C),modifyMVar')
import           Prelude hiding (lookup)
import qualified SDL as SDL (Texture, destroyTexture, Surface,freeSurface)
import qualified SDL.Raw as Raw

import           SDL.Data.Texture

-- | Something is cacheable if there is an action to release the
-- resource (if necessary).
class Cacheable r where
  releaseResource :: r -> IO ()

instance Cacheable (SDL.Texture) where
  releaseResource = SDL.destroyTexture

instance Cacheable (SDL.Surface) where
  releaseResource = SDL.freeSurface

instance Cacheable RawTexture where
  releaseResource (RawTexture tex) = Raw.destroyTexture tex

instance (Cacheable a) => Cacheable (Maybe a) where
  releaseResource Nothing = return ()
  releaseResource (Just r) = releaseResource r

instance Cacheable Int where
  releaseResource _ = return ()

instance (Cacheable a) => Cacheable [a] where
  releaseResource = mapM_ releaseResource

-- | Thread safe LRU cache.
newtype Cache k a = Cache (AtomicLRU k a)

-- | Create a new cache instance.
newCache :: (Ord k) =>
            Int -- ^ the size of the cache to be created (in elements)
         -> IO (Cache k a)
newCache s = Cache <$>
             newAtomicLRU (Just . fromIntegral $ s)

putInCache :: forall k r .
              (Ord k, Cacheable r) => Cache k r -> k -> IO r -> IO r
putInCache (Cache (C c)) key action = do
  newResource <- action
  mOldResource <- modifyMVar' c (return . insertInforming key newResource)
  mapM_ (releaseResource.snd) mOldResource
  pure newResource

lookupFromCache :: (Ord k) => Cache k r -> k -> IO (Maybe r)
lookupFromCache (Cache var) key =
  lookup key var

-- | Check if a certain element is already cached.  If not execute the
-- action the generate this element.
throughCache :: (Cacheable r, Ord k) =>
                Cache k r -- ^ cache instance
             -> k         -- ^ cache key
             -> IO r      -- ^ action to generate the resource
             -> IO r
throughCache cache key action = do
  mVal <- lookupFromCache cache key
  case mVal of
   Nothing -> putInCache cache key action
   Just val -> return val

-- | Invalidate every element in the cache and release the resources
-- accordingly.
emptyCache :: (Cacheable r, Ord k) => Cache k r -> IO ()
emptyCache (Cache (C c)) = do
  res <- modifyMVar' c $ \ lru ->
    return (newLRU (maxSize lru), map snd . Data.Cache.LRU.toList $ lru)
  mapM_ releaseResource res