133a55f · jrec · git.iko.soy

src/JRec.hs+15

compare with master

unifiedsplit

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

9 pattern Rec,

10 append,

11 union,

12+ insert,

12 -- insertOrSet

13 -- insertOrSet

13 )

14 )

14where

15where

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

75 Rec res

76 Rec res

76union = R.union

77union = R.union

77

78

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+

78--insertOrSet ::

93--insertOrSet ::

79-- forall label value rhs res.

94-- forall label value rhs res.

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

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

src/JRec/Internal.hs+3−4

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

165instance

166 ( Has l rts t,

167 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

169 ) =>

170 ) =>

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

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

171 where

172 where

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

173 let lbl :: FldProxy l

174 let lbl :: FldProxy l

174 lbl = FldProxy

175 lbl = FldProxy

175 val = get lbl lts

176 val = get lbl lts

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

177− pNext = Proxy

178 !(I# index#) =

177 !(I# index#) =

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

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

180 size# = sizeofSmallMutableArray# tgt#

179 size# = sizeofSmallMutableArray# tgt#

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

180 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'#

183

182

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

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

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

184-- '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

7spec :: Spec

8spec = do

9 it "polymorphic" $ do

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

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

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

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

12 it "show" $ do

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

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

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

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

59 r1 `union` r2

60 `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"

61-- describe "insertOrSet" $ do

67-- describe "insertOrSet" $ do

62-- it "distinct" $ do

68-- it "distinct" $ do

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

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