Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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 semigroupJoinRecordNilSemigroupJoinRecord 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 semigroupSubrecordNilSemigroupSubrecord 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