packages feed

comfort-array 0.4 → 0.4.1

raw patch · 13 files changed

+702/−128 lines, 13 filesdep +doctest-exitcode-stdiodep +doctest-libPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: doctest-exitcode-stdio, doctest-lib

API changes (from Hackage documentation)

- Data.Array.Comfort.Shape: instance GHC.Arr.Ix n => Data.Array.Comfort.Shape.C (Data.Array.Comfort.Shape.Range n)
- 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: Cube :: sh -> Cube sh
+ Data.Array.Comfort.Shape: Cyclic :: n -> Cyclic n
+ Data.Array.Comfort.Shape: Square :: sh -> Square sh
+ Data.Array.Comfort.Shape: [cubeSize] :: Cube sh -> sh
+ Data.Array.Comfort.Shape: [cyclicSize] :: Cyclic n -> n
+ Data.Array.Comfort.Shape: [squareSize] :: Square sh -> sh
+ Data.Array.Comfort.Shape: instance (GHC.Classes.Ord k, Data.Array.Comfort.Shape.C shape) => Data.Array.Comfort.Shape.C (Data.Map.Internal.Map k shape)
+ Data.Array.Comfort.Shape: instance (GHC.Classes.Ord k, Data.Array.Comfort.Shape.Indexed shape) => Data.Array.Comfort.Shape.Indexed (Data.Map.Internal.Map k shape)
+ Data.Array.Comfort.Shape: instance (GHC.Classes.Ord k, Data.Array.Comfort.Shape.InvIndexed shape) => Data.Array.Comfort.Shape.InvIndexed (Data.Map.Internal.Map k shape)
+ Data.Array.Comfort.Shape: instance Control.DeepSeq.NFData n => Control.DeepSeq.NFData (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance Control.DeepSeq.NFData sh => Control.DeepSeq.NFData (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance Control.DeepSeq.NFData sh => Control.DeepSeq.NFData (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.C sh => Data.Array.Comfort.Shape.C (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.C sh => Data.Array.Comfort.Shape.C (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed sh => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed sh => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed sh => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed sh => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance Foreign.Storable.Storable n => Foreign.Storable.Storable (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance Foreign.Storable.Storable sh => Foreign.Storable.Storable (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance Foreign.Storable.Storable sh => Foreign.Storable.Storable (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance GHC.Base.Applicative Data.Array.Comfort.Shape.Cube
+ Data.Array.Comfort.Shape: instance GHC.Base.Applicative Data.Array.Comfort.Shape.Cyclic
+ Data.Array.Comfort.Shape: instance GHC.Base.Applicative Data.Array.Comfort.Shape.Square
+ Data.Array.Comfort.Shape: instance GHC.Base.Functor Data.Array.Comfort.Shape.Cube
+ Data.Array.Comfort.Shape: instance GHC.Base.Functor Data.Array.Comfort.Shape.Cyclic
+ Data.Array.Comfort.Shape: instance GHC.Base.Functor Data.Array.Comfort.Shape.Square
+ Data.Array.Comfort.Shape: instance GHC.Classes.Eq n => GHC.Classes.Eq (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance GHC.Classes.Eq sh => GHC.Classes.Eq (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance GHC.Classes.Eq sh => GHC.Classes.Eq (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: instance GHC.Ix.Ix n => Data.Array.Comfort.Shape.C (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Ix.Ix n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Ix.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.C (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance GHC.Show.Show n => GHC.Show.Show (Data.Array.Comfort.Shape.Cyclic n)
+ Data.Array.Comfort.Shape: instance GHC.Show.Show sh => GHC.Show.Show (Data.Array.Comfort.Shape.Cube sh)
+ Data.Array.Comfort.Shape: instance GHC.Show.Show sh => GHC.Show.Show (Data.Array.Comfort.Shape.Square sh)
+ Data.Array.Comfort.Shape: newtype Cube sh
+ Data.Array.Comfort.Shape: newtype Cyclic n
+ Data.Array.Comfort.Shape: newtype Square sh
+ Data.Array.Comfort.Storable: takeCenter :: (C sh0, C sh1, C sh2, Storable a) => Array (sh0 :+: (sh1 :+: sh2)) a -> Array sh1 a
+ Data.Array.Comfort.Storable: toMap :: (Ord k, Storable a) => Array (Set k) a -> Map k a
+ Data.Array.Comfort.Storable.Unchecked: takeCenter :: (C sh0, C sh1, C sh2, Storable a) => Array (sh0 :+: (sh1 :+: sh2)) a -> Array sh1 a
- Data.Array.Comfort.Storable.Mutable.Private: Array :: sh -> MutablePtr a -> Array sh a
+ Data.Array.Comfort.Storable.Mutable.Private: Array :: sh -> MutablePtr a -> Array (m :: * -> *) sh a
- Data.Array.Comfort.Storable.Mutable.Private: [buffer] :: Array sh a -> MutablePtr a
+ Data.Array.Comfort.Storable.Mutable.Private: [buffer] :: Array (m :: * -> *) sh a -> MutablePtr a
- Data.Array.Comfort.Storable.Mutable.Private: [shape] :: Array sh a -> sh
+ Data.Array.Comfort.Storable.Mutable.Private: [shape] :: Array (m :: * -> *) sh a -> sh
- Data.Array.Comfort.Storable.Mutable.Unchecked: Array :: sh -> MutablePtr a -> Array sh a
+ Data.Array.Comfort.Storable.Mutable.Unchecked: Array :: sh -> MutablePtr a -> Array (m :: * -> *) sh a
- Data.Array.Comfort.Storable.Mutable.Unchecked: [buffer] :: Array sh a -> MutablePtr a
+ Data.Array.Comfort.Storable.Mutable.Unchecked: [buffer] :: Array (m :: * -> *) sh a -> MutablePtr a
- Data.Array.Comfort.Storable.Mutable.Unchecked: [shape] :: Array sh a -> sh
+ Data.Array.Comfort.Storable.Mutable.Unchecked: [shape] :: Array (m :: * -> *) sh a -> sh

Files

Changes.md view
@@ -1,5 +1,15 @@ # Change log for the `comfort-array` package +## 0.4.1++ * use `doctest-extract` for tests++ * `instance Shape Map`++ * `Shape.Cyclic`++ * `Shape.Square`, `Shape.Cube`+ ## 0.4   * `fromAssocations`: Make default value the first parameter.
comfort-array.cabal view
@@ -1,10 +1,10 @@ Name:             comfort-array-Version:          0.4+Version:          0.4.1 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de> Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>-Homepage:         http://hub.darcs.net/thielema/comfort-array/+Homepage:         https://hub.darcs.net/thielema/comfort-array/ Category:         Data Structures Synopsis:         Arrays where the index type is a function of the shape type Description:@@ -36,6 +36,9 @@   * @ZeroBased, OneBased@:     Arrays with fixed lower bound, either 0 or 1, respectively.   .+  * @Cyclic@:+    Indices with wrap-around semantics.+  .   * @Zero, ()@:     Arrays with fixed size 0 or 1, respectively.   .@@ -49,9 +52,15 @@   .   * @Set@: Use an arbitrary ordered set as index set.   .+  * @Map@: Concatenate a set of shapes.+  .   * @Triangular@:     A 2D array with the shape of a lower or upper triangular matrix.   .+  * @Square@: A 2D array where both dimensions always have equal size.+  .+  * @Cube@: A 3D array where all three dimensions always have equal size.+  .   * @Tagged@: Statically distinguish shapes and indices that are isomorphic.   .   The @lapack@ package defines even more fancy shapes@@ -62,15 +71,16 @@ Build-Type:       Simple Extra-Source-Files:   Changes.md+  test-module.list  Source-Repository this-  Tag:         0.4+  Tag:         0.4.1   Type:        darcs-  Location:    http://hub.darcs.net/thielema/comfort-array/+  Location:    https://hub.darcs.net/thielema/comfort-array/  Source-Repository head   Type:        darcs-  Location:    http://hub.darcs.net/thielema/comfort-array/+  Location:    https://hub.darcs.net/thielema/comfort-array/  Flag setIndex   Description: Use efficient Set indexing from containers>=0.5.4@@ -124,6 +134,8 @@   Type: exitcode-stdio-1.0   Build-Depends:     comfort-array,+    doctest-exitcode-stdio >=0.0 && <0.1,+    doctest-lib >=0.1 && <0.1.1,     ChasingBottoms >=1.2.2 && <1.4,     tagged,     containers,@@ -135,6 +147,9 @@   Hs-Source-Dirs:   test   Main-Is:          Main.hs   Other-Modules:-    Test.Storable+    DocTest.Data.Array.Comfort.Shape+    DocTest.Data.Array.Comfort.Storable.Unchecked+    DocTest.Data.Array.Comfort.Storable+    DocTest.Main     Test.Shape     Test.Utility
src/Data/Array/Comfort/Shape.hs view
@@ -17,10 +17,15 @@     (:+:)(..), +   Square(..),+   Cube(..),+    Triangular(..), Lower(Lower), Upper(Upper),    LowerTriangular, UpperTriangular,    lowerTriangular, upperTriangular,    triangleSize, triangleRoot,++   Cyclic(..),    ) where  import qualified Data.Array.Comfort.Shape.Set as ShapeSet@@ -40,17 +45,31 @@ import Control.Applicative (Applicative, pure, liftA2, liftA3, (<*>)) import Control.Applicative (Const(Const, getConst)) +import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.NonEmpty as NonEmpty+import qualified Data.List as List import Data.Functor.Identity (Identity(Identity), runIdentity) import Data.Function.HT (compose2) import Data.Tagged (Tagged(Tagged, unTagged))+import Data.Map (Map) import Data.Set (Set) import Data.List.HT (tails)+import Data.Maybe (fromMaybe) import Data.Tuple.HT (mapSnd, mapPair, swap, fst3, snd3, thd3) import Data.Eq.HT (equating)  +{- $setup+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import Data.Array.Comfort.Shape ((:+:)((:+:)))+-}++ class C sh where    -- Ix.rangeSize    size :: sh -> Int@@ -105,6 +124,10 @@    size () = 1    uncheckedSize () = 1 +{- |+>>> Shape.indices ()+[()]+-} instance Indexed () where    type Index () = ()    indices () = [()]@@ -123,6 +146,9 @@  {- | 'ZeroBased' denotes a range starting at zero and has a certain length.++>>> Shape.indices (Shape.ZeroBased (7::Int))+[0,1,2,3,4,5,6] -} newtype ZeroBased n = ZeroBased {zeroBasedSize :: n}    deriving (Eq, Show)@@ -171,6 +197,9 @@  {- | 'OneBased' denotes a range starting at one and has a certain length.++>>> Shape.indices (Shape.OneBased (7::Int))+[1,2,3,4,5,6,7] -} newtype OneBased n = OneBased {oneBasedSize :: n}    deriving (Eq, Show)@@ -216,6 +245,11 @@ those of the Haskell 98 standard @Array@ type from the @array@ package. E.g. the shape type @(Range Int32, Range Int64)@ is equivalent to the ix type @(Int32, Int64)@ for @Array@s.++>>> Shape.indices (Shape.Range (-5) (5::Int))+[-5,-4,-3,-2,-1,0,1,2,3,4,5]+>>> Shape.indices (Shape.Range (-1,-1) (1::Int,1::Int))+[(-1,-1),(-1,0),(-1,1),(0,-1),(0,0),(0,1),(1,-1),(1,0),(1,1)] -} data Range n = Range {rangeFrom, rangeTo :: n}    deriving (Eq, Show)@@ -263,6 +297,9 @@  {- | 'Shifted' denotes a range defined by the start index and the length.++>>> Shape.indices (Shape.Shifted (-4) (8::Int))+[-4,-3,-2,-1,0,1,2,3] -} data Shifted n = Shifted {shiftedOffset, shiftedSize :: n}    deriving (Eq, Show)@@ -294,7 +331,7 @@                 then fromIntegral k                 else error "Shape.Shifted: array index too big"    uncheckedOffset (Shifted offs _len) ix = fromIntegral $ ix-offs-   inBounds (Shifted offs len) ix = ix < offs+len+   inBounds (Shifted offs len) ix = offs <= ix && ix < offs+len  instance (Integral n) => InvIndexed (Shifted n) where    indexFromOffset (Shifted offs len) k0 =@@ -332,6 +369,9 @@ For correctness it is necessary that the 'Enum' and 'Bounded' instances are properly implemented. Automatically derived instances are fine.++>>> Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering)+[LT,EQ,GT] -} data Enumeration n = Enumeration    deriving (Eq, Show)@@ -377,14 +417,17 @@    peek _p = return Enumeration  -{- |-You can use an arbitrary 'Set' of indices as shape.-The array elements are ordered according to the index order in the 'Set'.--} instance (Ord n) => C (Set n) where    size = uncheckedSize    uncheckedSize = Set.size +{- |+You can use an arbitrary 'Set' of indices as shape.+The array elements are ordered according to the index order in the 'Set'.++>>> Shape.indices (Set.fromList "comfort")+"cfmort"+-} instance (Ord n) => Indexed (Set n) where    type Index (Set n) = n    indices = Set.toAscList@@ -398,6 +441,74 @@   {- |+Concatenate many arrays according to the shapes stored in a 'Map'.+-}+instance (Ord k, C shape) => C (Map k shape) where+   size = Fold.sum . Map.map size+   uncheckedSize = Fold.sum . Map.map uncheckedSize++{- |+The implementations of 'offset' et.al.+are optimized for frequent calls with respect to the same shape.++>>> Shape.indices $ fmap Shape.ZeroBased $ Map.fromList [('b', (0::Int)), ('a', 5), ('c', 2)]+[('a',0),('a',1),('a',2),('a',3),('a',4),('c',0),('c',1)]+-}+instance (Ord k, Indexed shape) => Indexed (Map k shape) where+   type Index (Map k shape) = (k, Index shape)+   indices =+      Fold.fold . Map.mapWithKey (\k shape -> map ((,) k) $ indices shape)+   offset m =+      let mu = snd $ Trav.mapAccumL (\l sh -> (l + size sh, (l,sh))) 0 m+      in \(k,ix) ->+         case Map.lookup k mu of+            Nothing -> error "Shape.Map.offset: unknown key"+            Just (l,sh) -> l + offset sh ix+   uncheckedOffset m =+      let mu =+            snd $ Trav.mapAccumL (\l sh -> (l + uncheckedSize sh, (l,sh))) 0 m+      in \(k,ix) ->+         case Map.lookup k mu of+            Nothing -> error "Shape.Map.uncheckedOffset: unknown key"+            Just (l,sh) -> l + uncheckedOffset sh ix+   inBounds m (k,ix) = Fold.any (flip inBounds ix) $ Map.lookup k m++   sizeOffset = mapSizeOffset . Map.map sizeOffset+   uncheckedSizeOffset = mapSizeOffset . Map.map uncheckedSizeOffset++{-# INLINE mapSizeOffset #-}+mapSizeOffset :: (Ord k, Num i) => Map k (i, ix -> i) -> (i, (k, ix) -> i)+mapSizeOffset ms =+   (Fold.sum $ Map.map fst ms,+    let mu = snd $ Trav.mapAccumL (\l (sz,offs) -> (l + sz, (l+) . offs)) 0 ms+    in \(k,ix) ->+         fromMaybe (error "Shape.Map.sizeOffset: unknown key")+            (Map.lookup k mu) ix)++instance (Ord k, InvIndexed shape) => InvIndexed (Map k shape) where+   indexFromOffset m i =+      (\xs ->+         case xs of+            (_u,ix):_ -> ix+            [] -> errorIndexFromOffset "Map" i) $+      dropWhile (\(u,_ix) -> u<=i) $ snd $+      List.mapAccumL+         (\l (k,sh) ->+            let u = l + size sh+            in (u, (u, (k, indexFromOffset sh (i-l))))) 0 $+      Map.toAscList m++   uncheckedIndexFromOffset m i =+      (\((_u,ix):_) -> ix) $+      dropWhile (\(u,_ix) -> u<=i) $ snd $+      List.mapAccumL+         (\l (k,sh) ->+            let u = l + size sh+            in (u, (u, (k, uncheckedIndexFromOffset sh (i-l))))) 0 $+      Map.toAscList m+++{- | This data type wraps another array shape. Its index type is a wrapped 'Int'. The advantages are:@@ -414,12 +525,14 @@  Example: -> Shape> let sh2 = (ZeroBased (2::Int), ZeroBased (2::Int))-> Shape> let sh3 = (ZeroBased (3::Int), ZeroBased (3::Int))-> Shape> offset sh3 $ indexFromOffset sh2 3-> 4-> Shape> offset (Deferred sh3) $ indexFromOffset (Deferred sh2) 3-> 3+>>> :{+let sh2 = (Shape.ZeroBased (2::Int), Shape.ZeroBased (2::Int)) in+let sh3 = (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)) in+(Shape.offset sh3 $ Shape.indexFromOffset sh2 3,+ Shape.offset (Shape.Deferred sh3) $+   Shape.indexFromOffset (Shape.Deferred sh2) 3)+:}+(4,3) -} newtype Deferred sh = Deferred sh    deriving (Eq, Show)@@ -507,13 +620,16 @@   -{- |-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 +{- |+Row-major composition of two dimensions.++>>> Shape.indices (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int))+[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]+-} 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)@@ -621,6 +737,112 @@   +{- |+'Square' is like a Cartesian product,+but it is statically asserted that both dimension shapes match.++>>> Shape.indices $ Shape.Square $ Shape.ZeroBased (3::Int)+[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]+-}+newtype Square sh = Square {squareSize :: sh}+   deriving (Eq, Show)++instance Functor Square where+   fmap f (Square sh) = Square $ f sh++instance Applicative Square where+   pure = Square+   Square f <*> Square sh = Square $ f sh++instance (NFData sh) => NFData (Square sh) where+   rnf (Square sh) = rnf sh++instance (Storable sh) => Storable (Square sh) where+   sizeOf = Store.sizeOf squareSize+   alignment = Store.alignment squareSize+   peek = Store.peek Square+   poke = Store.poke squareSize++instance (C sh) => C (Square sh) where+   size (Square sh) = size sh ^ (2::Int)+   uncheckedSize (Square sh) = uncheckedSize sh ^ (2::Int)++instance (Indexed sh) => Indexed (Square sh) where+   type Index (Square sh) = (Index sh, Index sh)+   indices (Square sh) = indices (sh,sh)+   offset (Square sh) = offset (sh,sh)+   uncheckedOffset (Square sh) = uncheckedOffset (sh,sh)+   sizeOffset (Square sh) =+      let szo = sizeOffset sh+      in mapSnd (.fst) szo `combineSizeOffset` mapSnd (.snd) szo+   uncheckedSizeOffset (Square sh) =+      let szo = uncheckedSizeOffset sh+      in mapSnd (.fst) szo `combineSizeOffset` mapSnd (.snd) szo+   inBounds (Square sh) = inBounds (sh,sh)++instance (InvIndexed sh) => InvIndexed (Square sh) where+   indexFromOffset (Square sh) = indexFromOffset (sh,sh)+   uncheckedIndexFromOffset (Square sh) = uncheckedIndexFromOffset (sh,sh)++++{- |+'Cube' is like a Cartesian product,+but it is statically asserted that both dimension shapes match.++>>> Shape.indices $ Shape.Cube $ Shape.ZeroBased (2::Int)+[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1)]+-}+newtype Cube sh = Cube {cubeSize :: sh}+   deriving (Eq, Show)++instance Functor Cube where+   fmap f (Cube sh) = Cube $ f sh++instance Applicative Cube where+   pure = Cube+   Cube f <*> Cube sh = Cube $ f sh++instance (NFData sh) => NFData (Cube sh) where+   rnf (Cube sh) = rnf sh++instance (Storable sh) => Storable (Cube sh) where+   sizeOf = Store.sizeOf cubeSize+   alignment = Store.alignment cubeSize+   peek = Store.peek Cube+   poke = Store.poke cubeSize++instance (C sh) => C (Cube sh) where+   size (Cube sh) = size sh ^ (3::Int)+   uncheckedSize (Cube sh) = uncheckedSize sh ^ (3::Int)++instance (Indexed sh) => Indexed (Cube sh) where+   type Index (Cube sh) = (Index sh, Index sh, Index sh)+   indices (Cube sh) = indices (sh,sh,sh)+   offset (Cube sh) = offset (sh,sh,sh)+   uncheckedOffset (Cube sh) = uncheckedOffset (sh,sh,sh)+   sizeOffset (Cube sh) =+      let szo = sizeOffset sh+      in mapSnd (.fst3) szo+         `combineSizeOffset`+         mapSnd (.snd3) szo+         `combineSizeOffset`+         mapSnd (.thd3) szo+   uncheckedSizeOffset (Cube sh) =+      let szo = uncheckedSizeOffset sh+      in mapSnd (.fst3) szo+         `combineSizeOffset`+         mapSnd (.snd3) szo+         `combineSizeOffset`+         mapSnd (.thd3) szo+   inBounds (Cube sh) = inBounds (sh,sh,sh)++instance (InvIndexed sh) => InvIndexed (Cube sh) where+   indexFromOffset (Cube sh) = indexFromOffset (sh,sh,sh)+   uncheckedIndexFromOffset (Cube sh) = uncheckedIndexFromOffset (sh,sh,sh)+++ data Lower = Lower deriving (Eq, Show) data Upper = Upper deriving (Eq, Show) @@ -636,6 +858,12 @@ caseTriangularPart part lo up =    getConstAs part $ switchTriangularPart (Const lo) (Const up) +{- |+>>> Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int)+[(0,0),(0,1),(0,2),(1,1),(1,2),(2,2)]+>>> Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int)+[(0,0),(1,0),(1,1),(2,0),(2,1),(2,2)]+-} data Triangular part size =    Triangular {       triangularPart :: part,@@ -759,8 +987,66 @@   +{- |+'Cyclic' is a shape, where the indices wrap around at the array boundaries.+E.g.++prop> let shape = Shape.Cyclic (10::Int) in Shape.offset shape (-1) == Shape.offset shape 9++This also means that there are multiple indices+that address the same array element.++>>> Shape.indices (Shape.Cyclic (7::Int))+[0,1,2,3,4,5,6]+-}+newtype Cyclic n = Cyclic {cyclicSize :: n}+   deriving (Eq, Show)++instance Functor Cyclic where+   fmap f (Cyclic n) = Cyclic $ f n++instance Applicative Cyclic where+   pure = Cyclic+   Cyclic f <*> Cyclic n = Cyclic $ f n++instance (NFData n) => NFData (Cyclic n) where+   rnf (Cyclic n) = rnf n++instance (Storable n) => Storable (Cyclic n) where+   sizeOf = Store.sizeOf cyclicSize+   alignment = Store.alignment cyclicSize+   peek = Store.peek Cyclic+   poke = Store.poke cyclicSize++instance (Integral n) => C (Cyclic n) where+   size (Cyclic len) = fromIntegral len+   uncheckedSize (Cyclic len) = fromIntegral len++instance (Integral n) => Indexed (Cyclic n) where+   type Index (Cyclic n) = n+   indices (Cyclic len) = indices $ ZeroBased len+   offset = uncheckedOffset+   uncheckedOffset (Cyclic len) ix = fromIntegral $ mod ix len+   inBounds (Cyclic len) _ix = len>0++instance (Integral n) => InvIndexed (Cyclic n) where+   indexFromOffset (Cyclic len) k0 =+      let k = fromIntegral k0+      in  if 0<=k && k<len+            then k+            else errorIndexFromOffset "Cyclic" k0+   uncheckedIndexFromOffset _ k = fromIntegral k+++ infixr 5 :+: +{- |+Row-major composition of two dimensions.++>>> Shape.indices (Shape.ZeroBased (3::Int) :+: Shape.Range 'a' 'c')+[Left 0,Left 1,Left 2,Right 'a',Right 'b',Right 'c']+-} data sh0:+:sh1 = sh0:+:sh1    deriving (Eq, Show) 
src/Data/Array/Comfort/Storable.hs view
@@ -10,7 +10,7 @@    Array.vectorFromList,    toAssociations,    fromList,-   fromMap,+   fromMap, toMap,    fromContainer,    toContainer,    sample,@@ -28,6 +28,7 @@    Array.append,    Array.take, Array.drop,    Array.takeLeft, Array.takeRight, Array.split,+   Array.takeCenter,     Array.sum, Array.product,    minimum, argMinimum,@@ -55,6 +56,7 @@ import Control.Monad.ST (runST)  import qualified Data.Map as Map+import qualified Data.Set as Set import qualified Data.Foldable as Fold import qualified Data.List as List import qualified Data.Tuple.Strict as StrictTuple@@ -68,6 +70,38 @@ import Prelude ()  +{- $setup+>>> import qualified Data.Array.Comfort.Storable as Array+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import Data.Array.Comfort.Storable (Array)+>>>+>>> import qualified Test.QuickCheck as QC+>>> import Test.ChasingBottoms.IsBottom (isBottom)+>>>+>>> import Control.Applicative ((<$>))+>>>+>>> import Data.Word (Word16)+>>>+>>> type ShapeInt = Shape.ZeroBased Int+>>>+>>> genArray :: QC.Gen (Array ShapeInt Word16)+>>> genArray = Array.vectorFromList <$> QC.arbitrary+>>>+>>> infix 4 ==?+>>> (==?) :: a -> a -> (a,a)+>>> (==?) = (,)+>>>+>>> forAllNonEmpty :: (Eq b) => (Array ShapeInt Word16 -> (b,b)) -> QC.Property+>>> forAllNonEmpty f =+>>>    QC.forAll genArray $ \xs ->+>>>    case f xs of+>>>       (resultArray,resultList) ->+>>>          if Array.shape xs == Shape.ZeroBased 0+>>>             then isBottom resultArray+>>>             else resultArray == resultList+-}++ shape :: Array sh a -> sh shape = Array.shape @@ -85,6 +119,9 @@ fromMap :: (Ord k, Storable a) => Map k a -> Array (Set k) a fromMap m = fromList (Map.keysSet m) (Map.elems m) +toMap :: (Ord k, Storable a) => Array (Set k) a -> Map k a+toMap arr = Map.fromAscList $ zip (Set.toAscList $ shape arr) (Array.toList arr)+ fromContainer ::    (Container.C f, Storable a) => f a -> Array (Container.Shape f) a fromContainer xs = fromList (Container.toShape xs) (Fold.toList xs)@@ -153,9 +190,18 @@  {- | It is a checked error if the vector is empty.++prop> forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs) -}-minimum, maximum :: (Shape.C sh, Storable a, Ord a) => Array sh a -> a+minimum :: (Shape.C sh, Storable a, Ord a) => Array sh a -> a minimum = foldl1 min++{- |+It is a checked error if the vector is empty.++prop> forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs)+-}+maximum :: (Shape.C sh, Storable a, Ord a) => Array sh a -> a maximum = foldl1 max  {-# INLINE foldl1 #-}@@ -165,7 +211,7 @@       Memory.foldl1 (const id) op (Shape.size sh) xPtr 1  {- |-> limits x = (minimum x, maximum x)+prop> forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs) -} limits :: (Shape.C sh, Storable a, Ord a) => Array sh a -> (a,a) limits = StrictTuple.mapPair (getMin, getMax) . foldMap (\x -> (Min x, Max x))
src/Data/Array/Comfort/Storable/Unchecked.hs view
@@ -27,6 +27,7 @@    append,    take, drop,    takeLeft, takeRight, split,+   takeCenter,     sum, product,    foldl,@@ -53,6 +54,25 @@ import Prelude hiding (map, zipWith, foldl, take, drop, sum, product)  +{- $setup+>>> import DocTest.Data.Array.Comfort.Storable (ShapeInt, genArray)+>>>+>>> import qualified Data.Array.Comfort.Storable as Array+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import Data.Array.Comfort.Storable (Array, (!))+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import Data.Word (Word16)+>>>+>>> newtype Array16 = Array16 (Array ShapeInt Word16)+>>>    deriving (Show)+>>>+>>> instance QC.Arbitrary Array16 where+>>>    arbitrary = fmap Array16 genArray+-}++ unsafeCreate ::    (Shape.C sh, Storable a) =>    sh -> (Ptr a -> IO ()) -> Array sh a@@ -110,6 +130,9 @@          (iterate (flip advancePtr 1) dstPtr)  +{- |+prop> \x  ->  Array.singleton x ! () == (x::Word16)+-} singleton :: (Storable a) => a -> Array () a singleton a = unsafeCreate () $ flip poke a @@ -125,6 +148,9 @@       copyArray zPtr xPtr sizeX       copyArray (advancePtr zPtr sizeX) yPtr sizeY +{- |+prop> \(QC.NonNegative n) (Array16 x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x))+-} take, drop ::    (Integral n, Storable a) =>    n -> Array (Shape.ZeroBased n) a -> Array (Shape.ZeroBased n) a@@ -137,31 +163,48 @@    Array (Shape.ZeroBased n :+: Shape.ZeroBased n) a splitN n = mapShape (Shape.zeroBasedSplit n) +{- |+prop> \(Array16 x) (Array16 y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy+-} takeLeft ::    (Shape.C sh0, Shape.C sh1, Storable a) =>    Array (sh0:+:sh1) a -> Array sh0 a-takeLeft (Array (sh0 :+: _sh1) x) =-   unsafeCreateWithSize sh0 $ \k yPtr ->-   withForeignPtr x $ \xPtr -> copyArray yPtr xPtr k+takeLeft =+   takeCenter . mapShape (\(sh0 :+: sh1) -> (Shape.Zero :+: sh0 :+: sh1))  takeRight ::    (Shape.C sh0, Shape.C sh1, Storable a) =>    Array (sh0:+:sh1) a -> Array sh1 a-takeRight (Array (sh0:+:sh1) x) =-   unsafeCreateWithSize sh1 $ \k yPtr ->-   withForeignPtr x $ \xPtr ->-      copyArray yPtr (advancePtr xPtr (Shape.size sh0)) k+takeRight =+   takeCenter . mapShape (\(sh0 :+: sh1) -> (sh0 :+: sh1 :+: Shape.Zero))  split ::    (Shape.C sh0, Shape.C sh1, Storable a) =>    Array (sh0:+:sh1) a -> (Array sh0 a, Array sh1 a) split x = (takeLeft x, takeRight x) +{- |+prop> \(Array16 x) (Array16 y) (Array16 z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz+-}+takeCenter ::+   (Shape.C sh0, Shape.C sh1, Shape.C sh2, Storable a) =>+   Array (sh0:+:sh1:+:sh2) a -> Array sh1 a+takeCenter (Array (sh0:+:sh1:+:_sh2) x) =+   unsafeCreateWithSize sh1 $ \k yPtr ->+   withForeignPtr x $ \xPtr ->+      copyArray yPtr (advancePtr xPtr (Shape.size sh0)) k  ++{- |+prop> \(Array16 xs)  ->  Array.sum xs == sum (Array.toList xs)+-} sum :: (Shape.C sh, Storable a, Num a) => Array sh a -> a sum = foldl (+) 0 +{- |+prop> \(Array16 xs)  ->  Array.product xs == product (Array.toList xs)+-} product :: (Shape.C sh, Storable a, Num a) => Array sh a -> a product = foldl (*) 1 
+ test-module.list view
@@ -0,0 +1,3 @@+Data.Array.Comfort.Shape+Data.Array.Comfort.Storable+Data.Array.Comfort.Storable.Unchecked
+ test/DocTest/Data/Array/Comfort/Shape.hs view
@@ -0,0 +1,129 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Shape.hs+{-# LINE 65 "src/Data/Array/Comfort/Shape.hs" #-}++module DocTest.Data.Array.Comfort.Shape where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 66 "src/Data/Array/Comfort/Shape.hs" #-}+import     qualified Data.Array.Comfort.Shape as Shape+import     qualified Data.Map as Map+import     qualified Data.Set as Set+import     Data.Array.Comfort.Shape ((:+:)((:+:)))++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Shape:128: "+{-# LINE 128 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 128 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices ())+  [ExpectedLine [LineChunk "[()]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:150: "+{-# LINE 150 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 150 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.ZeroBased (7::Int)))+  [ExpectedLine [LineChunk "[0,1,2,3,4,5,6]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:201: "+{-# LINE 201 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 201 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.OneBased (7::Int)))+  [ExpectedLine [LineChunk "[1,2,3,4,5,6,7]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:249: "+{-# LINE 249 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 249 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.Range (-5) (5::Int)))+  [ExpectedLine [LineChunk "[-5,-4,-3,-2,-1,0,1,2,3,4,5]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:251: "+{-# LINE 251 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 251 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.Range (-1,-1) (1::Int,1::Int)))+  [ExpectedLine [LineChunk "[(-1,-1),(-1,0),(-1,1),(0,-1),(0,0),(0,1),(1,-1),(1,0),(1,1)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:301: "+{-# LINE 301 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 301 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.Shifted (-4) (8::Int)))+  [ExpectedLine [LineChunk "[-4,-3,-2,-1,0,1,2,3]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:373: "+{-# LINE 373 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 373 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering))+  [ExpectedLine [LineChunk "[LT,EQ,GT]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:428: "+{-# LINE 428 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 428 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Set.fromList "comfort"))+  [ExpectedLine [LineChunk "\"cfmort\""]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:454: "+{-# LINE 454 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 454 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices $ fmap Shape.ZeroBased $ Map.fromList [('b', (0::Int)), ('a', 5), ('c', 2)])+  [ExpectedLine [LineChunk "[('a',0),('a',1),('a',2),('a',3),('a',4),('c',0),('c',1)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:528: "+{-# LINE 528 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 528 "src/Data/Array/Comfort/Shape.hs" #-}+   (+  let sh2 = (Shape.ZeroBased (2::Int), Shape.ZeroBased (2::Int)) in+  let sh3 = (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)) in+  (Shape.offset sh3 $ Shape.indexFromOffset sh2 3,+  Shape.offset (Shape.Deferred sh3) $+  Shape.indexFromOffset (Shape.Deferred sh2) 3)+  )+  [ExpectedLine [LineChunk "(4,3)"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:630: "+{-# LINE 630 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 630 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)))+  [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:744: "+{-# LINE 744 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 744 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices $ Shape.Square $ Shape.ZeroBased (3::Int))+  [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:793: "+{-# LINE 793 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 793 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices $ Shape.Cube $ Shape.ZeroBased (2::Int))+  [ExpectedLine [LineChunk "[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:862: "+{-# LINE 862 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 862 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int))+  [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,1),(1,2),(2,2)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:864: "+{-# LINE 864 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 864 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int))+  [ExpectedLine [LineChunk "[(0,0),(1,0),(1,1),(2,0),(2,1),(2,2)]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:994: "+{-# LINE 994 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.property+{-# LINE 994 "src/Data/Array/Comfort/Shape.hs" #-}+     (let shape = Shape.Cyclic (10::Int) in Shape.offset shape (-1) == Shape.offset shape 9)+ DocTest.printPrefix "Data.Array.Comfort.Shape:999: "+{-# LINE 999 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 999 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.Cyclic (7::Int)))+  [ExpectedLine [LineChunk "[0,1,2,3,4,5,6]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:1047: "+{-# LINE 1047 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1047 "src/Data/Array/Comfort/Shape.hs" #-}+   (Shape.indices (Shape.ZeroBased (3::Int) :+: Shape.Range 'a' 'c'))+  [ExpectedLine [LineChunk "[Left 0,Left 1,Left 2,Right 'a',Right 'b',Right 'c']"]]
+ test/DocTest/Data/Array/Comfort/Storable.hs view
@@ -0,0 +1,54 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable.hs+{-# LINE 73 "src/Data/Array/Comfort/Storable.hs" #-}++module DocTest.Data.Array.Comfort.Storable where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 74 "src/Data/Array/Comfort/Storable.hs" #-}+import     qualified Data.Array.Comfort.Storable as Array+import     qualified Data.Array.Comfort.Shape as Shape+import     Data.Array.Comfort.Storable (Array)++import     qualified Test.QuickCheck as QC+import     Test.ChasingBottoms.IsBottom (isBottom)++import     Control.Applicative ((<$>))++import     Data.Word (Word16)++type     ShapeInt = Shape.ZeroBased Int++genArray     :: QC.Gen (Array ShapeInt Word16)+genArray     = Array.vectorFromList <$> QC.arbitrary++infix     4 ==?+(==?)     :: a -> a -> (a,a)+(==?)     = (,)++forAllNonEmpty     :: (Eq b) => (Array ShapeInt Word16 -> (b,b)) -> QC.Property+forAllNonEmpty     f =+       QC.forAll genArray $ \xs ->+       case f xs of+          (resultArray,resultList) ->+             if Array.shape xs == Shape.ZeroBased 0+                then isBottom resultArray+                else resultArray == resultList++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Storable:194: "+{-# LINE 194 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property+{-# LINE 194 "src/Data/Array/Comfort/Storable.hs" #-}+     (forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs))+ DocTest.printPrefix "Data.Array.Comfort.Storable:202: "+{-# LINE 202 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property+{-# LINE 202 "src/Data/Array/Comfort/Storable.hs" #-}+     (forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs))+ DocTest.printPrefix "Data.Array.Comfort.Storable:214: "+{-# LINE 214 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property+{-# LINE 214 "src/Data/Array/Comfort/Storable.hs" #-}+     (forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs))
+ test/DocTest/Data/Array/Comfort/Storable/Unchecked.hs view
@@ -0,0 +1,56 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable/Unchecked.hs+{-# LINE 57 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}++module DocTest.Data.Array.Comfort.Storable.Unchecked where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 58 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+import     DocTest.Data.Array.Comfort.Storable (ShapeInt, genArray)++import     qualified Data.Array.Comfort.Storable as Array+import     qualified Data.Array.Comfort.Shape as Shape+import     Data.Array.Comfort.Storable (Array, (!))++import     qualified Test.QuickCheck as QC++import     Data.Word (Word16)++newtype     Array16 = Array16 (Array ShapeInt Word16)+       deriving (Show)++instance     QC.Arbitrary Array16 where+       arbitrary = fmap Array16 genArray++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:134: "+{-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\x  ->  Array.singleton x ! () == (x::Word16))+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:152: "+{-# LINE 152 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 152 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\(QC.NonNegative n) (Array16 x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x)))+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:167: "+{-# LINE 167 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 167 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\(Array16 x) (Array16 y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy)+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:187: "+{-# LINE 187 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 187 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\(Array16 x) (Array16 y) (Array16 z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz)+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:200: "+{-# LINE 200 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 200 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\(Array16 xs)  ->  Array.sum xs == sum (Array.toList xs))+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:206: "+{-# LINE 206 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.property+{-# LINE 206 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+     (\(Array16 xs)  ->  Array.product xs == product (Array.toList xs))
+ test/DocTest/Main.hs view
@@ -0,0 +1,14 @@+-- Do not edit! Automatically created with doctest-extract.+module DocTest.Main where++import qualified DocTest.Data.Array.Comfort.Shape+import qualified DocTest.Data.Array.Comfort.Storable+import qualified DocTest.Data.Array.Comfort.Storable.Unchecked++import qualified Test.DocTest.Driver as DocTest++main :: DocTest.T ()+main = do+    DocTest.Data.Array.Comfort.Shape.test+    DocTest.Data.Array.Comfort.Storable.test+    DocTest.Data.Array.Comfort.Storable.Unchecked.test
test/Main.hs view
@@ -1,16 +1,16 @@ {-# LANGUAGE TypeFamilies #-} module Main where +import qualified DocTest.Main as DocTestMain import qualified Test.Shape as TestShape-import qualified Test.Storable as TestStorable import Test.Utility (prefix) -import qualified Test.QuickCheck as QC+import qualified Test.DocTest.Driver as DocTest   main :: IO ()-main =-   mapM_ (\(name,prop) -> putStr (name ++ ": ") >> QC.quickCheck prop) $+main = DocTest.run $ (>> DocTestMain.main) $+   mapM_ (\(name,prop) ->+            DocTest.printPrefix (name ++ ": ") >> DocTest.property prop) $    prefix "Shape" TestShape.tests ++-   prefix "Storable" TestStorable.tests ++    []
test/Test/Shape.hs view
@@ -9,6 +9,7 @@  import Control.Applicative (liftA2, liftA3) +import qualified Data.Map as Map import qualified Data.Set as Set import Data.Tagged (Tagged(Tagged)) @@ -43,6 +44,10 @@    prefix "Set"       (ShapeTest.tests $        fmap Set.fromList (QC.listOf (QC.choose ('a','z')))) +++   prefix "Map"+      (ShapeTest.tests $+       fmap Map.fromList+         (QC.listOf (liftA2 (,) (QC.choose ('a','z')) (genZeroBased 10)))) ++    prefix "Deferred Shifted"       (ShapeTest.tests $ fmap Shape.Deferred $        liftA2 Shape.Shifted@@ -58,10 +63,16 @@        liftA3 (,,) (genZeroBased 10) (genZeroBased 10) (genZeroBased 10)) ++    prefix "Append"       (ShapeTest.tests $ liftA2 (:+:) (genZeroBased 10) (genZeroBased 10)) +++   prefix "Square"+      (ShapeTest.tests $ fmap Shape.Square $ genZeroBased 10) +++   prefix "Cube"+      (ShapeTest.tests $ fmap Shape.Cube $ genZeroBased 10) ++    prefix "Triangular Lower"       (ShapeTest.tests $        fmap (Shape.Triangular Shape.Lower) (genZeroBased 10)) ++    prefix "Triangular Upper"       (ShapeTest.tests $        fmap (Shape.Triangular Shape.Upper) (genZeroBased 10)) +++   prefix "Cyclic"+      (ShapeTest.tests $ fmap Shape.Cyclic $ QC.choose (0,10::Int)) ++    []
− test/Test/Storable.hs
@@ -1,93 +0,0 @@-module Test.Storable where--import qualified Data.Array.Comfort.Storable as Array-import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Storable (Array, (!))--import Foreign.Storable (Storable)--import qualified Test.QuickCheck as QC-import Test.ChasingBottoms.IsBottom (isBottom)--import Control.Applicative ((<$>))--import Data.Word (Word16)---type ShapeInt = Shape.ZeroBased Int--genArray :: QC.Gen (Array ShapeInt Word16)-genArray = Array.vectorFromList <$> QC.arbitrary---singleton :: (Storable a, Eq a) => a -> Bool-singleton x  =  x == Array.singleton x ! ()--appendTakeDrop ::-   (Storable a, Eq a) =>-   QC.NonNegative Int -> Array ShapeInt a -> Bool-appendTakeDrop (QC.NonNegative n) x =-   x ==-   Array.mapShape (Shape.ZeroBased . Shape.size)-      (Array.append (Array.take n x) (Array.drop n x))--takeLeftRightAppend ::-   (Storable a, Eq a) =>-   Array ShapeInt a -> Array ShapeInt a -> Bool-takeLeftRightAppend x y =-   let xy = Array.append x y-   in x == Array.takeLeft xy  &&  y == Array.takeRight xy---sumList :: (Storable a, Num a, Eq a) => Array ShapeInt a -> Bool-sumList xs  =  Array.sum xs == sum (Array.toList xs)--productList :: (Storable a, Num a, Eq a) => Array ShapeInt a -> Bool-productList xs  =  Array.product xs == product (Array.toList xs)---withNonEmpty ::-   (Array ShapeInt a -> b) ->-   (b -> Array ShapeInt a -> Bool) ->-   Array ShapeInt a -> Bool-withNonEmpty f law xs =-   let x = f xs-   in if Array.shape xs == Shape.ZeroBased 0-         then isBottom x-         else law x xs--minimumList :: (Storable a, Ord a) => Array ShapeInt a -> Bool-minimumList =-   withNonEmpty Array.minimum $ \x xs -> x == minimum (Array.toList xs)--maximumList :: (Storable a, Ord a) => Array ShapeInt a -> Bool-maximumList =-   withNonEmpty Array.maximum $ \x xs -> x == maximum (Array.toList xs)--limitsMinimumMaximum :: (Storable a, Ord a) => Array ShapeInt a -> Bool-limitsMinimumMaximum =-   withNonEmpty Array.limits $-      \xe xs -> xe == (Array.minimum xs, Array.maximum xs)---tests :: [(String, QC.Property)]-tests =-   ("singleton", QC.property (singleton . (id :: Word16 -> Word16))) :-   ("appendTakeDrop",-      QC.forAll QC.arbitrary $ \n ->-      QC.forAll genArray $ \xs -> appendTakeDrop n xs) :-   ("takeLeftRightAppend",-      QC.forAll genArray $ \xs ->-      QC.forAll genArray $ \ys -> takeLeftRightAppend xs ys) :--   ("sum",-      QC.forAll genArray sumList) :-   ("product",-      QC.forAll genArray productList) :-   ("minimum",-      QC.forAll genArray minimumList) :-   ("maximum",-      QC.forAll genArray maximumList) :-   ("limitsMinimumMaximum",-      QC.forAll genArray limitsMinimumMaximum) :-   []