Added appendRecord, works on two records containing semigroups

src/Data/Record/Extra.purs

@@ -3,11 +3,11 @@ module Data.Record.Extra where
 import Prelude
 
 import Data.List (List, (:))
-import Data.Monoid (mempty)
-import Data.Record (get, insert)
+import Data.Monoid (class Monoid, class Semigroup, mempty, (<>))
+import Data.Record (get, set, insert, modify)
 import Data.Tuple (Tuple(..))
-import Type.Prelude (class IsSymbol, class RowLacks, class RowToList, RLProxy(RLProxy), SProxy(SProxy), reflectSymbol)
-import Type.Row (Cons, Nil, kind RowList)
+import Type.Prelude (class IsSymbol, class ListToRow, class RowLacks, class RowToList, RLProxy(..), SProxy(SProxy), reflectSymbol)
+import Type.Row (class RowListRemove, Cons, Nil, kind RowList)
 
 mapRecord :: forall row xs a b row'
    . RowToList row xs
@@ -170,6 +170,59 @@ eqRecord :: forall row rl
   -> Boolean
 eqRecord a b = eqRecordImpl (RLProxy :: RLProxy rl) a b
 
+class AppendSubrecordImpl rl bigger smaller where
+  appendSubrecordImpl :: RLProxy rl -> Record bigger -> Record smaller -> Record bigger
+
+instance appendSubrecordNil :: AppendSubrecordImpl Nil bigger smaller where
+  appendSubrecordImpl _ b s = b
+
+instance appendSubrecordCons ::
+  ( IsSymbol name
+  , RowCons name t trash smaller
+  , RowCons name t trash' bigger
+  , Semigroup t
+  , AppendSubrecordImpl tail bigger smaller
+  ) => AppendSubrecordImpl (Cons name t tail) bigger smaller where
+    appendSubrecordImpl _ bigger smaller = modify key modifier rest
+      where
+        key = SProxy :: SProxy name
+        modifier v = v <> get key smaller
+        rest = appendSubrecordImpl (RLProxy ∷ RLProxy tail) bigger smaller
+
+
+appendRecord :: forall rl bigger smaller . RowToList smaller rl
+ => AppendSubrecordImpl rl bigger smaller
+ => Record bigger
+ -> Record smaller
+ -> Record bigger
+appendRecord b s = appendSubrecordImpl (RLProxy :: RLProxy rl) b s
+
+class MemptyRecord rl row | rl -> row
+  where
+    memptyRecordImpl :: RLProxy rl -> Record row
+
+instance memptyRecordNil :: MemptyRecord Nil () where
+  memptyRecordImpl _ = {}
+
+instance memptyRecordCons ::
+  ( IsSymbol name
+  , Monoid t
+  , MemptyRecord tail tailRow
+  , RowLacks name tailRow
+  , RowCons name t tailRow row
+  ) => MemptyRecord (Cons name t tail) row where
+  memptyRecordImpl _ =
+     insert namep mempty rest
+   where
+     namep = SProxy :: SProxy name
+     tailp = RLProxy :: RLProxy tail
+     rest = memptyRecordImpl tailp
+
+memptyRecord :: forall rl row . RowToList row rl
+   => MemptyRecord rl row
+   => Record row
+memptyRecord = memptyRecordImpl (RLProxy :: RLProxy rl)
+
 class Applicative m <= SequenceRecord rl row row' m
   | rl -> row row', rl -> m
   where

test/Main.purs

@@ -7,7 +7,7 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE)
 import Data.List (List(Nil), (:))
 import Data.Maybe (Maybe(..))
-import Data.Record.Extra (type (:::), SLProxy(..), SNil, eqRecord, keys, mapRecord, sequenceRecord, slistKeys, zipRecord)
+import Data.Record.Extra (type (:::), SLProxy(..), SNil, memptyRecord, appendRecord, eqRecord, keys, mapRecord, sequenceRecord, slistKeys, zipRecord)
 import Data.Tuple (Tuple(..))
 import Test.Unit (failure, success, suite, test)
 import Test.Unit.Assert (assert, assertFalse, equal)
@@ -52,6 +52,24 @@ main = runTest do
       assert "works equal" $ eqRecord {a: 1, b: 2, c: 3} {a: 1, b: 2, c: 3}
       assertFalse "works not equal" $ eqRecord {a: 5, b: 2, c: 3} {a: 1, b: 2, c: 3}
 
+    test "appendRecord" do
+      let appended = appendRecord {a: "1", b: [2], c: "3"} {a: "a", b: [4], c: "c"}
+      equal "1a" appended.a
+      equal [2,4] appended.b
+      equal "3c" appended.c
+
+    test "appendSubRecord" do
+      let appended = appendRecord {a: "1", b: [2], c: "3", d: 4} {a: "a", b: [4], c: "c"}
+      equal "1a" appended.a
+      equal [2,4] appended.b
+      equal "3c" appended.c
+      equal 4 appended.d
+
+    test "memptyRecord" do
+      let emptyRecord = memptyRecord :: {a :: String, b :: Array Int}
+      equal "" emptyRecord.a
+      equal [] emptyRecord.b
+
     test "sequenceRecord" do
       let sequenced = sequenceRecord {x: Just "a", y: Just 1, z: Just 3}
       case sequenced of