{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Foreign.FAI.Platform.Host.Debug
( peekHostBuffer
, pokeHostBuffer
, toHostBuffer
, unsafePeekHostBuffer
, unsafeToHostBuffer
) where
import Foreign.FAI
import Foreign.FAI.Platform.Host
import Foreign.FAI.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import System.IO.Unsafe
peekHostBuffer :: (Storable b, Pf Host a ~ b)
=> Buffer Host a
-> IO [b]
peekHostBuffer bf =
withForeignPtr (bufPtr bf) $ \ptr ->
peekBuf undefined ptr
where peekBuf :: Storable a => a -> Ptr a -> IO [a]
peekBuf = peekArray . (bufSize bf `div`) . sizeOf
pokeHostBuffer :: (Storable b, Pf Host a ~ b)
=> Buffer Host a
-> [b]
-> IO ()
pokeHostBuffer (Buffer fp s) ls = do
withForeignPtr fp $ \ptr ->
pokeArray ptr $ take len ls
return ()
where lsLen = length ls
bfLen = s `div` sizeOf (head ls)
len = min bfLen lsLen
toHostBuffer :: (Storable b, Pf Host a ~ b)
=> [b]
-> IO (Buffer Host a)
toHostBuffer ls = do
bf <- fst <$> newBufferIO (length ls) cc
withForeignPtr (bufPtr bf) $ \ptr ->
pokeArray ptr ls
return bf
where cc :: Context Host
cc = Context undefined
unsafePeekHostBuffer :: (Storable b,Pf Host a ~ b)
=> Buffer Host a
-> [b]
unsafePeekHostBuffer = unsafePerformIO . peekHostBuffer
unsafeToHostBuffer :: (Storable b, Pf Host a ~ b)
=> [b]
-> Buffer Host a
unsafeToHostBuffer = unsafePerformIO . toHostBuffer