    {-# LANGUAGE TypeFamilies, CPP, BangPatterns #-}

    {-|
      A strawman implementation of concurrent Dequeues.  This
      implementation is so simple that it also makes a good reference
      implementation for debugging.

      The queue representation is simply an IORef containing a Data.Sequence.

      Also see "Data.Concurrent.Deque.Reference.DequeInstance".
      By convention a module of this name is also provided.

    -}

    module Data.Concurrent.Deque.Reference
     (SimpleDeque(..),
      newQ, nullQ, newBoundedQ, pushL, pushR, tryPopR, tryPopL, tryPushL, tryPushR,

      _is_using_CAS -- Internal
     )
     where

    import Prelude hiding (length)
    import qualified Data.Concurrent.Deque.Class as C
    import Data.Sequence
    import Data.IORef

    #ifdef USE_CAS
    #warning "abstract-deque: reference implementation using CAS..."
    import Data.CAS (atomicModifyIORefCAS)
    -- Toggle these and compare performance:
    modify = atomicModifyIORefCAS
    _is_using_CAS = True
    #else
    modify :: forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify = IORef a -> (a -> (a, b)) -> IO b
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef
    _is_using_CAS :: Bool
    _is_using_CAS = Bool
    False
    #endif

    {-# INLINE modify #-}
    modify :: IORef a -> (a -> (a, b)) -> IO b
    _is_using_CAS :: Bool

    -- | Stores a size bound (if any) as well as a mutable Seq.
    data SimpleDeque elt = DQ {-# UNPACK #-} !Int !(IORef (Seq elt))

    newQ :: IO (SimpleDeque elt)
    newQ :: forall elt. IO (SimpleDeque elt)
    newQ = do r <- Seq elt -> IO (IORef (Seq elt))
    forall a. a -> IO (IORef a)
    newIORef Seq elt
    forall a. Seq a
    empty
    	  return $! DQ 0 r

    newBoundedQ :: Int -> IO (SimpleDeque elt)
    newBoundedQ :: forall elt. Int -> IO (SimpleDeque elt)
    newBoundedQ Int
    lim =
      do r <- Seq elt -> IO (IORef (Seq elt))
    forall a. a -> IO (IORef a)
    newIORef Seq elt
    forall a. Seq a
    empty
         return $! DQ lim r

    pushL :: SimpleDeque t -> t -> IO ()
    pushL :: forall t. SimpleDeque t -> t -> IO ()
    pushL (DQ Int
    0 IORef (Seq t)
    qr) !t
    x = do
       () <- IORef (Seq t) -> (Seq t -> (Seq t, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq t)
    qr Seq t -> (Seq t, ())
    addleft
       return ()
     where
       -- Here we are very strict to avoid stack leaks.
       addleft :: Seq t -> (Seq t, ())
    addleft !Seq t
    s = Seq t
    extended Seq t -> (Seq t, ()) -> (Seq t, ())
    forall a b. a -> b -> b
    `seq` (Seq t, ())
    pair
        where extended :: Seq t
    extended = t
    x t -> Seq t -> Seq t
    forall a. a -> Seq a -> Seq a
    <| Seq t
    s
              pair :: (Seq t, ())
    pair = (Seq t
    extended, ())
    pushL (DQ Int
    n IORef (Seq t)
    _) t
    _ = [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "should not call pushL on Deque with size bound "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n

    tryPopR :: SimpleDeque a -> IO (Maybe a)
    tryPopR :: forall a. SimpleDeque a -> IO (Maybe a)
    tryPopR (DQ Int
    _ IORef (Seq a)
    qr) = IORef (Seq a) -> (Seq a -> (Seq a, Maybe a)) -> IO (Maybe a)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq a)
    qr ((Seq a -> (Seq a, Maybe a)) -> IO (Maybe a))
    -> (Seq a -> (Seq a, Maybe a)) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \ Seq a
    s ->
       case Seq a -> ViewR a
    forall a. Seq a -> ViewR a
    viewr Seq a
    s of
         ViewR a
    EmptyR  -> (Seq a
    forall a. Seq a
    empty, Maybe a
    forall a. Maybe a
    Nothing)
         Seq a
    s' :> a
    x -> (Seq a
    s', a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)

    nullQ :: SimpleDeque elt -> IO Bool
    nullQ :: forall elt. SimpleDeque elt -> IO Bool
    nullQ (DQ Int
    _ IORef (Seq elt)
    qr) =
      do s <- IORef (Seq elt) -> IO (Seq elt)
    forall a. IORef a -> IO a
    readIORef IORef (Seq elt)
    qr
         case viewr s of
           ViewR elt
    EmptyR -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
           Seq elt
    _ :> elt
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    --   -- This simplistic version simply spins:
    --   popR q = do x <- tryPopR q
    -- 	      case x of
    -- 	        Nothing -> popR q
    -- 		Just x  -> return x

    --   popL q = do x <- tryPopL q
    -- 	      case x of
    -- 	        Nothing -> popL q
    -- 		Just x  -> return x

    tryPopL :: SimpleDeque a -> IO (Maybe a)
    tryPopL :: forall a. SimpleDeque a -> IO (Maybe a)
    tryPopL (DQ Int
    _ IORef (Seq a)
    qr) = IORef (Seq a) -> (Seq a -> (Seq a, Maybe a)) -> IO (Maybe a)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq a)
    qr ((Seq a -> (Seq a, Maybe a)) -> IO (Maybe a))
    -> (Seq a -> (Seq a, Maybe a)) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \Seq a
    s ->
      case Seq a -> ViewL a
    forall a. Seq a -> ViewL a
    viewl Seq a
    s of
        ViewL a
    EmptyL  -> (Seq a
    forall a. Seq a
    empty, Maybe a
    forall a. Maybe a
    Nothing)
        a
    x :< Seq a
    s' -> (Seq a
    s', a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)

    pushR :: SimpleDeque t -> t -> IO ()
    pushR :: forall t. SimpleDeque t -> t -> IO ()
    pushR (DQ Int
    0 IORef (Seq t)
    qr) t
    x = IORef (Seq t) -> (Seq t -> (Seq t, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq t)
    qr (\Seq t
    s -> (Seq t
    s Seq t -> t -> Seq t
    forall a. Seq a -> a -> Seq a
    |> t
    x, ()))
    pushR (DQ Int
    n IORef (Seq t)
    _) t
    _ = [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "should not call pushR on Deque with size bound "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n

    tryPushL :: SimpleDeque a -> a -> IO Bool
    tryPushL :: forall a. SimpleDeque a -> a -> IO Bool
    tryPushL q :: SimpleDeque a
    q@(DQ Int
    0 IORef (Seq a)
    _) a
    v = SimpleDeque a -> a -> IO ()
    forall t. SimpleDeque t -> t -> IO ()
    pushL SimpleDeque a
    q a
    v IO () -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    tryPushL (DQ Int
    lim IORef (Seq a)
    qr) a
    v =
      IORef (Seq a) -> (Seq a -> (Seq a, Bool)) -> IO Bool
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq a)
    qr ((Seq a -> (Seq a, Bool)) -> IO Bool)
    -> (Seq a -> (Seq a, Bool)) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Seq a
    s ->
         if Seq a -> Int
    forall a. Seq a -> Int
    length Seq a
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    lim
         then (Seq a
    s, Bool
    False)
         else (a
    v a -> Seq a -> Seq a
    forall a. a -> Seq a -> Seq a
    <| Seq a
    s, Bool
    True)

    tryPushR :: SimpleDeque a -> a -> IO Bool
    tryPushR :: forall a. SimpleDeque a -> a -> IO Bool
    tryPushR q :: SimpleDeque a
    q@(DQ Int
    0 IORef (Seq a)
    _) a
    v = SimpleDeque a -> a -> IO ()
    forall t. SimpleDeque t -> t -> IO ()
    pushR SimpleDeque a
    q a
    v IO () -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    tryPushR (DQ Int
    lim IORef (Seq a)
    qr) a
    v =
      IORef (Seq a) -> (Seq a -> (Seq a, Bool)) -> IO Bool
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    modify IORef (Seq a)
    qr ((Seq a -> (Seq a, Bool)) -> IO Bool)
    -> (Seq a -> (Seq a, Bool)) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Seq a
    s ->
         if Seq a -> Int
    forall a. Seq a -> Int
    length Seq a
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    lim
         then (Seq a
    s, Bool
    False)
         else (Seq a
    s Seq a -> a -> Seq a
    forall a. Seq a -> a -> Seq a
    |> a
    v, Bool
    True)

    --------------------------------------------------------------------------------
    --   Instances
    --------------------------------------------------------------------------------

    instance C.DequeClass SimpleDeque where
      newQ :: forall elt. IO (SimpleDeque elt)
    newQ     = IO (SimpleDeque elt)
    forall elt. IO (SimpleDeque elt)
    newQ
      nullQ :: forall elt. SimpleDeque elt -> IO Bool
    nullQ    = SimpleDeque elt -> IO Bool
    forall elt. SimpleDeque elt -> IO Bool
    nullQ
      pushL :: forall t. SimpleDeque t -> t -> IO ()
    pushL    = SimpleDeque elt -> elt -> IO ()
    forall t. SimpleDeque t -> t -> IO ()
    pushL
      tryPopR :: forall a. SimpleDeque a -> IO (Maybe a)
    tryPopR  = SimpleDeque elt -> IO (Maybe elt)
    forall a. SimpleDeque a -> IO (Maybe a)
    tryPopR
      leftThreadSafe :: forall elt. SimpleDeque elt -> Bool
    leftThreadSafe SimpleDeque elt
    _ = Bool
    True
      rightThreadSafe :: forall elt. SimpleDeque elt -> Bool
    rightThreadSafe SimpleDeque elt
    _ = Bool
    True
    instance C.PopL SimpleDeque where
      tryPopL :: forall a. SimpleDeque a -> IO (Maybe a)
    tryPopL  = SimpleDeque elt -> IO (Maybe elt)
    forall a. SimpleDeque a -> IO (Maybe a)
    tryPopL
    instance C.PushR SimpleDeque where
      pushR :: forall t. SimpleDeque t -> t -> IO ()
    pushR    = SimpleDeque elt -> elt -> IO ()
    forall t. SimpleDeque t -> t -> IO ()
    pushR

    instance C.BoundedL SimpleDeque where
      tryPushL :: forall a. SimpleDeque a -> a -> IO Bool
    tryPushL    = SimpleDeque elt -> elt -> IO Bool
    forall a. SimpleDeque a -> a -> IO Bool
    tryPushL
      newBoundedQ :: forall elt. Int -> IO (SimpleDeque elt)
    newBoundedQ = Int -> IO (SimpleDeque elt)
    forall elt. Int -> IO (SimpleDeque elt)
    newBoundedQ

    instance C.BoundedR SimpleDeque where
      tryPushR :: forall a. SimpleDeque a -> a -> IO Bool
    tryPushR = SimpleDeque elt -> elt -> IO Bool
    forall a. SimpleDeque a -> a -> IO Bool
    tryPushR