SemigroupRecord.purs

class SemigroupJoinRecord rl (row ∷ # Type) where
  appendRecordsImpl :: RLProxy rl → Record row -> Record row -> Record row

instance semigroupJoinRecordCons ∷ (Semigroup ty, RowCons name ty row' row, SemigroupJoinRecord tail row, IsSymbol name) ⇒ SemigroupJoinRecord (Cons name ty tail) row where
  appendRecordsImpl _ r1 r2 =
    let
      _name = (SProxy ∷ SProxy name)
      v1 = get _name r1
      v2 = get _name r2
    in
      set _name (v1 <> v2) (appendRecordsImpl (RLProxy ∷ RLProxy tail) r1 r2)

instance semigroupJoinRecordNil ∷ SemigroupJoinRecord Nil row where
  appendRecordsImpl _ r1 r2 = r1

appendRecords ∷ ∀ rl row
  . (RowToList row rl)
  ⇒ (SemigroupJoinRecord rl row)
  ⇒ Record row
  → Record row
  → Record row
appendRecords r1 r2 = appendRecordsImpl (RLProxy ∷ RLProxy rl) r1 r2


x = (appendRecords {i: "i", s: "b", l: ["c"]} {i: "i", s: "s", l: ["c"]})

SemigroupSubrecord.purs

class SemigroupSubrecord rl (bigger ∷ # Type) (smaller ∷ #Type) where
  appendSubrecordsImpl :: RLProxy rl → Record bigger -> Record smaller -> Record bigger

instance semigroupSubrecordNil ∷ SemigroupSubrecord Nil bigger smaller where
  appendSubrecordsImpl _ = const

instance semigroupSubrecordCons ∷ (Semigroup ty, RowCons name ty trash bigger, RowCons name ty trash' smaller, SemigroupSubrecord tail bigger smaller, IsSymbol name) ⇒ SemigroupSubrecord (Cons name ty tail) bigger smaller where
  appendSubrecordsImpl _ r1 r2 =
    let
      _name = (SProxy ∷ SProxy name)
      v2 = get _name r2
    in
      modify _name (_ <> v2) (appendSubrecordsImpl (RLProxy ∷ RLProxy tail) r1 r2)

appendSubrecords ∷ ∀ rl bigger smaller
  . (RowToList smaller rl)
  ⇒ (SemigroupSubrecord rl bigger smaller)
  ⇒ Record bigger
  → Record smaller
  → Record bigger
appendSubrecords r1 r2 = appendSubrecordsImpl (RLProxy ∷ RLProxy rl) r1 r2


x = appendSubrecords {i: "i", s: "b", l: ["c"], x: 8} {i: "i", s: "s", l: ["c"]}