content: {-# LANGUAGE ScopedTypeVariables #-}
  module Network.AMQP.Helpers where
  
  import Control.Concurrent
  import Control.Exception
  import Control.Monad
  import Data.Int (Int64)
  import System.Clock
  
  import qualified Data.ByteString.Char8 as BS
  import qualified Data.ByteString.Lazy.Char8 as BL
  
  toStrict :: BL.ByteString -> BS.ByteString
  toStrict = BS.concat . BL.toChunks
  
  toLazy :: BS.ByteString -> BL.ByteString
  toLazy = BL.fromChunks . return
  
  -- if the lock is open, calls to waitLock will immediately return.
  -- if it is closed, calls to waitLock will block.
  -- if the lock is killed, it will always be open and can't be closed anymore
  data Lock = Lock (MVar Bool) (MVar ())
  
  newLock :: IO Lock
  newLock = liftM2 Lock (newMVar False) (newMVar ())
  
  openLock :: Lock -> IO ()
  openLock (Lock _ b) = void $ tryPutMVar b ()
  
  closeLock :: Lock -> IO ()
  closeLock (Lock a b) = withMVar a $ flip unless (void $ tryTakeMVar b)
  
  waitLock :: Lock -> IO ()
  waitLock (Lock _ b) = readMVar b
  
  killLock :: Lock -> IO Bool
  killLock (Lock a b) = do
      modifyMVar_ a $ const (return True)
      tryPutMVar b ()
  
  chooseMin :: Ord a => a -> Maybe a -> a
  chooseMin a (Just b) = min a b
  chooseMin a Nothing  = a
  
  getTimestamp :: IO Int64
  getTimestamp = µs <$> getTime Monotonic
    where
      seconds spec = (fromIntegral . sec) spec * 1000 * 1000
      micros spec = (fromIntegral . nsec) spec `div` 1000
      µs spec = seconds spec + micros spec
  
  scheduleAtFixedRate :: Int -> IO () -> IO ThreadId
  scheduleAtFixedRate interval_µs action = forkIO $ forever $ do
      action
      threadDelay interval_µs
  
  -- | Copy of base's 'forkFinally', to support GHC < 7.6.x
  forkFinally' :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
  forkFinally' action and_then =
    mask $ \restore ->
      forkIO $ try (restore action) >>= and_then
  