Record merge with evidence

RecordMerge.index.js

// @inline export mergeRecord arity=7
// @inline export mergeRecordRhsSkip arity=1
// @inline export mergeRecordRhsCons arity=5
// @inline export mergeRecordRhsNil always
const mergeRecord = () => () => () => () => () => () => dictMergeRecordRhs => ({merge: a => b => dictMergeRecordRhs.mergeRecordRhs(a)(b)});
const merge = dict => dict.merge;
const test1 = {bar: false, foo: 12};
const test2 = v => ({...v, bar: false});
const test3 = v => ({bar: v.bar, foo: 12});
export {merge, mergeRecord, test1, test2, test3};

RecordMerge.purs

-- @inline export mergeRecord arity=7
-- @inline export mergeRecordRhsSkip arity=1
-- @inline export mergeRecordRhsCons arity=5
-- @inline export mergeRecordRhsNil always
module RecordMerge
  ( class Merge
  , merge
  , test1
  , test2
  , test3
  ) where

import Data.Symbol (class IsSymbol)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, RowList)
import Record as Record
import Type.Proxy (Proxy(..))

class Merge a b c | a b -> c where
  merge :: a -> b -> c

instance mergeRecord ::
  ( Row.Nub r1 r1n
  , Row.Nub r2 r2n
  , RowToList r1n r1l
  , MergeRecordLhs r1l r2n r2d
  , Row.Nub r2d r2dn
  , RowToList r2dn r2dnl
  , MergeRecordRhs r2dnl r1n r2n r3
  ) =>
  Merge { | r1 } { | r2 } { | r3 } where
  merge a b = mergeRecordRhs @r2dnl (Record.nub a) (Record.nub b)

class MergeRecordLhs :: RowList Type -> Row Type -> Row Type -> Constraint
class MergeRecordLhs rl r1 r2 | rl r1 -> r2

data Deleted

instance
  ( Row.Cons sym Deleted r1 r3
  , MergeRecordLhs rl r2 r3
  ) =>
  MergeRecordLhs (Cons sym a rl) r1 r3

instance MergeRecordLhs Nil r1 r1

class MergeRecordRhs :: RowList Type -> Row Type -> Row Type -> Row Type -> Constraint
class MergeRecordRhs rl r1 r2 r3 | rl r1 r2 -> r3 where
  mergeRecordRhs :: { | r1 } -> { | r2 } -> { | r3 }

instance mergeRecordRhsSkip ::
  ( MergeRecordRhs rl r1 r2 r3
  ) =>
  MergeRecordRhs (Cons sym Deleted rl) r1 r2 r3 where
  mergeRecordRhs = mergeRecordRhs @rl

else instance mergeRecordRhsCons ::
  ( IsSymbol sym
  , MergeRecordRhs rl r1 r2 r3'
  , Row.Lacks sym r3'
  , Row.Cons sym a r3' r3
  , Row.Cons sym a rx r2
  ) =>
  MergeRecordRhs (Cons sym a rl) r1 r2 r3 where
  mergeRecordRhs a b = Record.insert (Proxy :: _ sym) (Record.get (Proxy :: _ sym) b) (mergeRecordRhs @rl a b)

instance mergeRecordRhsNil :: MergeRecordRhs Nil r1 r2 r1 where
  mergeRecordRhs a _ = a

test1 = merge { foo: 12 } { foo: "hello", bar: false }
test2 (a :: { foo :: Int }) = merge a { foo: "hello", bar: false }
test3 (b :: { foo :: String, bar :: Boolean }) = merge { foo: 12 } b