module Instrument.Sampler
( Sampler (..),
new,
sample,
get,
reset,
)
where
import Control.Concurrent.MVar
import Control.Exception (mask_, onException)
import Control.Monad
import qualified Data.Vector.Mutable as V
data Buffer a = B
{ forall a. Buffer a -> Int
_size :: Int,
forall a. Buffer a -> IOVector a
_contents :: V.IOVector a,
forall a. Buffer a -> MVar Int
_writePos :: MVar Int
}
{-# INLINE modifyMVar_mask #-}
modifyMVar_mask :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar_mask :: forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar_mask MVar a
m a -> IO (a, b)
io =
forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
a
a <- forall a. MVar a -> IO a
takeMVar MVar a
m
(a
a', b
b) <- a -> IO (a, b)
io a
a forall a b. IO a -> IO b -> IO a
`onException` forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a
forall a. MVar a -> a -> IO ()
putMVar MVar a
m forall a b. (a -> b) -> a -> b
$! a
a'
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE modifyMVar_mask_ #-}
modifyMVar_mask_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_mask_ :: forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_mask_ MVar a
m a -> IO a
io =
forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
a
a <- forall a. MVar a -> IO a
takeMVar MVar a
m
a
a' <- a -> IO a
io a
a forall a b. IO a -> IO b -> IO a
`onException` forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a
forall a. MVar a -> a -> IO ()
putMVar MVar a
m forall a b. (a -> b) -> a -> b
$! a
a'
newBuffer :: Int -> IO (Buffer a)
newBuffer :: forall a. Int -> IO (Buffer a)
newBuffer Int
lim = do
MVar Int
pos <- forall a. a -> IO (MVar a)
newMVar Int
0
IOVector a
entries <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
V.new Int
lim
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Int -> IOVector a -> MVar Int -> Buffer a
B Int
lim IOVector a
entries MVar Int
pos)
writeBuffer :: Buffer a -> a -> IO ()
writeBuffer :: forall a. Buffer a -> a -> IO ()
writeBuffer (B Int
size IOVector a
contents MVar Int
wposMV) a
x = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_mask_ MVar Int
wposMV forall a b. (a -> b) -> a -> b
$
\Int
wpos ->
case Int
wpos forall a. Ord a => a -> a -> Bool
>= Int
size of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
wpos
Bool
False -> do
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write IOVector a
contents Int
wpos a
x
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => a -> a
succ Int
wpos)
getBuffer :: Buffer a -> IO [a]
getBuffer :: forall a. Buffer a -> IO [a]
getBuffer (B Int
_size IOVector a
contents MVar Int
pos) = do
Int
wpos <- forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar_mask MVar Int
pos forall a b. (a -> b) -> a -> b
$ \Int
wpos -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wpos, Int
wpos)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. (Int
wpos forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i -> (forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
V.read IOVector a
contents Int
i)
resetBuffer :: Buffer a -> IO ()
resetBuffer :: forall a. Buffer a -> IO ()
resetBuffer (B Int
_size IOVector a
_els MVar Int
pos) = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_mask_ MVar Int
pos (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Int
0))
newtype Sampler = S {Sampler -> Buffer Double
unS :: Buffer Double}
new :: Int -> IO Sampler
new :: Int -> IO Sampler
new Int
i = Buffer Double -> Sampler
S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Int -> IO (Buffer a)
newBuffer Int
i
sample :: Double -> Sampler -> IO ()
sample :: Double -> Sampler -> IO ()
sample Double
v Sampler
s = forall a. Buffer a -> a -> IO ()
writeBuffer (Sampler -> Buffer Double
unS Sampler
s) Double
v
get :: Sampler -> IO [Double]
get :: Sampler -> IO [Double]
get (S Buffer Double
buffer) = forall a. Buffer a -> IO [a]
getBuffer Buffer Double
buffer
reset :: Sampler -> IO ()
reset :: Sampler -> IO ()
reset (S Buffer Double
buf) = forall a. Buffer a -> IO ()
resetBuffer Buffer Double
buf