{-# LANGUAGE TypeFamilies #-}
-- | Use 1-length mutable boxed vectors for mutable references.
--
-- Motivated by: <http://stackoverflow.com/questions/27261813/why-is-my-little-stref-int-require-allocating-gigabytes> and ArrayRef.
module Data.Mutable.BRef
    ( -- * Types
      BRef
    , IOBRef
      -- * Functions
    , asBRef
    , MutableRef (..)
    ) where

import           Control.Monad               (liftM)
import           Data.Monoid                 (Monoid, mempty)
import           Data.MonoTraversable        (Element)
import           Data.Mutable.Class
import           Data.Sequences              (IsSequence)
import qualified Data.Vector.Generic.Mutable as V
import qualified Data.Vector.Mutable         as VB

-- | A boxed vector reference, supporting any monad.
--
-- Since 0.2.0
newtype BRef s a = BRef (VB.MVector s a)

-- |
-- Since 0.2.0
asBRef :: BRef s a -> BRef s a
asBRef :: forall s a. BRef s a -> BRef s a
asBRef BRef s a
x = BRef s a
x
{-# INLINE asBRef #-}

-- | A boxed IO vector reference.
type IOBRef = BRef (PrimState IO)

instance MutableContainer (BRef s a) where
    type MCState (BRef s a) = s
instance MutableRef (BRef s a) where
    type RefElement (BRef s a) = a

    newRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
RefElement (BRef s a) -> m (BRef s a)
newRef = (MVector s a -> BRef s a) -> m (MVector s a) -> m (BRef s a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM MVector s a -> BRef s a
forall s a. MVector s a -> BRef s a
BRef (m (MVector s a) -> m (BRef s a))
-> (a -> m (MVector s a)) -> a -> m (BRef s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> a -> m (v (PrimState m) a)
V.replicate Int
1
    {-# INLINE newRef#-}

    readRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
BRef s a -> m (RefElement (BRef s a))
readRef (BRef MVector s a
v) = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead MVector s a
MVector (PrimState m) a
v Int
0
    {-# INLINE readRef #-}

    writeRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
BRef s a -> RefElement (BRef s a) -> m ()
writeRef (BRef MVector s a
v) = MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite MVector s a
MVector (PrimState m) a
v Int
0
    {-# INLINE writeRef #-}

    modifyRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
BRef s a
-> (RefElement (BRef s a) -> RefElement (BRef s a)) -> m ()
modifyRef (BRef MVector s a
v) RefElement (BRef s a) -> RefElement (BRef s a)
f = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead MVector s a
MVector (PrimState m) a
v Int
0 m a -> (a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite MVector s a
MVector (PrimState m) a
v Int
0 (a -> m ()) -> (a -> a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
RefElement (BRef s a) -> RefElement (BRef s a)
f
    {-# INLINE modifyRef #-}

    modifyRef' :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
BRef s a
-> (RefElement (BRef s a) -> RefElement (BRef s a)) -> m ()
modifyRef' = BRef s a
-> (RefElement (BRef s a) -> RefElement (BRef s a)) -> m ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> (RefElement c -> RefElement c) -> m ()
forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s a)) =>
BRef s a
-> (RefElement (BRef s a) -> RefElement (BRef s a)) -> m ()
modifyRef
    {-# INLINE modifyRef' #-}

instance Monoid w => MutableCollection (BRef s w) where
    type CollElement (BRef s w) = Element w
    newColl :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s w)) =>
m (BRef s w)
newColl = RefElement (BRef s w) -> m (BRef s w)
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
RefElement c -> m c
forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s w)) =>
RefElement (BRef s w) -> m (BRef s w)
newRef w
RefElement (BRef s w)
forall a. Monoid a => a
mempty
    {-# INLINE newColl #-}
instance IsSequence seq => MutablePushFront (BRef s seq) where
    pushFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s seq)) =>
BRef s seq -> CollElement (BRef s seq) -> m ()
pushFront = BRef s seq -> CollElement (BRef s seq) -> m ()
forall (m :: * -> *) c.
(PrimMonad m, PrimState m ~ MCState c, MutableRef c,
 CollElement c ~ Element (RefElement c),
 IsSequence (RefElement c)) =>
c -> CollElement c -> m ()
pushFrontRef
    {-# INLINE pushFront #-}
instance IsSequence seq => MutablePushBack (BRef s seq) where
    pushBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s seq)) =>
BRef s seq -> CollElement (BRef s seq) -> m ()
pushBack = BRef s seq -> CollElement (BRef s seq) -> m ()
forall (m :: * -> *) c.
(PrimMonad m, PrimState m ~ MCState c, MutableRef c,
 CollElement c ~ Element (RefElement c),
 IsSequence (RefElement c)) =>
c -> CollElement c -> m ()
pushBackRef
    {-# INLINE pushBack #-}
instance IsSequence seq => MutablePopFront (BRef s seq) where
    popFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s seq)) =>
BRef s seq -> m (Maybe (CollElement (BRef s seq)))
popFront = BRef s seq -> m (Maybe (CollElement (BRef s seq)))
forall (m :: * -> *) c.
(PrimMonad m, PrimState m ~ MCState c, MutableRef c,
 CollElement c ~ Element (RefElement c),
 IsSequence (RefElement c)) =>
c -> m (Maybe (CollElement c))
popFrontRef
    {-# INLINE popFront #-}
instance IsSequence seq => MutablePopBack (BRef s seq) where
    popBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (BRef s seq)) =>
BRef s seq -> m (Maybe (CollElement (BRef s seq)))
popBack = BRef s seq -> m (Maybe (CollElement (BRef s seq)))
forall (m :: * -> *) c.
(PrimMonad m, PrimState m ~ MCState c, MutableRef c,
 CollElement c ~ Element (RefElement c),
 IsSequence (RefElement c)) =>
c -> m (Maybe (CollElement c))
popBackRef
    {-# INLINE popBack #-}