{-# LANGUAGE TypeFamilies #-}
-- | Use 1-length mutable storable 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.SRef
    ( -- * Types
      SRef
    , IOSRef
      -- * Functions
    , asSRef
    , MutableRef (..)
    ) where

import           Data.Mutable.Class
import Foreign.ForeignPtr
import Foreign.Storable
import Control.Monad.Primitive

-- | A storable vector reference, supporting any monad.
--
-- Since 0.2.0
newtype SRef s a = SRef (ForeignPtr a)

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

-- | A storable IO vector reference.
type IOSRef = SRef (PrimState IO)

instance MutableContainer (SRef s a) where
    type MCState (SRef s a) = s
instance Storable a => MutableRef (SRef s a) where
    type RefElement (SRef s a) = a

    newRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (SRef s a)) =>
RefElement (SRef s a) -> m (SRef s a)
newRef RefElement (SRef s a)
x = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ do
        ForeignPtr a
fptr <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Storable a => Ptr a -> a -> IO ()
poke RefElement (SRef s a)
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s a. ForeignPtr a -> SRef s a
SRef ForeignPtr a
fptr
    {-# INLINE newRef#-}

    readRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (SRef s a)) =>
SRef s a -> m (RefElement (SRef s a))
readRef (SRef ForeignPtr a
fptr) = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a. Storable a => Ptr a -> IO a
peek
    {-# INLINE readRef #-}

    writeRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (SRef s a)) =>
SRef s a -> RefElement (SRef s a) -> m ()
writeRef (SRef ForeignPtr a
fptr) RefElement (SRef s a)
x = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Storable a => Ptr a -> a -> IO ()
poke RefElement (SRef s a)
x
    {-# INLINE writeRef #-}

    modifyRef :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (SRef s a)) =>
SRef s a
-> (RefElement (SRef s a) -> RefElement (SRef s a)) -> m ()
modifyRef (SRef ForeignPtr a
fptr) RefElement (SRef s a) -> RefElement (SRef s a)
f = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
        forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefElement (SRef s a) -> RefElement (SRef s a)
f
    {-# INLINE modifyRef #-}

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