module IHP.RequestVault.Helper
( insertVaultMiddleware
, insertNewIORefVaultMiddleware
, lookupRequestVault
, insertVaultMiddlewareAndGetter
) where

import Prelude
import Data.IORef
import Network.Wai
import qualified Data.Vault.Lazy as Vault
import Data.Proxy
import Data.Typeable

{-# INLINE insertVaultMiddleware #-}
insertVaultMiddleware :: Vault.Key value -> value -> Middleware
insertVaultMiddleware :: forall value. Key value -> value -> Middleware
insertVaultMiddleware Key value
key value
value Application
app Request
req Response -> IO ResponseReceived
respond = do
    let req' :: Request
req' = Request
req { vault = Vault.insert key value req.vault }
    Application
app Request
req' Response -> IO ResponseReceived
respond

{-# INLINE lookupRequestVault #-}
lookupRequestVault :: forall value. Typeable value => Vault.Key value -> Request -> value
lookupRequestVault :: forall value. Typeable value => Key value -> Request -> value
lookupRequestVault Key value
key Request
req =
    case Key value -> Vault -> Maybe value
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key value
key Request
req.vault of
        Just value
modelContext -> value
modelContext
        Maybe value
Nothing -> [Char] -> value
forall a. HasCallStack => [Char] -> a
error ([Char] -> value) -> [Char] -> value
forall a b. (a -> b) -> a -> b
$ [Char]
"lookupRequestVault: Could not find " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Proxy value -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @value) ) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" in request.vault. Did you forget to add the middleware to your application?"

-- | Like 'insertVaultMiddleware', but creates a fresh 'IORef' with the given
-- default value on each request. Use this for mutable per-request state
-- (e.g. response headers, modal containers).
{-# INLINE insertNewIORefVaultMiddleware #-}
insertNewIORefVaultMiddleware :: Vault.Key (IORef value) -> value -> Middleware
insertNewIORefVaultMiddleware :: forall value. Key (IORef value) -> value -> Middleware
insertNewIORefVaultMiddleware Key (IORef value)
key value
defaultValue Application
app Request
req Response -> IO ResponseReceived
respond = do
    ref <- value -> IO (IORef value)
forall a. a -> IO (IORef a)
newIORef value
defaultValue
    let req' = Request
req { vault = Vault.insert key ref req.vault }
    app req' respond

{-# INLINE insertVaultMiddlewareAndGetter #-}
insertVaultMiddlewareAndGetter :: Typeable value => Vault.Key value -> (value -> Middleware, Request -> value)
insertVaultMiddlewareAndGetter :: forall value.
Typeable value =>
Key value -> (value -> Middleware, Request -> value)
insertVaultMiddlewareAndGetter Key value
key = (Key value -> value -> Middleware
forall value. Key value -> value -> Middleware
insertVaultMiddleware Key value
key, Key value -> Request -> value
forall value. Typeable value => Key value -> Request -> value
lookupRequestVault Key value
key)