{-# LANGUAGE CPP, NoImplicitPrelude #-}

module Utils
    ( mask
    , mask_
    , (.!)
    , void
    , ifM
    , purelyModifyMVar
    , modifyIORefM
    , modifyIORefM_
    ) where

--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------

-- from base:
import Control.Concurrent.MVar ( MVar, takeMVar, putMVar )
import Control.Monad           ( Monad, return, (>>=) )
import Data.Bool               ( Bool )
import Data.Function           ( ($), (.) )
import Data.IORef              ( IORef, readIORef, writeIORef )
import Prelude                 ( ($!) )
import System.IO               ( IO )

#if __GLASGOW_HASKELL__ < 700
import Control.Monad           ( (>>), fail )
#endif


--------------------------------------------------------------------------------
-- Utility functions
--------------------------------------------------------------------------------

#if MIN_VERSION_base(4,3,0)
import Control.Exception       ( mask, mask_ )
import Control.Monad           ( void )
#else
import Control.Exception       ( blocked, block, unblock )
import Data.Function           ( id )
import Data.Functor            ( Functor, (<$) )

mask :: ((IO a -> IO a) -> IO b) -> IO b
mask io = blocked >>= \b -> if b then io id else block $ io unblock

mask_ :: IO a -> IO a
mask_ = block

void :: (Functor f) => f a -> f ()
void = (() <$)
#endif

-- | Strict function composition.
(.!) :: (b -> γ) -> (a -> b) -> (a -> γ)
b -> γ
f .! :: forall b γ a. (b -> γ) -> (a -> b) -> a -> γ
.! a -> b
g = (b -> γ
f (b -> γ) -> b -> γ
forall a b. (a -> b) -> a -> b
$!) (b -> γ) -> (a -> b) -> a -> γ
forall b γ a. (b -> γ) -> (a -> b) -> a -> γ
. a -> b
g

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
c m a
t m a
e = m Bool
c m Bool -> (Bool -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
t else m a
e

purelyModifyMVar :: MVar a -> (a -> a) -> IO ()
purelyModifyMVar :: forall a. MVar a -> (a -> a) -> IO ()
purelyModifyMVar MVar a
mv a -> a
f = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
mv IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
mv (a -> IO ()) -> (a -> a) -> a -> IO ()
forall b γ a. (b -> γ) -> (a -> b) -> a -> γ
.! a -> a
f

modifyIORefM :: IORef a -> (a -> IO (a, b)) -> IO b
modifyIORefM :: forall a b. IORef a -> (a -> IO (a, b)) -> IO b
modifyIORefM IORef a
r a -> IO (a, b)
f = do (a
y, b
z) <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r IO a -> (a -> IO (a, b)) -> IO (a, b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (a, b)
f
                      IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r a
y
                      b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
z

modifyIORefM_ :: IORef a -> (a -> IO a) -> IO ()
modifyIORefM_ :: forall a. IORef a -> (a -> IO a) -> IO ()
modifyIORefM_ IORef a
r a -> IO a
f = IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
f IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r