133a55f · jrec · git.iko.soy

git.iko.soy/jrec

Add insert

commit133a55f1484dd8b6b99994deacc9b5316b1ccbc5 authorSridhar Ratnakumar <srid@srid.ca> dateSun 23 Aug 2020, 14:53 (6 years ago) parent321daa4

3 files changed+26−6

compare with master

unifiedsplit

src/JRec.hs+15 src/JRec/Internal.hs+3−4 test/JRecSpec.hs+8−2

src/JRec.hs+15

@@ -9,6 +9,7 @@ module JRec

99 pattern Rec,

1010 append,

1111 union,

12+ insert,

1213 -- insertOrSet

1314 )

1415where

@@ -75,6 +76,20 @@ union ::

7576 Rec res

7677union = R.union

7778

79+-- | Insert a field into a record that does not already contain it

80+insert ::

81+ forall label value lts res.

82+ ( KnownNat (1 + R.RecSize lts),

83+ KnownNat (R.RecSize lts),

84+ KnownSymbol label,

85+ R.RecCopy lts lts res,

86+ res ~ ((label := value) : lts),

87+ R.KeyDoesNotExist label lts

88+ ) =>

89+ label := value ->

90+ Rec lts -> Rec res

91+insert = R.combine . Rec

92+

7893--insertOrSet ::

7994-- forall label value rhs res.

8095-- ( KnownNat (R.RecSize rhs),

src/JRec/Internal.hs+3−4

@@ -165,7 +165,8 @@ instance RecCopy '[] lts rts where

165165instance

166166 ( Has l rts t,

167167 Has l lts t,

168− RecCopy (RemoveAccessTo l (l := t ': pts)) lts rts

168+ nts ~ RemoveAccessTo l (l := t ': pts),

169+ RecCopy nts lts rts

169170 ) =>

170171 RecCopy (l := t ': pts) lts rts

171172 where

@@ -173,13 +174,11 @@ instance

173174 let lbl :: FldProxy l

174175 lbl = FldProxy

175176 val = get lbl lts

176− pNext :: Proxy (RemoveAccessTo l (l := t ': pts))

177− pNext = Proxy

178177 !(I# index#) =

179178 fromIntegral (natVal' (proxy# :: Proxy# (RecTyIdxH 0 l rts)))

180179 size# = sizeofSmallMutableArray# tgt#

181180 in case writeSmallArray# tgt# (size# -# index# -# 1#) (unsafeCoerce# val) s# of

182− s'# -> recCopyInto pNext lts prxy tgt# s'#

181+ s'# -> recCopyInto (Proxy :: Proxy nts) lts prxy tgt# s'#

183182

184183-- | Prepend a record entry to a record 'Rec'. Assumes that the record was created with

185184-- 'unsafeRNil' and still has enough free slots, mutates the original 'Rec' which should

test/JRecSpec.hs+8−2

@@ -7,8 +7,8 @@ import Test.Hspec

77spec :: Spec

88spec = do

99 it "polymorphic" $ do

10− (Rec (#u := True, #a := 5, #a := 2, #b := 6) & #u .~ 5)

11− `shouldBe` Rec (#u := 5, #a := 5, #a := 2, #b := 6)

10+ (Rec (#u := True, #a := 5, #b := 6, #a := 2 ) & #u .~ 5)

11+ `shouldBe` Rec (#u := 5, #a := 5, #b := 6, #a := 2)

1212 it "show" $ do

1313 show (Rec ()) `shouldBe` "{}"

1414 show (Rec (#foo := True)) `shouldBe` "{foo = True}"

@@ -58,6 +58,12 @@ spec = do

5858 r2 = Rec (#c := 7, #a := 8)

5959 r1 `union` r2

6060 `shouldBe` Rec (#b := 5, #a := 6, #c := 7)

61+ describe "insert" $ do

62+ it "simple insert" $ do

63+ (#a := 1) `insert` Rec (#b := 2, #c := 3)

64+ `shouldBe` Rec (#a := 1, #b := 2, #c := 3)

65+ it "duplicate insert should be disallowed" $ do

66+ pendingWith "TODO"

6167-- describe "insertOrSet" $ do

6268-- it "distinct" $ do

6369-- insertOrSet (#a := 1) (Rec (#b := 2, #c := 3))