packages feed

storable-record (empty) → 0.0.1

raw patch · 6 files changed

+348/−0 lines, 6 filesdep +basedep +special-functorsdep +transformerssetup-changed

Dependencies added: base, special-functors, transformers, utility-ht

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Foreign/Storable/FixedArray.hs view
@@ -0,0 +1,38 @@+module Foreign.Storable.FixedArray where++import Control.Monad.Trans.State (StateT, evalStateT, get, put, )+import Control.Monad.Trans (lift, )++import Foreign.Ptr (Ptr, castPtr, )+import Foreign.Storable (Storable(..))+import Foreign.Marshal.Array (advancePtr, )+++{-# INLINE roundUp #-}+roundUp :: Int -> Int -> Int+roundUp m x = x + mod (-x) m++{-# INLINE sizeOfArray #-}+sizeOfArray :: Storable a => Int -> a -> Int+sizeOfArray n x =+   n * roundUp (alignment x) (sizeOf x)++{-# INLINE pokeNext #-}+pokeNext :: (Storable a) => a -> StateT (Ptr a) IO ()+pokeNext x =+   do ptr <- get+      lift $ poke ptr x+      put (ptr `advancePtr` 1)+--      put (ptr `plusPtr` size x + div (- size x) (alignment x))++{-# INLINE peekNext #-}+peekNext :: (Storable a) => StateT (Ptr a) IO a+peekNext =+   do ptr <- get+      a <- lift $ peek ptr+      put (ptr `advancePtr` 1)+      return a++run :: Ptr (t a) -> StateT (Ptr a) IO c -> IO c+run ptr act =+   evalStateT act (castPtr ptr)
+ src/Foreign/Storable/Newtype.hs view
@@ -0,0 +1,26 @@+{- |+Storable instances for simple wrapped types.+-}+module Foreign.Storable.Newtype where++import Foreign.Ptr (Ptr, castPtr, )+import Foreign.Storable (Storable, )+import qualified Foreign.Storable as Store+++sizeOf :: Storable core => (wrapper -> core) -> wrapper -> Int+sizeOf unwrap = Store.sizeOf . unwrap++alignment :: Storable core => (wrapper -> core) -> wrapper -> Int+alignment unwrap = Store.alignment . unwrap+++peek :: Storable core =>+   (core -> wrapper) -> Ptr wrapper -> IO wrapper+peek wrap =+   fmap wrap . Store.peek . castPtr++poke :: Storable core =>+   (wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()+poke unwrap ptr =+   Store.poke (castPtr ptr) . unwrap
+ src/Foreign/Storable/Record.hs view
@@ -0,0 +1,142 @@+module Foreign.Storable.Record (+   Dictionary, Access,+   element, run,++   alignment, sizeOf,+   peek, poke,+   ) where++import Control.Monad.Trans.Reader+          (ReaderT(ReaderT), runReaderT,+           Reader, reader, runReader, )+import Control.Monad.Trans.Writer+          (Writer, writer, runWriter, )+import Control.Monad.Trans.State+          (State, modify, state, runState, )+import Control.Applicative (Applicative(..), liftA2, )+import Data.Monoid (Monoid(mempty, mappend), )++import Foreign.Storable.FixedArray (roundUp, )+import qualified Foreign.Storable as St++import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, )+++data Dictionary r =+   Dictionary {+      sizeOf_ :: Int,+      alignment_ :: Alignment,+      ptrBox :: Reader (Ptr r) (Box r r)+   }++newtype Access r a =+   Access+      (Compose (Writer Alignment)+        (Compose (State Int)+          (Compose (Reader (Ptr r))+              (Box r)))+        a)++instance Functor (Access r) where+   {-# INLINE fmap #-}+   fmap f (Access m) = Access (fmap f m)++instance Applicative (Access r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Access (pure a)+   Access f <*> Access x = Access (f <*> x)+++{- |+See (.:) in TypeCompose library.+However I find this library too heavy weight+with respect to type extensions in order to depend on it.+-}+newtype Compose f g a =+   Compose (f (g a))++instance (Functor f, Functor g) => Functor (Compose f g) where+   {-# INLINE fmap #-}+   fmap f (Compose x) = Compose (fmap (fmap f) x)++instance (Applicative f, Applicative g) => Applicative (Compose f g) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure x = Compose (pure (pure x))+   Compose f <*> Compose x =+      Compose (liftA2 (<*>) f x)+++data Box r a =+   Box {+      peek_ :: IO a,+      poke_ :: ReaderT r IO ()+   }++instance Functor (Box r) where+   {-# INLINE fmap #-}+   fmap f (Box pe po) =+      Box (fmap f pe) po++instance Applicative (Box r) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure a = Box (pure a) (pure ())+   f <*> x = Box (peek_ f <*> peek_ x) (poke_ f >> poke_ x)+++newtype Alignment = Alignment Int++instance Monoid Alignment where+   {-# INLINE mempty #-}+   {-# INLINE mappend #-}+   mempty = Alignment 1+   mappend (Alignment x) (Alignment y) = Alignment (lcm x y)+++{-# INLINE element #-}+element :: Storable a => (r -> a) -> Access r a+element f =+   let align = St.alignment (f undefined)+       size  = St.sizeOf (f undefined)+   in  Access $+       Compose $ writer $ flip (,) (Alignment align) $+       Compose $+       modify (roundUp align) >>+       state (\offset ->+          (Compose $ reader $ \ptr ->+           Box+             (St.peekByteOff ptr offset)+             (ReaderT $ St.pokeByteOff ptr offset . f),+           offset+size))++{-# INLINE run #-}+run :: Access r r -> Dictionary r+run (Access (Compose m)) =+   let (Compose s, align) = runWriter m+       (Compose r, size) = runState s 0+   in  Dictionary size align r+++{-# INLINE alignment #-}+alignment :: Dictionary r -> r -> Int+alignment dict _ =+   let (Alignment align) = alignment_ dict+   in  align++{-# INLINE sizeOf #-}+sizeOf :: Dictionary r -> r -> Int+sizeOf dict _ =+   sizeOf_ dict++{-# INLINE peek #-}+peek :: Dictionary r -> Ptr r -> IO r+peek dict ptr =+   peek_ $ runReader (ptrBox dict) ptr++{-# INLINE poke #-}+poke :: Dictionary r -> Ptr r -> r -> IO ()+poke dict ptr =+   runReaderT (poke_ $ runReader (ptrBox dict) ptr)
+ storable-record.cabal view
@@ -0,0 +1,112 @@+Name:         storable-record+Version:      0.0.1+Category:     Data, Foreign+Synopsis:     Elegant definition of Storable instances for records+Description:+  With this package definition+  you can build a Storable instance of a record type+  from Storable instances of its elements.+  This is as simple as:+  .+  > import Foreign.Storable.Record as Store+  > import Foreign.Storable (Storable (..), )+  >+  > import Control.Applicative (liftA2, )+  >+  > data Stereo a = Stereo (left, right :: a)+  > -- parentheses must be curly braces, but Haddock does not like them+  >+  > store :: Storable a => Store.Dictionary (Stereo a)+  > store =+  >    Store.run $+  >    liftA2 Stereo+  >       (Store.element left)+  >       (Store.element right)+  >+  > instance (Storable a) => Storable (Stereo a) where+  >    sizeOf = Store.sizeOf store+  >    alignment = Store.alignment store+  >    peek = Store.peek store+  >    poke = Store.poke store+  .+  I cannot promise that the generated memory layout+  is compatible with that of a corresponding C struct.+  However, the module generates the smallest layout+  that is possible with respect to the alignment of the record elements.+  Thus this package might provide a Haskell98 alternative to HSC+  without a preprocessor.+  If you encounter, that a record does not have a compatible layout,+  we should fix that.+  But also without C compatibility this package is useful+  e.g. in connection with StorableVector.+  .+  The @Stereo@ constructor is exclusively used+  for constructing the @peek@ function,+  where as the accessors in the @element@ calls+  are used for assembling the @poke@ function.+  It is required that the order of arguments of @Stereo@+  matches the record accessors in the @element@ calls.+  If you want that the stored data correctly and fully represents+  your Haskell data, it must hold:+  .+  >   Stereo (left x) (right x) = x   .+  .+  Unfortunately this cannot be checked automatically.+  However, mismatching types that are caused by swapped arguments+  are detected by the type system.+  Our system performs for you:+  Size and alignment computation, poking and peeking.+  Thus several inconsistency bugs can be prevented using this package,+  like size mismatches space required by @poke@ actions.+  There is no more restriction,+  thus smart constructors and accessors+  and nested records work, too.+  For nested records however,+  I recommend individual Storable instances for the sub-records.+  .+  You see it would simplify class instantiation+  if we could tell the class dictionary at once+  instead of defining each method separately.+  .+  For examples see packages sox and synthesizer.+License:             BSD3+License-file:        LICENSE+Author:              Henning Thielemann <storable@henning-thielemann.de>+Maintainer:          Henning Thielemann <storable@henning-thielemann.de>+Homepage:            http://code.haskell.org/~thielema/storable-record/+Stability:           Experimental+Build-Type:          Simple+Tested-With:         GHC==6.8.2+Cabal-Version:       >=1.6++Source-Repository head+  Type:     darcs+  Location: http://code.haskell.org/~thielema/storable-record/++Source-Repository this+  Type:     darcs+  Location: http://code.haskell.org/~thielema/storable-record/+  Tag:      0.0.1++Flag splitBase+  description: Choose the new smaller, split-up base package.++Library+  Build-Depends:+    transformers >=0.0.1 && <0.2,+    utility-ht >=0.0.1 && <0.1+  If flag(splitBase)+    Build-Depends: base >= 3+  Else+    Build-Depends:+      special-functors >= 1.0 && <1.1,+      base >= 1.0 && < 2++  GHC-Options:         -Wall+  Hs-Source-Dirs:      src++  Exposed-Modules:+    Foreign.Storable.Record+    Foreign.Storable.Newtype+  Other-Modules:+    Foreign.Storable.FixedArray