ats-storable 0.2.0.1 → 0.2.0.2

raw patch · 3 files changed

+39/−26 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +3/−0
• ats-storable.cabal +1/−1
• src/Foreign/Storable/ATS.hs +35/−25

@@ -3,3 +3,6 @@ Resuscitation of [generic-storable](hackage.haskell.org/package/generic-storable) altered to work with ATS' algebraic data types.++For documentation of how to use the ATS side of things, consult the+[documentation](http://ats-lang.sourceforge.net/DOCUMENT/INT2PROGINATS/HTML/x2179.html).

@@ -1,5 +1,5 @@ name:                ats-storable-version:             0.2.0.1+version:             0.2.0.2 synopsis:            Marshal ATS types into Haskell description:         Facilities for sharing types between ATS and Haskell homepage:            https://github.com//ats-generic#readme

@@ -14,6 +14,7 @@ import           Control.Composition import qualified Data.ByteString       as BS import qualified Data.ByteString.Lazy  as BSL+import           Data.Data import qualified Data.Text             as T import qualified Data.Text.Lazy        as TL import           Data.Word@@ -47,15 +48,15 @@      alignment' :: f a -> Int -    peek' :: Ptr (f a) -> IO (f a)+    peek' :: Word8 -> Ptr (f a) -> IO (f a) -    poke' :: Ptr (f a) -> f a -> IO ()+    poke' :: Word8 -> Ptr (f a) -> f a -> IO ()      pokeByteOff' :: Ptr (f a) -> Int -> f a -> IO ()-    pokeByteOff' = poke' .* plusPtr+    pokeByteOff' = poke' 0 .* plusPtr      peekByteOff' :: Ptr (f a) -> Int -> IO (f a)-    peekByteOff' = peek' .* plusPtr+    peekByteOff' = peek' 0 .* plusPtr  instance Storable' V1 where     peek' = undefined@@ -66,11 +67,11 @@ instance (Storable' a, Storable' b) => Storable' (a :*: b) where     sizeOf' _ = sizeOf' (undefined :: a x) + sizeOf' (undefined :: b x)     alignment' _ = gcd (alignment' (undefined :: a x)) (alignment' (undefined :: b x))-    peek' ptr = do-        a <- peek' (castPtr ptr)+    peek' n ptr = do+        a <- peek' n (castPtr ptr)         (a :*:) <$> peekByteOff' (castPtr ptr) (sizeOf' a)-    poke' ptr (a :*: b) = mconcat-        [ poke' (castPtr ptr) a+    poke' n ptr (a :*: b) = mconcat+        [ poke' n (castPtr ptr) a         , pokeByteOff' (castPtr ptr) (sizeOf' a) b ]  instance C.Storable a => ATSStorable a where@@ -83,35 +84,44 @@     peek :: Ptr a -> IO a     peek = C.peek --- FIXME use reference types+asIndex :: (Data a) => a -> Int+asIndex x = length $ takeWhile (/= ix) cs+    where ix = toConstr x+          cs = dataTypeConstrs (dataTypeOf x)+ instance (Storable' a, Storable' b) => Storable' (a :+: b) where     sizeOf' _ = 1 + max (sizeOf' (undefined :: a x)) (sizeOf' (undefined :: b x))     alignment' _ = 1-    peek' ptr = do+    peek' n ptr = do         tag <- peek (castPtr ptr)-        if (tag :: Word8) == 0-            then pure L1 <*> peekByteOff' (castPtr ptr) 1-            else pure R1 <*> peekByteOff' (castPtr ptr) 1-    poke' ptr (L1 val) = mconcat-        [ poke (castPtr ptr) (0 :: Word8)+        g (tag :: Word8)+        where g t | t == n = pure L1 <*> peekByteOff' (castPtr ptr) 1+                  | otherwise = pure R1 <*> peekByteOff' (castPtr ptr) 1+    poke' n ptr (L1 val) = mconcat+        [ poke (castPtr ptr) (n :: Word8)         , pokeByteOff' (castPtr ptr) 1 val ]-    poke' ptr (R1 val) = mconcat-        [ poke (castPtr ptr) (1 :: Word8)+    poke' n ptr (R1 val) = mconcat+        [ poke (castPtr ptr) (n :: Word8)         , pokeByteOff' (castPtr ptr) 1 val ]  -- instance (ATSStorable a) => Storable' (K1 i a) where     sizeOf' _ = sizeOf (undefined :: a)     alignment' _ = alignment (undefined :: a)-    peek' ptr = pure K1 <*> peek (castPtr ptr)-    poke' ptr (K1 val) = poke (castPtr ptr) val+    peek' _ ptr = pure K1 <*> peek (castPtr ptr)+    poke' _ ptr (K1 val) = poke (castPtr ptr) val  instance (Storable' a) => Storable' (M1 i c a) where     sizeOf' _ = sizeOf' (undefined :: a x)     alignment' _ = alignment' (undefined :: a x)-    peek' ptr = pure M1 <*> peek' (castPtr ptr)-    poke' ptr (M1 val) = poke' (castPtr ptr) val+    peek' n ptr = pure M1 <*> peek' n (castPtr ptr)+    poke' n ptr (M1 val) = poke' n (castPtr ptr) val +class Indexed a where+    index :: a -> Word8+    default index :: (Data a) => a -> Word8+    index = fromIntegral . asIndex+ class ATSStorable a where      sizeOf :: a -> Int@@ -123,12 +133,12 @@     alignment _ = (alignment' . from) (undefined :: a)      poke :: Ptr a -> a -> IO ()-    default poke :: (Generic a, Storable' (Rep a)) => Ptr a -> a -> IO ()-    poke ptr x = poke' (castPtr ptr) (from x)+    default poke :: (Generic a, Indexed a, Storable' (Rep a)) => Ptr a -> a -> IO ()+    poke ptr x = poke' (index x) (castPtr ptr) (from x)      peek :: Ptr a -> IO a-    default peek :: (Generic a, Storable' (Rep a)) => Ptr a -> IO a-    peek = fmap to . peek' . castPtr+    default peek :: (Generic a, Indexed a, Storable' (Rep a)) => Ptr a -> IO a+    peek = fmap to . peek' undefined . castPtr      writePtr :: a -> IO (Ptr a)     writePtr val = do