c-storable-deriving (empty) → 0.1

raw patch · 6 files changed

+252/−0 lines, 6 filesdep +basedep +ghc-primsetup-changed

Dependencies added: base, ghc-prim

Files

Foreign/CStorable.hs +23/−0
Foreign/CStorable/BaseInstances.hs +82/−0
Foreign/CStorable/TypeClass.hs +83/−0
LICENSE +30/−0
Setup.hs +2/−0
c-storable-deriving.cabal +32/−0

+ Foreign/CStorable.hs view

@@ -0,0 +1,23 @@+-- | This primarily exports the CStorable typeclass, which may have its+--   methods automatically defaulted if it has a Generic instance.+--   Then, this instance can be transfered via the `Storable' constructor.+module Foreign.CStorable+(CStorable(..),+ StorableWrap(..)+) where++import Foreign.CStorable.TypeClass+import Foreign.CStorable.BaseInstances+import Foreign.Storable+import Foreign.Ptr++-- | Applying the `Storable' constructor to something which is Storable+--   gives it a corresponding CStorable instance.+newtype StorableWrap a = Storable a++-- | Translates a Storable instance to a CStorable instance+instance (Storable a) => CStorable (StorableWrap a) where+  cPeek p                 = fmap Storable $ peek (castPtr p)+  cPoke p (Storable x)    = poke (castPtr p) x+  cAlignment (Storable x) = alignment x+  cSizeOf (Storable x)    = sizeOf x

+ Foreign/CStorable/BaseInstances.hs view

@@ -0,0 +1,82 @@+-- | Provides lots of bas instances, pulled over from `Storable'.+module Foreign.CStorable.BaseInstances where++import Data.Word+import Data.Int++import Foreign.CStorable.TypeClass+import Foreign.C.Types+import Foreign.Storable+import System.Posix.Types+import Foreign.Ptr++#define C(x) \+instance CStorable x where\+  cPeek      = peek;\+  cPoke      = poke;\+  cAlignment = alignment;\+  cSizeOf    = sizeOf\++C(Bool)+C(Char)+C(Double)+C(Float)+C(Int)+C(Int8)+C(Int16)+C(Int32)+C(Int64)+C(Word)+C(Word8)+C(Word16)+C(Word32)+C(Word64)+C(CUIntMax)+C(CIntMax)+C(CUIntPtr)+C(CIntPtr)+C(CTime)+C(CClock)+C(CSigAtomic)+C(CWchar)+C(CSize)+C(CPtrdiff)+C(CDouble)+C(CFloat)+C(CULLong)+C(CLLong)+C(CULong)+C(CLong)+C(CUInt)+C(CInt)+C(CUShort)+C(CShort)+C(CUChar)+C(CSChar)+C(CChar)+C(IntPtr)+C(WordPtr)+C(Fd)+C(CRLim)+C(CTcflag)+C(CSpeed)+C(CCc)+C(CUid)+C(CNlink)+C(CGid)+C(CSsize)+C(CPid)+C(COff)+C(CMode)+C(CIno)+C(CDev)+-- TODO Figure out how to pull these types in+{-+C(CTimeval)+C(Event)+C(Event)+C(PollFd)+C((StablePtr a))+-}+C((Ptr a))+C((FunPtr a))

+ Foreign/CStorable/TypeClass.hs view

@@ -0,0 +1,83 @@+{-# LANGUAGE DefaultSignatures #-}+-- | This module provides the mechanical deriving+--   mechanism for `CStorable'.+module Foreign.CStorable.TypeClass where++import Foreign.Ptr+import Foreign.Storable+import GHC.Generics++-- | A wrapper class for the raw autoderivation functions,+--   representing twhat is necessary for the defaulted+--   `CStorable' methods.+class GCStorable a where+  gcPeek      :: Ptr (a x)-> IO (a x)+  gcPoke      :: Ptr (a x) -> a x -> IO ()+  gcAlignment :: a x -> Int+  gcSizeOf    :: a x -> Int++instance GCStorable U1 where+  gcPeek _      = return U1+  gcPoke _ _    = return ()+  gcAlignment _ = 0+  gcSizeOf _    = 0++-- | Calculates extra space between two items based on alignment+--   and size.+padding :: (GCStorable a, GCStorable b) => a x -> b y -> Int+padding a b = let+  sizeA   = gcSizeOf a+  alignB  = gcAlignment b+  in ((alignB - sizeA) `mod` alignB)++-- | Calculates the total space consumed by a given element, including+--   alignment padding.+offset :: (GCStorable a, GCStorable b) => a x -> b y -> Int+offset a b = padding a b + gcSizeOf a++-- | Test+instance (GCStorable a, GCStorable b) => GCStorable (a :*: b) where+  gcPeek p = do+    a <- gcPeek $ castPtr p+    b <- gcPeek $ castPtr p `plusPtr` offset a (undefined :: b x)+    return $ a :*: b+  gcPoke p (a :*: b) = do+    gcPoke (castPtr p) a+    gcPoke (castPtr (p `plusPtr` offset a b)) b+  gcAlignment _ = lcm (gcAlignment (undefined :: a x))+                      (gcAlignment (undefined :: b y))+  gcSizeOf _    = let+    a = undefined :: a x+    b = undefined :: b y+    in gcSizeOf a + gcSizeOf b + padding a b++instance (GCStorable a) => GCStorable (M1 i c a) where+  gcPeek p           = fmap M1 $ gcPeek (castPtr p)+  gcPoke p (M1 x)    = gcPoke (castPtr p) x+  gcAlignment (M1 x) = gcAlignment x+  gcSizeOf (M1 x)    = gcSizeOf x++instance (CStorable a) => GCStorable (K1 i a) where+  gcPeek p           = fmap K1 $ cPeek (castPtr p)+  gcPoke p (K1 x)    = cPoke (castPtr p) x+  gcAlignment (K1 x) = cAlignment x+  gcSizeOf (K1 x)    = cSizeOf x++-- | This typeclass is basically just a duplicate of `Storable'. It exists+--   because I can't easily modify `Storable', as it is part of base.+class CStorable a where+  cPeek              :: Ptr a -> IO a+  default cPeek      :: (Generic a, GCStorable (Rep a)) => Ptr a -> IO a+  cPeek p            = fmap to $ gcPeek (castPtr p)++  cPoke              :: Ptr a -> a -> IO ()+  default cPoke      :: (Generic a, GCStorable (Rep a)) => Ptr a -> a -> IO ()+  cPoke p x          = gcPoke (castPtr p) $ from x++  cAlignment         :: a -> Int+  default cAlignment :: (Generic a, GCStorable (Rep a)) => a -> Int+  cAlignment         = gcAlignment . from++  cSizeOf            :: a -> Int+  default cSizeOf    :: (Generic a, GCStorable (Rep a)) => a -> Int+  cSizeOf            = gcAlignment . from

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c)2011, Matthew Maurer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Matthew Maurer nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ c-storable-deriving.cabal view

@@ -0,0 +1,32 @@+Name:                c-storable-deriving+Version:             0.1+Synopsis:            Generate C-like storable instances from datatypes+Description:         Automatically generates struct-rule based Storable+                     instances based on the Generic typeclass.+Homepage:            https://github.com/maurer/c-storable-deriving+License:             BSD3+License-File:        LICENSE+Author:              Matthew Maurer+Maintainer:          maurer@matthewmaurer.org+Category:            Foreign+Build-Type:          Simple+Cabal-Version:       >=1.6+Tested-With:         GHC ==7.2.1++Library+  Exposed-Modules:+    Foreign.CStorable+  Other-Modules:+    Foreign.CStorable.TypeClass+    Foreign.CStorable.BaseInstances+  Build-Depends: base < 5,+                 ghc-prim+  Extensions: FlexibleInstances,+              ScopedTypeVariables,+              TypeOperators,+              FlexibleContexts,+              CPP++Source-Repository HEAD+  Type:     git+  Location: git://github.com/maurer/c-storable-deriving.git