{-# LANGUAGE BangPatterns #-}

-- | 'io-sim' implementation of 'TQueue' and 'TBQueue'.  Unlike the default
-- implementation available in 'io-classes' they are using a single 'TVar',
-- which simplifies the implementation of 'traceTQueue' and 'traceTBQueue'
-- methods.
--
module Control.Monad.IOSim.STM where

import           Control.Monad.Class.MonadSTM (MonadInspectSTM (..),
                     MonadLabelledSTM (..), MonadSTM (..), MonadTraceSTM (..),
                     TraceValue (..))

import           Numeric.Natural (Natural)

--
-- Default TQueue implementation in terms of 'Seq' (used by sim)
--

newtype TQueueDefault m a = TQueue (TVar m ([a], [a]))

labelTQueueDefault
  :: MonadLabelledSTM m
  => TQueueDefault m a -> String -> STM m ()
labelTQueueDefault :: TQueueDefault m a -> String -> STM m ()
labelTQueueDefault (TQueue TVar m ([a], [a])
queue) String
label =  TVar m ([a], [a]) -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m ([a], [a])
queue String
label

traceTQueueDefault
  :: MonadTraceSTM m
  => proxy m
  -> TQueueDefault m a
  -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
  -> STM m ()
traceTQueueDefault :: proxy m
-> TQueueDefault m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTQueueDefault proxy m
p (TQueue TVar m ([a], [a])
queue) Maybe [a] -> [a] -> InspectMonad m TraceValue
f =
    proxy m
-> TVar m ([a], [a])
-> (Maybe ([a], [a]) -> ([a], [a]) -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
p TVar m ([a], [a])
queue
              (\Maybe ([a], [a])
mas ([a], [a])
as -> Maybe [a] -> [a] -> InspectMonad m TraceValue
f (([a], [a]) -> [a]
forall a. ([a], [a]) -> [a]
g (([a], [a]) -> [a]) -> Maybe ([a], [a]) -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([a], [a])
mas) (([a], [a]) -> [a]
forall a. ([a], [a]) -> [a]
g ([a], [a])
as))
  where
    g :: ([a], [a]) -> [a]
g ([a]
xs, [a]
ys) = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys

newTQueueDefault :: MonadSTM m => STM m (TQueueDefault m a)
newTQueueDefault :: STM m (TQueueDefault m a)
newTQueueDefault = TVar m ([a], [a]) -> TQueueDefault m a
forall (m :: * -> *) a. TVar m ([a], [a]) -> TQueueDefault m a
TQueue (TVar m ([a], [a]) -> TQueueDefault m a)
-> STM m (TVar m ([a], [a])) -> STM m (TQueueDefault m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a], [a]) -> STM m (TVar m ([a], [a]))
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar ([], [])

writeTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
writeTQueueDefault :: TQueueDefault m a -> a -> STM m ()
writeTQueueDefault (TQueue TVar m ([a], [a])
queue) a
a = do
    ([a]
xs, [a]
ys) <- TVar m ([a], [a]) -> STM m ([a], [a])
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], [a])
queue
    TVar m ([a], [a]) -> ([a], [a]) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], [a])
queue (([a], [a]) -> STM m ()) -> ([a], [a]) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
xs, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)

readTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m a
readTQueueDefault :: TQueueDefault m a -> STM m a
readTQueueDefault TQueueDefault m a
queue = STM m a -> (a -> STM m a) -> Maybe a -> STM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m a) -> STM m (Maybe a) -> STM m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TQueueDefault m a -> STM m (Maybe a)
forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault TQueueDefault m a
queue

tryReadTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault :: TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault (TQueue TVar m ([a], [a])
queue) = do
  ([a]
xs, [a]
ys) <- TVar m ([a], [a]) -> STM m ([a], [a])
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], [a])
queue
  case [a]
xs of
    (a
x:[a]
xs') -> do
      TVar m ([a], [a]) -> ([a], [a]) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], [a])
queue (([a], [a]) -> STM m ()) -> ([a], [a]) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
xs', [a]
ys)
      Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    [] ->
      case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys of
        []     -> Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        (a
z:[a]
zs) -> do
          TVar m ([a], [a]) -> ([a], [a]) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], [a])
queue (([a], [a]) -> STM m ()) -> ([a], [a]) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
zs, [])
          Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
z)

isEmptyTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m Bool
isEmptyTQueueDefault :: TQueueDefault m a -> STM m Bool
isEmptyTQueueDefault (TQueue TVar m ([a], [a])
queue) = do
  ([a]
xs, [a]
ys) <- TVar m ([a], [a]) -> STM m ([a], [a])
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], [a])
queue
  Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> STM m Bool) -> Bool -> STM m Bool
forall a b. (a -> b) -> a -> b
$ case [a]
xs of
    a
_:[a]
_ -> Bool
False
    []  -> case [a]
ys of
             [] -> Bool
True
             [a]
_  -> Bool
False

peekTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m a
peekTQueueDefault :: TQueueDefault m a -> STM m a
peekTQueueDefault (TQueue TVar m ([a], [a])
queue) = do
    ([a]
xs, [a]
_) <- TVar m ([a], [a]) -> STM m ([a], [a])
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], [a])
queue
    case [a]
xs of
      a
x :[a]
_ -> a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      []   -> STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry

tryPeekTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m (Maybe a)
tryPeekTQueueDefault :: TQueueDefault m a -> STM m (Maybe a)
tryPeekTQueueDefault (TQueue TVar m ([a], [a])
queue) = do
    ([a]
xs, [a]
_) <- TVar m ([a], [a]) -> STM m ([a], [a])
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], [a])
queue
    Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m (Maybe a)) -> Maybe a -> STM m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case [a]
xs of
      a
x :[a]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
      []   -> Maybe a
forall a. Maybe a
Nothing

--
-- Default TBQueue implementation in terms of 'Seq' (used by sim)
--

data TBQueueDefault m a = TBQueue
  !(TVar m ([a], Natural, [a], Natural))
  !Natural

labelTBQueueDefault
  :: MonadLabelledSTM m
  => TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault :: TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) String
label = TVar m ([a], Natural, [a], Natural) -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m ([a], Natural, [a], Natural)
queue String
label

traceTBQueueDefault
  :: MonadTraceSTM m
  => proxy m
  -> TBQueueDefault m a
  -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
  -> STM m ()
traceTBQueueDefault :: proxy m
-> TBQueueDefault m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTBQueueDefault proxy m
p (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) Maybe [a] -> [a] -> InspectMonad m TraceValue
f =
    proxy m
-> TVar m ([a], Natural, [a], Natural)
-> (Maybe ([a], Natural, [a], Natural)
    -> ([a], Natural, [a], Natural) -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
p TVar m ([a], Natural, [a], Natural)
queue (\Maybe ([a], Natural, [a], Natural)
mas ([a], Natural, [a], Natural)
as -> Maybe [a] -> [a] -> InspectMonad m TraceValue
f (([a], Natural, [a], Natural) -> [a]
forall a b d. ([a], b, [a], d) -> [a]
g (([a], Natural, [a], Natural) -> [a])
-> Maybe ([a], Natural, [a], Natural) -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([a], Natural, [a], Natural)
mas) (([a], Natural, [a], Natural) -> [a]
forall a b d. ([a], b, [a], d) -> [a]
g ([a], Natural, [a], Natural)
as))
  where
    g :: ([a], b, [a], d) -> [a]
g ([a]
xs, b
_, [a]
ys, d
_) = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys


newTBQueueDefault :: MonadSTM m => Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault :: Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault Natural
size | Natural
size Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
                       = String -> STM m (TBQueueDefault m a)
forall a. HasCallStack => String -> a
error String
"newTBQueueDefault: size larger than Int"
newTBQueueDefault Natural
size =
  (TVar m ([a], Natural, [a], Natural)
 -> Natural -> TBQueueDefault m a)
-> Natural
-> TVar m ([a], Natural, [a], Natural)
-> TBQueueDefault m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar m ([a], Natural, [a], Natural)
-> Natural -> TBQueueDefault m a
forall (m :: * -> *) a.
TVar m ([a], Natural, [a], Natural)
-> Natural -> TBQueueDefault m a
TBQueue Natural
size (TVar m ([a], Natural, [a], Natural) -> TBQueueDefault m a)
-> STM m (TVar m ([a], Natural, [a], Natural))
-> STM m (TBQueueDefault m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([a], Natural, [a], Natural)
-> STM m (TVar m ([a], Natural, [a], Natural))
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (([a], Natural, [a], Natural)
 -> STM m (TVar m ([a], Natural, [a], Natural)))
-> ([a], Natural, [a], Natural)
-> STM m (TVar m ([a], Natural, [a], Natural))
forall a b. (a -> b) -> a -> b
$! ([], Natural
0, [], Natural
size))

readTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault :: TBQueueDefault m a -> STM m a
readTBQueueDefault TBQueueDefault m a
queue = STM m a -> (a -> STM m a) -> Maybe a -> STM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m a) -> STM m (Maybe a) -> STM m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TBQueueDefault m a -> STM m (Maybe a)
forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault TBQueueDefault m a
queue

tryReadTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault :: TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) = do
  ([a]
xs, Natural
r, [a]
ys, Natural
w) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  let !r' :: Natural
r' = Natural
r Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
  case [a]
xs of
    (a
x:[a]
xs') -> do
      TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue (([a], Natural, [a], Natural) -> STM m ())
-> ([a], Natural, [a], Natural) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
xs', Natural
r', [a]
ys, Natural
w)
      Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    [] ->
      case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys of
        [] -> do
          TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue (([a], Natural, [a], Natural) -> STM m ())
-> ([a], Natural, [a], Natural) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
xs, Natural
r', [a]
ys, Natural
w)
          Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

        -- NB. lazy: we want the transaction to be
        -- short, otherwise it will conflict
        (a
z:[a]
zs) -> do
           TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue (([a], Natural, [a], Natural) -> STM m ())
-> ([a], Natural, [a], Natural) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
zs, Natural
r', [], Natural
w)
           Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
z)

peekTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
peekTBQueueDefault :: TBQueueDefault m a -> STM m a
peekTBQueueDefault TBQueueDefault m a
queue = STM m a -> (a -> STM m a) -> Maybe a -> STM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m a) -> STM m (Maybe a) -> STM m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TBQueueDefault m a -> STM m (Maybe a)
forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m (Maybe a)
tryPeekTBQueueDefault TBQueueDefault m a
queue

tryPeekTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m (Maybe a)
tryPeekTBQueueDefault :: TBQueueDefault m a -> STM m (Maybe a)
tryPeekTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) = do
    ([a]
xs, Natural
_, [a]
_, Natural
_) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
    Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m (Maybe a)) -> Maybe a -> STM m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case [a]
xs of
      (a
x:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
      [a]
_     -> Maybe a
forall a. Maybe a
Nothing

writeTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> a -> STM m ()
writeTBQueueDefault :: TBQueueDefault m a -> a -> STM m ()
writeTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) a
a = do
  ([a]
xs, Natural
r, [a]
ys, Natural
w) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  if (Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
    then do let !w' :: Natural
w' = Natural
w Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
            TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue (([a], Natural, [a], Natural) -> STM m ())
-> ([a], Natural, [a], Natural) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([a]
xs, Natural
r, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, Natural
w')
    else do
          if (Natural
r Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
            then let !w' :: Natural
w' = Natural
r Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1 in
                 TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue ([a]
xs, Natural
0, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, Natural
w')
            else STM m ()
forall (m :: * -> *) a. MonadSTM m => STM m a
retry

isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault :: TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) = do
  ([a]
xs, Natural
_, [a]
_, Natural
_) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  case [a]
xs of
    a
_:[a]
_ -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    []  -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

isFullTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isFullTBQueueDefault :: TBQueueDefault m a -> STM m Bool
isFullTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
_size) = do
  ([a]
_, Natural
r, [a]
_, Natural
w) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> STM m Bool) -> Bool -> STM m Bool
forall a b. (a -> b) -> a -> b
$
    if (Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
    then Bool
False
    else if (Natural
r Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
         then Bool
False
         else Bool
True

lengthTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Natural
lengthTBQueueDefault :: TBQueueDefault m a -> STM m Natural
lengthTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
size) = do
  ([a]
_, Natural
r, [a]
_, Natural
w) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  Natural -> STM m Natural
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> STM m Natural) -> Natural -> STM m Natural
forall a b. (a -> b) -> a -> b
$! Natural
size Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
r Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
w

flushTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m [a]
flushTBQueueDefault :: TBQueueDefault m a -> STM m [a]
flushTBQueueDefault (TBQueue TVar m ([a], Natural, [a], Natural)
queue Natural
size) = do
  ([a]
xs, Natural
_, [a]
ys, Natural
_) <- TVar m ([a], Natural, [a], Natural)
-> STM m ([a], Natural, [a], Natural)
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m ([a], Natural, [a], Natural)
queue
  if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs Bool -> Bool -> Bool
&& [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys
    then [a] -> STM m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      TVar m ([a], Natural, [a], Natural)
-> ([a], Natural, [a], Natural) -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m ([a], Natural, [a], Natural)
queue (([a], Natural, [a], Natural) -> STM m ())
-> ([a], Natural, [a], Natural) -> STM m ()
forall a b. (a -> b) -> a -> b
$! ([], Natural
0, [], Natural
size)
      [a] -> STM m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys)