Skip to content

Commit 70f7ad4

Browse files
jaceredajacereda
committed
compare/eq, unsafe Show/Ord/Eq/Semigroup/Monoid
1 parent f224bbf commit 70f7ad4

File tree

7 files changed

+156
-7
lines changed

7 files changed

+156
-7
lines changed

‎bower.json‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,12 +20,13 @@
2020
"purescript-typelevel": "^4.0.0",
2121
"purescript-uint": "^5.1.0",
2222
"purescript-sized-vectors": "^3.1.0",
23-
"purescript-float32": "^0.0.1"
23+
"purescript-partial": "^2.0.0",
24+
"purescript-float32": "~0.1.1"
2425
},
2526
"devDependencies": {
2627
"purescript-debug": "^4.0.0",
2728
"purescript-quickcheck": "^5.0.0",
28-
"purescript-partial": "^2.0.0",
29-
"purescript-quickcheck-combinators": "^0.1.0"
29+
"purescript-quickcheck-combinators": "~0.1.0",
30+
"purescript-quickcheck-laws": "^4.0.0"
3031
}
3132
}

‎src/Data/ArrayBuffer/Typed.purs‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@
3232
module Data.ArrayBuffer.Typed
3333
( Index, Length
3434
, buffer, byteOffset, byteLength, length
35+
, compare, eq
3536
, class TypedArray
3637
, create, whole, remainder, part, empty, fromArray
3738
, fill, set, setTyped, copyWithin
@@ -60,7 +61,8 @@ import Data.UInt (UInt)
6061
import Effect (Effect)
6162
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
6263
import Effect.Unsafe (unsafePerformEffect)
63-
import Prelude (Unit, flip, pure, ($), (&&), (*), (*>), (-), (<$>), (<<<), (<=), (>=))
64+
import Prelude (class Eq, class Ord, Ordering, Unit, flip, pure, ($), (&&), (*), (*>), (-), (<$>), (<*>), (<<<), (<=), (>=))
65+
import Prelude as Prelude
6466
import Type.Proxy (Proxy(..))
6567

6668

@@ -390,3 +392,11 @@ infixl 3 at as !
390392
toArray :: forall a t. TypedArray a t => ArrayView a -> Effect (Array t)
391393
toArray a = runEffectFn1 toArrayImpl a
392394
foreign import toArrayImpl :: forall a b. EffectFn1 (ArrayView a) (Array b)
395+
396+
-- | Compare 2 typed arrays.
397+
compare :: forall a t. TypedArray a t => Ord t => ArrayView a -> ArrayView a -> Effect Ordering
398+
compare a b = Prelude.compare <$> toArray a <*> toArray b
399+
400+
-- | Equality test for typed arrays.
401+
eq :: forall a t. TypedArray a t => Eq t => ArrayView a -> ArrayView a -> Effect Boolean
402+
eq a b = Prelude.eq <$> toArray a <*> toArray b

‎src/Data/ArrayBuffer/Typed/Gen.purs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ import Control.Monad.Gen.Class (class MonadGen, sized, chooseInt, chooseFloat)
66
import Data.ArrayBuffer.Typed (class TypedArray)
77
import Data.ArrayBuffer.Typed as TA
88
import Data.ArrayBuffer.Types (ArrayView)
9-
import Data.Float32 (Float32, fromNumber) as F
9+
import Data.Float32 (Float32, fromNumber') as F
1010
import Data.Generic.Rep (class Generic)
1111
import Data.Maybe (Maybe(..))
1212
import Data.Typelevel.Num (class Nat, toInt')
@@ -51,7 +51,7 @@ genInt32 :: forall m. MonadGen m => m Int
5151
genInt32 = chooseInt bottom top
5252

5353
genFloat32 :: forall m. MonadGen m => m F.Float32
54-
genFloat32 = F.fromNumber <$> chooseFloat (-3.40282347e+38) 3.40282347e+38
54+
genFloat32 = F.fromNumber' <$> chooseFloat (-3.40282347e+38) 3.40282347e+38
5555

5656
genFloat64 :: forall m. MonadGen m => m Number
5757
genFloat64 = chooseFloat ((-1.7976931348623157e+308)/div) (1.7976931348623157e+308/div)

‎src/Data/ArrayBuffer/Typed/Unsafe.purs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
module Data.ArrayBuffer.Typed.Unsafe where
2+
3+
import Data.ArrayBuffer.Typed (class TypedArray, toString)
4+
import Data.ArrayBuffer.Typed as TA
5+
import Data.ArrayBuffer.Types (ArrayView)
6+
import Data.Maybe (Maybe(..))
7+
import Effect.Unsafe (unsafePerformEffect)
8+
import Prelude (class Eq, class Monoid, class Ord, class Semigroup, class Show, bind, discard, pure, void, ($), (+), (<>))
9+
10+
newtype AV a t = AV (ArrayView a)
11+
12+
instance ordArrayView :: (TypedArray a t, Ord t) => Ord (AV a t) where
13+
compare (AV a) (AV b) = unsafePerformEffect $ TA.compare a b
14+
15+
instance eqArrayView :: (TypedArray a t, Eq t) => Eq (AV a t) where
16+
eq (AV a) (AV b) = unsafePerformEffect $ TA.eq a b
17+
18+
instance showArrayView :: (TypedArray a t, Show t) => Show (AV a t) where
19+
show (AV a) = "T[" <> s <> "]"
20+
where s = unsafePerformEffect $ toString a
21+
22+
instance semigroupArrayView :: TypedArray a t => Semigroup (AV a t) where
23+
append (AV a) (AV b) = unsafePerformEffect do
24+
let la = TA.length a
25+
lb = TA.length b
26+
r <- TA.empty $ la + lb
27+
void $ TA.setTyped r (Just 0) a
28+
void $ TA.setTyped r (Just la) b
29+
pure $ AV r
30+
31+
instance monoidArrayView :: TypedArray a t => Monoid (AV a t) where
32+
mempty = AV $ unsafePerformEffect $ TA.empty 0

‎test/Properties.purs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import Effect.Ref (new, read) as Ref
66
import Prelude (Unit, bind, discard, ($), (<>), (*), show)
77
import Test.Properties.DataView (dataViewTests)
88
import Test.Properties.TypedArray (typedArrayTests)
9+
import Test.Properties.Typed.Laws (typedArrayLaws)
910

1011

1112
propertiesTests :: Effect Unit
@@ -14,6 +15,7 @@ propertiesTests = do
1415
count <- Ref.new 0
1516
log " - TypedArray Tests:"
1617
typedArrayTests count
18+
typedArrayLaws count
1719
c <- Ref.read count
1820
log $ " - Verified " <> show c <> " properties, generating " <> show (c * 9 * 100) <> " test cases."
1921

‎test/Properties/DataView.purs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ type TestableViewF a name b n t q =
4747

4848
overAll :: forall q n. Testable q => Nat n => Ref Int -> (forall a name b t. TestableViewF a name b n t q) -> Effect Unit
4949
overAll count f = do
50-
void (Ref.modify (\x -> x + 1) count)
50+
void (Ref.modify (_ + 1) count)
5151
log " - Uint32"
5252
quickCheckGen $
5353
let f' :: TestableViewF Uint32 "Uint32" D4 n UInt q

‎test/Properties/Typed/Laws.purs‎

Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
module Test.Properties.Typed.Laws where
2+
3+
import Data.ArrayBuffer.Typed (class TypedArray)
4+
import Data.ArrayBuffer.Typed.Gen (genFloat32, genFloat64, genInt16, genInt32, genInt8, genTypedArray, genUint16, genUint32, genUint8)
5+
import Data.ArrayBuffer.Typed.Unsafe (AV(..))
6+
import Data.ArrayBuffer.Types (ArrayView, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8, Uint8Clamped, kind ArrayViewType)
7+
import Data.Float32 as F
8+
import Data.UInt (UInt)
9+
import Effect (Effect)
10+
import Effect.Ref (Ref)
11+
import Effect.Ref as Ref
12+
import Prelude (class Eq, class Monoid, class Ord, class Semigroup, Unit, discard, void, ($), (+), (<$>), (<<<))
13+
import Test.QuickCheck (class Arbitrary)
14+
import Test.QuickCheck.Gen (Gen)
15+
import Test.QuickCheck.Laws.Data (checkEq, checkMonoid, checkOrd, checkSemigroup)
16+
import Type.Prelude (Proxy(..))
17+
18+
newtype A a = A a
19+
20+
foreign import data ArrayElt :: ArrayViewType -> Type -> Type
21+
22+
class ArrayEl (a :: ArrayViewType) (t :: Type) where
23+
arb :: Proxy (ArrayView a) -> Gen t
24+
25+
instance arrayElUint8Clamped :: ArrayEl Uint8Clamped UInt where
26+
arb _ = genUint8
27+
instance arrayElUint32 :: ArrayEl Uint32 UInt where
28+
arb _ = genUint32
29+
instance arrayElUint16 :: ArrayEl Uint16 UInt where
30+
arb _ = genUint16
31+
instance arrayElUint8 :: ArrayEl Uint8 UInt where
32+
arb _ = genUint8
33+
instance arrayElInt32 :: ArrayEl Int32 Int where
34+
arb _ = genInt32
35+
instance arrayElInt16 :: ArrayEl Int16 Int where
36+
arb _ = genInt16
37+
instance arrayElInt8 :: ArrayEl Int8 Int where
38+
arb _ = genInt8
39+
instance arrayElFloat32 :: ArrayEl Float32 F.Float32 where
40+
arb _ = genFloat32
41+
instance arrayElFloat64 :: ArrayEl Float64 Number where
42+
arb _ = genFloat64
43+
44+
instance arbitraryAAV :: (TypedArray a t, ArrayEl a t) => Arbitrary (A (AV a t)) where
45+
arbitrary = (A <<< AV) <$> genTypedArray (arb (Proxy :: Proxy (ArrayView a)))
46+
47+
derive newtype instance eqA :: Eq t => Eq (A t)
48+
derive newtype instance ordA :: Ord t => Ord (A t)
49+
derive newtype instance semigroupA :: Semigroup t => Semigroup (A t)
50+
derive newtype instance monoidA :: Monoid t => Monoid (A t)
51+
52+
typedArrayLaws :: Ref Int -> Effect Unit
53+
typedArrayLaws count = do
54+
do
55+
let f = checkEq
56+
void $ Ref.modify (_ + 1) count
57+
f (Proxy :: Proxy (A (AV Float32 F.Float32)))
58+
f (Proxy :: Proxy (A (AV Float64 Number)))
59+
f (Proxy :: Proxy (A (AV Int16 Int)))
60+
f (Proxy :: Proxy (A (AV Int32 Int)))
61+
f (Proxy :: Proxy (A (AV Int8 Int)))
62+
f (Proxy :: Proxy (A (AV Uint16 UInt)))
63+
f (Proxy :: Proxy (A (AV Uint32 UInt)))
64+
f (Proxy :: Proxy (A (AV Uint8 UInt)))
65+
f (Proxy :: Proxy (A (AV Uint8Clamped UInt)))
66+
67+
do
68+
let f = checkOrd
69+
void $ Ref.modify (_ + 1) count
70+
f (Proxy :: Proxy (A (AV Float32 F.Float32)))
71+
f (Proxy :: Proxy (A (AV Float64 Number)))
72+
f (Proxy :: Proxy (A (AV Int16 Int)))
73+
f (Proxy :: Proxy (A (AV Int32 Int)))
74+
f (Proxy :: Proxy (A (AV Int8 Int)))
75+
f (Proxy :: Proxy (A (AV Uint16 UInt)))
76+
f (Proxy :: Proxy (A (AV Uint32 UInt)))
77+
f (Proxy :: Proxy (A (AV Uint8 UInt)))
78+
f (Proxy :: Proxy (A (AV Uint8Clamped UInt)))
79+
80+
do
81+
let f = checkSemigroup
82+
void $ Ref.modify (_ + 1) count
83+
f (Proxy :: Proxy (A (AV Float32 F.Float32)))
84+
f (Proxy :: Proxy (A (AV Float64 Number)))
85+
f (Proxy :: Proxy (A (AV Int16 Int)))
86+
f (Proxy :: Proxy (A (AV Int32 Int)))
87+
f (Proxy :: Proxy (A (AV Int8 Int)))
88+
f (Proxy :: Proxy (A (AV Uint16 UInt)))
89+
f (Proxy :: Proxy (A (AV Uint32 UInt)))
90+
f (Proxy :: Proxy (A (AV Uint8 UInt)))
91+
f (Proxy :: Proxy (A (AV Uint8Clamped UInt)))
92+
93+
do
94+
let f = checkMonoid
95+
void $ Ref.modify (_ + 1) count
96+
f (Proxy :: Proxy (A (AV Float32 F.Float32)))
97+
f (Proxy :: Proxy (A (AV Float64 Number)))
98+
f (Proxy :: Proxy (A (AV Int16 Int)))
99+
f (Proxy :: Proxy (A (AV Int32 Int)))
100+
f (Proxy :: Proxy (A (AV Int8 Int)))
101+
f (Proxy :: Proxy (A (AV Uint16 UInt)))
102+
f (Proxy :: Proxy (A (AV Uint32 UInt)))
103+
f (Proxy :: Proxy (A (AV Uint8 UInt)))
104+
f (Proxy :: Proxy (A (AV Uint8Clamped UInt)))

0 commit comments

Comments
 (0)