purescript · garyb · May 22, 2018 · Apr 28, 2018 · Apr 28, 2018 · Apr 29, 2018
diff --git a/bower.json b/bower.json
@@ -19,7 +19,8 @@
   "dependencies": {
     "purescript-functions": "#compiler/0.12",
     "purescript-typelevel-prelude": "#compiler/0.12",
-    "purescript-st": "#compiler/0.12"
+    "purescript-st": "#compiler/0.12",
+    "purescript-unsafe-coerce": "#compiler/0.12"
   },
   "devDependencies": {
     "purescript-assert": "#compiler/0.12"

diff --git a/src/Record.purs b/src/Record.purs
@@ -6,15 +6,21 @@ module Record
   , delete
   , rename
   , equal
+  , merge
+  , union
+  , disjointUnion
+  , nub
   , class EqualFields
   , equalFields
   ) where
 
-import Prelude
-
+import Data.Function.Uncurried (runFn2)
+import Record.Unsafe (unsafeGet, unsafeSet, unsafeDelete)
+import Record.Unsafe.Union (unsafeUnionFn)
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
-import Record.Unsafe (unsafeDelete, unsafeGet, unsafeSet)
-import Type.Row (class Lacks, class Cons, class RowToList, Cons, Nil, RLProxy(RLProxy), kind RowList)
+import Prelude (class Eq, (&&), (==))
+import Type.Row (class Lacks, class Cons, class Nub, class RowToList, class Union, Cons, Nil, RLProxy(RLProxy), kind RowList)
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | Get a property for a label which is specified using a value-level proxy for
 -- | a type-level string.
@@ -141,6 +147,69 @@ rename :: forall prev next ty input inter output
 rename prev next record =
   insert next (get prev record) (delete prev record :: Record inter)
 
+-- | Merges two records with the first record's labels taking precedence in the
+-- | case of overlaps.
+-- |
+-- | For example:
+-- |
+-- | ```purescript
+-- | merge { x: 1, y: "y" } { y: 2, z: true }
+-- |  :: { x :: Int, y :: String, z :: Boolean }
+-- | ```
+merge
+  :: forall r1 r2 r3 r4
+   . Union r1 r2 r3
+  => Nub r3 r4
+  => Record r1
+  -> Record r2
+  -> Record r4
+merge l r = runFn2 unsafeUnionFn l r
+
+-- | Merges two records with the first record's labels taking precedence in the
+-- | case of overlaps. Unlike `merge`, this does not remove duplicate labels
+-- | from the resulting record type. This can result in better inference for
+-- | some pipelines, deferring the need for a `Nub` constraint.
+-- |
+-- | For example:
+-- |
+-- | ```purescript
+-- | union { x: 1, y: "y" } { y: 2, z: true }
+-- |  :: { x :: Int, y :: String, y :: Int, z :: Boolean }
+-- | ```
+union
+  :: forall r1 r2 r3
+   . Union r1 r2 r3
+  => Record r1
+  -> Record r2
+  -> Record r3
+union l r = runFn2 unsafeUnionFn l r
+
+-- | Merges two records where no labels overlap. This restriction exhibits
+-- | better inference than `merge` when the resulting record type is known,
+-- | but one argument is not.
+-- |
+-- | For example, hole `?help` is inferred to have type `{ b :: Int }` here:
+-- |
+-- | ```purescript
+-- | disjoinUnion { a: 5 } ?help :: { a :: Int, b :: Int }
+-- | ```
+disjointUnion
+  :: forall r1 r2 r3
+   . Union r1 r2 r3
+  => Nub r3 r3
+  => Record r1
+  -> Record r2
+  -> Record r3
+disjointUnion l r = runFn2 unsafeUnionFn l r
+
+-- | A coercion which removes duplicate labels from a record's type.
+nub
+  :: forall r1 r2
+   . Nub r1 r2
+  => Record r1
+  -> Record r2
+nub = unsafeCoerce
+
 -- | Check two records of the same type for equality.
 equal
   :: forall r rs

diff --git a/src/Record/Builder.js b/src/Record/Builder.js
@@ -44,20 +44,3 @@ exports.unsafeRename = function(l1) {
     };
   };
 };
-
-exports.unsafeMerge = function(r1) {
-  return function(r2) {
-    var copy = {};
-    for (var k1 in r2) {
-      if ({}.hasOwnProperty.call(r2, k1)) {
-        copy[k1] = r2[k1];
-      }
-    }
-    for (var k2 in r1) {
-      if ({}.hasOwnProperty.call(r1, k2)) {
-        copy[k2] = r1[k2];
-      }
-    }
-    return copy;
-  };
-};
diff --git a/src/Record/Builder.purs b/src/Record/Builder.purs
@@ -6,19 +6,24 @@ module Record.Builder
   , delete
   , rename
   , merge
+  , union
+  , disjointUnion
+  , nub
   ) where
 
 import Prelude
 
+import Data.Function.Uncurried (runFn2)
 import Data.Symbol (class IsSymbol, SProxy, reflectSymbol)
+import Record.Unsafe.Union (unsafeUnionFn)
 import Type.Row as Row
+import Unsafe.Coerce (unsafeCoerce)
 
 foreign import copyRecord :: forall r1. Record r1 -> Record r1
 foreign import unsafeInsert :: forall a r1 r2. String -> a -> Record r1 -> Record r2
 foreign import unsafeModify :: forall a b r1 r2. String -> (a -> b) -> Record r1 -> Record r2
 foreign import unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2
 foreign import unsafeRename :: forall r1 r2. String -> String -> Record r1 -> Record r2
-foreign import unsafeMerge :: forall r1 r2 r3. Record r1 -> Record r2 -> Record r3
 
 -- | A `Builder` can be used to `build` a record by incrementally adding
 -- | fields in-place, instead of using `insert` and repeatedly generating new
@@ -87,8 +92,36 @@ rename l1 l2 = Builder \r1 -> unsafeRename (reflectSymbol l1) (reflectSymbol l2)
 
 -- | Build by merging existing fields from another record.
 merge
+  :: forall r1 r2 r3 r4
+   . Row.Union r1 r2 r3
+  => Row.Nub r3 r4
+  => Record r2
+  -> Builder (Record r1) (Record r4)
+merge r2 = Builder \r1 -> runFn2 unsafeUnionFn r1 r2
+
+-- | Build by merging existing fields from another record. Unlike `merge`,
+-- | this does not remove duplicate labels from the resulting record type.
+-- | This can result in better inference for some pipelines, deferring the
+-- | need for a `Nub` constraint.
+union
   :: forall r1 r2 r3
    . Row.Union r1 r2 r3
   => Record r2
   -> Builder (Record r1) (Record r3)
-merge r2 = Builder \r1 -> unsafeMerge r1 r2
+union r2 = Builder \r1 -> runFn2 unsafeUnionFn r1 r2
+
+-- | Build by merging some disjoint set of fields from another record.
+disjointUnion
+  :: forall r1 r2 r3
+   . Row.Union r1 r2 r3
+  => Row.Nub r3 r3
+  => Record r1
+  -> Builder (Record r2) (Record r3)
+disjointUnion r1 = Builder \r2 -> runFn2 unsafeUnionFn r1 r2
+
+-- | A coercion which removes duplicate labels from a record's type.
+nub
+  :: forall r1 r2
+   . Row.Nub r1 r2
+  => Builder (Record r1) (Record r2)
+nub = Builder unsafeCoerce
diff --git a/src/Record/Unsafe/Union.js b/src/Record/Unsafe/Union.js
@@ -0,0 +1,16 @@
+"use strict";
+
+exports.unsafeUnionFn = function(r1, r2) {
+  var copy = {};
+  for (var k1 in r2) {
+    if ({}.hasOwnProperty.call(r2, k1)) {
+      copy[k1] = r2[k1];
+    }
+  }
+  for (var k2 in r1) {
+    if ({}.hasOwnProperty.call(r1, k2)) {
+      copy[k2] = r1[k2];
+    }
+  }
+  return copy;
+};
diff --git a/src/Record/Unsafe/Union.purs b/src/Record/Unsafe/Union.purs
@@ -0,0 +1,8 @@
+module Record.Unsafe.Union where
+
+import Data.Function.Uncurried (Fn2, runFn2)
+
+foreign import unsafeUnionFn :: forall r1 r2 r3. Fn2 (Record r1) (Record r2) (Record r3)
+
+unsafeUnion :: forall r1 r2 r3. Record r1 -> Record r2 -> Record r3
+unsafeUnion = runFn2 unsafeUnionFn
diff --git a/test/Main.purs b/test/Main.purs
@@ -3,7 +3,7 @@ module Test.Main where
 import Prelude
 
 import Effect (Effect)
-import Record (delete, equal, get, insert, modify, rename, set)
+import Record (delete, equal, get, insert, merge, modify, rename, set)
 import Record.Builder as Builder
 import Control.Monad.ST (run) as ST
 import Record.ST (poke, thaw, freeze) as ST
@@ -33,6 +33,8 @@ main = do
     equal { a: 1, b: "b", c: true } { a: 1, b: "b", c: true }
   assert' "equal2" $
     not $ equal { a: 1, b: "b", c: true } { a: 1, b: "b", c: false }
+  assert' "merge" $
+    equal { x: 1, y: "y" } (merge { y: "y" } { x: 1, y: 2 })
   assert' "unsafeHas1" $
     unsafeHas "a" { a: 42 }
   assert' "unsafeHas2" $