e11e34a · rowtype-yoga/purescript-record-studio

git.iko.soy/rowtype-yoga/purescript-record-studio

Same keys (#2)

commite11e34a00a1e7780fe608bbf8f17b2d08875d064 authorMark Eibes <mark.eibes@gmail.com> dateFri 4 Nov 2022, 12:42 (4 years ago) parentbb48898

7 files changed+101−23

compare with main

unifiedsplit

README.md+10 spago.dhall+1−1 src/Record/Studio.purs+3−1 src/Record/Studio/Keys.purs+12−11 src/Record/Studio/SameKeys.purs+44 src/Record/Studio/Shrink.purs+3−10 test/SameKeysSpec.purs+28

README.md+10

@@ -4,6 +4,16 @@ You finally scored a record deal.

55## Usage guide

7+### Assert two records have the same keys with `SameKeys`

9+```purescript

10+-- An example of a function that requires `{|r1}` and `{|r2}` to have the same keys

11+sameKeys :: forall r1 r2. SameKeys r1 r2 => {|r1} -> {|r2} -> Unit

12+sameKeys _ _ = unit

13+let _ = sameKeys { b: "hi", a: 4, c: 4 } { b: "hu", a: "ha" }

14+-- Won't compile: The key "c" is missing from the second record

15+```

16+

717### Merge records with `//`

818Easily merge two records:

919

spago.dhall+1−1

@@ -1,5 +1,5 @@

11{ name = "record-studio"

2−, dependencies = [ "heterogeneous", "lists", "prelude", "record" ]

2+, dependencies = [ "heterogeneous", "lists", "prelude", "record", "typelevel-prelude" ]

33, packages = ./packages.dhall

44, sources = [ "src/**/*.purs" ]

55, license = "MIT-0"

src/Record/Studio.purs+3−1

@@ -5,11 +5,13 @@ module Record.Studio

55 , module Record.Studio.Merge

66 , module Record.Studio.Keys

77 , module Record.Studio.Shrink

8+ , module Record.Studio.SameKeys

89 ) where

910

1011import Record.Studio.Sequence (SequenceRecord(..), sequenceRecord)

1112import Record.Studio.Map (MapRecord(..), mapRecord)

1213import Record.Studio.MapKind (MapRecordKind(..), mapRecordKind)

13−import Record.Studio.Keys (class Keys, recordKeys)

14+import Record.Studio.Keys (class Keys, keys, recordKeys)

1415import Record.Studio.Shrink (shrink)

1516import Record.Studio.Merge (mergeFlipped, (//))

17+import Record.Studio.SameKeys (class SameKeys)

src/Record/Studio/Keys.purs+12−11

@@ -1,4 +1,4 @@

1−module Record.Studio.Keys where

1+module Record.Studio.Keys (class Keys, keys, class KeysRL, keysImpl, recordKeys) where

33import Prelude

@@ -8,22 +8,23 @@ import Data.Symbol (class IsSymbol, reflectSymbol)

88import Prim.RowList as RL

99import Type.Proxy (Proxy(..))

1010

11−class Keys (xs :: RL.RowList Type) where

11+class Keys (r :: Row Type) where

12+ keys :: (Proxy r) -> Array String

13+

14+instance (RL.RowToList r rl, KeysRL rl) => Keys r where

15+ keys _ = List.toUnfoldable $ keysImpl (Proxy :: _ rl)

16+

17+class KeysRL (xs :: RL.RowList Type) where

1218 keysImpl :: Proxy xs -> List String

1319

14−instance Keys RL.Nil where

20+instance KeysRL RL.Nil where

1521 keysImpl _ = mempty

1622

17−instance (IsSymbol name, Keys tail) => Keys (RL.Cons name ty tail) where

23+instance (IsSymbol name, KeysRL tail) => KeysRL (RL.Cons name ty tail) where

1824 keysImpl _ = first : rest

1925 where

2026 first = reflectSymbol (Proxy :: _ name)

2127 rest = keysImpl (Proxy :: _ tail)

2228

23−recordKeys

24− :: forall g row rl

25− . RL.RowToList row rl

26− => Keys rl

27− => g row -- this will work for any type with the row as a param!

28− -> Array String

29−recordKeys _ = List.toUnfoldable $ keysImpl (Proxy :: _ rl)

29+recordKeys :: forall r. Keys r => { | r } -> Array String

30+recordKeys _ = keys (Proxy :: _ r)

src/Record/Studio/SameKeys.pursnew file+44

@@ -0,0 +1,44 @@

1+module Record.Studio.SameKeys (class SameKeys, class SameKeysRL) where

4+import Data.Symbol (class IsSymbol)

5+import Prim.Row (class Lacks)

6+import Prim.RowList (class RowToList)

7+import Prim.RowList as RL

8+import Prim.TypeError (class Fail, Beside, Quote, Text)

9+import Type.RowList (class ListToRow)

10+

11+class SameKeys (r1 :: Row Type) (r2 :: Row Type)

12+

13+instance (RowToList r1 rl1, RowToList r2 rl2, SameKeysRL rl1 rl2) => SameKeys r1 r2

14+

15+class SameKeysRL (xs :: RL.RowList Type) (ys :: RL.RowList Type)

16+

17+instance SameKeysRL RL.Nil RL.Nil

18+instance

19+ ( IsSymbol name

20+ , SameKeysRL tail1 tail2

21+ ) =>

22+ SameKeysRL (RL.Cons name ty1 tail1) (RL.Cons name ty2 tail2)

23+else instance

24+ ( ListToRow RL.Nil r

25+ , Fail (Beside (Text "The key ") (Beside (Quote name) (Text " is missing from the second record")))

26+ ) =>

27+ SameKeysRL (RL.Cons name ty tail) RL.Nil

28+else instance

29+ ( ListToRow RL.Nil r

30+ , Fail (Beside (Text "The key ") (Beside (Quote name) (Text " is missing from the first record")))

31+ ) =>

32+ SameKeysRL RL.Nil (RL.Cons name ty tail)

33+else instance

34+ ( ListToRow (RL.Cons name2 ty1 tail1) r

35+ , Lacks name1 r

36+ , Fail (Beside (Text "The key ") (Beside (Quote name1) (Text " is missing from the second record")))

37+ ) =>

38+ SameKeysRL (RL.Cons name1 ty1 tail1) (RL.Cons name2 ty2 tail2)

39+else instance

40+ ( ListToRow (RL.Cons name1 ty1 tail1) r

41+ , Lacks name2 r

42+ , Fail (Beside (Text "The key ") (Beside (Quote name2) (Text " is missing from the first record")))

43+ ) =>

44+ SameKeysRL (RL.Cons name1 ty1 tail1) (RL.Cons name2 ty2 tail2)

src/Record/Studio/Shrink.purs+3−10

@@ -1,17 +1,10 @@

11module Record.Studio.Shrink (shrink) where

33import Prim.Row (class Union)

4−import Prim.RowList (class RowToList)

5−import Record.Studio.Keys (class Keys, recordKeys)

4+import Record.Studio.Keys (class Keys, keys)

65import Type.Proxy (Proxy(..))

87foreign import shrinkImpl :: forall r1 r2. Array String -> Record r1 -> Record r2

10−shrink

11− :: forall a b bl r

12− . RowToList b bl

13− => Union b r a

14− => Keys bl

15− => Record a

16− -> Record b

17−shrink = shrinkImpl (recordKeys (Proxy :: _ b))

9+shrink :: forall a b r. Union b r a => Keys b => { | a } -> { | b }

10+shrink = shrinkImpl (keys (Proxy :: Proxy b))

test/SameKeysSpec.pursnew file+28

@@ -0,0 +1,28 @@

1+module SameKeysSpec where

3+import Prelude

5+import Record.Studio.SameKeys (class SameKeys)

6+import Test.Spec (Spec, describe, it)

8+spec :: Spec Unit

9+spec =

10+ describe "same keys" do

11+ it "asserts the same keys" do

12+ -- let _ = sameKeys { b: "hi", a: 4, c: 4 } { b: "hu", a: "ha" }

13+ -- The key "c" is missing from the second record

14+

15+ -- let _ = sameKeys { b: "hi", a: 4 } { b: "hu", a: "ha", c: 4 }

16+ -- The key "c" is missing from the first record

17+

18+ -- let _ = sameKeys { b: "hi", a: 4 } { b: "hu" }

19+ -- The key "a" is missing from the second record

20+

21+ -- let _ = sameKeys { b: "hi", a: 4 } { b: "hu" }

22+ -- The key "a" is missing from the second record

23+

24+ let _ = sameKeys { b: "hi", z: 1 } { z: "", b: { c: false } }

25+ pure unit

26+

27+sameKeys :: forall r1 r2. SameKeys r1 r2 => {|r1} -> {|r2} -> Unit

28+sameKeys _ _ = unit