packages feed

comfort-array 0.0.1.1 → 0.1

raw patch · 7 files changed

+335/−39 lines, 7 filesdep +QuickCheckdep +comfort-arraydep +guarded-allocationdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, comfort-array, guarded-allocation, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Data.Array.Comfort.Shape: class C sh => Indexed sh where {
+ Data.Array.Comfort.Shape: class Indexed sh => InvIndexed sh
+ Data.Array.Comfort.Shape: indexFromOffset :: InvIndexed sh => sh -> Int -> Index sh
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1) => Data.Array.Comfort.Shape.Indexed (sh0 Data.Array.Comfort.Shape.:+: sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1) => Data.Array.Comfort.Shape.Indexed (sh0, sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1, Data.Array.Comfort.Shape.Indexed sh2) => Data.Array.Comfort.Shape.Indexed (sh0, sh1, sh2)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1) => Data.Array.Comfort.Shape.InvIndexed (sh0 Data.Array.Comfort.Shape.:+: sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1) => Data.Array.Comfort.Shape.InvIndexed (sh0, sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1, Data.Array.Comfort.Shape.InvIndexed sh2) => Data.Array.Comfort.Shape.InvIndexed (sh0, sh1, sh2)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed ()
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed ()
+ Data.Array.Comfort.Shape: instance GHC.Arr.Ix n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Arr.Ix n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.OneBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Shifted n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.ZeroBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.OneBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Shifted n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.ZeroBased n)
+ Data.Array.Comfort.Shape: uncheckedIndexFromOffset :: InvIndexed sh => sh -> Int -> Index sh
+ Data.Array.Comfort.Shape.Test: tests :: (InvIndexed sh, Show sh, Index sh ~ ix, Eq ix, Show ix) => Gen sh -> [(String, Property)]
+ Data.Array.Comfort.Storable.Internal: createWithSizeAndResultIO :: (C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> IO (Array sh a, b)
+ Data.Array.Comfort.Storable.Internal: unsafeCreateWithSizeAndResult :: (C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
- Data.Array.Comfort.Shape: class C sh where {
+ Data.Array.Comfort.Shape: class C sh
- Data.Array.Comfort.Shape: inBounds :: C sh => sh -> Index sh -> Bool
+ Data.Array.Comfort.Shape: inBounds :: Indexed sh => sh -> Index sh -> Bool
- Data.Array.Comfort.Shape: indices :: C sh => sh -> [Index sh]
+ Data.Array.Comfort.Shape: indices :: Indexed sh => sh -> [Index sh]
- Data.Array.Comfort.Shape: offset :: C sh => sh -> Index sh -> Int
+ Data.Array.Comfort.Shape: offset :: Indexed sh => sh -> Index sh -> Int
- Data.Array.Comfort.Shape: sizeOffset :: C sh => sh -> Index sh -> (Int, Int)
+ Data.Array.Comfort.Shape: sizeOffset :: Indexed sh => sh -> Index sh -> (Int, Int)
- Data.Array.Comfort.Shape: uncheckedOffset :: C sh => sh -> Index sh -> Int
+ Data.Array.Comfort.Shape: uncheckedOffset :: Indexed sh => sh -> Index sh -> Int
- Data.Array.Comfort.Shape: uncheckedSizeOffset :: C sh => sh -> Index sh -> (Int, Int)
+ Data.Array.Comfort.Shape: uncheckedSizeOffset :: Indexed sh => sh -> Index sh -> (Int, Int)
- Data.Array.Comfort.Storable: (!) :: (C sh, Storable a) => Array sh a -> Index sh -> a
+ Data.Array.Comfort.Storable: (!) :: (Indexed sh, Storable a) => Array sh a -> Index sh -> a
- Data.Array.Comfort.Storable.Internal: (!) :: (C sh, Storable a) => Array sh a -> Index sh -> a
+ Data.Array.Comfort.Storable.Internal: (!) :: (Indexed sh, Storable a) => Array sh a -> Index sh -> a
- Data.Array.Comfort.Storable.Internal: readIO :: (C sh, Storable a) => Array sh a -> Index sh -> IO a
+ Data.Array.Comfort.Storable.Internal: readIO :: (Indexed sh, Storable a) => Array sh a -> Index sh -> IO a

Files

comfort-array.cabal view
@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.0.1.1+Version:          0.1 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -10,7 +10,8 @@ Description:   Arrays from the basic @array@ package are already very powerful   compared with arrays in other languages.-  It provides arrays of any dimension in a type safe and uniform way+  They may have any number of dimensions, are type safe+  and defined in a uniform way using the Ix class   with free choice of the lower bounds (0, 1, or whatever you like).   .   This package goes one step further:@@ -38,14 +39,21 @@   * @ZeroBased, OneBased@:     Arrays with fixed lower bound, either 0 or 1, respectively.   .+  * @(:+:)@:+    The Append type constructor allows to respresent block arrays,+    e.g. block matrices.+  .   * Arrays with indices like 'LT', 'EQ', 'GT' and dummy shape.+  .+  The @lapack@ package defines even more fancy shapes+  like tall rectangular matrices, triangular matrices and banded matrices.  Tested-With:      GHC==7.4.2, GHC==7.8.4, GHC==8.2.2-Cabal-Version:    >=1.6+Cabal-Version:    1.14 Build-Type:       Simple  Source-Repository this-  Tag:         0.0.1.1+  Tag:         0.1   Type:        darcs   Location:    http://hub.darcs.net/thielema/comfort-array/ @@ -55,12 +63,32 @@  Library   Build-Depends:+    guarded-allocation >=0.0 && <0.1,+    QuickCheck >=2 && <3,+    transformers >=0.3 && <0.6,     utility-ht >=0.0.10 && <0.1,     base >=4.5 && <5    GHC-Options:      -Wall+  Default-Language: Haskell98   Hs-Source-Dirs:   src   Exposed-Modules:     Data.Array.Comfort.Shape+    Data.Array.Comfort.Shape.Test     Data.Array.Comfort.Storable     Data.Array.Comfort.Storable.Internal++Test-Suite comfort-array-test+  Type: exitcode-stdio-1.0+  Build-Depends:+    comfort-array,+    QuickCheck,+    base++  GHC-Options:      -Wall+  Default-Language: Haskell98+  Hs-Source-Dirs:   test+  Main-Is:          Main.hs+  Other-Modules:+    Test.Shape+    Test.Utility
src/Data/Array/Comfort/Shape.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE TypeOperators #-} module Data.Array.Comfort.Shape (    C(..),+   Indexed(..),+   InvIndexed(..),     ZeroBased(..),    OneBased(..),@@ -17,13 +19,25 @@  import qualified GHC.Arr as Ix +import qualified Control.Monad.Trans.State as MS import qualified Control.Monad.HT as Monad+import qualified Control.Applicative.Backwards as Back+import Control.Applicative (liftA2, liftA3) -import Data.Tuple.HT (mapFst, mapPair)+import Text.Printf (printf) +import Data.Tuple.HT (mapFst, mapPair, swap) + class C sh where-   {-# MINIMAL indices, size, (sizeOffset|offset), inBounds #-}+   -- Ix.rangeSize+   size :: sh -> Int+   -- Ix.unsafeRangeSize+   uncheckedSize :: sh -> Int+   uncheckedSize = size++class C sh => Indexed sh where+   {-# MINIMAL indices, (sizeOffset|offset), inBounds #-}    type Index sh :: *    -- Ix.range    indices :: sh -> [Index sh]@@ -35,28 +49,43 @@    uncheckedOffset = offset    -- Ix.inRange    inBounds :: sh -> Index sh -> Bool-   -- Ix.rangeSize-   size :: sh -> Int-   -- Ix.unsafeRangeSize-   uncheckedSize :: sh -> Int-   uncheckedSize = size     sizeOffset :: sh -> Index sh -> (Int,Int)    sizeOffset sh ix = (size sh, offset sh ix)    uncheckedSizeOffset :: sh -> Index sh -> (Int,Int)    uncheckedSizeOffset sh ix = (uncheckedSize sh, uncheckedOffset sh ix) +class Indexed sh => InvIndexed sh where+   {- |+   It should hold @indexFromOffset sh k == indices sh !! k@,+   but 'indexFromOffset' should generally be faster.+   -}+   indexFromOffset :: sh -> Int -> Index sh+   uncheckedIndexFromOffset :: sh -> Int -> Index sh+   uncheckedIndexFromOffset = indexFromOffset +errorIndexFromOffset :: String -> Int -> a+errorIndexFromOffset name k =+   error $ printf "indexFromOffset (%s): index %d out of range" name k++ instance C () where+   size () = 1+   uncheckedSize () = 1++instance Indexed () where    type Index () = ()    indices () = [()]    offset () () = 0    uncheckedOffset () () = 0    inBounds () () = True-   size () = 1-   uncheckedSize () = 1 +instance InvIndexed () where+   indexFromOffset () 0 = ()+   indexFromOffset () k = errorIndexFromOffset "()" k+   uncheckedIndexFromOffset () _ = () + {- | 'ZeroBased' denotes a range starting at zero and has a certain length. -}@@ -64,14 +93,25 @@    deriving (Eq, Show)  instance (Integral n) => C (ZeroBased n) where+   size (ZeroBased len) = fromIntegral len+   uncheckedSize (ZeroBased len) = fromIntegral len++instance (Integral n) => Indexed (ZeroBased n) where    type Index (ZeroBased n) = n    indices (ZeroBased len) = indices $ Shifted 0 len    offset (ZeroBased len) = offset $ Shifted 0 len    uncheckedOffset _ ix = fromIntegral ix    inBounds (ZeroBased len) ix = 0<=ix && ix<len-   size (ZeroBased len) = fromIntegral len-   uncheckedSize (ZeroBased len) = fromIntegral len +instance (Integral n) => InvIndexed (ZeroBased n) where+   indexFromOffset (ZeroBased len) k0 =+      let k = fromIntegral k0+      in  if 0<=k && k<len+            then k+            else errorIndexFromOffset "ZeroBased" k0+   uncheckedIndexFromOffset _ k = fromIntegral k++ {- | 'OneBased' denotes a range starting at one and has a certain length. -}@@ -79,15 +119,25 @@    deriving (Eq, Show)  instance (Integral n) => C (OneBased n) where+   size (OneBased len) = fromIntegral len+   uncheckedSize (OneBased len) = fromIntegral len++instance (Integral n) => Indexed (OneBased n) where    type Index (OneBased n) = n    indices (OneBased len) = indices $ Shifted 1 len    offset (OneBased len) = offset $ Shifted 1 len    uncheckedOffset _ ix = fromIntegral ix - 1    inBounds (OneBased len) ix = 0<ix && ix<=len-   size (OneBased len) = fromIntegral len-   uncheckedSize (OneBased len) = fromIntegral len +instance (Integral n) => InvIndexed (OneBased n) where+   indexFromOffset (OneBased len) k0 =+      let k = fromIntegral k0+      in  if 0<=k && k<len+            then 1+k+            else errorIndexFromOffset "OneBased" k0+   uncheckedIndexFromOffset _ k = 1 + fromIntegral k + {- | 'Range' denotes an inclusive range like those of the Haskell 98 standard @Array@ type from the @array@ package.@@ -98,14 +148,24 @@    deriving (Eq, Show)  instance (Ix.Ix n) => C (Range n) where+   size (Range from to) = Ix.rangeSize (from,to)+   uncheckedSize (Range from to) = Ix.unsafeRangeSize (from,to)++instance (Ix.Ix n) => Indexed (Range n) where    type Index (Range n) = n    indices (Range from to) = Ix.range (from,to)    offset (Range from to) ix = Ix.index (from,to) ix    uncheckedOffset (Range from to) ix = Ix.unsafeIndex (from,to) ix    inBounds (Range from to) ix = Ix.inRange (from,to) ix-   size (Range from to) = Ix.rangeSize (from,to)-   uncheckedSize (Range from to) = Ix.unsafeRangeSize (from,to) +-- pretty inefficient when we rely solely on Ix+instance (Ix.Ix n) => InvIndexed (Range n) where+   indexFromOffset (Range from to) k =+      if 0<=k && k < Ix.rangeSize (from,to)+         then Ix.range (from,to) !! k+         else errorIndexFromOffset "Range" k+   uncheckedIndexFromOffset (Range from to) k = Ix.range (from,to) !! k+ -- cf. sample-frame:Stereo instance Storable n => Storable (Range n) where    {-# INLINE sizeOf #-}@@ -129,6 +189,10 @@    deriving (Eq, Show)  instance (Integral n) => C (Shifted n) where+   size (Shifted _offs len) = fromIntegral len+   uncheckedSize (Shifted _offs len) = fromIntegral len++instance (Integral n) => Indexed (Shifted n) where    type Index (Shifted n) = n    indices (Shifted offs len) =       map snd $@@ -146,9 +210,15 @@                 else error "Shape.Shifted: array index too big"    uncheckedOffset (Shifted offs _len) ix = fromIntegral $ ix-offs    inBounds (Shifted offs len) ix = ix < offs+len-   size (Shifted _offs len) = fromIntegral len-   uncheckedSize (Shifted _offs len) = fromIntegral len +instance (Integral n) => InvIndexed (Shifted n) where+   indexFromOffset (Shifted offs len) k0 =+      let k = fromIntegral k0+      in  if 0<=k && k<len+            then offs+k+            else errorIndexFromOffset "Shifted" k0+   uncheckedIndexFromOffset (Shifted offs _len) k = offs + fromIntegral k+ -- cf. sample-frame:Stereo instance Storable n => Storable (Shifted n) where    {-# INLINE sizeOf #-}@@ -175,6 +245,10 @@ Row-major composition of two dimensions. -} instance (C sh0, C sh1) => C (sh0,sh1) where+   size (sh0,sh1) = size sh0 * size sh1+   uncheckedSize (sh0,sh1) = uncheckedSize sh0 * uncheckedSize sh1++instance (Indexed sh0, Indexed sh1) => Indexed (sh0,sh1) where    type Index (sh0,sh1) = (Index sh0, Index sh1)    indices (sh0,sh1) = Monad.lift2 (,) (indices sh0) (indices sh1)    offset (sh0,sh1) (ix0,ix1) =@@ -188,10 +262,20 @@       `combineSizeOffset`       uncheckedSizeOffset sh1 ix1    inBounds (sh0,sh1) (ix0,ix1) = inBounds sh0 ix0 && inBounds sh1 ix1-   size (sh0,sh1) = size sh0 * size sh1-   uncheckedSize (sh0,sh1) = uncheckedSize sh0 * uncheckedSize sh1 +instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where+   indexFromOffset (sh0,sh1) k =+      runInvIndex k $ liftA2 (,) (pickLastIndex sh0) (pickIndex sh1)+   uncheckedIndexFromOffset (sh0,sh1) k =+      runInvIndex k $ liftA2 (,) (uncheckedPickLastIndex sh0) (pickIndex sh1)++ instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where+   size (sh0,sh1,sh2) = size sh0 * size sh1 * size sh2+   uncheckedSize (sh0,sh1,sh2) =+      uncheckedSize sh0 * uncheckedSize sh1 * uncheckedSize sh2++instance (Indexed sh0, Indexed sh1, Indexed sh2) => Indexed (sh0,sh1,sh2) where    type Index (sh0,sh1,sh2) = (Index sh0, Index sh1, Index sh2)    indices (sh0,sh1,sh2) =       Monad.lift3 (,,) (indices sh0) (indices sh1) (indices sh2)@@ -215,11 +299,37 @@       uncheckedSizeOffset sh2 ix2    inBounds (sh0,sh1,sh2) (ix0,ix1,ix2) =       inBounds sh0 ix0 && inBounds sh1 ix1 && inBounds sh2 ix2-   size (sh0,sh1,sh2) = size sh0 * size sh1 * size sh2-   uncheckedSize (sh0,sh1,sh2) =-      uncheckedSize sh0 * uncheckedSize sh1 * uncheckedSize sh2 +instance+   (InvIndexed sh0, InvIndexed sh1, InvIndexed sh2) =>+      InvIndexed (sh0,sh1,sh2) where+   indexFromOffset (sh0,sh1,sh2) k =+      runInvIndex k $+      liftA3 (,,) (pickLastIndex sh0) (pickIndex sh1) (pickIndex sh2)+   uncheckedIndexFromOffset (sh0,sh1,sh2) k =+      runInvIndex k $+      liftA3 (,,) (uncheckedPickLastIndex sh0) (pickIndex sh1) (pickIndex sh2) +runInvIndex :: s -> Back.Backwards (MS.State s) a -> a+runInvIndex k = flip MS.evalState k . Back.forwards++pickLastIndex ::+   (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+pickLastIndex sh =+   Back.Backwards $ MS.gets $ indexFromOffset sh++uncheckedPickLastIndex ::+   (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+uncheckedPickLastIndex sh =+   Back.Backwards $ MS.gets $ uncheckedIndexFromOffset sh++pickIndex :: (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+pickIndex sh =+   fmap (uncheckedIndexFromOffset sh) $+   Back.Backwards $ MS.state $ \k -> swap $ divMod k $ size sh+++ infixr 7 `combineOffset`, `combineSizeOffset`  {-# INLINE combineOffset #-}@@ -239,6 +349,10 @@    deriving (Eq, Show)  instance (C sh0, C sh1) => C (sh0:+:sh1) where+   size (sh0:+:sh1) = size sh0 + size sh1+   uncheckedSize (sh0:+:sh1) = uncheckedSize sh0 + uncheckedSize sh1++instance (Indexed sh0, Indexed sh1) => Indexed (sh0:+:sh1) where    type Index (sh0:+:sh1) = Either (Index sh0) (Index sh1)    indices (sh0:+:sh1) = map Left (indices sh0) ++ map Right (indices sh1)    offset (sh0:+:sh1) ix =@@ -261,9 +375,16 @@          Right ix1 ->             let size0 = uncheckedSize sh0             in  mapPair ((size0+), (size0+)) $ uncheckedSizeOffset sh1 ix1-   inBounds (sh0:+:sh1) ix =-      case ix of-         Left ix0 -> inBounds sh0 ix0-         Right ix1 -> inBounds sh1 ix1-   size (sh0:+:sh1) = size sh0 + size sh1-   uncheckedSize (sh0:+:sh1) = uncheckedSize sh0 + uncheckedSize sh1+   inBounds (sh0:+:sh1) = either (inBounds sh0) (inBounds sh1)++instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0:+:sh1) where+   indexFromOffset (sh0:+:sh1) k =+      let pivot = size sh0+      in if k < pivot+            then Left $ indexFromOffset sh0 k+            else Right $ indexFromOffset sh1 $ k-pivot+   uncheckedIndexFromOffset (sh0:+:sh1) k =+      let pivot = size sh0+      in if k < pivot+            then Left $ uncheckedIndexFromOffset sh0 k+            else Right $ uncheckedIndexFromOffset sh1 $ k-pivot
+ src/Data/Array/Comfort/Shape/Test.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Shape.Test (tests) where++import qualified Data.Array.Comfort.Shape as Shape++import qualified Test.QuickCheck as QC+++uncheckedSize :: (Shape.C sh) => sh -> Bool+uncheckedSize sh  =  Shape.size sh == Shape.uncheckedSize sh++inBounds :: (Shape.Indexed sh) => sh -> Bool+inBounds sh  =  all (Shape.inBounds sh) $ Shape.indices sh+++forAllIndices ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix, QC.Testable prop) =>+   sh -> (ix -> prop) -> QC.Property+forAllIndices sh f =+   let ixs = Shape.indices sh+   in not (null ixs)  QC.==>  QC.forAll (QC.elements ixs) f++sizeOffset ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property+sizeOffset sh =+   forAllIndices sh $ \ix ->+      Shape.sizeOffset sh ix == (Shape.size sh, Shape.offset sh ix)++uncheckedSizeOffset ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property+uncheckedSizeOffset sh =+   forAllIndices sh $ \ix ->+      Shape.uncheckedSizeOffset sh ix ==+         (Shape.uncheckedSize sh, Shape.uncheckedOffset sh ix)++uncheckedOffset ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property+uncheckedOffset sh =+   forAllIndices sh $ \ix ->+      Shape.offset sh ix == Shape.uncheckedOffset sh ix++lengthIndices :: (Shape.Indexed sh) => sh -> Bool+lengthIndices sh  =  length (Shape.indices sh) == Shape.size sh++indexOffsets :: (Shape.Indexed sh) => sh -> Bool+indexOffsets sh =+   map (Shape.offset sh) (Shape.indices sh) == take (Shape.size sh) [0..]++invIndices :: (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool+invIndices sh =+   Shape.indices sh ==+   map (Shape.indexFromOffset sh) (take (Shape.size sh) [0..])++uncheckedInvIndices ::+   (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool+uncheckedInvIndices sh =+   Shape.indices sh ==+   map (Shape.uncheckedIndexFromOffset sh) (take (Shape.size sh) [0..])+++tests ::+   (Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>+   QC.Gen sh -> [(String, QC.Property)]+tests gen =+   ("uncheckedSize", QC.forAll gen uncheckedSize) :+   ("inBounds", QC.forAll gen inBounds) :+   ("sizeOffset", QC.forAll gen sizeOffset) :+   ("uncheckedSizeOffset", QC.forAll gen uncheckedSizeOffset) :+   ("uncheckedOffset", QC.forAll gen uncheckedOffset) :+   ("lengthIndices", QC.forAll gen lengthIndices) :+   ("indexOffsets", QC.forAll gen indexOffsets) :+   ("invIndices", QC.forAll gen invIndices) :+   ("uncheckedInvIndices", QC.forAll gen uncheckedInvIndices) :+   []
src/Data/Array/Comfort/Storable/Internal.hs view
@@ -7,6 +7,7 @@    (!),    unsafeCreate,    unsafeCreateWithSize,+   unsafeCreateWithSizeAndResult,    toList,    fromList,    vectorFromList,@@ -15,6 +16,7 @@     createIO,    createWithSizeIO,+   createWithSizeAndResultIO,    showIO,    readIO,    toListIO,@@ -24,13 +26,18 @@  import qualified Data.Array.Comfort.Shape as Shape +import qualified Foreign.Marshal.Array.Guarded as Alloc import Foreign.Marshal.Array (pokeArray, peekArray, advancePtr, ) import Foreign.Storable (Storable, poke, peek, peekElemOff, )-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrArray, )+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Ptr (Ptr, )  import System.IO.Unsafe (unsafePerformIO, ) +import Control.Applicative ((<$>))++import Data.Tuple.HT (mapFst)+ import Prelude hiding (map, readIO, )  @@ -60,7 +67,12 @@    (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> Array sh a unsafeCreateWithSize sh = unsafePerformIO . createWithSizeIO sh -(!) :: (Shape.C sh, Storable a) => Array sh a -> Shape.Index sh -> a+unsafeCreateWithSizeAndResult ::+   (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)+unsafeCreateWithSizeAndResult sh =+   unsafePerformIO . createWithSizeAndResultIO sh++(!) :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> a (!) arr = unsafePerformIO . readIO arr  toList :: (Shape.C sh, Storable a) => Array sh a -> [a]@@ -92,18 +104,22 @@  createWithSizeIO ::    (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> IO (Array sh a)-createWithSizeIO sh f = do+createWithSizeIO sh f =+   fst <$> createWithSizeAndResultIO sh f++createWithSizeAndResultIO ::+   (Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO b) -> IO (Array sh a, b)+createWithSizeAndResultIO sh f =    let size = Shape.size sh-   fptr <- mallocForeignPtrArray size-   withForeignPtr fptr $ f size-   return $ Array sh fptr+   in fmap (mapFst (Array sh)) $ Alloc.create size $ f size  showIO :: (Shape.C sh, Show sh, Storable a, Show a) => Array sh a -> IO String showIO arr = do    xs <- toListIO arr    return $ "fromList " ++ showsPrec 11 (shape arr) (' ' : show xs) -readIO :: (Shape.C sh, Storable a) => Array sh a -> Shape.Index sh -> IO a+readIO :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> IO a readIO (Array sh fptr) ix =    withForeignPtr fptr $ flip peekElemOff (Shape.offset sh ix) 
+ test/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies #-}+module Main where++import qualified Test.Shape as TestShape+import Test.Utility (prefix)++import qualified Test.QuickCheck as QC+++main :: IO ()+main =+   mapM_ (\(name,prop) -> putStr (name ++ ": ") >> QC.quickCheck prop) $+   prefix "Shape" TestShape.tests +++   []
+ test/Test/Shape.hs view
@@ -0,0 +1,38 @@+module Test.Shape where++import qualified Data.Array.Comfort.Shape.Test as ShapeTest+import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Shape ((:+:)((:+:)))++import qualified Test.QuickCheck as QC+import Test.Utility (prefix)++import Control.Applicative (liftA2, liftA3)+++genZeroBased :: Int -> QC.Gen (Shape.ZeroBased Int)+genZeroBased n = fmap Shape.ZeroBased $ QC.choose (0,n)++tests :: [(String, QC.Property)]+tests =+   prefix "ZeroBased"+      (ShapeTest.tests $ genZeroBased 10) +++   prefix "OneBased"+      (ShapeTest.tests $ fmap Shape.OneBased $ QC.choose (0,10::Int)) +++   prefix "Range"+      (ShapeTest.tests $ do+         from <- QC.choose (0,10::Int)+         to <- QC.choose (from-1, 10)+         return $ Shape.Range from to) +++   prefix "Shifted"+      (ShapeTest.tests $+       liftA2 Shape.Shifted+         (QC.choose (-10,10::Int)) (QC.choose (0,10::Int))) +++   prefix "Pair"+      (ShapeTest.tests $ liftA2 (,) (genZeroBased 10) (genZeroBased 10)) +++   prefix "Triple"+      (ShapeTest.tests $+       liftA3 (,,) (genZeroBased 10) (genZeroBased 10) (genZeroBased 10)) +++   prefix "Append"+      (ShapeTest.tests $ liftA2 (:+:) (genZeroBased 10) (genZeroBased 10)) +++   []
+ test/Test/Utility.hs view
@@ -0,0 +1,5 @@+module Test.Utility where++prefix :: String -> [(String, test)] -> [(String, test)]+prefix msg =+   map (\(str,test) -> (msg ++ "." ++ str, test))