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"]}) |
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"]} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment