{-# 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 = fmap µ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