diff --git a/bower.json b/bower.json index 35fecdb..c32aac9 100644 --- a/bower.json +++ b/bower.json @@ -19,5 +19,8 @@ "devDependencies": { "purescript-console": "^4.0.0", "purescript-exceptions": "^4.0.0" + }, + "dependencies": { + "purescript-prelude": "^4.1.0" } } diff --git a/src/Unsafe/Reference.purs b/src/Unsafe/Reference.purs index ae9f1f5..d78d818 100644 --- a/src/Unsafe/Reference.purs +++ b/src/Unsafe/Reference.purs @@ -1,11 +1,32 @@ module Unsafe.Reference ( unsafeRefEq , reallyUnsafeRefEq + , UnsafeRefEq (..) + , UnsafeRefEqFallback (..) ) where +import Prelude + -- | Compares two values of the same type using strict (`===`) equality. unsafeRefEq :: forall a. a -> a -> Boolean unsafeRefEq = reallyUnsafeRefEq -- | Compares two values of different types using strict (`===`) equality. foreign import reallyUnsafeRefEq :: forall a b. a -> b -> Boolean + +-- | The `Eq` instance is defined by `unsafeRefEq`. +newtype UnsafeRefEq a = UnsafeRefEq a + +instance eqUnsafeRefEq :: Eq (UnsafeRefEq a) where + eq (UnsafeRefEq l) (UnsafeRefEq r) = unsafeRefEq l r + +-- | The `Eq` instance first checks `unsafeRefEq`, if `false` falls back to +-- | the underlying `Eq` instance. +newtype UnsafeRefEqFallback a = UnsafeRefEqFallback a + +instance eqUnsafeRefEqFallback :: + Eq a => + Eq (UnsafeRefEqFallback a) where + eq (UnsafeRefEqFallback l) (UnsafeRefEqFallback r) = + unsafeRefEq l r || l == r + diff --git a/test/Main.purs b/test/Main.purs index 0ceb9c0..075b980 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -5,7 +5,7 @@ import Prelude import Effect (Effect) import Effect.Exception (throwException, error) -import Unsafe.Reference (unsafeRefEq, reallyUnsafeRefEq) +import Unsafe.Reference (unsafeRefEq, reallyUnsafeRefEq, UnsafeRefEq(..), UnsafeRefEqFallback(..)) data Foo = Foo String data Bar = Bar String @@ -17,6 +17,10 @@ assert :: Boolean -> String -> Effect Unit assert true _ = pure unit assert _ desc = throwException (error desc) +data X = Y Unit | Z + +derive instance eqX :: Eq X + main :: Effect Unit main = do let @@ -32,3 +36,7 @@ main = do assert (unsafeRefEq foo3 foo4) "unsafeRefEq newtype" assert (reallyUnsafeRefEq foo3 bar2) "reallyUnsafeRefEq newtype" assert (not reallyUnsafeRefEq foo1 bar1) "not reqallyUnsafeRefEq data" + assert (UnsafeRefEq 0 == UnsafeRefEq 0) "UnsafeRefEq eq with identical values" + assert (UnsafeRefEq (Y unit) /= UnsafeRefEq (Y unit)) "UnsafeRefEq not eq with non-identical values" + assert (UnsafeRefEqFallback (Y unit) == UnsafeRefEqFallback (Y unit)) "UnsafeRefEqFallback eq with non-identical but equal values" + assert (UnsafeRefEqFallback (Y unit) /= UnsafeRefEqFallback Z) "UnsafeRefEqFallback not eq with non equal values"