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

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

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

waitLock :: Lock -> IO ()
waitLock :: Lock -> IO ()
waitLock (Lock MVar Bool
_ MVar ()
b) = MVar () -> IO ()
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
    MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
a ((Bool -> IO Bool) -> IO ()) -> (Bool -> IO Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> Bool -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
    MVar () -> () -> IO Bool
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) = a -> a -> a
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 = TimeSpec -> Int64
forall {a}. Integral a => TimeSpec -> a
µs (TimeSpec -> Int64) -> IO TimeSpec -> IO Int64
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 = (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> a) -> (TimeSpec -> Int64) -> TimeSpec -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Int64
sec) TimeSpec
spec a -> a -> a
forall a. Num a => a -> a -> a
* a
1000 a -> a -> a
forall a. Num a => a -> a -> a
* a
1000
    micros :: TimeSpec -> a
micros TimeSpec
spec = (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> a) -> (TimeSpec -> Int64) -> TimeSpec -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Int64
nsec) TimeSpec
spec a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1000
    µs :: TimeSpec -> a
µs TimeSpec
spec = TimeSpec -> a
forall {a}. Num a => TimeSpec -> a
seconds TimeSpec
spec a -> a -> a
forall a. Num a => a -> a -> a
+ TimeSpec -> 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 (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
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 a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
    IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO a
forall a. IO a -> IO a
restore IO a
action) IO (Either SomeException a)
-> (Either SomeException 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
>>= Either SomeException a -> IO ()
and_then