0a96582 · jrec · git.iko.soy

git.iko.soy/jrec

Drop the newtype (#2)

* Drop the newtype Record * Don't expose MkRep * Add Show instance, fixing tests

commit0a9658222c3475e6f98d70dc097ad68116349c01 authorSridhar Ratnakumar <srid@srid.ca> dateSun 2 Aug 2020, 13:32 (6 years ago) parentb8524e1

3 files changed+63−80

compare with master

unifiedsplit

src/JRec.hs+22−45 src/JRec/Super.hs+18−12 test/JRecSpec.hs+23−23

src/JRec.hs+22−45

@@ -3,12 +3,11 @@

33{-# LANGUAGE TypeApplications #-}

55module JRec

6− ( Record,

7− pattern Record,

8− pattern ExactRecord,

9− unField,

6+ ( unField,

107 union,

118 (:=) (..),

9+ Rec,

10+ pattern Rec,

1211 )

1312where

1413

@@ -23,24 +22,10 @@ import GHC.TypeLits

2322import Generic.Data

2423import JRec.Field

2524import qualified JRec.Super as R

26−import JRec.Super ((:=) (..))

25+import JRec.Super ((:=) (..), Rec)

2726import JRec.Tuple

2827import Unsafe.Coerce

2928

30−----------------------------------------------------------------------------

31−-- Type

32−----------------------------------------------------------------------------

33−

34−newtype Record fields = MkRecord (R.Rec fields)

35−

36−deriving instance R.RecEq fields fields => Eq (Record fields)

37−

38−instance

39− (Generic (Record fields), GShow0 (Rep (Record fields))) =>

40− Show (Record fields)

41− where

42− show = (\x -> if null x then "{}" else x) . unwords . drop 1 . words . flip (gshowsPrec 0) ""

43−

4429----------------------------------------------------------------------------

4530-- unField

4631----------------------------------------------------------------------------

@@ -61,10 +46,10 @@ union ::

6146 R.RecCopy lhs lhs res,

6247 R.RecCopy rhs rhs res

6348 ) =>

64− Record lhs ->

65− Record rhs ->

66− Record res

67−union (MkRecord a) (MkRecord b) = MkRecord (R.combine a b)

49+ Rec lhs ->

50+ Rec rhs ->

51+ Rec res

52+union = R.combine

6853

6954----------------------------------------------------------------------------

7055-- Generic

@@ -87,38 +72,30 @@ type RecordRep fields =

8772

8873instance

8974 (R.FromNative (RecordRep fields) fields, R.ToNative (RecordRep fields) fields) =>

90− Generic (Record fields)

75+ Generic (Rec fields)

9176 where

9277 type

93− Rep (Record fields) =

78+ Rep (Rec fields) =

9479 RecordRep fields

95− from (MkRecord r) = R.toNative' r

96− to rep = MkRecord (R.fromNative' rep)

80+ from r = R.toNative' r

81+ to rep = R.fromNative' rep

9782

9883----------------------------------------------------------------------------

9984-- generic-lens

10085----------------------------------------------------------------------------

10186

102−instance {-# OVERLAPPING #-} (R.Set field fields a' ~ fields', R.Set field fields' a ~ fields, R.Has field fields a, R.Has field fields' a') => GL.HasField field (Record fields) (Record fields') a a' where

103− field = coerced @(Record fields) @_ @(R.Rec fields) @_ . R.lens (R.FldProxy @field)

87+instance {-# OVERLAPPING #-} (R.Set field fields a' ~ fields', R.Set field fields' a ~ fields, R.Has field fields a, R.Has field fields' a') => GL.HasField field (Rec fields) (Rec fields') a a' where

88+ field = R.lens (R.FldProxy @field)

10489

105−instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GL.HasField' field (Record fields) a where

106− field' = coerced @(Record fields) @_ @(R.Rec fields) @_ . R.lens (R.FldProxy @field)

107−

108−pattern ExactRecord :: RecTuple tuple fields => tuple -> Record fields

109−pattern ExactRecord a <-

110− MkRecord (toTuple -> a)

111− where

112− ExactRecord = MkRecord . fromTuple

90+instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GL.HasField' field (Rec fields) a where

91+ field' = R.lens (R.FldProxy @field)

11392

114−pattern Record ::

115− ( RecTuple tuple fields,

116− R.RecCopy fields fields fields',

117− R.RecCopy fields' fields' fields

93+pattern Rec ::

94+ ( RecTuple tuple fields

11895 ) =>

11996 tuple ->

120− Record fields'

121−pattern Record a <-

122− MkRecord (toTuple . R.recCopy -> a)

97+ Rec fields

98+pattern Rec a <-

99+ (toTuple -> a)

123100 where

124− Record = MkRecord . R.recCopy . fromTuple

101+ Rec = fromTuple

src/JRec/Super.hs+18−12

@@ -40,6 +40,8 @@ import GHC.OverloadedLabels

4040import GHC.Prim

4141import GHC.ST (ST (..), runST)

4242import GHC.TypeLits

43+import Generic.Data (gshowsPrec)

44+import Generic.Data.Internal.Show (GShow)

4345import Unsafe.Coerce

4446import Prelude

4547

@@ -80,14 +82,18 @@ instance l ~ l' => IsLabel (l :: Symbol) (FldProxy l') where

8082-- | Internal record type. When manually writing an explicit type signature for

8183-- a record, use 'Record' instead. For abstract type signatures 'Rec' will work

8284-- well.

83−data Rec (lts :: [*]) = Rec

85+data Rec (lts :: [*]) = MkRec

8486 { _unRec :: SmallArray# Any -- Note that the values are physically in reverse order

8587 }

8688

8789type role Rec representational

8890

89−instance (RecApply lts lts Show) => Show (Rec lts) where

90− show = show . showRec

91+instance

92+ ( RecApply lts lts Show,

93+ GShow Proxy (Rep (Rec lts)),

94+ Generic (Rec lts)

95+ ) => Show (Rec lts) where

96+ show = (\x -> if null x then "{}" else x) . unwords . drop 1 . words . flip (gshowsPrec 0) ""

9197

9298instance RecEq lts lts => Eq (Rec lts) where

9399 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)

@@ -123,12 +129,12 @@ unsafeRNil (I# n#) =

123129 case newSmallArray# n# (error "No Value") s# of

124130 (# s'#, arr# #) ->

125131 case unsafeFreezeSmallArray# arr# s'# of

126− (# s''#, a# #) -> (# s''#, Rec a# #)

132+ (# s''#, a# #) -> (# s''#, MkRec a# #)

127133{-# INLINE unsafeRNil #-}

128134

129135-- Not in superrecord

130136recCopy :: forall lts rts. RecCopy lts lts rts => Rec lts -> Rec rts

131−recCopy r@(Rec vec#) =

137+recCopy r@(MkRec vec#) =

132138 let size# = sizeofSmallArray# vec#

133139 in runST' $ ST $ \s# ->

134140 case newSmallArray# size# (error "No value") s# of

@@ -136,7 +142,7 @@ recCopy r@(Rec vec#) =

136142 case recCopyInto (Proxy @lts) r (Proxy @rts) arr# s'# of

137143 s''# ->

138144 case unsafeFreezeSmallArray# arr# s''# of

139− (# s'''#, a# #) -> (# s'''#, Rec a# #)

145+ (# s'''#, a# #) -> (# s'''#, MkRec a# #)

140146{-# INLINE recCopy #-}

141147

142148class RecCopy (pts :: [*]) (lts :: [*]) (rts :: [*]) where

@@ -185,14 +191,14 @@ unsafeRCons ::

185191 l := t ->

186192 Rec lts ->

187193 Rec (l := t ': lts)

188−unsafeRCons (_ := val) (Rec vec#) =

194+unsafeRCons (_ := val) (MkRec vec#) =

189195 runST' $ ST $ \s# ->

190196 case unsafeThawSmallArray# vec# s# of

191197 (# s'#, arr# #) ->

192198 case writeSmallArray# arr# size# (unsafeCoerce# val) s'# of

193199 s''# ->

194200 case unsafeFreezeSmallArray# arr# s''# of

195− (# s'''#, a# #) -> (# s'''#, Rec a# #)

201+ (# s'''#, a# #) -> (# s'''#, MkRec a# #)

196202 where

197203 !(I# size#) = fromIntegral $ natVal' (proxy# :: Proxy# s)

198204{-# INLINE unsafeRCons #-}

@@ -262,7 +268,7 @@ get ::

262268 FldProxy l ->

263269 Rec lts ->

264270 v

265−get _ (Rec vec#) =

271+get _ (MkRec vec#) =

266272 let !(I# index#) =

267273 fromIntegral (natVal' (proxy# :: Proxy# (RecTyIdxH 0 l lts)))

268274 size# = sizeofSmallArray# vec#

@@ -292,7 +298,7 @@ set ::

292298 v' ->

293299 Rec lts ->

294300 Rec lts'

295−set _ !val (Rec vec#) =

301+set _ !val (MkRec vec#) =

296302 let !(I# index#) = fromIntegral (natVal' (proxy# :: Proxy# (RecTyIdxH 0 l lts)))

297303 -- Unlike superrecord - calculating size dynamically instead of statically

298304 size# = sizeofSmallArray# vec#

@@ -307,7 +313,7 @@ set _ !val (Rec vec#) =

307313 case writeSmallArray# arr# (size# -# index# -# 1#) dynVal s''# of

308314 s'''# ->

309315 case unsafeFreezeSmallArray# arr# s'''# of

310− (# s''''#, a# #) -> (# s''''#, Rec a# #)

316+ (# s''''#, a# #) -> (# s''''#, MkRec a# #)

311317 in r2

312318{-# INLINE set #-}

313319

@@ -379,7 +385,7 @@ combine lts rts =

379385 case recCopyInto (Proxy :: Proxy rhs) rts (Proxy :: Proxy res) arr# s''# of

380386 s'''# ->

381387 case unsafeFreezeSmallArray# arr# s'''# of

382− (# s''''#, a# #) -> (# s''''#, Rec a# #)

388+ (# s''''#, a# #) -> (# s''''#, MkRec a# #)

383389{-# INLINE combine #-}

384390

385391-- | Alias for 'combine'

test/JRecSpec.hs+23−23

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

77spec :: Spec

88spec = do

99 it "polymorphic" $ do

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

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

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

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

1212 it "show" $ do

13− show (ExactRecord ()) `shouldBe` "{}"

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

15− show (ExactRecord (#foo := True, #bar := 0)) `shouldBe` "{foo = True, bar = 0}"

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

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

15+ show (Rec (#foo := True, #bar := 0)) `shouldBe` "{foo = True, bar = 0}"

1616 it "get" $ do

17− let getA1 :: Record ("a" := Int ': rest) -> Int

17+ let getA1 :: Rec ("a" := Int ': rest) -> Int

1818 getA1 = (^. #a)

19− let getA2 :: Record ("u" := Bool ': "a" := Int ': rest) -> Int

19+ let getA2 :: Rec ("u" := Bool ': "a" := Int ': rest) -> Int

2020 getA2 = (^. #a)

21− getA1 (ExactRecord (#a := 5)) `shouldBe` 5

22− getA1 (ExactRecord (#a := 5, #b := 6)) `shouldBe` 5

23− getA2 (ExactRecord (#u := True, #a := 5)) `shouldBe` 5

24− getA2 (ExactRecord (#u := True, #a := 5, #b := 6)) `shouldBe` 5

21+ getA1 (Rec (#a := 5)) `shouldBe` 5

22+ getA1 (Rec (#a := 5, #b := 6)) `shouldBe` 5

23+ getA2 (Rec (#u := True, #a := 5)) `shouldBe` 5

24+ getA2 (Rec (#u := True, #a := 5, #b := 6)) `shouldBe` 5

2525 it "set" $ do

2626 let setA1 ::

27− Record ("a" := Int ': rest) ->

28− Record ("a" := Int ': rest)

27+ Rec ("a" := Int ': rest) ->

28+ Rec ("a" := Int ': rest)

2929 setA1 = (#a .~ 8)

3030 let setA2 ::

31− Record ("u" := Bool ': "a" := Int ': rest) ->

32− Record ("u" := Bool ': "a" := Int ': rest)

31+ Rec ("u" := Bool ': "a" := Int ': rest) ->

32+ Rec ("u" := Bool ': "a" := Int ': rest)

3333 setA2 = (#a .~ 8)

34− setA1 (ExactRecord (#a := 5))

35− `shouldBe` (ExactRecord (#a := 8))

36− setA1 (ExactRecord (#a := 5, #b := 6))

37− `shouldBe` (ExactRecord (#a := 8, #b := 6))

38− setA2 (ExactRecord (#u := True, #a := 5))

39− `shouldBe` (ExactRecord (#u := True, #a := 8))

40− setA2 (ExactRecord (#u := True, #a := 5, #b := 6))

41− `shouldBe` (ExactRecord (#u := True, #a := 8, #b := 6))

34+ setA1 (Rec (#a := 5))

35+ `shouldBe` (Rec (#a := 8))

36+ setA1 (Rec (#a := 5, #b := 6))

37+ `shouldBe` (Rec (#a := 8, #b := 6))

38+ setA2 (Rec (#u := True, #a := 5))

39+ `shouldBe` (Rec (#u := True, #a := 8))

40+ setA2 (Rec (#u := True, #a := 5, #b := 6))

41+ `shouldBe` (Rec (#u := True, #a := 8, #b := 6))