-- | C arrays of known, constant size
--
-- This module is intended to be imported qualified.
--
-- > import HsBindgen.Runtime.Prelude
-- > import HsBindgen.Runtime.ConstantArray qualified as CA
module HsBindgen.Runtime.ConstantArray (
    ConstantArray -- opaque
  , toVector
  , fromVector
    -- * Pointers
    -- $pointers
  , toPtr
  , toFirstElemPtr
  , withPtr
    -- * Construction
  , repeat
  , fromList
    -- * Query
  , toList
    -- * Auxiliary
  , intVal
  ) where

import Prelude hiding (repeat)

import Data.Coerce (Coercible, coerce)
import Data.Proxy (Proxy (..))
import Data.Vector.Storable qualified as VS
import Foreign.ForeignPtr (mallocForeignPtrArray, withForeignPtr)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable (..))
import GHC.Records (HasField (..))
import GHC.Stack (HasCallStack)
import GHC.TypeNats (KnownNat, Nat, natVal)

import HsBindgen.Runtime.Marshal (ReadRaw, StaticSize, WriteRaw)

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

-- | A C array of known size
newtype ConstantArray (n :: Nat) a = CA (VS.Vector a)
  deriving stock (ConstantArray n a -> ConstantArray n a -> Bool
(ConstantArray n a -> ConstantArray n a -> Bool)
-> (ConstantArray n a -> ConstantArray n a -> Bool)
-> Eq (ConstantArray n a)
forall (n :: Nat) a.
(Storable a, Eq a) =>
ConstantArray n a -> ConstantArray n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Nat) a.
(Storable a, Eq a) =>
ConstantArray n a -> ConstantArray n a -> Bool
== :: ConstantArray n a -> ConstantArray n a -> Bool
$c/= :: forall (n :: Nat) a.
(Storable a, Eq a) =>
ConstantArray n a -> ConstantArray n a -> Bool
/= :: ConstantArray n a -> ConstantArray n a -> Bool
Eq, Int -> ConstantArray n a -> ShowS
[ConstantArray n a] -> ShowS
ConstantArray n a -> String
(Int -> ConstantArray n a -> ShowS)
-> (ConstantArray n a -> String)
-> ([ConstantArray n a] -> ShowS)
-> Show (ConstantArray n a)
forall (n :: Nat) a.
(Show a, Storable a) =>
Int -> ConstantArray n a -> ShowS
forall (n :: Nat) a.
(Show a, Storable a) =>
[ConstantArray n a] -> ShowS
forall (n :: Nat) a.
(Show a, Storable a) =>
ConstantArray n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Nat) a.
(Show a, Storable a) =>
Int -> ConstantArray n a -> ShowS
showsPrec :: Int -> ConstantArray n a -> ShowS
$cshow :: forall (n :: Nat) a.
(Show a, Storable a) =>
ConstantArray n a -> String
show :: ConstantArray n a -> String
$cshowList :: forall (n :: Nat) a.
(Show a, Storable a) =>
[ConstantArray n a] -> ShowS
showList :: [ConstantArray n a] -> ShowS
Show)
  deriving anyclass (Ptr (ConstantArray n a) -> IO (ConstantArray n a)
(Ptr (ConstantArray n a) -> IO (ConstantArray n a))
-> ReadRaw (ConstantArray n a)
forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Ptr (ConstantArray n a) -> IO (ConstantArray n a)
forall a. (Ptr a -> IO a) -> ReadRaw a
$creadRaw :: forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Ptr (ConstantArray n a) -> IO (ConstantArray n a)
readRaw :: Ptr (ConstantArray n a) -> IO (ConstantArray n a)
ReadRaw, Proxy (ConstantArray n a) -> Int
(Proxy (ConstantArray n a) -> Int)
-> (Proxy (ConstantArray n a) -> Int)
-> StaticSize (ConstantArray n a)
forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Proxy (ConstantArray n a) -> Int
forall a. (Proxy a -> Int) -> (Proxy a -> Int) -> StaticSize a
$cstaticSizeOf :: forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Proxy (ConstantArray n a) -> Int
staticSizeOf :: Proxy (ConstantArray n a) -> Int
$cstaticAlignment :: forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Proxy (ConstantArray n a) -> Int
staticAlignment :: Proxy (ConstantArray n a) -> Int
StaticSize, Ptr (ConstantArray n a) -> ConstantArray n a -> IO ()
(Ptr (ConstantArray n a) -> ConstantArray n a -> IO ())
-> WriteRaw (ConstantArray n a)
forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Ptr (ConstantArray n a) -> ConstantArray n a -> IO ()
forall a. (Ptr a -> a -> IO ()) -> WriteRaw a
$cwriteRaw :: forall (n :: Nat) a.
(Storable a, KnownNat n) =>
Ptr (ConstantArray n a) -> ConstantArray n a -> IO ()
writeRaw :: Ptr (ConstantArray n a) -> ConstantArray n a -> IO ()
WriteRaw)

type role ConstantArray nominal nominal

-- | /( O(1) /): Get the underlying 'VS.Vector' representation
--
-- This makes the full 'VS.Vector' API available.
toVector ::
     forall a n arrayLike.
     Coercible arrayLike (ConstantArray n a)
  => arrayLike
  -> (Proxy n, VS.Vector a)
toVector :: forall a (n :: Nat) arrayLike.
Coercible arrayLike (ConstantArray n a) =>
arrayLike -> (Proxy n, Vector a)
toVector (arrayLike -> Vector a
forall a b. Coercible a b => a -> b
coerce -> Vector a
xs) = (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n, Vector a
xs)

-- | /( O(1) /): Construct from a 'VS.Vector' representation
--
-- This makes the full 'VS.Vector' API available.
--
-- Precondition: the vector must have the right number of elements.
fromVector ::
     forall a n arrayLike. (
       Coercible arrayLike (ConstantArray n a)
     , Storable a
     , KnownNat n
     , HasCallStack
     )
  => Proxy n
  -> VS.Vector a
  -> arrayLike
fromVector :: forall a (n :: Nat) arrayLike.
(Coercible arrayLike (ConstantArray n a), Storable a, KnownNat n,
 HasCallStack) =>
Proxy n -> Vector a -> arrayLike
fromVector Proxy n
_ Vector a
xs
  | Vector a -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Vector a -> arrayLike
forall a b. Coercible a b => a -> b
coerce Vector a
xs
  | Bool
otherwise = String -> arrayLike
forall a. HasCallStack => String -> a
error (String -> arrayLike) -> String -> arrayLike
forall a b. (a -> b) -> a -> b
$ String
"fromVector: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" elements"
  where
    n :: Int
n = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)

{-------------------------------------------------------------------------------
  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[3];
-- > void foo () {
-- >   int (*p1)[3] = &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' ('ConstantArray' n 'CInt')@ and @'Ptr' 'CInt'@ respectively.
--
-- Functions like 'peek' require a @'Ptr' ('ConstantArray' n 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' ('ConstantArray' n 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
-- 'ConstantArray', hence the addition of 'Coercible' constraints in many
-- places. For example, we can use 'toPtr' at a 'ConstantArray' type
-- or we can use 'toPtr' at a newtype around a 'ConstantArray'.
--
-- > newtype A n = A (ConstantArray n CInt)
-- > toPtr @(ConstantArray 3 CInt) ::
-- >   Proxy 3 -> Ptr CInt -> Ptr (ConstantArray 3 CInt)
-- > toPtr @(A 3) ::
-- >   Proxy 3 -> Ptr CInt -> Ptr (A 3)

-- | 'toFirstElemPtr' for overloaded record dot syntax
instance HasField "toFirstElemPtr" (Ptr (ConstantArray n a)) (Ptr a) where
  getField :: Ptr (ConstantArray n a) -> Ptr a
getField = (Proxy Any, Ptr a) -> Ptr a
forall a b. (a, b) -> b
snd ((Proxy Any, Ptr a) -> Ptr a)
-> (Ptr (ConstantArray n a) -> (Proxy Any, Ptr a))
-> Ptr (ConstantArray n a)
-> Ptr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (ConstantArray n a) -> (Proxy Any, Ptr a)
forall arrayLike (n :: Nat) a.
Coercible arrayLike (ConstantArray n a) =>
Ptr arrayLike -> (Proxy n, 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 n a. Coercible arrayLike (ConstantArray n a)
  => Proxy n
  -> Ptr a
  -> Ptr arrayLike
toPtr :: forall arrayLike (n :: Nat) a.
Coercible arrayLike (ConstantArray n a) =>
Proxy n -> Ptr a -> Ptr arrayLike
toPtr Proxy n
_ = 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 -> ConstantArray n a
_unused = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @arrayLike @(ConstantArray n a)

-- | /( O(1) /): Use a pointer to a whole array as a pointer to the first element of said
-- array.
toFirstElemPtr ::
     forall arrayLike n a. Coercible arrayLike (ConstantArray n a)
  => Ptr arrayLike
  -> (Proxy n, Ptr a)
toFirstElemPtr :: forall arrayLike (n :: Nat) a.
Coercible arrayLike (ConstantArray n a) =>
Ptr arrayLike -> (Proxy n, Ptr a)
toFirstElemPtr Ptr arrayLike
ptr = (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n, 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 -> ConstantArray n a
_unused = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @arrayLike @(ConstantArray n a)

instance (Storable a, KnownNat n) => Storable (ConstantArray n a) where
    sizeOf :: ConstantArray n a -> Int
sizeOf ConstantArray n a
_ = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n) Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

    alignment :: ConstantArray n a -> Int
alignment ConstantArray n a
_ = a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a)

    peek :: Ptr (ConstantArray n a) -> IO (ConstantArray n a)
peek Ptr (ConstantArray n a)
ptr = do
        ForeignPtr a
fptr <- Int -> IO (ForeignPtr a)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray 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' -> do
            Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr a
ptr' (Ptr (ConstantArray n a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (ConstantArray n a)
ptr) (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)
        ConstantArray n a -> IO (ConstantArray n a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> ConstantArray n a
forall (n :: Nat) a. Vector a -> ConstantArray n a
CA Vector a
vs)
      where
        size :: Int
size = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
        sizeOfA :: Int
sizeOfA = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

    poke :: Ptr (ConstantArray n a) -> ConstantArray n a -> IO ()
poke Ptr (ConstantArray n a)
ptr (CA 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' -> do
            Ptr (ConstantArray n a) -> Ptr (ConstantArray n a) -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr (ConstantArray n a)
ptr (Ptr a -> Ptr (ConstantArray n a)
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr') (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)

-- | /( O(n) /): Retrieve the underlying pointer
withPtr ::
     forall b n a r. (Coercible b (ConstantArray n a), Storable a)
  => b -> (Ptr b -> IO r) -> IO r
withPtr :: forall b (n :: Nat) a r.
(Coercible b (ConstantArray n a), Storable a) =>
b -> (Ptr b -> IO r) -> IO r
withPtr (b -> ConstantArray Any a
forall a b. Coercible a b => a -> b
coerce -> CA Vector a
v) Ptr b -> IO r
k = do
    -- we copy the data, a e.g. int fun(int xs[3]) 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 (Proxy n -> Ptr a -> Ptr b
forall arrayLike (n :: Nat) a.
Coercible arrayLike (ConstantArray n a) =>
Proxy n -> Ptr a -> Ptr arrayLike
toPtr (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n) Ptr a
ptr)

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

-- | /( O(n) /)
repeat :: forall n a. (KnownNat n, Storable a) => a -> ConstantArray n a
repeat :: forall (n :: Nat) a.
(KnownNat n, Storable a) =>
a -> ConstantArray n a
repeat a
x = Vector a -> ConstantArray n a
forall (n :: Nat) a. Vector a -> ConstantArray n a
CA (Int -> a -> Vector a
forall a. Storable a => Int -> a -> Vector a
VS.replicate (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)) a
x)

-- | /( O(n) /): Construct from a list
--
-- Precondition: the list must have the right number of elements.
fromList :: forall n a.
     (KnownNat n, Storable a, HasCallStack)
  => [a] -> ConstantArray n a
fromList :: forall (n :: Nat) a.
(KnownNat n, Storable a, HasCallStack) =>
[a] -> ConstantArray n a
fromList [a]
xs = Proxy n -> Vector a -> ConstantArray n a
forall a (n :: Nat) arrayLike.
(Coercible arrayLike (ConstantArray n a), Storable a, KnownNat n,
 HasCallStack) =>
Proxy n -> Vector a -> arrayLike
fromVector (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n) ([a] -> Vector a
forall a. Storable a => [a] -> Vector a
VS.fromList [a]
xs)

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

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

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

intVal :: forall n. KnownNat n => Proxy n -> Int
intVal :: forall (n :: Nat). KnownNat n => Proxy n -> Int
intVal Proxy n
p = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal Proxy n
p)