From 86169b961457dfcf77af1400fcc4c95ee17886af Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sun, 31 Mar 2019 21:23:57 -0400 Subject: Provided instance to use ForeignPtr as a struct. --- src/Data/Primitive/Struct.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Data/Primitive/Struct.hs b/src/Data/Primitive/Struct.hs index 154b750..705e65d 100644 --- a/src/Data/Primitive/Struct.hs +++ b/src/Data/Primitive/Struct.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Primitive.Struct where import Control.Monad.Primitive @@ -16,6 +17,7 @@ import Data.Primitive.ByteArray.Util import Data.Primitive.Types import Data.Tagged import Data.Typeable +import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.TypeLits @@ -110,3 +112,17 @@ withPointer :: Struct IO base tag -> (Ptr tag -> IO x) -> IO x withPointer (Struct (Offset off) ary) f = do x <- f (ptr (mutableByteArrayContents ary) `plusPtr` off) seq ary $ return x + +data ForeignStruct tag = ForeignStruct + { fsPtr :: !(ForeignPtr tag) + , fsOffset :: !Int + } + +instance IsStruct IO ForeignStruct where + type BaseOffset ForeignStruct = TypeError (Text "ForeignStruct has no type-level offset information.") + type NestedStruct IO ForeignStruct j t = ForeignStruct t + setField (ForeignStruct fptr base) (Field (Offset o)) val = withForeignPtr fptr $ \ptr -> do + poke (castPtr $ ptr `plusPtr` o `plusPtr` base) $ PrimStorable val + getField (ForeignStruct fptr base) (Field (Offset o)) = withForeignPtr fptr $ \ptr -> do + getPrimStorable <$> peek (castPtr $ ptr `plusPtr` o `plusPtr` base) + nestedField (ForeignStruct fptr base) (Field (Offset o)) _ = ForeignStruct (castForeignPtr fptr) (base + o) -- cgit v1.2.3