packages feed

comfort-array 0.5.3 → 0.5.4

raw patch · 13 files changed

+899/−272 lines, 13 filesdep ~transformers-compatdep ~utility-htPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: transformers-compat, utility-ht

API changes (from Hackage documentation)

+ Data.Array.Comfort.Boxed: cartesian :: (C sh0, C sh1) => Array sh0 a -> Array sh1 b -> Array (sh0, sh1) (a, b)
+ Data.Array.Comfort.Shape: cartesianFromCube :: Cube sh -> (sh, sh, sh)
+ Data.Array.Comfort.Shape: cartesianFromSquare :: Square sh -> (sh, sh)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.C Data.IntSet.Internal.IntSet
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.C shape => Data.Array.Comfort.Shape.C (Data.IntMap.Internal.IntMap shape)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed Data.IntSet.Internal.IntSet
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed shape => Data.Array.Comfort.Shape.Indexed (Data.IntMap.Internal.IntMap shape)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed Data.IntSet.Internal.IntSet
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed shape => Data.Array.Comfort.Shape.InvIndexed (Data.IntMap.Internal.IntMap shape)
+ Data.Array.Comfort.Storable: fromBlockArray1 :: (Ord k, C shape, Storable a) => Array (Set k) (Array shape a) -> Array (Map k shape) a
+ Data.Array.Comfort.Storable: fromBlockArray2 :: (Ord row, C height, Eq height) => (Ord column, C width, Eq width) => Storable a => Map row height -> Map column width -> Array (Set row, Set column) (Array (height, width) a) -> Array (Map row height, Map column width) a
+ Data.Array.Comfort.Storable: fromIntMap :: Storable a => IntMap a -> Array IntSet a
+ Data.Array.Comfort.Storable: fromNonEmptyBlockArray2 :: (Ord row, C height, Eq height) => (Ord column, C width, Eq width) => Storable a => Array (Set row, Set column) (Array (height, width) a) -> Array (Map row height, Map column width) a
+ Data.Array.Comfort.Storable: replicate :: (Indexed sh, Storable a) => sh -> a -> Array sh a
+ Data.Array.Comfort.Storable: toIntMap :: Storable a => Array IntSet a -> IntMap a

Files

comfort-array.cabal view
@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.5.3+Version:          0.5.4 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -97,7 +97,7 @@   test-module.list  Source-Repository this-  Tag:         0.5.3+  Tag:         0.5.4   Type:        darcs   Location:    https://hub.darcs.net/thielema/comfort-array/ @@ -122,7 +122,7 @@     semigroups >=0.18.3 && <1.0,     containers >=0.4 && <0.8,     -- transformers-compat required for Functor.Classes in GHC-7.8.4-    transformers-compat >=0.7.2 && <0.8,+    transformers-compat >=0.6.6 && <0.8,     transformers >=0.3 && <0.7,     non-empty >=0.3.2 && <0.4,     utility-ht >=0.0.10 && <0.1,@@ -169,6 +169,7 @@     tagged,     containers,     QuickCheck,+    utility-ht >=0.0.13,     deepseq,     base @@ -181,6 +182,7 @@     DocTest.Data.Array.Comfort.Storable.Unchecked     DocTest.Data.Array.Comfort.Storable     DocTest.Data.Array.Comfort.Boxed.Unchecked+    DocTest.Data.Array.Comfort.Boxed     DocTest.Main     Test.Shape     Test.Utility
src/Data/Array/Comfort/Boxed.hs view
@@ -18,6 +18,7 @@    toContainer,    indices,    Array.replicate,+   cartesian,     Array.map,    zipWith,@@ -44,7 +45,7 @@ import qualified Control.Monad.Primitive as PrimM import qualified Control.Monad.Trans.State as MS import Control.Monad.ST (runST)-import Control.Applicative ((<$>))+import Control.Applicative (liftA2, (<$>))  import qualified Data.Foldable as Fold import qualified Data.Map as Map@@ -58,6 +59,28 @@ import Prelude hiding (zipWith, replicate)  +{- $setup+>>> import qualified Data.Array.Comfort.Boxed as Array+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import Data.Array.Comfort.Boxed (Array, (!))+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> type ShapeInt = Shape.ZeroBased Int+>>>+>>> genArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Char)+>>> genArray2 = do+>>>    xs <- QC.arbitrary+>>>    let n = length xs+>>>    (k,m) <-+>>>       if n == 0+>>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)+>>>          else fmap (\m -> (div n m, m)) $ QC.choose (1,n)+>>>    return $+>>>       Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) $ take (k*m) xs+-}++ shape :: Array.Array sh a -> sh shape = Array.shape @@ -174,6 +197,14 @@   +{- |+prop> :{+   QC.forAll genArray2 $ \xs ->+   let shape = Array.shape xs in+   Shape.size shape > 0   QC.==>+   QC.forAll (QC.elements $ Shape.indices shape) $ \(ix0,ix1) ->+      Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)+-} pick ::    (Shape.Indexed sh0, Shape.C sh1) =>    Array (sh0,sh1) a -> Shape.Index sh0 -> Array sh1 a@@ -181,3 +212,11 @@    Array sh1 $    let k = Shape.size sh1    in Prim.cloneArray x (Shape.offset sh0 ix0 * k) k+++cartesian ::+   (Shape.C sh0, Shape.C sh1) =>+   Array sh0 a -> Array sh1 b -> Array (sh0,sh1) (a,b)+cartesian a b =+   Array.fromList (shape a, shape b) $+      liftA2 (,) (Array.toList a) (Array.toList b)
src/Data/Array/Comfort/Boxed/Unchecked.hs view
@@ -38,7 +38,8 @@ {- $setup >>> import qualified Data.Array.Comfort.Boxed as Array >>> import qualified Data.Array.Comfort.Shape as Shape->>> import Data.Array.Comfort.Boxed (Array)+>>> import Data.Array.Comfort.Boxed (Array, (!))+>>> import Data.Tuple.HT (swap) >>> import Control.Applicative ((<$>)) >>> >>> import qualified Test.QuickCheck as QC@@ -53,6 +54,13 @@ >>> >>> instance QC.Arbitrary ArrayChar where >>>    arbitrary = fmap ArrayChar genArray+>>>+>>>+>>> transpose ::+>>>    (Shape.Indexed sh0, Shape.Indexed sh1) =>+>>>    Array (sh0,sh1) a -> Array (sh1,sh0) a+>>> transpose a =+>>>    fmap (\(i,j) -> a!(j,i)) $ Array.indices $ swap $ Array.shape a -}  
src/Data/Array/Comfort/Shape.hs view
@@ -32,8 +32,8 @@     (::+)(..), -   Square(..),-   Cube(..),+   Square(..), cartesianFromSquare,+   Cube(..), cartesianFromCube,     Triangular(..), Lower(Lower), Upper(Upper),    LowerTriangular, UpperTriangular,@@ -100,6 +100,8 @@ import qualified Data.Functor.Classes as FunctorC import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.NonEmpty as NonEmpty@@ -113,6 +115,8 @@ import Data.Function.HT (compose2) import Data.Tagged (Tagged(Tagged, unTagged)) import Data.Complex (Complex((:+)), realPart, imagPart)+import Data.IntMap (IntMap)+import Data.IntSet (IntSet) import Data.Map (Map) import Data.Set (Set) import Data.List.HT (tails)@@ -124,6 +128,8 @@  {- $setup >>> import qualified Data.Array.Comfort.Shape as Shape+>>> import qualified Data.IntMap as IntMap+>>> import qualified Data.IntSet as IntSet >>> import qualified Data.Map as Map >>> import qualified Data.Set as Set >>> import Data.Array.Comfort.Shape ((::+)((::+)))@@ -223,6 +229,12 @@          (Unchecked, UncheckedResult x) -> b x  +{- |+Shape types, that is, instances of 'C', that are also instance of 'Eq',+must have proper 'Eq' instances,+otherwise evil memory corruption will occur.+At least, it must hold @sh0 == sh1  ==>  Shape.size sh0 == Shape.size sh1@.+-} class C sh where    {-    This is the counterpart to 'Ix.rangeSize'.@@ -536,9 +548,15 @@          (iterate (subtract 1) len)          (iterate (1+) offs)    unifiedOffset (Shifted offs len) ix = do-      assert (printf "Shape.Shifted: array index too small (%d vs %d)" (toInteger offs) (toInteger ix)) $ ix>=offs+      assert+         (printf "Shape.Shifted %d: array index too small (%d vs %d)"+            (toInteger offs) (toInteger offs) (toInteger ix))+         (ix>=offs)       let k = ix-offs-      assert (printf "Shape.Shifted: array index too big (%d vs %d)" (toInteger k) (toInteger len)) $ k<len+      assert+         (printf "Shape.Shifted %d: array index too big (%d vs %d)"+            (toInteger offs) (toInteger k) (toInteger len))+         (k<len)       return $ fromIntegral k    inBounds (Shifted offs len) ix = offs <= ix && ix < offs+len @@ -667,7 +685,35 @@                Nothing -> throw $ messageIndexFromOffset "Set" k  ++instance C IntSet where+   size = IntSet.size+ {- |+>>> Shape.indices (IntSet.fromList [3,1,4,1,5,9,2,6,5,3])+[1,2,3,4,5,6,9]+-}+instance Indexed IntSet where+   type Index IntSet = Int+   indices = IntSet.toAscList+   unifiedOffset set ix =+      case IntSet.splitMember ix set of+         (less, hit, _) -> do+            assert "Shape.IntSet: array index not member of the index set" hit+            pure $ IntSet.size less+   inBounds = flip IntSet.member++instance InvIndexed IntSet where+   unifiedIndexFromOffset sh =+      let m = IntMap.fromList $ zip [0..] $ indices sh+      in \k ->+         case IntMap.lookup k m of+            Nothing -> throwOrError "Shape.IntSet.offset: unknown key"+            Just ix -> pure ix++++{- | Concatenate many arrays according to the shapes stored in a 'Map'. -} instance (Ord k, C shape) => C (Map k shape) where@@ -726,6 +772,65 @@   {- |+Concatenate many arrays according to the shapes stored in a 'IntMap'.+-}+instance (C shape) => C (IntMap shape) where+   size = Fold.sum . IntMap.map size++{- |+The implementations of 'offset' et.al.+are optimized for frequent calls with respect to the same shape.++>>> Shape.indices $ IntMap.fromList [(2, Set.fromList "abc"), (0, Set.fromList "a"), (1, Set.fromList "d")]+[(0,'a'),(1,'d'),(2,'a'),(2,'b'),(2,'c')]+-}+instance (Indexed shape) => Indexed (IntMap shape) where+   type Index (IntMap shape) = (Int, Index shape)+   indices =+      Fold.fold . IntMap.mapWithKey (\k shape -> map ((,) k) $ indices shape)+   unifiedOffset m =+      let ms = fmap unifiedSizeOffset m+          mu = snd $+            Trav.mapAccumL (\l (sz,getOffset) -> (l + sz, (l,getOffset))) 0 ms+      in \(k,ix) ->+         case IntMap.lookup k mu of+            Nothing -> throwOrError "Shape.IntMap.offset: unknown key"+            Just (l,getOffset) -> (l+) <$> getOffset ix+   inBounds m (k,ix) = Fold.any (flip inBounds ix) $ IntMap.lookup k m++   unifiedSizeOffset = intMapSizeOffset . fmap unifiedSizeOffset++{-# INLINE intMapSizeOffset #-}+intMapSizeOffset ::+   (Checking check, Num i) =>+   IntMap (i, ix -> Result check i) -> (i, (Int, ix) -> Result check i)+intMapSizeOffset ms =+   (Fold.sum $ IntMap.map fst ms,+    let mu = snd $+         Trav.mapAccumL (\l (sz,offs) -> (l + sz, fmap (l+) . offs)) 0 ms+    in \(k,ix) ->+         maybe+            (throwOrError "Shape.IntMap.sizeOffset: unknown key")+            ($ix)+            (IntMap.lookup k mu))++-- ToDo: can be sped up using IntMap.lookupLT for containers>=0.5+instance (InvIndexed shape) => InvIndexed (IntMap shape) where+   unifiedIndexFromOffset m i =+      (\xs ->+         case xs of+            (_u,ix):_ -> ix+            [] -> throwOrError $ messageIndexFromOffset "IntMap" i) $+      dropWhile (\(u,_ix) -> u<=i) $ snd $+      List.mapAccumL+         (\l (k,sh) ->+            let u = l + size sh+            in (u, (u, (,) k <$> unifiedIndexFromOffset sh (i-l)))) 0 $+      IntMap.toAscList m++++{- | This data type wraps another array shape. Its index type is a wrapped 'Int'. The advantages are:@@ -743,11 +848,11 @@ Example:  >>> :{-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)+   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) -}@@ -974,6 +1079,9 @@ newtype Square sh = Square {squareSize :: sh}    deriving (Eq, Show) +cartesianFromSquare :: Square sh -> (sh,sh)+cartesianFromSquare (Square sh) = (sh,sh)+ instance Functor Square where    fmap f (Square sh) = Square $ f sh @@ -1027,6 +1135,9 @@ -} newtype Cube sh = Cube {cubeSize :: sh}    deriving (Eq, Show)++cartesianFromCube :: Cube sh -> (sh,sh,sh)+cartesianFromCube (Cube sh) = (sh,sh,sh)  instance Functor Cube where    fmap f (Cube sh) = Cube $ f sh
src/Data/Array/Comfort/Storable.hs view
@@ -10,15 +10,20 @@    toAssociations,    fromList,    fromMap, toMap,+   fromIntMap, toIntMap,    fromTuple, toTuple,    fromRecord, toRecord,    fromContainer,    toContainer,    sample,+   replicate,    fromBoxed,    toBoxed,    fromStorableVector,    toStorableVector,+   fromBlockArray1,+   fromBlockArray2,+   fromNonEmptyBlockArray2,     Array.map,    Array.mapWithIndex,@@ -66,25 +71,34 @@ import qualified Control.Monad.Trans.State as MS import Control.Monad.ST (runST) +import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB+import qualified Data.IntMap as IntMap import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold+import qualified Data.List.HT as ListHT import qualified Data.List as List import qualified Data.Tuple.Strict as StrictTuple+import Data.IntMap (IntMap)+import Data.IntSet (IntSet) import Data.Map (Map) import Data.Set (Set) import Data.Foldable (forM_) import Data.Either.HT (maybeRight)+import Data.Tuple.HT (mapPair) import Data.Semigroup          (Semigroup, (<>), Min(Min,getMin), Max(Max,getMax), Arg(Arg)) -import Prelude2010 hiding (map, zipWith, foldl1, minimum, maximum)+import Prelude2010 hiding (map, zipWith, foldl1, minimum, maximum, replicate) import Prelude ()   {- $setup+>>> import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked+>>>                                              as TestBoxedArray+>>> import qualified Data.Array.Comfort.Boxed as BoxedArray >>> import qualified Data.Array.Comfort.Storable as Array >>> import qualified Data.Array.Comfort.Shape as Shape >>> import Data.Array.Comfort.Storable (Array, (!))@@ -92,13 +106,25 @@ >>> import qualified Test.QuickCheck as QC >>> import Test.ChasingBottoms.IsBottom (isBottom) >>>+>>> import Control.Monad (replicateM) >>> import Control.Applicative ((<$>), (<*>)) >>>+>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import Data.Map (Map)+>>> import Data.Function.HT (Id) >>> import Data.Complex (Complex((:+)))+>>> import Data.Tuple.HT (swap) >>> import Data.Word (Word16) >>>+>>> import Foreign.Storable (Storable)+>>> >>> type ShapeInt = Shape.ZeroBased Int+>>> type X = Shape.Element >>>+>>> shapeInt :: Int -> ShapeInt+>>> shapeInt = Shape.ZeroBased+>>> >>> genArray :: QC.Gen (Array ShapeInt Word16) >>> genArray = Array.vectorFromList <$> QC.arbitrary >>>@@ -108,10 +134,14 @@ >>>    let n = length xs >>>    (k,m) <- >>>       if n == 0->>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,n)+>>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20) >>>          else fmap (\m -> (div n m, m)) $ QC.choose (1,n) >>>    return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs >>>+>>> genArrayForShape :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)+>>> genArrayForShape sh =+>>>    Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary+>>> >>> genNonEmptyArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Word16) >>> genNonEmptyArray2 = do >>>    xs <- QC.getNonEmpty <$> QC.arbitrary@@ -133,7 +163,10 @@ >>>             else resultArray == resultList >>> >>>->>> type X = Shape.Element+>>> transpose ::+>>>    (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>+>>>    Array (sh0,sh1) a -> Array (sh1,sh0) a+>>> transpose a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i)) -}  @@ -149,7 +182,7 @@   {- |->>> Array.fromList (Shape.ZeroBased (5::Int)) ['a'..]+>>> Array.fromList (shapeInt 5) ['a'..] StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) "abcde" -} fromList :: (Shape.C sh, Storable a) => sh -> [a] -> Array sh a@@ -159,14 +192,22 @@ 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)+toMap = Map.fromAscList . toAssociations +fromIntMap :: (Storable a) => IntMap a -> Array IntSet a+fromIntMap m = fromList (IntMap.keysSet m) (IntMap.elems m)++toIntMap :: (Storable a) => Array IntSet a -> IntMap a+toIntMap = IntMap.fromAscList . toAssociations+ {- |->>> Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char+>>> Array.fromTuple ('a',('b','c')) :: Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) "abc" ->>> :{ let arr = Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char-in (arr ! fst, arr ! (fst.snd))+>>> :{+   let arr :: Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char+       arr = Array.fromTuple ('a',('b','c'))+   in (arr ! fst, arr ! (fst.snd)) :} ('a','b') -}@@ -186,9 +227,10 @@       (Array.toList arr)  {- |->>> :{ let arr = Array.fromRecord ('a' :+ 'b') in-let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in-(arr ! real, arr ! imag)+>>> :{+   let arr = Array.fromRecord ('a' :+ 'b') in+   let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in+   (arr ! real, arr ! imag) :} ('a','b') -}@@ -222,7 +264,12 @@    (Shape.Indexed sh, Storable a) => sh -> (Shape.Index sh -> a) -> Array sh a sample sh f = Array.fromList sh $ List.map f $ Shape.indices sh +replicate ::+   (Shape.Indexed sh, Storable a) =>+   sh -> a -> Array sh a+replicate sh a = runST (MutArrayNC.unsafeFreeze =<< MutArray.new sh a) + fromBoxed :: (Shape.C sh, Storable a) => BoxedArray.Array sh a -> Array sh a fromBoxed arr = Array.fromList (BoxedArray.shape arr) $ BoxedArray.toList arr @@ -242,6 +289,165 @@ toStorableVector :: (Shape.C sh, Storable a) => Array sh a -> SVB.Vector a toStorableVector (Array sh fptr) =    SVB.fromForeignPtr fptr $ Shape.size sh+++{- |+>>> :{+   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16+:}+StorableArray.fromList (fromList []) []++>>> :{+   let block n a = Array.replicate (shapeInt n) (a::Word16) in+   Array.fromBlockArray1 $+   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]+:}+StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3}),('C',ZeroBased {... 5})]) [0,0,1,1,1,2,2,2,2,2]+-}+fromBlockArray1 ::+   (Ord k, Shape.C shape, Storable a) =>+   BoxedArray.Array (Set k) (Array shape a) -> Array (Map k shape) a+fromBlockArray1 a =+   reshape (BoxedArray.toMap $ fmap Array.shape a) $+   fromStorableVector $ SV.concat $+   List.map toStorableVector $ BoxedArray.toList a++{- |+Only the outer @BoxedArray@ need to be non-empty.++>>> :{+   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in+   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in+   let block sh a = Array.replicate sh (a::Word16) in+   Array.fromBlockArray2+      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)+      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $+   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,+       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]+:}+StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList [('1',ZeroBased {... 3}),('2',ZeroBased {... 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]++prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   transpose (Array.fromNonEmptyBlockArray2 blocked)+   QC.===+   Array.fromNonEmptyBlockArray2+      (TestBoxedArray.transpose (fmap transpose blocked))+:}++prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   QC.forAll genArray2 $ \blockC3 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR2 = fst $ Array.shape blockC3 in+   let shapeC2 = snd $ Array.shape blockC3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")+            [blockA1, blockA2, blockA3,+             blockB1, blockB2, blockB3,+             blockC1, blockC2, blockC3] in++   transpose (Array.fromNonEmptyBlockArray2 blocked)+   QC.===+   Array.fromNonEmptyBlockArray2+      (TestBoxedArray.transpose (fmap transpose blocked))+:}+-}+fromNonEmptyBlockArray2 ::+   (Ord row,    Shape.C height, Eq height) =>+   (Ord column, Shape.C width,  Eq width) =>+   (Storable a) =>+   BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->+   Array (Map row height, Map column width) a+fromNonEmptyBlockArray2 arr =+   let shapes = List.map Array.shape $ BoxedArray.toList arr in+   let width = Set.size $ snd $ BoxedArray.shape arr in+   let (rowIxs, columnIxs) =+         mapPair (Set.toAscList, Set.toAscList) $ BoxedArray.shape arr in+   case (ListHT.sieve width shapes, take width shapes) of+      (leftColumn@(_:_), topRow@(_:_)) ->+         fromBlockArray2+            (Map.fromList $ List.zip rowIxs $ List.map fst leftColumn)+            (Map.fromList $ List.zip columnIxs $ List.map snd topRow)+            arr+      _ -> errorArray "fromNonEmptyBlockArray2" "empty array"++{- |+Explicit parameters for the shape of the result matrix+allow for working with arrays of zero rows or columns.++>>> :{+   (id :: Id (array (height, Map Char ShapeInt) Word16)) $+   Array.fromBlockArray2+      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))+      Map.empty $+   BoxedArray.fromList (Set.fromList "AB", Set.empty) []+:}+StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList []) []++prop> :{+   QC.forAll genArray2 $ \block ->+   let height = Map.singleton 'A' $ fst $ Array.shape block in+   let width  = Map.singleton '1' $ snd $ Array.shape block in++   Array.reshape (height,width) block+   QC.===+   Array.fromBlockArray2 height width+      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)+:}+-}+fromBlockArray2 ::+   (Ord row,    Shape.C height, Eq height) =>+   (Ord column, Shape.C width,  Eq width) =>+   (Storable a) =>+   Map row height -> Map column width ->+   BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->+   Array (Map row height, Map column width) a+fromBlockArray2 height width =+   Array.reshape (height, width) . fromStorableVector .+   SV.concat . List.concat . List.concatMap List.transpose .+   ListHT.sliceVertical (Map.size width) . BoxedArray.toList .+   BoxedArray.zipWith+      (\(h,w) block ->+         if (h,w) == Array.shape block+            then toRowSlices block+            else errorArray "fromBlockArray2" "block shapes mismatch")+      (BoxedArray.cartesian+         (BoxedArray.fromMap height) (BoxedArray.fromMap width))+{-+[[[111,111],[222,222]],[[333,333],[444,444]]]+  |+  v+[111,222,111,222,333,444,333,444]+-}++toRowSlices ::+   (Shape.C sh0, Shape.C sh1, Storable a) =>+   Array (sh0, sh1) a -> [SV.Vector a]+toRowSlices arr =+   SV.sliceVertical (Shape.size $ snd $ shape arr) $ toStorableVector arr   toAssociations ::
test-module.list view
@@ -1,4 +1,5 @@ Data.Array.Comfort.Shape Data.Array.Comfort.Storable Data.Array.Comfort.Storable.Unchecked+Data.Array.Comfort.Boxed Data.Array.Comfort.Boxed.Unchecked
+ test/DocTest/Data/Array/Comfort/Boxed.hs view
@@ -0,0 +1,40 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Boxed.hs+{-# LINE 62 "src/Data/Array/Comfort/Boxed.hs" #-}++module DocTest.Data.Array.Comfort.Boxed where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 63 "src/Data/Array/Comfort/Boxed.hs" #-}+import     qualified Data.Array.Comfort.Boxed as Array+import     qualified Data.Array.Comfort.Shape as Shape+import     Data.Array.Comfort.Boxed (Array, (!))++import     qualified Test.QuickCheck as QC++type     ShapeInt = Shape.ZeroBased Int++genArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Char)+genArray2     = do+       xs <- QC.arbitrary+       let n = length xs+       (k,m) <-+          if n == 0+             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)+             else fmap (\m -> (div n m, m)) $ QC.choose (1,n)+       return $+          Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) $ take (k*m) xs++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Boxed:201: "+{-# LINE 201 "src/Data/Array/Comfort/Boxed.hs" #-}+ DocTest.property(+{-# LINE 201 "src/Data/Array/Comfort/Boxed.hs" #-}+        +   QC.forAll genArray2 $ \xs ->+   let shape = Array.shape xs in+   Shape.size shape > 0   QC.==>+   QC.forAll (QC.elements $ Shape.indices shape) $ \(ix0,ix1) ->+      Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)+  )
test/DocTest/Data/Array/Comfort/Boxed/Unchecked.hs view
@@ -8,7 +8,8 @@ {-# LINE 39 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-} import     qualified Data.Array.Comfort.Boxed as Array import     qualified Data.Array.Comfort.Shape as Shape-import     Data.Array.Comfort.Boxed (Array)+import     Data.Array.Comfort.Boxed (Array, (!))+import     Data.Tuple.HT (swap) import     Control.Applicative ((<$>))  import     qualified Test.QuickCheck as QC@@ -24,20 +25,30 @@ instance     QC.Arbitrary ArrayChar where        arbitrary = fmap ArrayChar genArray ++transpose     ::+       (Shape.Indexed sh0, Shape.Indexed sh1) =>+       Array (sh0,sh1) a -> Array (sh1,sh0) a+transpose     a =+       fmap (\(i,j) -> a!(j,i)) $ Array.indices $ swap $ Array.shape a+ test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:165: "-{-# LINE 165 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}- DocTest.property-{-# LINE 165 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}-     (\(QC.NonNegative n) (ArrayChar x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x)))- DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:180: "-{-# LINE 180 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}- DocTest.property-{-# LINE 180 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}-     (\(ArrayChar x) (ArrayChar y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy)- DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:200: "-{-# LINE 200 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}- DocTest.property-{-# LINE 200 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}-     (\(ArrayChar x) (ArrayChar y) (ArrayChar z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz)+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:173: "+{-# LINE 173 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property(+{-# LINE 173 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+      \(QC.NonNegative n) (ArrayChar x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x))+  )+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:188: "+{-# LINE 188 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property(+{-# LINE 188 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+      \(ArrayChar x) (ArrayChar y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy+  )+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:208: "+{-# LINE 208 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property(+{-# LINE 208 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+      \(ArrayChar x) (ArrayChar y) (ArrayChar z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz+  )
test/DocTest/Data/Array/Comfort/Shape.hs view
@@ -1,13 +1,15 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Shape.hs-{-# LINE 125 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 129 "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 126 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 130 "src/Data/Array/Comfort/Shape.hs" #-} import     qualified Data.Array.Comfort.Shape as Shape+import     qualified Data.IntMap as IntMap+import     qualified Data.IntSet as IntSet import     qualified Data.Map as Map import     qualified Data.Set as Set import     Data.Array.Comfort.Shape ((::+)((::+)))@@ -17,200 +19,245 @@  test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Shape:332: "-{-# LINE 332 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 332 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices ())+ DocTest.printPrefix "Data.Array.Comfort.Shape:344: "+{-# LINE 344 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 344 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices ()+  )   [ExpectedLine [LineChunk "[()]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:355: "-{-# LINE 355 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 355 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.ZeroBased (7::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:367: "+{-# LINE 367 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 367 "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:413: "-{-# LINE 413 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 413 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.OneBased (7::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:425: "+{-# LINE 425 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 425 "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:463: "-{-# LINE 463 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 463 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.Range (-5) (5::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:475: "+{-# LINE 475 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 475 "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:465: "-{-# LINE 465 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 465 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.Range (-1,-1) (1::Int,1::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:477: "+{-# LINE 477 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 477 "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:515: "-{-# LINE 515 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 515 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.Shifted (-4) (8::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:527: "+{-# LINE 527 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 527 "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:580: "-{-# LINE 580 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 580 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering))+ DocTest.printPrefix "Data.Array.Comfort.Shape:598: "+{-# LINE 598 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 598 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering)+  )   [ExpectedLine [LineChunk "[LT,EQ,GT]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:644: "-{-# LINE 644 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 644 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Set.fromList "comfort"))+ DocTest.printPrefix "Data.Array.Comfort.Shape:662: "+{-# LINE 662 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 662 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices (Set.fromList "comfort")+  )   [ExpectedLine [LineChunk "\"cfmort\""]]- DocTest.printPrefix "Data.Array.Comfort.Shape:680: "-{-# LINE 680 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 680 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ fmap Shape.ZeroBased $ Map.fromList [('b', (0::Int)), ('a', 5), ('c', 2)])+ DocTest.printPrefix "Data.Array.Comfort.Shape:693: "+{-# LINE 693 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 693 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices (IntSet.fromList [3,1,4,1,5,9,2,6,5,3])+  )+  [ExpectedLine [LineChunk "[1,2,3,4,5,6,9]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:726: "+{-# LINE 726 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 726 "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:745: "-{-# LINE 745 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 745 "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)+ DocTest.printPrefix "Data.Array.Comfort.Shape:784: "+{-# LINE 784 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 784 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ IntMap.fromList [(2, Set.fromList "abc"), (0, Set.fromList "a"), (1, Set.fromList "d")]   )+  [ExpectedLine [LineChunk "[(0,'a'),(1,'d'),(2,'a'),(2,'b'),(2,'c')]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:850: "+{-# LINE 850 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 850 "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:849: "-{-# LINE 849 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 849 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:954: "+{-# LINE 954 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 954 "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:971: "-{-# LINE 971 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 971 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.Square $ Shape.ZeroBased (3::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1076: "+{-# LINE 1076 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1076 "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:1025: "-{-# LINE 1025 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1025 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.Cube $ Shape.ZeroBased (2::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1133: "+{-# LINE 1133 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1133 "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:1084: "-{-# LINE 1084 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1084 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1195: "+{-# LINE 1195 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1195 "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:1086: "-{-# LINE 1086 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1086 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1197: "+{-# LINE 1197 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1197 "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:1218: "-{-# LINE 1218 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1218 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexAscending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1329: "+{-# LINE 1329 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1329 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexAscending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[0,1,2],[0,1,3],[0,2,3],[1,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1220: "-{-# LINE 1220 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1220 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexAscending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1331: "+{-# LINE 1331 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1331 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexAscending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)+  )   [ExpectedLine [LineChunk "[[0,0,0],[0,0,1],[0,0,2],[0,1,1],[0,1,2],[0,2,2],[1,1,1],[1,1,2],[1,2,2],[2,2,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1222: "-{-# LINE 1222 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1222 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1333: "+{-# LINE 1333 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1333 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1224: "-{-# LINE 1224 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1224 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1335: "+{-# LINE 1335 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1335 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1227: "-{-# LINE 1227 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1227 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexDescending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1338: "+{-# LINE 1338 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1338 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexDescending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[2,1,0],[3,1,0],[3,2,0],[3,2,1]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1229: "-{-# LINE 1229 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1229 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexDescending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1340: "+{-# LINE 1340 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1340 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexDescending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)+  )   [ExpectedLine [LineChunk "[[0,0,0],[1,0,0],[1,1,0],[1,1,1],[2,0,0],[2,1,0],[2,1,1],[2,2,0],[2,2,1],[2,2,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1231: "-{-# LINE 1231 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1231 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1342: "+{-# LINE 1342 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1342 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1233: "-{-# LINE 1233 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1233 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1344: "+{-# LINE 1344 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1344 "src/Data/Array/Comfort/Shape.hs" #-}+    Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)+  )   [ExpectedLine [LineChunk "[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1467: "-{-# LINE 1467 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.property-{-# LINE 1467 "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:1472: "-{-# LINE 1472 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1472 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.Cyclic (7::Int)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1578: "+{-# LINE 1578 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.property(+{-# LINE 1578 "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:1583: "+{-# LINE 1583 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1583 "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:1516: "-{-# LINE 1516 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1516 "src/Data/Array/Comfort/Shape.hs" #-}-   (Shape.indices (Shape.ZeroBased (3::Int) ::+ Shape.Range 'a' 'c'))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1627: "+{-# LINE 1627 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1627 "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']"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1603: "-{-# LINE 1603 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1603 "src/Data/Array/Comfort/Shape.hs" #-}-   (rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1714: "+{-# LINE 1714 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1714 "src/Data/Array/Comfort/Shape.hs" #-}+    rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2))+  )   [ExpectedLine [LineChunk "()"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1605: "-{-# LINE 1605 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1605 "src/Data/Array/Comfort/Shape.hs" #-}-   (rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element 3))))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1716: "+{-# LINE 1716 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1716 "src/Data/Array/Comfort/Shape.hs" #-}+    rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element 3)))+  )   [ExpectedLine [LineChunk "()"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1607: "-{-# LINE 1607 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1607 "src/Data/Array/Comfort/Shape.hs" #-}-   (isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, Shape.Element 2)))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1718: "+{-# LINE 1718 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1718 "src/Data/Array/Comfort/Shape.hs" #-}+    isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, Shape.Element 2))+  )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1609: "-{-# LINE 1609 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1609 "src/Data/Array/Comfort/Shape.hs" #-}-   (isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, (Shape.Element 2, Shape.Element 3))))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1720: "+{-# LINE 1720 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1720 "src/Data/Array/Comfort/Shape.hs" #-}+    isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, (Shape.Element 2, Shape.Element 3)))+  )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1611: "-{-# LINE 1611 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1611 "src/Data/Array/Comfort/Shape.hs" #-}-   (isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element undefined, Shape.Element 3))))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1722: "+{-# LINE 1722 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1722 "src/Data/Array/Comfort/Shape.hs" #-}+    isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element undefined, Shape.Element 3)))+  )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1613: "-{-# LINE 1613 "src/Data/Array/Comfort/Shape.hs" #-}- DocTest.example-{-# LINE 1613 "src/Data/Array/Comfort/Shape.hs" #-}-   (isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined))))+ DocTest.printPrefix "Data.Array.Comfort.Shape:1724: "+{-# LINE 1724 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example(+{-# LINE 1724 "src/Data/Array/Comfort/Shape.hs" #-}+    isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined)))+  )   [ExpectedLine [LineChunk "True"]]
test/DocTest/Data/Array/Comfort/Storable.hs view
@@ -1,12 +1,15 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable.hs-{-# LINE 87 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 98 "src/Data/Array/Comfort/Storable.hs" #-}  module DocTest.Data.Array.Comfort.Storable where  import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 88 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 99 "src/Data/Array/Comfort/Storable.hs" #-}+import     qualified DocTest.Data.Array.Comfort.Boxed.Unchecked+                                                 as TestBoxedArray+import     qualified Data.Array.Comfort.Boxed as BoxedArray import     qualified Data.Array.Comfort.Storable as Array import     qualified Data.Array.Comfort.Shape as Shape import     Data.Array.Comfort.Storable (Array, (!))@@ -14,13 +17,25 @@ import     qualified Test.QuickCheck as QC import     Test.ChasingBottoms.IsBottom (isBottom) +import     Control.Monad (replicateM) import     Control.Applicative ((<$>), (<*>)) +import     qualified Data.Map as Map+import     qualified Data.Set as Set+import     Data.Map (Map)+import     Data.Function.HT (Id) import     Data.Complex (Complex((:+)))+import     Data.Tuple.HT (swap) import     Data.Word (Word16) +import     Foreign.Storable (Storable)+ type     ShapeInt = Shape.ZeroBased Int+type     X = Shape.Element +shapeInt     :: Int -> ShapeInt+shapeInt     = Shape.ZeroBased+ genArray     :: QC.Gen (Array ShapeInt Word16) genArray     = Array.vectorFromList <$> QC.arbitrary @@ -30,10 +45,14 @@        let n = length xs        (k,m) <-           if n == 0-             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,n)+             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)              else fmap (\m -> (div n m, m)) $ QC.choose (1,n)        return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs +genArrayForShape     :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)+genArrayForShape     sh =+       Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary+ genNonEmptyArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Word16) genNonEmptyArray2     = do        xs <- QC.getNonEmpty <$> QC.arbitrary@@ -55,61 +74,187 @@                 else resultArray == resultList  -type     X = Shape.Element+transpose     ::+       (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>+       Array (sh0,sh1) a -> Array (sh1,sh0) a+transpose     a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))  test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Storable:152: "-{-# LINE 152 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example-{-# LINE 152 "src/Data/Array/Comfort/Storable.hs" #-}-   (Array.fromList (Shape.ZeroBased (5::Int)) ['a'..])+ DocTest.printPrefix "Data.Array.Comfort.Storable:185: "+{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}+    Array.fromList (shapeInt 5) ['a'..]+  )   [ExpectedLine [LineChunk "StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) \"abcde\""]]- DocTest.printPrefix "Data.Array.Comfort.Storable:165: "-{-# LINE 165 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example-{-# LINE 165 "src/Data/Array/Comfort/Storable.hs" #-}-   (Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char)+ DocTest.printPrefix "Data.Array.Comfort.Storable:204: "+{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}+    Array.fromTuple ('a',('b','c')) :: Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char+  )   [ExpectedLine [LineChunk "StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) \"abc\""]]- DocTest.printPrefix "Data.Array.Comfort.Storable:168: "-{-# LINE 168 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example-{-# LINE 168 "src/Data/Array/Comfort/Storable.hs" #-}-   ( let arr = Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char-  in (arr ! fst, arr ! (fst.snd))+ DocTest.printPrefix "Data.Array.Comfort.Storable:207: "+{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}+      +   let arr :: Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char+       arr = Array.fromTuple ('a',('b','c'))+   in (arr ! fst, arr ! (fst.snd))   )   [ExpectedLine [LineChunk "('a','b')"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:189: "-{-# LINE 189 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example-{-# LINE 189 "src/Data/Array/Comfort/Storable.hs" #-}-   ( let arr = Array.fromRecord ('a' :+ 'b') in-  let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in-  (arr ! real, arr ! imag)+ DocTest.printPrefix "Data.Array.Comfort.Storable:230: "+{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}+      +   let arr = Array.fromRecord ('a' :+ 'b') in+   let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in+   (arr ! real, arr ! imag)   )   [ExpectedLine [LineChunk "('a','b')"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:310: "-{-# LINE 310 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property-{-# LINE 310 "src/Data/Array/Comfort/Storable.hs" #-}-     (QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1))- DocTest.printPrefix "Data.Array.Comfort.Storable:328: "-{-# LINE 328 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property-{-# LINE 328 "src/Data/Array/Comfort/Storable.hs" #-}-     (QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs))- DocTest.printPrefix "Data.Array.Comfort.Storable:345: "-{-# LINE 345 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property-{-# LINE 345 "src/Data/Array/Comfort/Storable.hs" #-}-     (forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs))- DocTest.printPrefix "Data.Array.Comfort.Storable:353: "-{-# LINE 353 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property-{-# LINE 353 "src/Data/Array/Comfort/Storable.hs" #-}-     (forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs))- DocTest.printPrefix "Data.Array.Comfort.Storable:365: "-{-# LINE 365 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property-{-# LINE 365 "src/Data/Array/Comfort/Storable.hs" #-}-     (forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs))+ DocTest.printPrefix "Data.Array.Comfort.Storable:295: "+{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}+      +   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList []) []"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:300: "+{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}+      +   let block n a = Array.replicate (shapeInt n) (a::Word16) in+   Array.fromBlockArray1 $+   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3}),('C',ZeroBased {",WildCardChunk,LineChunk " 5})]) [0,0,1,1,1,2,2,2,2,2]"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:318: "+{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}+      +   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in+   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in+   let block sh a = Array.replicate sh (a::Word16) in+   Array.fromBlockArray2+      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)+      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $+   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,+       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList [('1',ZeroBased {",WildCardChunk,LineChunk " 3}),('2',ZeroBased {",WildCardChunk,LineChunk " 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:331: "+{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   transpose (Array.fromNonEmptyBlockArray2 blocked)+   QC.===+   Array.fromNonEmptyBlockArray2+      (TestBoxedArray.transpose (fmap transpose blocked))+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:350: "+{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   QC.forAll genArray2 $ \blockC3 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR2 = fst $ Array.shape blockC3 in+   let shapeC2 = snd $ Array.shape blockC3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")+            [blockA1, blockA2, blockA3,+             blockB1, blockB2, blockB3,+             blockC1, blockC2, blockC3] in++   transpose (Array.fromNonEmptyBlockArray2 blocked)+   QC.===+   Array.fromNonEmptyBlockArray2+      (TestBoxedArray.transpose (fmap transpose blocked))+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:401: "+{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example(+{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}+      +   (id :: Id (array (height, Map Char ShapeInt) Word16)) $+   Array.fromBlockArray2+      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))+      Map.empty $+   BoxedArray.fromList (Set.fromList "AB", Set.empty) []+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList []) []"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:410: "+{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}+        +   QC.forAll genArray2 $ \block ->+   let height = Map.singleton 'A' $ fst $ Array.shape block in+   let width  = Map.singleton '1' $ snd $ Array.shape block in++   Array.reshape (height,width) block+   QC.===+   Array.fromBlockArray2 height width+      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:516: "+{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}+      QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:534: "+{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}+      QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:551: "+{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}+      forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:559: "+{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}+      forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable:571: "+{-# LINE 571 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.property(+{-# LINE 571 "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
@@ -26,31 +26,37 @@ test = do  DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:134: " {-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}-     (\x  ->  Array.singleton x ! () == (x::Word16))+      \x  ->  Array.singleton x ! () == (x::Word16)+  )  DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:148: " {-# LINE 148 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 148 "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)))+      \(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:163: " {-# LINE 163 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 163 "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)+      \(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:183: " {-# LINE 183 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 183 "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)+      \(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:196: " {-# LINE 196 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 196 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}-     (\(Array16 xs)  ->  Array.sum xs == sum (Array.toList xs))+      \(Array16 xs)  ->  Array.sum xs == sum (Array.toList xs)+  )  DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:202: " {-# LINE 202 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 202 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}-     (\(Array16 xs)  ->  Array.product xs == product (Array.toList xs))+      \(Array16 xs)  ->  Array.product xs == product (Array.toList xs)+  )
test/DocTest/Main.hs view
@@ -4,6 +4,7 @@ import qualified DocTest.Data.Array.Comfort.Shape import qualified DocTest.Data.Array.Comfort.Storable import qualified DocTest.Data.Array.Comfort.Storable.Unchecked+import qualified DocTest.Data.Array.Comfort.Boxed import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked  import qualified Test.DocTest.Driver as DocTest@@ -13,4 +14,5 @@     DocTest.Data.Array.Comfort.Shape.test     DocTest.Data.Array.Comfort.Storable.test     DocTest.Data.Array.Comfort.Storable.Unchecked.test+    DocTest.Data.Array.Comfort.Boxed.test     DocTest.Data.Array.Comfort.Boxed.Unchecked.test
test/Test/Shape.hs view
@@ -9,6 +9,8 @@  import Control.Applicative (liftA2, liftA3, pure, (<$>)) +import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Set as Set import Data.Tagged (Tagged(Tagged))@@ -69,6 +71,13 @@       (ShapeTest.tests $        fmap Map.fromList          (QC.listOf (liftA2 (,) (QC.choose ('a','z')) (genZeroBased 10)))) +++   prefix "IntSet"+      (ShapeTest.tests $+       fmap IntSet.fromList (QC.listOf (QC.choose (1,10)))) +++   prefix "IntMap"+      (ShapeTest.tests $+       fmap IntMap.fromList+         (QC.listOf (liftA2 (,) (QC.choose (1,10)) (genZeroBased 10)))) ++    prefix "Deferred Shifted"       (ShapeTest.tests $ fmap Shape.Deferred $        liftA2 Shape.Shifted