diff --git a/src/Data/Record/Extra.purs b/src/Data/Record/Extra.purs index 496aa84..501cc7a 100644 --- a/src/Data/Record/Extra.purs +++ b/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 diff --git a/test/Main.purs b/test/Main.purs index eb33a3e..d27d462 100644 --- a/test/Main.purs +++ b/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