{-# LANGUAGE TypeFamilies #-}
module Data.Mutable.Deque
    ( Deque
    , UDeque
    , asUDeque
    , SDeque
    , asSDeque
    , BDeque
    , asBDeque
    , module Data.Mutable.Class
    ) where

import           Control.Exception            (assert)
import           Control.Monad                (liftM)
import           Data.Mutable.Class
import qualified Data.Vector.Generic.Mutable  as V
import qualified Data.Vector.Mutable          as B
import qualified Data.Vector.Storable.Mutable as S
import qualified Data.Vector.Unboxed.Mutable  as U

data DequeState v s a = DequeState
    (v s a)
    {-# UNPACK #-} !Int -- start
    {-# UNPACK #-} !Int -- size

-- | A double-ended queue supporting any underlying vector type and any monad.
--
-- This implements a circular double-ended queue with exponential growth.
--
-- Since 0.2.0
newtype Deque v s a = Deque (MutVar s (DequeState v s a))

-- | A 'Deque' specialized to unboxed vectors.
--
-- Since 0.2.0
type UDeque = Deque U.MVector

-- | A 'Deque' specialized to storable vectors.
--
-- Since 0.2.0
type SDeque = Deque S.MVector

-- | A 'Deque' specialized to boxed vectors.
--
-- Since 0.2.0
type BDeque = Deque B.MVector

-- |
-- Since 0.2.0
asUDeque :: UDeque s a -> UDeque s a
asUDeque :: forall s a. UDeque s a -> UDeque s a
asUDeque = UDeque s a -> UDeque s a
forall a. a -> a
id

-- |
-- Since 0.2.0
asSDeque :: SDeque s a -> SDeque s a
asSDeque :: forall s a. SDeque s a -> SDeque s a
asSDeque = SDeque s a -> SDeque s a
forall a. a -> a
id

-- |
-- Since 0.2.0
asBDeque :: BDeque s a -> BDeque s a
asBDeque :: forall s a. BDeque s a -> BDeque s a
asBDeque = BDeque s a -> BDeque s a
forall a. a -> a
id

instance MutableContainer (Deque v s a) where
    type MCState (Deque v s a) = s
instance V.MVector v a => MutableCollection (Deque v s a) where
    type CollElement (Deque v s a) = a
    newColl :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
m (Deque v s a)
newColl = do
        v s a
v <- Int -> m (v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
V.new Int
baseSize
        (MutVar s (DequeState v s a) -> Deque v s a)
-> m (MutVar s (DequeState v s a)) -> m (Deque v s a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM MutVar s (DequeState v s a) -> Deque v s a
forall (v :: * -> * -> *) s a.
MutVar s (DequeState v s a) -> Deque v s a
Deque (m (MutVar s (DequeState v s a)) -> m (Deque v s a))
-> m (MutVar s (DequeState v s a)) -> m (Deque v s a)
forall a b. (a -> b) -> a -> b
$ RefElement (MutVar s (DequeState v s a))
-> m (MutVar s (DequeState v s a))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
RefElement c -> m c
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
RefElement (MutVar s (DequeState v s a))
-> m (MutVar s (DequeState v s a))
newRef (v s a -> Int -> Int -> DequeState v s a
forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
0 Int
0)
      where
        baseSize :: Int
baseSize = Int
32
    {-# INLINE newColl #-}
instance V.MVector v a => MutablePopFront (Deque v s a) where
    popFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> m (Maybe (CollElement (Deque v s a)))
popFront (Deque MutVar s (DequeState v s a)
var) = do
        DequeState v s a
v Int
start Int
size <- MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
readRef MutVar s (DequeState v s a)
var
        if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            else do
                a
x <- v (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead v s a
v (PrimState m) a
v Int
start
                let start' :: Int
start' = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    start'' :: Int
start''
                        | Int
start' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
0
                        | Bool
otherwise = Int
start'
                MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
writeRef MutVar s (DequeState v s a)
var (DequeState v s a -> m ()) -> DequeState v s a -> m ()
forall a b. (a -> b) -> a -> b
$! v s a -> Int -> Int -> DequeState v s a
forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start'' (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
x
    {-# INLINE popFront #-}
instance V.MVector v a => MutablePopBack (Deque v s a) where
    popBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> m (Maybe (CollElement (Deque v s a)))
popBack (Deque MutVar s (DequeState v s a)
var) = do
        DequeState v s a
v Int
start Int
size <- MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
readRef MutVar s (DequeState v s a)
var
        if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            else do
                let size' :: Int
size' = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size'
                    end' :: Int
end'
                        | Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
                        | Bool
otherwise = Int
end
                a
x <- v (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead v s a
v (PrimState m) a
v Int
end'
                MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
writeRef MutVar s (DequeState v s a)
var (DequeState v s a -> m ()) -> DequeState v s a -> m ()
forall a b. (a -> b) -> a -> b
$! v s a -> Int -> Int -> DequeState v s a
forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start Int
size'
                Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
x
    {-# INLINE popBack #-}
instance V.MVector v a => MutablePushFront (Deque v s a) where
    pushFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> CollElement (Deque v s a) -> m ()
pushFront (Deque MutVar s (DequeState v s a)
var) CollElement (Deque v s a)
x = do
        DequeState v s a
v Int
start Int
size <- MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
readRef MutVar s (DequeState v s a)
var
        v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size
      where
        inner :: v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size = do
            if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
                then v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m ()) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v s a
v (PrimState m) a
v Int
start Int
size v s a -> Int -> Int -> m ()
v (PrimState m) a -> Int -> Int -> m ()
inner
                else do
                    let size' :: Int
size' = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        start' :: Int
start' = (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
                        start'' :: Int
start''
                            | Int
start' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start'
                            | Bool
otherwise = Int
start'
                    v (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite v s a
v (PrimState m) a
v Int
start'' a
CollElement (Deque v s a)
x
                    MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
writeRef MutVar s (DequeState v s a)
var (DequeState v s a -> m ()) -> DequeState v s a -> m ()
forall a b. (a -> b) -> a -> b
$! v s a -> Int -> Int -> DequeState v s a
forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start'' Int
size'
    {-# INLINE pushFront #-}
instance V.MVector v a => MutablePushBack (Deque v s a) where
    pushBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> CollElement (Deque v s a) -> m ()
pushBack (Deque MutVar s (DequeState v s a)
var) CollElement (Deque v s a)
x = do
        DequeState v s a
v Int
start Int
size <- MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> m (RefElement (MutVar s (DequeState v s a)))
readRef MutVar s (DequeState v s a)
var
        v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size
      where
        inner :: v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size = do
            if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
                then v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m ()) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v s a
v (PrimState m) a
v Int
start Int
size v s a -> Int -> Int -> m ()
v (PrimState m) a -> Int -> Int -> m ()
inner
                else do
                    let end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size
                        end' :: Int
end'
                            | Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
                            | Bool
otherwise = Int
end
                    v (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite v s a
v (PrimState m) a
v Int
end' a
CollElement (Deque v s a)
x
                    MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
forall (m :: * -> *).
(PrimMonad m,
 PrimState m ~ MCState (MutVar s (DequeState v s a))) =>
MutVar s (DequeState v s a)
-> RefElement (MutVar s (DequeState v s a)) -> m ()
writeRef MutVar s (DequeState v s a)
var (DequeState v s a -> m ()) -> DequeState v s a -> m ()
forall a b. (a -> b) -> a -> b
$! v s a -> Int -> Int -> DequeState v s a
forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    {-# INLINE pushBack #-}

newVector :: (PrimMonad m, V.MVector v a)
          => v (PrimState m) a
          -> Int
          -> Int
          -> (v (PrimState m) a -> Int -> Int -> m b)
          -> m b
newVector :: forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v (PrimState m) a
v Int
size2 Int
sizeOrig v (PrimState m) a -> Int -> Int -> m b
f = Bool -> m b -> m b
forall a. HasCallStack => Bool -> a -> a
assert (Int
sizeOrig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== v (PrimState m) a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v) (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
    v (PrimState m) a
v' <- Int -> m (v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
V.unsafeNew (v (PrimState m) a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
    let size1 :: Int
size1 = v (PrimState m) a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size2
    v (PrimState m) a -> v (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
V.unsafeCopy
        (Int -> v (PrimState m) a -> v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
V.unsafeTake Int
size1 v (PrimState m) a
v')
        (Int -> Int -> v (PrimState m) a -> v (PrimState m) a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
V.unsafeSlice Int
size2 Int
size1 v (PrimState m) a
v)
    v (PrimState m) a -> v (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
V.unsafeCopy
        (Int -> Int -> v (PrimState m) a -> v (PrimState m) a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
V.unsafeSlice Int
size1 Int
size2 v (PrimState m) a
v')
        (Int -> v (PrimState m) a -> v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
V.unsafeTake Int
size2 v (PrimState m) a
v)
    v (PrimState m) a -> Int -> Int -> m b
f v (PrimState m) a
v' Int
0 Int
sizeOrig
{-# INLINE newVector #-}