ats-storable 0.2.0.3 → 0.2.1.0

raw patch · 3 files changed

+63/−66 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ats-storable.cabal +2/−3
• cabal.project.local +0/−10
• src/Foreign/Storable/ATS.hs +61/−53

@@ -1,5 +1,5 @@ name:                ats-storable-version:             0.2.0.3+version:             0.2.1.0 synopsis:            Marshal ATS types into Haskell description:         Facilities for sharing types between ATS and Haskell homepage:            https://github.com//ats-generic#readme@@ -11,8 +11,7 @@ category:            ATS, Generics build-type:          Simple extra-doc-files:     README.md-extra-source-files:  cabal.project.local-cabal-version:       >=1.18+cabal-version:       1.18  Flag development {   Description: Enable `-Werror`

@@ -1,10 +0,0 @@-constraints:-  ats-storable +development--optimization: 2-with-compiler: ghc-8.2.2-tests: True-benchmarks: True-documentation: True-haddock-hoogle: True-haddock-internal: True

@@ -1,10 +1,17 @@-{-# LANGUAGE DefaultSignatures    #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE InstanceSigs         #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeOperators        #-}-{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DefaultSignatures       #-}+{-# LANGUAGE DeriveDataTypeable      #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE IncoherentInstances     #-}+{-# LANGUAGE InstanceSigs            #-}+{-# LANGUAGE MonoLocalBinds          #-}+{-# LANGUAGE RankNTypes              #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE StandaloneDeriving      #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UndecidableInstances    #-}  module Foreign.Storable.ATS     ( ATSStorable (..)@@ -20,11 +27,15 @@ import qualified Data.Text.Lazy        as TL import           Data.Word import           Foreign.C.String+import           Foreign.C.Types import           Foreign.Marshal.Alloc import           Foreign.Ptr import qualified Foreign.Storable      as C import           GHC.Generics +deriving instance Data CChar+deriving instance Data CInt+ class AsCString a where     toCString :: a -> IO CString @@ -59,10 +70,16 @@     peekByteOff' :: Ptr (f a) -> Int -> IO (f a)     peekByteOff' = peek' 0 .* plusPtr +instance Storable' U1 where+    sizeOf' = pure 0+    alignment' = pure 0+    poke' _ _ = pure undefined+    peek' _ _ = pure undefined+ instance Storable' V1 where     peek' = undefined-    poke' = undefined     alignment' = undefined+    poke' = undefined     sizeOf' = undefined  instance (Storable' a, Storable' b) => Storable' (a :*: b) where@@ -75,42 +92,36 @@         [ poke' n (castPtr ptr) a         , pokeByteOff' (castPtr ptr) (sizeOf' a) b ] -instance C.Storable a => ATSStorable a where-    sizeOf :: a -> Int-    sizeOf = C.sizeOf-    alignment :: a -> Int-    alignment = C.alignment-    poke :: Ptr a -> a -> IO ()-    poke = C.poke-    peek :: Ptr a -> IO a-    peek = C.peek- asIndex :: (Data a) => a -> Int-asIndex x = length $ takeWhile (/= ix) cs+asIndex x = subtract 1 . length $ takeWhile (/= ix) cs     where ix = toConstr x           cs = dataTypeConstrs (dataTypeOf x) +sumHelper :: Storable' f => Word8 -> Ptr a -> f b -> IO ()+sumHelper n ptr val = do+    bptr <- mallocBytes (sizeOf' val)+    poke' n bptr val+    C.poke (castPtr ptr) bptr++ptrSize :: Int+ptrSize = C.sizeOf (undefined :: (Ptr Word8))+ instance (Storable' a, Storable' b) => Storable' (a :+: b) where-    sizeOf' _ = 1 + max (sizeOf' (undefined :: a x)) (sizeOf' (undefined :: b x))+    sizeOf' _ = 1 + ptrSize     alignment' _ = 1-    peek' n ptr = do-        tag <- peek (castPtr ptr)-        g (tag :: Word8)-        where g t | t == n = pure L1 <*> peekByteOff' (castPtr ptr) 1-                  | otherwise = pure R1 <*> peekByteOff' (castPtr ptr) 1+    peek' _ _ = undefined     poke' n ptr (L1 val) = mconcat-        [ poke (castPtr ptr) (n :: Word8)-        , pokeByteOff' (castPtr ptr) 1 val ]+        [ C.poke (castPtr ptr) n+        , sumHelper n ptr val ]     poke' n ptr (R1 val) = mconcat-        [ poke (castPtr ptr) (n :: Word8)-        , pokeByteOff' (castPtr ptr) 1 val ]+        [ C.poke (castPtr ptr) n+        , sumHelper n ptr 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+instance (C.Storable a) => Storable' (K1 i a) where+    sizeOf' _ = C.sizeOf (undefined :: a)+    alignment' _ = C.alignment (undefined :: a)+    peek' _ ptr = pure K1 <*> C.peek (castPtr ptr)+    poke' _ ptr (K1 val) = C.poke (castPtr ptr) val  instance (Storable' a) => Storable' (M1 i c a) where     sizeOf' _ = sizeOf' (undefined :: a x)@@ -118,31 +129,28 @@     peek' n ptr = pure M1 <*> peek' n (castPtr ptr)     poke' n ptr (M1 val) = poke' n (castPtr ptr) val +instance C.Storable a => Indexed a where+    index :: a -> Word8+    index = pure 1+ class Indexed a where     index :: a -> Word8-    default index :: (Data a) => a -> Word8+    default index :: Data a => a -> Word8     index = fromIntegral . asIndex -class ATSStorable a where--    sizeOf :: a -> Int-    default sizeOf :: (Generic a, Storable' (Rep a)) => a -> Int+instance (Generic a, Storable' (Rep a), Data a) => C.Storable a where     sizeOf _ = (sizeOf' . from) (undefined :: a)--    alignment :: a -> Int-    default alignment :: (Generic a, Storable' (Rep a)) => a -> Int-    alignment _ = (alignment' . from) (undefined :: a)--    poke :: Ptr a -> a -> IO ()-    default poke :: (Generic a, Indexed a, Storable' (Rep a)) => Ptr a -> a -> IO ()+    alignment = C.sizeOf     poke ptr x = poke' (index x) (castPtr ptr) (from x)--    peek :: Ptr a -> IO a-    default peek :: (Generic a, Indexed a, Storable' (Rep a)) => Ptr a -> IO a     peek = fmap to . peek' undefined . castPtr -    writePtr :: a -> IO (Ptr a)+class ATSStorable a where++    readPtr :: C.Storable a => Ptr a -> IO a+    readPtr = C.peek++    writePtr :: C.Storable a => a -> IO (Ptr a)     writePtr val = do-        ptr <- mallocBytes (sizeOf val)-        poke ptr val+        ptr <- mallocBytes (C.sizeOf val)+        C.poke ptr val         pure ptr