module Bindings.Utilities (
	storableCast,
	storableCastArray,
  ) where

import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable

-- |'storableCast' works like 'storableCastArray', except that it
-- takes a single value and returns a single value.

storableCast :: (Storable a, Storable b) => a -> IO b
storableCast :: forall a b. (Storable a, Storable b) => a -> IO b
storableCast a
a = forall a b. (Storable a, Storable b) => [a] -> IO [b]
storableCastArray [a
a] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head)

-- |'storableCastArray' takes a list of values of a first type, stores it
-- at a contiguous memory area (that is first blanked with 0s), and then
-- reads it as if it was a list of a second type, with enough elements to
-- fill at least the same space.
--
-- @
-- ghci
-- :m + Bindings.Sandbox Data.Int
-- storableCastArray (replicate 13 (1::Int8)) :: IO [Int32]
--         ==> [16843009,16843009,16843009,1]
-- @

storableCastArray :: (Storable a, Storable b) => [a] -> IO [b]
storableCastArray :: forall a b. (Storable a, Storable b) => [a] -> IO [b]
storableCastArray [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
storableCastArray [a]
a = do
	b
u <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a. HasCallStack => a
undefined
	let (Int
q,Int
r) = forall a. Integral a => a -> a -> (a, a)
divMod (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a forall a. Num a => a -> a -> a
* (forall a. Storable a => a -> Int
sizeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) [a]
a) (forall a. Storable a => a -> Int
sizeOf b
u)
	let len :: Int
len = forall a. Ord a => a -> a -> a
max Int
1 (if Int
r forall a. Ord a => a -> a -> Bool
> Int
0 then Int
q forall a. Num a => a -> a -> a
+ Int
1 else Int
q)
	let blank :: [CChar]
blank = forall a. Int -> a -> [a]
replicate (Int
len forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf b
u) (CChar
0::CChar)
	[b]
b <- forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CChar]
blank forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr -> do
		forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) [a]
a
		forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr)
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
True then [b]
b else [b
u]