-- | C arrays of unknown size
--
-- This module is intended to be imported qualified.
--
-- > import HsBindgen.Runtime.Prelude
-- > import HsBindgen.Runtime.IncompleteArray qualified as IA
module HsBindgen.Runtime.IncompleteArray (
    IncompleteArray -- opaque
  , toVector
  , fromVector
    -- * Pointers
    -- $pointers
  , toPtr
  , toFirstElemPtr
  , peekArray
  , pokeArray
  , withPtr
    -- * Construction
  , repeat
  , fromList
    -- * Query
  , toList
  ) where

import Prelude hiding (repeat)

import Data.Coerce (Coercible, coerce)
import Data.Vector.Storable qualified as VS
import Foreign.ForeignPtr (mallocForeignPtrArray, withForeignPtr)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (Storable (..))
import GHC.Records (HasField (..))

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | A C array of unknown size
newtype IncompleteArray a = IA (VS.Vector a)
  deriving stock (IncompleteArray a -> IncompleteArray a -> Bool
(IncompleteArray a -> IncompleteArray a -> Bool)
-> (IncompleteArray a -> IncompleteArray a -> Bool)
-> Eq (IncompleteArray a)
forall a.
(Storable a, Eq a) =>
IncompleteArray a -> IncompleteArray a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
(Storable a, Eq a) =>
IncompleteArray a -> IncompleteArray a -> Bool
== :: IncompleteArray a -> IncompleteArray a -> Bool
$c/= :: forall a.
(Storable a, Eq a) =>
IncompleteArray a -> IncompleteArray a -> Bool
/= :: IncompleteArray a -> IncompleteArray a -> Bool
Eq, Int -> IncompleteArray a -> ShowS
[IncompleteArray a] -> ShowS
IncompleteArray a -> String
(Int -> IncompleteArray a -> ShowS)
-> (IncompleteArray a -> String)
-> ([IncompleteArray a] -> ShowS)
-> Show (IncompleteArray a)
forall a. (Show a, Storable a) => Int -> IncompleteArray a -> ShowS
forall a. (Show a, Storable a) => [IncompleteArray a] -> ShowS
forall a. (Show a, Storable a) => IncompleteArray a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. (Show a, Storable a) => Int -> IncompleteArray a -> ShowS
showsPrec :: Int -> IncompleteArray a -> ShowS
$cshow :: forall a. (Show a, Storable a) => IncompleteArray a -> String
show :: IncompleteArray a -> String
$cshowList :: forall a. (Show a, Storable a) => [IncompleteArray a] -> ShowS
showList :: [IncompleteArray a] -> ShowS
Show)

type role IncompleteArray nominal

-- | /( O(1) /): Get the underlying 'VS.Vector' representation
--
-- This makes the full 'VS.Vector' API available.
toVector ::
     Coercible arrayLike (IncompleteArray a)
  => arrayLike
  -> VS.Vector a
toVector :: forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
arrayLike -> Vector a
toVector (arrayLike -> Vector a
forall a b. Coercible a b => a -> b
coerce -> Vector a
xs) = Vector a
xs

-- | /( O(1) /): Construct from a 'VS.Vector' representation
--
-- This makes the full 'VS.Vector' API available.
fromVector ::
     Coercible arrayLike (IncompleteArray a)
  => VS.Vector a
  -> arrayLike
fromVector :: forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
Vector a -> arrayLike
fromVector = Vector a -> arrayLike
forall a b. Coercible a b => a -> b
coerce

{-------------------------------------------------------------------------------
  Pointers
-------------------------------------------------------------------------------}

-- $pointers
--
-- In example C code below, @p1@ points to the array @xs@ as a whole, while @p2@
-- points to the first element of @xs@.
--
-- > extern int xs[];
-- > void foo () {
-- >   int (*p1)[] = &xs;
-- >   int *p2 = &(xs[0]);
-- > }
--
-- Though the types of @p1@ and @p2@ differ, the /values/ of the pointers (the
-- address they point to) is the same. An array is just a block of contiguous
-- memory storing array elements. @p1@ points to where @xs@ starts, and @p2@
-- points to where the first element of @xs@ starts, and these addresses are the
-- same. In Haskell, the corresponding types for @p1@ and @p2@ respectively are
-- @'Ptr' ('IncompleteArray' 'CInt')@ and @'Ptr' 'CInt'@ respectively.
--
-- Functions like 'peekArray' require a @'Ptr' ('IncompleteArray' a)@ argument.
-- If the user only has access to a @'Ptr' a@ but they know that is pointing to
-- the first element in an array, then they can use 'toPtr' to convert the
-- pointer before using 'peekArray' on it. Conversely, if the user has access to
-- a @'Ptr' ('IncompleteArray' a)@ but they want to convert it to a @'Ptr' a@,
-- then they can use @'toFirstElemPtr'@.
--
-- NOTE: with overloaded record dot syntax, syntax like @.toFirstElemPtr@ is
-- also supported.
--
-- Relevant functions in this module also support pointers of newtypes around
-- 'IncompleteArray', hence the addition of 'Coercible' constraints in many
-- places. For example, we can use 'toPtr' at an 'IncompleteArray' type or we
-- can use 'toPtr' at a newtype around an 'IncompleteArray'.
--
-- > newtype A = A (IncompleteArray CInt)
-- > toPtr @(IncompleteArray CInt) :: Ptr CInt -> Ptr (IncompleteArray CInt)
-- > toPtr @A                      :: Ptr CInt -> Ptr A

-- | 'toFirstElemPtr' for overloaded record dot syntax
instance HasField "toFirstElemPtr" (Ptr (IncompleteArray a)) (Ptr a) where
  getField :: Ptr (IncompleteArray a) -> Ptr a
getField = Ptr (IncompleteArray a) -> Ptr a
forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
Ptr arrayLike -> Ptr a
toFirstElemPtr

-- | /( O(1) /): Use a pointer to the first element of an array as a pointer to the whole of
-- said array.
--
-- NOTE: this function does not check that the pointer /is/ actually a pointer
-- to the first element of an array.
toPtr ::
     forall arrayLike a. Coercible arrayLike (IncompleteArray a)
  => Ptr a
  -> Ptr arrayLike
toPtr :: forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
Ptr a -> Ptr arrayLike
toPtr = Ptr a -> Ptr arrayLike
forall a b. Ptr a -> Ptr b
castPtr
  where
    -- The 'Coercible' constraint is unused but that is intentional, so we
    -- circumvent the @-Wredundant-constraints@ warning by defining @_unused@.
    --
    -- Why is it intentional? The constraint adds a little bit of type safety to
    -- the use of 'castPtr', which can normally cast pointers arbitrarily.
    _unused :: arrayLike -> IncompleteArray a
_unused = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @arrayLike @(IncompleteArray a)

-- | /( O(1) /): Use a pointer to a whole array as a pointer to the first element of said
-- array.
toFirstElemPtr ::
     forall arrayLike a. Coercible arrayLike (IncompleteArray a)
  => Ptr arrayLike
  -> Ptr a
toFirstElemPtr :: forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
Ptr arrayLike -> Ptr a
toFirstElemPtr Ptr arrayLike
ptr = Ptr arrayLike -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr arrayLike
ptr
  where
    -- The 'Coercible' constraint is unused but that is intentional, so we
    -- circumvent the @-Wredundant-constraints@ warning by defining @_unused@.
    --
    -- Why is it intentional? The constraint adds a little bit of type safety to
    -- the use of 'castPtr', which can normally cast pointers arbitrarily.
    _unused :: arrayLike -> IncompleteArray a
_unused = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @arrayLike @(IncompleteArray a)

-- | /( O(n) /): Peek a number of elements from a pointer to an incomplete array.
peekArray ::
     forall a arrayLike. (Coercible arrayLike (IncompleteArray a), Storable a)
  => Int
  -> Ptr arrayLike
  -> IO arrayLike
peekArray :: forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Int -> Ptr arrayLike -> IO arrayLike
peekArray = Int -> Int -> Ptr arrayLike -> IO arrayLike
forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Int -> Int -> Ptr arrayLike -> IO arrayLike
peekArrayOff Int
0

-- | /( O(n) /): Peek a number of elements from a pointer to an incomplete array, starting
-- at an offset in terms of a number of array elements into the array pointer.
peekArrayOff ::
     forall a arrayLike. (Coercible arrayLike (IncompleteArray a), Storable a)
  => Int
  -> Int
  -> Ptr arrayLike
  -> IO arrayLike
peekArrayOff :: forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Int -> Int -> Ptr arrayLike -> IO arrayLike
peekArrayOff Int
off Int
size Ptr arrayLike
ptr = do
    ForeignPtr a
fptr <- forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray @a Int
size
    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) -> do
        Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr a
ptr' (Ptr arrayLike -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr arrayLike
ptr Ptr Any -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offBytes) (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeOfA)
    Vector a
vs <- MVector (PrimState IO) a -> IO (Vector a)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.freeze (Int -> ForeignPtr a -> MVector RealWorld a
forall s a. Int -> ForeignPtr a -> MVector s a
VS.MVector Int
size ForeignPtr a
fptr)
    arrayLike -> IO arrayLike
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (arrayLike -> IO arrayLike) -> arrayLike -> IO arrayLike
forall a b. (a -> b) -> a -> b
$ IncompleteArray a -> arrayLike
forall a b. Coercible a b => a -> b
coerce (Vector a -> IncompleteArray a
forall a. Vector a -> IncompleteArray a
IA Vector a
vs)
  where
    sizeOfA :: Int
sizeOfA = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    offBytes :: Int
offBytes = Int
sizeOfA Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
off

-- | /( O(n) /): Poke a number of elements to a pointer to an incomplete array.
pokeArray ::
     forall a arrayLike. (Coercible arrayLike (IncompleteArray a), Storable a)
  => Ptr arrayLike
  -> arrayLike
  -> IO ()
pokeArray :: forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Ptr arrayLike -> arrayLike -> IO ()
pokeArray = Int -> Ptr arrayLike -> arrayLike -> IO ()
forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Int -> Ptr arrayLike -> arrayLike -> IO ()
pokeArrayOff Int
0

-- | /( O(n) /): Poke a number of elements to a pointer to an incomplete array, starting at
-- an offset in terms of a number of array elements into the array pointer.
pokeArrayOff ::
     forall a arrayLike. (Coercible arrayLike (IncompleteArray a), Storable a)
  => Int
  -> Ptr arrayLike
  -> arrayLike
  -> IO ()
pokeArrayOff :: forall a arrayLike.
(Coercible arrayLike (IncompleteArray a), Storable a) =>
Int -> Ptr arrayLike -> arrayLike -> IO ()
pokeArrayOff Int
off Ptr arrayLike
ptr (arrayLike -> IncompleteArray a
forall a b. Coercible a b => a -> b
coerce -> IA Vector a
vs) = do
    VS.MVector Int
size ForeignPtr a
fptr <- Vector a -> IO (MVector (PrimState IO) a)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
VS.unsafeThaw Vector a
vs
    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) ->
      Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr arrayLike -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr arrayLike
ptr) (Ptr a
ptr' Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offBytes) (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeOfA)
  where
    sizeOfA :: Int
sizeOfA = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    offBytes :: Int
offBytes = Int
sizeOfA Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
off

-- | /( O(n) /): Retrieve the underlying pointer
withPtr ::
     (Coercible b (IncompleteArray a), Storable a)
  => b -> (Ptr b -> IO r) -> IO r
withPtr :: forall b a r.
(Coercible b (IncompleteArray a), Storable a) =>
b -> (Ptr b -> IO r) -> IO r
withPtr (b -> IncompleteArray a
forall a b. Coercible a b => a -> b
coerce -> IA Vector a
v) Ptr b -> IO r
k = do
    -- we copy the data, as e.g. @int fun(int xs[])@ may mutate it.
    VS.MVector Int
_ ForeignPtr a
fptr <- Vector a -> IO (MVector (PrimState IO) a)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
VS.thaw Vector a
v
    ForeignPtr a -> (Ptr a -> IO r) -> IO r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO r) -> IO r) -> (Ptr a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \(Ptr a
ptr :: Ptr a) -> Ptr b -> IO r
k (Ptr a -> Ptr b
forall arrayLike a.
Coercible arrayLike (IncompleteArray a) =>
Ptr a -> Ptr arrayLike
toPtr Ptr a
ptr)

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | /( O(n) /)
repeat :: Storable a => Int -> a -> IncompleteArray a
repeat :: forall a. Storable a => Int -> a -> IncompleteArray a
repeat Int
n a
x = Vector a -> IncompleteArray a
forall a. Vector a -> IncompleteArray a
IA (Int -> a -> Vector a
forall a. Storable a => Int -> a -> Vector a
VS.replicate Int
n a
x)

-- | /( O(n) /)
fromList :: Storable a => [a] -> IncompleteArray a
fromList :: forall a. Storable a => [a] -> IncompleteArray a
fromList [a]
xs = Vector a -> IncompleteArray a
forall a. Vector a -> IncompleteArray a
IA ([a] -> Vector a
forall a. Storable a => [a] -> Vector a
VS.fromList [a]
xs)

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

-- | /( O(n) /)
toList :: Storable a => IncompleteArray a -> [a]
toList :: forall a. Storable a => IncompleteArray a -> [a]
toList (IA Vector a
v) = Vector a -> [a]
forall a. Storable a => Vector a -> [a]
VS.toList Vector a
v