{-# 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 :: ByteString -> ByteString
toStrict = [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks

toLazy :: BS.ByteString -> BL.ByteString
toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
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 :: IO Lock
newLock = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 MVar Bool -> MVar () -> Lock
Lock (forall a. a -> IO (MVar a)
newMVar Bool
False) (forall a. a -> IO (MVar a)
newMVar ())

openLock :: Lock -> IO ()
openLock :: Lock -> IO ()
openLock (Lock MVar Bool
_ MVar ()
b) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
b ()

closeLock :: Lock -> IO ()
closeLock :: Lock -> IO ()
closeLock (Lock MVar Bool
a MVar ()
b) = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Bool
a forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
b)

waitLock :: Lock -> IO ()
waitLock :: Lock -> IO ()
waitLock (Lock MVar Bool
_ MVar ()
b) = forall a. MVar a -> IO a
readMVar MVar ()
b

killLock :: Lock -> IO Bool
killLock :: Lock -> IO Bool
killLock (Lock MVar Bool
a MVar ()
b) = do
    forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
a forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
    forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
b ()

chooseMin :: Ord a => a -> Maybe a -> a
chooseMin :: forall a. Ord a => a -> Maybe a -> a
chooseMin a
a (Just a
b) = forall a. Ord a => a -> a -> a
min a
a a
b
chooseMin a
a Maybe a
Nothing  = a
a

getTimestamp :: IO Int64
getTimestamp :: IO Int64
getTimestamp = forall {a}. Integral a => TimeSpec -> a
µs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
Monotonic
  where
    seconds :: TimeSpec -> a
seconds TimeSpec
spec = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Int64
sec) TimeSpec
spec forall a. Num a => a -> a -> a
* a
1000 forall a. Num a => a -> a -> a
* a
1000
    micros :: TimeSpec -> a
micros TimeSpec
spec = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Int64
nsec) TimeSpec
spec forall a. Integral a => a -> a -> a
`div` a
1000
    µs :: TimeSpec -> a
µs TimeSpec
spec = forall {a}. Num a => TimeSpec -> a
seconds TimeSpec
spec forall a. Num a => a -> a -> a
+ forall {a}. Integral a => TimeSpec -> a
micros TimeSpec
spec

scheduleAtFixedRate :: Int -> IO () -> IO ThreadId
scheduleAtFixedRate :: Int -> IO () -> IO ThreadId
scheduleAtFixedRate Int
interval_µs IO ()
action = IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    IO ()
action
    Int -> IO ()
threadDelay Int
interval_µs

-- | Copy of base's 'forkFinally', to support GHC < 7.6.x

forkFinally' :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally' :: forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally' IO a
action Either SomeException a -> IO ()
and_then =
  forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
    IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. IO a -> IO a
restore IO a
action) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> IO ()
and_then