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 +10/−0
- comfort-array.cabal +21/−6
- src/Data/Array/Comfort/Shape.hs +300/−14
- src/Data/Array/Comfort/Storable.hs +49/−3
- src/Data/Array/Comfort/Storable/Unchecked.hs +50/−7
- test-module.list +3/−0
- test/DocTest/Data/Array/Comfort/Shape.hs +129/−0
- test/DocTest/Data/Array/Comfort/Storable.hs +54/−0
- test/DocTest/Data/Array/Comfort/Storable/Unchecked.hs +56/−0
- test/DocTest/Main.hs +14/−0
- test/Main.hs +5/−5
- test/Test/Shape.hs +11/−0
- test/Test/Storable.hs +0/−93
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) :- []