{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Network.Wai.Middleware.Push.Referer.Manager ( MakePushPromise , defaultMakePushPromise , Settings(..) , defaultSettings , Manager , URLPath , getManager , Network.Wai.Middleware.Push.Referer.Manager.lookup , Network.Wai.Middleware.Push.Referer.Manager.insert ) where import Control.Monad (unless) import Data.IORef import Network.Wai.Handler.Warp hiding (Settings, defaultSettings) import System.IO.Unsafe (unsafePerformIO) import Network.Wai.Middleware.Push.Referer.Types import qualified Network.Wai.Middleware.Push.Referer.LRU as LRU newtype Manager = Manager (IORef (LRU.Cache URLPath PushPromise)) getManager :: Settings -> IO Manager getManager :: Settings -> IO Manager getManager Settings{Int MakePushPromise makePushPromise :: MakePushPromise duration :: Int keyLimit :: Int valueLimit :: Int makePushPromise :: Settings -> MakePushPromise duration :: Settings -> Int keyLimit :: Settings -> Int valueLimit :: Settings -> Int ..} = do Bool isInitialized <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef Bool lruInitialized ((Bool -> (Bool, Bool)) -> IO Bool) -> (Bool -> (Bool, Bool)) -> IO Bool forall a b. (a -> b) -> a -> b $ \Bool x -> (Bool True, Bool x) Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool isInitialized (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do let cache :: Cache k v cache = Int -> Int -> Cache k v forall k v. Int -> Int -> Cache k v LRU.empty Int keyLimit Int valueLimit Manager IORef (Cache URLPath PushPromise) ref = Manager cacheManager IORef (Cache URLPath PushPromise) -> Cache URLPath PushPromise -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Cache URLPath PushPromise) ref Cache URLPath PushPromise forall {k} {v}. Cache k v cache Manager -> IO Manager forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Manager cacheManager lruInitialized :: IORef Bool lruInitialized :: IORef Bool lruInitialized = IO (IORef Bool) -> IORef Bool forall a. IO a -> a unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool forall a b. (a -> b) -> a -> b $ Bool -> IO (IORef Bool) forall a. a -> IO (IORef a) newIORef Bool False {-# NOINLINE lruInitialized #-} cacheManager :: Manager cacheManager :: Manager cacheManager = IORef (Cache URLPath PushPromise) -> Manager Manager (IORef (Cache URLPath PushPromise) -> Manager) -> IORef (Cache URLPath PushPromise) -> Manager forall a b. (a -> b) -> a -> b $ IO (IORef (Cache URLPath PushPromise)) -> IORef (Cache URLPath PushPromise) forall a. IO a -> a unsafePerformIO (IO (IORef (Cache URLPath PushPromise)) -> IORef (Cache URLPath PushPromise)) -> IO (IORef (Cache URLPath PushPromise)) -> IORef (Cache URLPath PushPromise) forall a b. (a -> b) -> a -> b $ Cache URLPath PushPromise -> IO (IORef (Cache URLPath PushPromise)) forall a. a -> IO (IORef a) newIORef (Cache URLPath PushPromise -> IO (IORef (Cache URLPath PushPromise))) -> Cache URLPath PushPromise -> IO (IORef (Cache URLPath PushPromise)) forall a b. (a -> b) -> a -> b $ Int -> Int -> Cache URLPath PushPromise forall k v. Int -> Int -> Cache k v LRU.empty Int 0 Int 0 {-# NOINLINE cacheManager #-} lookup :: URLPath -> Manager -> IO [PushPromise] lookup :: URLPath -> Manager -> IO [PushPromise] lookup URLPath k (Manager IORef (Cache URLPath PushPromise) ref) = IORef (Cache URLPath PushPromise) -> (Cache URLPath PushPromise -> (Cache URLPath PushPromise, [PushPromise])) -> IO [PushPromise] forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef (Cache URLPath PushPromise) ref ((Cache URLPath PushPromise -> (Cache URLPath PushPromise, [PushPromise])) -> IO [PushPromise]) -> (Cache URLPath PushPromise -> (Cache URLPath PushPromise, [PushPromise])) -> IO [PushPromise] forall a b. (a -> b) -> a -> b $ URLPath -> Cache URLPath PushPromise -> (Cache URLPath PushPromise, [PushPromise]) forall k v. Ord k => k -> Cache k v -> (Cache k v, [v]) LRU.lookup URLPath k insert :: URLPath -> PushPromise -> Manager -> IO () insert :: URLPath -> PushPromise -> Manager -> IO () insert URLPath k PushPromise v (Manager IORef (Cache URLPath PushPromise) ref) = IORef (Cache URLPath PushPromise) -> (Cache URLPath PushPromise -> (Cache URLPath PushPromise, ())) -> IO () forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef (Cache URLPath PushPromise) ref ((Cache URLPath PushPromise -> (Cache URLPath PushPromise, ())) -> IO ()) -> (Cache URLPath PushPromise -> (Cache URLPath PushPromise, ())) -> IO () forall a b. (a -> b) -> a -> b $ \Cache URLPath PushPromise c -> (URLPath -> PushPromise -> Cache URLPath PushPromise -> Cache URLPath PushPromise forall k v. (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v LRU.insert URLPath k PushPromise v Cache URLPath PushPromise c, ())