d399bdd · rowtype-yoga/purescript-record-studio

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

Add `key` and `mapUniformRecord` (#4)

commitd399bdd2acee7b810f53dd0a398127c7923af52c authorMark Eibes <mark.eibes@gmail.com> dateSun 13 Nov 2022, 13:37 (4 years ago) parent1aec4f6

9 files changed+164−6

compare with main

unifiedsplit

README.md+16 src/Record/Studio/MapUniform.purs+47 src/Record/Studio/SameKeys.purs−1 src/Record/Studio/Sequence.purs−1 src/Record/Studio/SingletonRecord.purs+54 test/MapRecordSpec.purs+1−2 test/MapUniformRecordSpec.purs+22 test/SequenceSpec.purs+1−2 test/SingletonRecordSpec.purs+23

README.md+16

@@ -94,6 +94,14 @@ let

9494(sequenceRecord input) `shouldEqual` expected

9595```

9696

97+### `mapUniformRecord`

98+

99+Recursively map a function over a record where all entries have the same value.

100+This is often better at type inference than `mapRecord`

101+```purescript

102+ (mapUniformRecord (_ + 1) { a: 1, b: 2 }) `shouldEqual` { a: 2, b: 3}

103+```

104+

97105### `mapRecord`

98106

99107Recursively map a function over a record.

@@ -163,6 +171,14 @@ Recursively map a natural transformation over a record.

163171(mapRecordKind nt input) `shouldEqual` expected

164172```

165173

174+### `key`

175+

176+Get the only field name of a Record with one field as a `Proxy`

177+

178+```purescript

179+SingletonRecord.key { foo: unit } `shouldEqual` (Proxy :: Proxy "foo")

180+```

181+

166182## Licence

167183This is a fork of [heterogeneous-extrablatt](https://github.com/sigma-andex/purescript-heterogeneous-extrablatt), which is licenced under MIT. See the [original licence](./LICENCES/heterogeneous-extrablatt.LICENCE). This work is similarly licenced under [MIT](./LICENCE).

168184It includes part of [`purescript-record-extra`](https://github.com/justinwoo/purescript-record-extra) as an inline dependency, which is licenced under MIT, see [original licence](./LICENCES/record-extra.LICENCE).

src/Record/Studio/MapUniform.pursnew file+47

@@ -0,0 +1,47 @@

1+module Record.Studio.MapUniform where

3+import Prelude

5+import Data.Symbol (class IsSymbol)

6+import Prim.Row as Row

7+import Prim.RowList (class RowToList, RowList)

8+import Prim.RowList as RL

9+import Record as R

10+import Record.Builder (Builder)

11+import Record.Builder as Builder

12+import Type.Proxy (Proxy(..))

13+

14+mapUniformRecord

15+ :: forall row xs a b row'

16+ . RowToList row xs

17+ => MapUniformRecord xs row a b () row'

18+ => (a -> b)

19+ -> Record row

20+ -> Record row'

21+mapUniformRecord fn = Builder.buildFromScratch

22+ <<< mapUniformRecordBuilder (Proxy :: Proxy xs) fn

23+

24+class

25+ MapUniformRecord (xs :: RowList Type) (row :: Row Type) a b (from :: Row Type) (to :: Row Type)

26+ | xs -> row a b from to where

27+ mapUniformRecordBuilder :: Proxy xs -> (a -> b) -> Record row -> Builder { | from } { | to }

28+

29+-- Start the recursion

30+instance MapUniformRecord RL.Nil row a b () () where

31+ mapUniformRecordBuilder _ _ _ = identity

32+

33+instance

34+ ( IsSymbol name

35+ , Row.Cons name a rest row

36+ , Row.Lacks name from'

37+ , Row.Cons name b from' to

38+ , MapUniformRecord tail row a b from from'

39+ ) =>

40+ MapUniformRecord (RL.Cons name a tail) row a b from to where

41+ mapUniformRecordBuilder _ fn r = first <<< rest

42+ where

43+ first = Builder.insert nameP value

44+ rest = mapUniformRecordBuilder tailP fn r

45+ value = fn (R.get nameP r)

46+ nameP = Proxy :: Proxy name

47+ tailP = Proxy :: Proxy tail

src/Record/Studio/SameKeys.purs−1

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

11module Record.Studio.SameKeys (class SameKeys, class SameKeysRL) where

3−

43import Data.Symbol (class IsSymbol)

54import Prim.Row (class Lacks)

65import Prim.RowList (class RowToList)

src/Record/Studio/Sequence.purs−1

@@ -2,7 +2,6 @@ module Record.Studio.Sequence where

33import Prelude

5−import Prelude

65import Data.Symbol (class IsSymbol)

76import Heterogeneous.Folding (class FoldingWithIndex, class FoldlRecord, class HFoldlWithIndex, hfoldlWithIndex)

87import Prim.Row as Row

src/Record/Studio/SingletonRecord.pursnew file+54

@@ -0,0 +1,54 @@

1+module Record.Studio.SingletonRecord where

3+import Prelude

5+import Data.Symbol (class IsSymbol)

6+import Prim.Row as Row

7+import Prim.RowList (class RowToList)

8+import Prim.RowList as RL

9+import Prim.TypeError (class Fail, Text)

10+import Type.Proxy (Proxy(..))

11+import Unsafe.Coerce (unsafeCoerce)

12+

13+class SingletonRecord :: forall k1 k2 k3. k1 -> k2 -> Row Type -> k3 -> Constraint

14+class SingletonRecord key value rec recRL | rec -> key value recRL where

15+ -- | Get the key of a record with only one field as a `Proxy`

16+ key :: Record rec -> Proxy key

17+

18+instance

19+ ( RowToList rec recRL

20+ , SingletonRecordFields key a rec recRL

21+ ) =>

22+ SingletonRecord key a rec (RL.Cons key a RL.Nil) where

23+ key = singletonRecordFields (Proxy :: Proxy recRL)

24+else instance (Fail (Text "The record must have exactly one field")) => SingletonRecord key a rec recRL where

25+ key _ = unsafeCoerce unit

26+

27+class SingletonRecordFields :: forall k1 k2. k1 -> Type -> Row Type -> k2 -> Constraint

28+class

29+ SingletonRecordFields key value rec recRL

30+ | rec -> key value

31+ where

32+ singletonRecordFields :: Proxy recRL -> { | rec } -> Proxy key

33+

34+instance

35+ ( RowToList rec (RL.Cons key a RL.Nil)

36+ , Row.Cons key a () rec

37+ , IsSymbol key

38+ ) =>

39+ SingletonRecordFields key a rec (RL.Cons key a RL.Nil) where

40+ singletonRecordFields _ _ = (Proxy :: Proxy key)

41+

42+instance

43+ ( Fail ErrorMsg

44+ ) =>

45+ SingletonRecordFields key a rec RL.Nil where

46+ singletonRecordFields _ _ = unsafeCoerce unit

47+

48+else instance

49+ ( Fail ErrorMsg

50+ ) =>

51+ SingletonRecordFields key a rec (RL.Cons key a (RL.Cons key1 a1 rl)) where

52+ singletonRecordFields _ _ = unsafeCoerce unit

53+

54+type ErrorMsg = (Text "The record provided to `key` must have exactly one field")

test/MapRecordSpec.purs+1−2

@@ -2,9 +2,8 @@ module MapRecordSpec where

33import Prelude

5−import Data.Either (Either(..), hush)

65import Data.Maybe (Maybe(..))

7−import Record.Studio (mapRecord, mapRecordKind, sequenceRecord)

6+import Record.Studio (mapRecord)

87import Test.Spec (Spec, describe, it)

98import Test.Spec.Assertions (shouldEqual)

109

test/MapUniformRecordSpec.pursnew file+22

@@ -0,0 +1,22 @@

1+module MapUniformRecordSpec where

3+import Prelude

5+import Record.Studio.MapUniform (mapUniformRecord)

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

7+import Test.Spec.Assertions (shouldEqual)

9+spec :: Spec Unit

10+spec =

11+ describe "mapUniformRecord" do

12+ it "should map a function over a uniform record" do

13+ let

14+ input = { a: 10, b: 12 }

15+

16+ f = (_ + 4)

17+

18+ expected =

19+ { a: 14

20+ , b: 16

21+ }

22+ (mapUniformRecord f input) `shouldEqual` expected

test/SequenceSpec.purs+1−2

@@ -2,9 +2,8 @@ module SequenceRecordSpec where

33import Prelude

5−import Data.Either (Either(..), hush)

65import Data.Maybe (Maybe(..))

7−import Record.Studio (mapRecord, mapRecordKind, sequenceRecord)

6+import Record.Studio (sequenceRecord)

87import Test.Spec (Spec, describe, it)

98import Test.Spec.Assertions (shouldEqual)

109

test/SingletonRecordSpec.pursnew file+23

@@ -0,0 +1,23 @@

1+module SingletonRecordSpec where

3+import Prelude

5+import Record.Studio.SingletonRecord (key)

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

7+import Test.Spec.Assertions (shouldEqual)

8+import Type.Proxy (Proxy(..))

10+spec :: Spec Unit

11+spec =

12+ describe "key" do

13+ it "should get the only key of a singleton record as a `Proxy`" do

14+ let

15+ input = { a: 10 }

16+

17+ -- inputFails1 = key {}

18+ -- ^ The record provided to `key` must have exactly one field

19+ -- inputFails2 = key { a: 10, b: "a" }

20+ -- ^ The record provided to `key` must have exactly one field

21+ expected = Proxy :: Proxy "a"

22+

23+ (key input) `shouldEqual` expected