    {-# 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
    valueLimit :: Settings -> Int
    keyLimit :: Settings -> Int
    duration :: Settings -> Int
    makePushPromise :: Settings -> MakePushPromise
    ..} = do
        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)
        unless isInitialized $ do
            let cache = Int -> Int -> Cache k v
    forall k v. Int -> Int -> Cache k v
    LRU.empty Int
    keyLimit Int
    valueLimit
                Manager ref = cacheManager
            writeIORef ref cache
        return 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, ())