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 $! ()