1 {-# LANGUAGE BangPatterns #-}
    2 {-# LANGUAGE CPP          #-}
    3 
    4 module Snap.Internal.Http.Server.Common
    5   ( atomicModifyIORef'
    6   , eatException
    7   ) where
    8 
    9 import           Control.Exception (SomeException, catch)
   10 import           Control.Monad     (void)
   11 import           Prelude           (IO, return, ($!))
   12 
   13 #if MIN_VERSION_base(4,6,0)
   14 ------------------------------------------------------------------------------
   15 import           Data.IORef        (atomicModifyIORef')
   16 
   17 #else
   18 ------------------------------------------------------------------------------
   19 import           Data.IORef        (IORef, atomicModifyIORef)
   20 import           Prelude           (seq)
   21 
   22 
   23 ------------------------------------------------------------------------------
   24 -- | Strict version of 'atomicModifyIORef'.  This forces both the value stored
   25 -- in the 'IORef' as well as the value returned.
   26 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
   27 atomicModifyIORef' ref f = do
   28     b <- atomicModifyIORef ref
   29             (\x -> let (a, b) = f x
   30                     in (a, a `seq` b))
   31     b `seq` return b
   32 #endif
   33 
   34 
   35 ------------------------------------------------------------------------------
   36 eatException :: IO a -> IO ()
   37 eatException m = void m `catch` f
   38   where
   39     f :: SomeException -> IO ()
   40     f !_ = return $! ()