{-# LANGUAGE Rank2Types #-}
{- |
Module      : Data.StorableVector.ST.Strict
License     : BSD-style
Maintainer  : haskell@henning-thielemann.de
Stability   : experimental
Portability : portable, requires ffi
Tested with : GHC 6.4.1

Interface for access to a mutable StorableVector.
-}
module Data.StorableVector.ST.Lazy (
        Vector,
        new,
        new_,
        read,
        write,
        modify,
        unsafeRead,
        unsafeWrite,
        unsafeModify,
        freeze,
        unsafeFreeze,
        thaw,
        VST.length,
        runSTVector,
        mapST,
        mapSTLazy,
        ) where

-- import qualified Data.StorableVector.Base as V
import qualified Data.StorableVector as VS
import qualified Data.StorableVector.Lazy as VL

import qualified Data.StorableVector.ST.Strict as VST

import Data.StorableVector.ST.Strict (Vector)


import qualified Control.Monad.ST.Lazy as ST
import Control.Monad.ST.Lazy (ST)

import Foreign.Storable         (Storable)

-- import Prelude (Int, ($), (+), return, const, )
import Prelude hiding (read, length, )



-- * access to mutable storable vector

{-# INLINE new #-}
new :: (Storable e) =>
   Int -> e -> ST s (Vector s e)
new :: forall e s. Storable e => Int -> e -> ST s (Vector s e)
new Int
n e
x = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Int -> e -> ST s (Vector s e)
VST.new Int
n e
x)

{-# INLINE new_ #-}
new_ :: (Storable e) =>
   Int -> ST s (Vector s e)
new_ :: forall e s. Storable e => Int -> ST s (Vector s e)
new_ Int
n  =  forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Int -> ST s (Vector s e)
VST.new_ Int
n)

{- |
> Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3)
-}
{-# INLINE read #-}
read :: (Storable e) =>
   Vector s e -> Int -> ST s e
read :: forall e s. Storable e => Vector s e -> Int -> ST s e
read Vector s e
xs Int
n = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> ST s e
VST.read Vector s e
xs Int
n)

{- |
> VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr)
-}
{-# INLINE write #-}
write :: (Storable e) =>
   Vector s e -> Int -> e -> ST s ()
write :: forall e s. Storable e => Vector s e -> Int -> e -> ST s ()
write Vector s e
xs Int
n e
x = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> e -> ST s ()
VST.write Vector s e
xs Int
n e
x)

{-# INLINE modify #-}
modify :: (Storable e) =>
   Vector s e -> Int -> (e -> e) -> ST s ()
modify :: forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
modify Vector s e
xs Int
n e -> e
f = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
VST.modify Vector s e
xs Int
n e -> e
f)


{-# INLINE unsafeRead #-}
unsafeRead :: (Storable e) =>
   Vector s e -> Int -> ST s e
unsafeRead :: forall e s. Storable e => Vector s e -> Int -> ST s e
unsafeRead Vector s e
xs Int
n = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> ST s e
VST.unsafeRead Vector s e
xs Int
n)

{-# INLINE unsafeWrite #-}
unsafeWrite :: (Storable e) =>
   Vector s e -> Int -> e -> ST s ()
unsafeWrite :: forall e s. Storable e => Vector s e -> Int -> e -> ST s ()
unsafeWrite Vector s e
xs Int
n e
x = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> e -> ST s ()
VST.unsafeWrite Vector s e
xs Int
n e
x)

{-# INLINE unsafeModify #-}
unsafeModify :: (Storable e) =>
   Vector s e -> Int -> (e -> e) -> ST s ()
unsafeModify :: forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
unsafeModify Vector s e
xs Int
n e -> e
f = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
VST.unsafeModify Vector s e
xs Int
n e -> e
f)


{-# INLINE freeze #-}
freeze :: (Storable e) =>
   Vector s e -> ST s (VS.Vector e)
freeze :: forall e s. Storable e => Vector s e -> ST s (Vector e)
freeze Vector s e
xs = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> ST s (Vector e)
VST.freeze Vector s e
xs)

{-# INLINE unsafeFreeze #-}
unsafeFreeze :: (Storable e) =>
   Vector s e -> ST s (VS.Vector e)
unsafeFreeze :: forall e s. Storable e => Vector s e -> ST s (Vector e)
unsafeFreeze Vector s e
xs = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector s e -> ST s (Vector e)
VST.unsafeFreeze Vector s e
xs)

{-# INLINE thaw #-}
thaw :: (Storable e) =>
   VS.Vector e -> ST s (Vector s e)
thaw :: forall e s. Storable e => Vector e -> ST s (Vector s e)
thaw Vector e
xs = forall s a. ST s a -> ST s a
ST.strictToLazyST (forall e s. Storable e => Vector e -> ST s (Vector s e)
VST.thaw Vector e
xs)



{-# INLINE runSTVector #-}
runSTVector :: (Storable e) =>
   (forall s. ST s (Vector s e)) -> VS.Vector e
runSTVector :: forall e. Storable e => (forall s. ST s (Vector s e)) -> Vector e
runSTVector forall s. ST s (Vector s e)
m = forall e. Storable e => (forall s. ST s (Vector s e)) -> Vector e
VST.runSTVector (forall s a. ST s a -> ST s a
ST.lazyToStrictST forall s. ST s (Vector s e)
m)



-- * operations on immutable storable vector within ST monad

{- |
> :module + Data.STRef
> VS.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapST (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VS.pack [1,2,3,4::Data.Int.Int16]))
-}
{-# INLINE mapST #-}
mapST :: (Storable a, Storable b) =>
   (a -> ST s b) -> VS.Vector a -> ST s (VS.Vector b)
mapST :: forall a b s.
(Storable a, Storable b) =>
(a -> ST s b) -> Vector a -> ST s (Vector b)
mapST a -> ST s b
f Vector a
xs =
   forall s a. ST s a -> ST s a
ST.strictToLazyST (forall a b s.
(Storable a, Storable b) =>
(a -> ST s b) -> Vector a -> ST s (Vector b)
VST.mapST (forall s a. ST s a -> ST s a
ST.lazyToStrictST forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ST s b
f) Vector a
xs)


{- |
> *Data.StorableVector.ST.Strict Data.STRef> VL.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [1,2,3,4::Data.Int.Int16]))
> "abcd"

The following should not work on infinite streams,
since we are in 'ST' with strict '>>='.
But it works. Why?

> *Data.StorableVector.ST.Strict Data.STRef.Lazy> VL.unpack $ Control.Monad.ST.Lazy.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [0::Data.Int.Int16 ..]))
> "Interrupted.
-}
{-# INLINE mapSTLazy #-}
mapSTLazy :: (Storable a, Storable b) =>
   (a -> ST s b) -> VL.Vector a -> ST s (VL.Vector b)
mapSTLazy :: forall a b s.
(Storable a, Storable b) =>
(a -> ST s b) -> Vector a -> ST s (Vector b)
mapSTLazy a -> ST s b
f (VL.SV [Vector a]
xs) =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Vector a] -> Vector a
VL.SV forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b s.
(Storable a, Storable b) =>
(a -> ST s b) -> Vector a -> ST s (Vector b)
mapST a -> ST s b
f) [Vector a]
xs