purescript · MonoidMusician · Feb 28, 2018 · Feb 28, 2018 · Feb 28, 2018
diff --git a/src/Data/Record.purs b/src/Data/Record.purs
@@ -5,16 +5,17 @@ module Data.Record
   , insert
   , delete
   , rename
+  , merge
   , equal
   , class EqualFields
   , equalFields
   ) where
 
 import Data.Function.Uncurried (runFn2, runFn3)
-import Data.Record.Unsafe (unsafeGetFn, unsafeSetFn, unsafeDeleteFn)
+import Data.Record.Unsafe (unsafeGetFn, unsafeSetFn, unsafeDeleteFn, unsafeMerge)
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Prelude (class Eq, (&&), (==))
-import Type.Row (class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), kind RowList)
+import Type.Row (class ListToRow, class RowLacks, class RowListNub, class RowToList, Cons, Nil, RLProxy(RLProxy), kind RowList)
 
 -- | Get a property for a label which is specified using a value-level proxy for
 -- | a type-level string.
@@ -141,6 +142,44 @@ rename :: forall prev next ty input inter output
 rename prev next record =
   insert next (get prev record) (delete prev record :: Record inter)
 
+-- | Merge two records, keeping overlapping fields from the left.
+-- |
+-- | For example:
+-- |
+-- | ```purescript
+-- | merge { a: 5, b: true } { a: false, c: "foo" } == { a: 5, b: true, c: "foo" }
+-- | ```
+merge :: forall l r u ul ul' u'
+   . Union l r u
+  => RowToList u ul
+  => RowListNub ul ul'
+  => ListToRow ul' u'
+  => Record l
+  -> Record r
+  -> Record u'
+merge = unsafeMerge
+
+-- | Merge two disjoint records (containing different labels). This helps infer
+-- | types for the input records based on the output records, as `merge` only
+-- | will infer the output based upon the input.
+-- |
+-- | For example, hole `?help` is inferred to have type ``{ b :: Int }` here:
+-- |
+-- | ```purescript
+-- | merge' { a: 5 } ?help :: { a :: Int, b :: Int }
+-- | ```
+merge' :: forall l r u ul
+   . Union l r u
+  => RowToList u ul
+  -- saying two records are disjoint is equivalent to saying their union
+  -- contains no duplicate labels
+  => RowListNub ul ul
+  => ListToRow ul u
+  => Record l
+  -> Record r
+  -> Record u
+merge' = merge
+
 -- | Check two records of the same type for equality.
 equal
   :: forall r rs

diff --git a/src/Data/Record/Builder.js b/src/Data/Record/Builder.js
@@ -47,17 +47,11 @@ 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];
+        r1[k1] = r2[k1];
       }
     }
-    for (var k2 in r1) {
-      if ({}.hasOwnProperty.call(r1, k2)) {
-        copy[k2] = r1[k2];
-      }
-    }
-    return copy;
+    return r1;
   };
 };
diff --git a/src/Data/Record/Builder.purs b/src/Data/Record/Builder.purs
@@ -1,17 +1,19 @@
 module Data.Record.Builder
   ( Builder
+  , BuildRecord
   , build
   , insert
   , modify
   , delete
   , rename
   , merge
+  , merge'
   ) where
 
 import Prelude
 
 import Data.Symbol (class IsSymbol, SProxy, reflectSymbol)
-import Type.Row (class RowLacks)
+import Type.Row (class ListToRow, class RowLacks, class RowListNub, class RowToList)
 
 foreign import copyRecord :: forall r1. Record r1 -> Record r1
 foreign import unsafeInsert :: forall a r1 r2. String -> a -> Record r1 -> Record r2
@@ -33,6 +35,8 @@ foreign import unsafeMerge :: forall r1 r2 r3. Record r1 -> Record r2 -> Record
 -- | ```
 newtype Builder a b = Builder (a -> b)
 
+type BuildRecord r1 r2 = Builder (Record r1) (Record r2)
+
 -- | Build a record, starting from some other record.
 build :: forall r1 r2. Builder (Record r1) (Record r2) -> Record r1 -> Record r2
 build (Builder b) r1 = b (copyRecord r1)
@@ -48,7 +52,7 @@ insert
   => IsSymbol l
   => SProxy l
   -> a
-  -> Builder (Record r1) (Record r2)
+  -> BuildRecord r1 r2
 insert l a = Builder \r1 -> unsafeInsert (reflectSymbol l) a r1
 
 -- | Build by modifying an existing field.
@@ -59,7 +63,7 @@ modify
   => IsSymbol l
   => SProxy l
   -> (a -> b)
-  -> Builder (Record r1) (Record r2)
+  -> BuildRecord r1 r2
 modify l f = Builder \r1 -> unsafeModify (reflectSymbol l) f r1
 
 -- | Build by deleting an existing field.
@@ -69,7 +73,7 @@ delete
    => RowLacks l r1
    => RowCons l a r1 r2
    => SProxy l
-   -> Builder (Record r2) (Record r1)
+   -> BuildRecord r2 r1
 delete l = Builder \r2 -> unsafeDelete (reflectSymbol l) r2
 
 -- | Build by renaming an existing field.
@@ -82,13 +86,28 @@ rename :: forall l1 l2 a r1 r2 r3
   => RowLacks l2 r2
   => SProxy l1
   -> SProxy l2
-  -> Builder (Record r1) (Record r3)
+  -> BuildRecord r1 r3
 rename l1 l2 = Builder \r1 -> unsafeRename (reflectSymbol l1) (reflectSymbol l2) r1
 
--- | Build by merging existing fields from another record.
+-- | Build by merging existing fields from another record. Will overwrite
+-- | existing labels with any overlapping new labels.
 merge
-  :: forall r1 r2 r3
-   . Union r1 r2 r3
-  => Record r2
-  -> Builder (Record r1) (Record r3)
+  :: forall l r u ul ul' u'
+   . Union l r u
+  => RowToList u ul
+  => RowListNub ul ul'
+  => ListToRow ul' u'
+  => Record l
+  -> BuildRecord r u'
 merge r2 = Builder \r1 -> unsafeMerge r1 r2
+
+-- | Merge two disjoint records, helps with "backwards" inference.
+merge'
+  :: forall l r u ul
+   . Union l r u
+  => RowToList u ul
+  => RowListNub ul ul
+  => ListToRow ul u
+  => Record l
+  -> BuildRecord r u
+merge' = merge
diff --git a/src/Data/Record/Unsafe.js b/src/Data/Record/Unsafe.js
@@ -28,3 +28,18 @@ exports.unsafeDeleteFn = function(label, rec) {
 exports.unsafeHasFn = function(label, rec) {
   return {}.hasOwnProperty.call(rec, label);
 };
+
+exports.unsafeMergeFn = function(r1, r2) {
+  var r = {};
+  for (var k1 in r2) {
+    if ({}.hasOwnProperty.call(r2, k1)) {
+      r[k1] = r2[k1];
+    }
+  }
+  for (var k2 in r1) {
+    if ({}.hasOwnProperty.call(r1, k2)) {
+      r[k2] = r1[k2];
+    }
+  }
+  return r;
+};
diff --git a/src/Data/Record/Unsafe.purs b/src/Data/Record/Unsafe.purs
@@ -6,6 +6,8 @@ module Data.Record.Unsafe
   , unsafeGet
   , unsafeSet
   , unsafeDelete
+  , unsafeMerge
+  , unsafeMergeFn
   , unsafeHas
   ) where
 
@@ -14,6 +16,7 @@ import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
 foreign import unsafeGetFn :: forall r a. Fn2 String (Record r) a
 foreign import unsafeSetFn :: forall r1 r2 a. Fn3 String a (Record r1) (Record r2)
 foreign import unsafeDeleteFn :: forall r1 r2. Fn2 String (Record r1) (Record r2)
+foreign import unsafeMergeFn :: forall r1 r2 r3. Fn2 (Record r1) (Record r2) (Record r3)
 foreign import unsafeHasFn :: forall r1. Fn2 String (Record r1) Boolean
 
 unsafeGet :: forall r a. String -> Record r -> a
@@ -25,5 +28,8 @@ unsafeSet = runFn3 unsafeSetFn
 unsafeDelete :: forall r1 r2. String -> Record r1 -> Record r2
 unsafeDelete = runFn2 unsafeDeleteFn
 
+unsafeMerge :: forall r1 r2 r3. Record r1 -> Record r2 -> Record r3
+unsafeMerge = runFn2 unsafeMergeFn
+
 unsafeHas :: forall r1. String -> Record r1 -> Boolean
 unsafeHas = runFn2 unsafeHasFn
diff --git a/test/Main.purs b/test/Main.purs
@@ -3,7 +3,7 @@ module Test.Main where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Data.Record (delete, equal, get, insert, modify, rename, set)
+import Data.Record (delete, equal, get, insert, merge, modify, rename, set)
 import Data.Record.Builder as Builder
 import Data.Record.ST (pokeSTRecord, pureSTRecord, thawSTRecord)
 import Data.Record.Unsafe (unsafeHas)
@@ -36,6 +36,8 @@ main = do
     unsafeHas "a" { a: 42 }
   assert' "unsafeHas2" $
     not $ unsafeHas "b" { a: 42 }
+  assert' "merge" $
+    equal { a: 42, b: true, c: "foo" } $ merge { a: 42, b: true } { a: false, c: "foo" }
 
   let stTest1 = pureSTRecord do
         rec <- thawSTRecord { x: 41, y: "" }
@@ -46,11 +48,12 @@ main = do
   assert' "pokeSTRecord" $
     stTest1.x == 42 && stTest1.y == "testing"
 
-  let testBuilder = Builder.build (Builder.insert x 42
+  let testBuilder :: { x :: String, y :: String }
+      testBuilder = Builder.build (Builder.insert x 42
                                   >>> Builder.merge { y: true, z: "testing" }
                                   >>> Builder.delete y
                                   >>> Builder.modify x show
-                                  >>> Builder.rename z y) {}
+                                  >>> Builder.rename z y) { z: false }
 
   assert' "Data.Record.Builder" $
     testBuilder.x == "42" && testBuilder.y == "testing"