Skip to content

Instantly share code, notes, and snippets.

@paluh
Last active April 22, 2018 15:02
Show Gist options
  • Save paluh/c3767862dea5ee9d2cca55eb8602c152 to your computer and use it in GitHub Desktop.
Save paluh/c3767862dea5ee9d2cca55eb8602c152 to your computer and use it in GitHub Desktop.
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