{-# 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 = IO (SRef s a) -> m (SRef s a)
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (SRef s a) -> m (SRef s a)) -> IO (SRef s a) -> m (SRef s a)
forall a b. (a -> b) -> a -> b
$ do
        ForeignPtr a
fptr <- IO (ForeignPtr a)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
        ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr a -> a -> IO ()) -> a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke a
RefElement (SRef s a)
x
        SRef s a -> IO (SRef s a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRef s a -> IO (SRef s a)) -> SRef s a -> IO (SRef s a)
forall a b. (a -> b) -> a -> b
$! ForeignPtr a -> SRef s a
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) = IO (RefElement (SRef s a)) -> m (RefElement (SRef s a))
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (RefElement (SRef s a)) -> m (RefElement (SRef s a)))
-> IO (RefElement (SRef s a)) -> m (RefElement (SRef s a))
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr Ptr a -> IO a
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 = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr a -> a -> IO ()) -> a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke a
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 = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
        Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr (a -> IO ()) -> (a -> a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
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' = SRef s a
-> (RefElement (SRef s a) -> RefElement (SRef 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 (SRef s a)) =>
SRef s a
-> (RefElement (SRef s a) -> RefElement (SRef s a)) -> m ()
modifyRef
    {-# INLINE modifyRef' #-}