├── src └── Record │ ├── Studio │ ├── SingletonRecord.js │ ├── Shrink.js │ ├── Shrink.purs │ ├── Merge.purs │ ├── Keys.purs │ ├── MapUniform.purs │ ├── SameKeys.purs │ ├── SequenceUniform.purs │ ├── SingletonRecord.purs │ ├── Map.purs │ ├── Sequence.purs │ └── MapKind.purs │ └── Studio.purs ├── .gitignore ├── packages.dhall ├── spago.dhall ├── test ├── Main.purs ├── KeysSpec.purs ├── MapUniformRecordSpec.purs ├── SequenceUniformRecordSpec.purs ├── SingletonRecordSpec.purs ├── MergeFlippedSpec.purs ├── ShrinkSpec.purs ├── SameKeysSpec.purs ├── MapRecordSpec.purs ├── MapRecordKindSpec.purs └── SequenceSpec.purs ├── package.json ├── test.dhall ├── bower.json ├── LICENCE ├── LICENCES ├── heterogeneous-extrablatt.LICENCE └── record-extra.LICENCE ├── .github └── workflows │ └── ci.yml └── README.md /src/Record/Studio/SingletonRecord.js: -------------------------------------------------------------------------------- 1 | 2 | export const unsafeGetFirstField = rec => Object.values(rec)[0] 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago 11 | -------------------------------------------------------------------------------- /src/Record/Studio/Shrink.js: -------------------------------------------------------------------------------- 1 | export const shrinkImpl = keys => record => { 2 | return keys.reduce((acc, key) => { 3 | acc[key] = record[key]; 4 | return acc; 5 | }, {}); 6 | } 7 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220513/packages.dhall sha256:1ed784f37ae6131d99acd542d058d5ce39954ccaacc3adba5cc7cf1549d2bffa 3 | 4 | in upstream 5 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "record-studio" 2 | , dependencies = 3 | [ "heterogeneous" 4 | , "lists" 5 | , "prelude" 6 | , "record" 7 | , "typelevel-prelude" 8 | , "unsafe-coerce" 9 | ] 10 | , packages = ./packages.dhall 11 | , sources = [ "src/**/*.purs" ] 12 | , license = "MIT-0" 13 | , repository = "https://github.com/rowtype-yoga/purescript-record-studio.git" 14 | } 15 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Test.Spec.Discovery (discover) 8 | import Test.Spec.Reporter.Console (consoleReporter) 9 | import Test.Spec.Runner (runSpec) 10 | 11 | main :: Effect Unit 12 | main = launchAff_ $ discover pattern >>= runSpec [ consoleReporter ] 13 | where 14 | pattern = ".*Spec" 15 | -------------------------------------------------------------------------------- /src/Record/Studio/Shrink.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.Shrink (shrink) where 2 | 3 | import Prim.Row (class Union) 4 | import Record.Studio.Keys (class Keys, keys) 5 | import Type.Proxy (Proxy(..)) 6 | 7 | foreign import shrinkImpl :: forall r1 r2. Array String -> Record r1 -> Record r2 8 | 9 | shrink :: forall a b r. Union b r a => Keys b => { | a } -> { | b } 10 | shrink = shrinkImpl (keys (Proxy :: Proxy b)) 11 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "record-studio", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "index.js", 6 | "scripts": { 7 | "test": "echo \"Error: no test specified\" && exit 1" 8 | }, 9 | "keywords": [], 10 | "author": "", 11 | "license": "MIT-0", 12 | "devDependencies": { 13 | "purescript": "^0.14.0", 14 | "purty": "^7.0.0", 15 | "spago": "^0.19.1" 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /test.dhall: -------------------------------------------------------------------------------- 1 | let conf = ./spago.dhall 2 | 3 | in conf 4 | // { sources = conf.sources # [ "test/**/*.purs" ] 5 | , dependencies = 6 | conf.dependencies 7 | # [ "aff" 8 | , "effect" 9 | , "spec" 10 | , "spec-discovery" 11 | , "either" 12 | , "maybe" 13 | , "foreign-object" 14 | , "unsafe-coerce" 15 | ] 16 | } 17 | -------------------------------------------------------------------------------- /test/KeysSpec.purs: -------------------------------------------------------------------------------- 1 | module KeysSpec where 2 | 3 | import Prelude 4 | 5 | import Record.Studio (recordKeys) 6 | import Test.Spec (Spec, describe, it) 7 | import Test.Spec.Assertions (shouldEqual) 8 | 9 | spec :: Spec Unit 10 | spec = 11 | describe "keys" do 12 | it "gets the keys of {}" do 13 | recordKeys {} `shouldEqual` [] 14 | it "gets the keys of { a :: String }" do 15 | recordKeys { a: "" } `shouldEqual` [ "a" ] 16 | it "gets the keys of { a :: String, b :: Int }" do 17 | recordKeys { a: "", b: 1 } `shouldEqual` [ "a", "b" ] 18 | -------------------------------------------------------------------------------- /test/MapUniformRecordSpec.purs: -------------------------------------------------------------------------------- 1 | module MapUniformRecordSpec where 2 | 3 | import Prelude 4 | 5 | import Record.Studio.MapUniform (mapUniformRecord) 6 | import Test.Spec (Spec, describe, it) 7 | import Test.Spec.Assertions (shouldEqual) 8 | 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 23 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-record-studio", 3 | "license": [ 4 | "MIT-0" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/rowtype-yoga/purescript-record-studio.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-heterogeneous": "^v0.6.0", 18 | "purescript-lists": "^v7.0.0", 19 | "purescript-prelude": "^v6.0.0", 20 | "purescript-record": "^v4.0.0", 21 | "purescript-typelevel-prelude": "^v7.0.0" 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /test/SequenceUniformRecordSpec.purs: -------------------------------------------------------------------------------- 1 | module SequenceUniformRecordSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Record.Studio.SequenceUniform (sequenceUniformRecord) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Spec.Assertions (shouldEqual) 9 | 10 | spec :: Spec Unit 11 | spec = 12 | describe "sequenceUniformRecord" do 13 | it "should sequence an homogeneous record" do 14 | let input = { a: Just 4, b: Nothing :: Maybe String } 15 | sequenceUniformRecord input `shouldEqual` Nothing 16 | it "should sequence another homogeneous record" do 17 | let input = { a: Just 4, b: Just "a" } 18 | sequenceUniformRecord input `shouldEqual` (Just { a: 4, b: "a" }) 19 | -------------------------------------------------------------------------------- /test/SingletonRecordSpec.purs: -------------------------------------------------------------------------------- 1 | module SingletonRecordSpec where 2 | 3 | import Prelude 4 | 5 | import Record.Studio.SingletonRecord (key, value) 6 | import Test.Spec (Spec, describe, it) 7 | import Test.Spec.Assertions (shouldEqual) 8 | import Type.Proxy (Proxy(..)) 9 | 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 | -- | These should fail to compile with a helpful message 18 | -- inputFails1 = key {} 19 | -- inputFails2 = key { a: 10, b: "a" } 20 | -- inputFails3 = value {} 21 | -- inputFails4 = value { a: 10, b: "a" } 22 | 23 | (key input) `shouldEqual` (Proxy :: Proxy "a") 24 | (value input) `shouldEqual` 10 25 | -------------------------------------------------------------------------------- /src/Record/Studio/Merge.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.Merge where 2 | 3 | import Prelude 4 | 5 | import Prim.Row (class Nub, class Union) 6 | import Record (merge) 7 | 8 | -- | Like `merge` but with its arguments flipped. I.e. merges two records with the seconds record's labels taking precedence in the 9 | -- | case of overlaps. 10 | -- | 11 | -- | For example: 12 | -- | 13 | -- | ```purescript 14 | -- | mergeFlipped { x: 1, y: "y" } { y: 2, z: true } 15 | -- | = { x: 1, y: 2, z: true } 16 | -- | ``` 17 | mergeFlipped 18 | :: forall r1 r2 r3 r4 19 | . Union r1 r2 r3 20 | => Nub r3 r4 21 | => Record r2 22 | -> Record r1 23 | -> Record r4 24 | mergeFlipped = flip merge 25 | 26 | -- | `record1 // record2` is equivalent to JS's 27 | -- | `{ ...record1, ...record2 }` 28 | infixr 1 mergeFlipped as // 29 | -------------------------------------------------------------------------------- /test/MergeFlippedSpec.purs: -------------------------------------------------------------------------------- 1 | module MergeFlippedSpec where 2 | 3 | import Prelude 4 | 5 | import Record.Studio ((//)) 6 | import Test.Spec (Spec, describe, it) 7 | import Test.Spec.Assertions (shouldEqual) 8 | 9 | spec :: Spec Unit 10 | spec = 11 | describe "Record Operations" do 12 | describe "mergeFlipped (//)" do 13 | it "should merge disjoint records" do 14 | ({ a: 1, b: 2 } // { c: 3 }) `shouldEqual` { a: 1, b: 2, c: 3 } 15 | it "should prioritise the right-hand-side" do 16 | ({ a: 1, b: 2 } // { b: 3 }) `shouldEqual` { a: 1, b: 3 } 17 | it "should prioritise the right-hand-side type" do 18 | ({ a: 1, b: 2 } // { b: "a" }) `shouldEqual` { a: 1, b: "a" } 19 | it "should work with larger records" do 20 | ({ a: 1, b: 2 } // { c: 3, d: 4 }) `shouldEqual` { a: 1, b: 2, c: 3, d: 4 } 21 | -------------------------------------------------------------------------------- /test/ShrinkSpec.purs: -------------------------------------------------------------------------------- 1 | module ShrinkSpec where 2 | 3 | import Prelude 4 | 5 | import Foreign.Object as Object 6 | import Record.Studio (shrink) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Spec.Assertions (shouldEqual) 9 | import Unsafe.Coerce (unsafeCoerce) 10 | 11 | spec :: Spec Unit 12 | spec = 13 | describe "shrink" do 14 | it "shrinks down records all the way" do 15 | shrink { a: 1, b: 2, c: "c" } `shouldEqual` {} 16 | it "shrinks down records a bit" do 17 | shrink { a: 1, b: 2, c: 3, d: 4 } `shouldEqual` { a: 1, b: 2, c: 3 } 18 | it "shrinks to the correct runtime representation" do 19 | let 20 | shrunk :: { c :: Int, e :: Int } 21 | shrunk = shrink { a: 1, b: 2, c: 3, d: 4, e: 5 } 22 | unsafeCoerce shrunk `shouldEqual` Object.fromHomogeneous { c: 3, e: 5 } 23 | it "shrinks heterogeneous records" do 24 | shrink { a: "a", b: { e: 4 }, c: false } `shouldEqual` { c: false } 25 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | MIT No Attribution 2 | 3 | Copyright 2022 Jan Schulte 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this 6 | software and associated documentation files (the "Software"), to deal in the Software 7 | without restriction, including without limitation the rights to use, copy, modify, 8 | merge, publish, distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so. 10 | 11 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 12 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 13 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 14 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 15 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 16 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 17 | -------------------------------------------------------------------------------- /src/Record/Studio.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio 2 | ( module Record.Studio.Sequence 3 | , module Record.Studio.Map 4 | , module Record.Studio.MapKind 5 | , module Record.Studio.MapUniform 6 | , module Record.Studio.Merge 7 | , module Record.Studio.Keys 8 | , module Record.Studio.Shrink 9 | , module Record.Studio.SameKeys 10 | , module Record.Studio.SingletonRecord 11 | ) where 12 | 13 | import Record.Studio.Sequence (SequenceRecord(..), sequenceRecord) 14 | import Record.Studio.Map (MapRecord(..), mapRecord) 15 | import Record.Studio.MapKind (MapRecordKind(..), mapRecordKind) 16 | import Record.Studio.MapUniform (class MapUniformRecord, mapUniformRecord, mapUniformRecordBuilder) 17 | import Record.Studio.Keys (class Keys, keys, recordKeys) 18 | import Record.Studio.Shrink (shrink) 19 | import Record.Studio.Merge (mergeFlipped, (//)) 20 | import Record.Studio.SameKeys (class SameKeys) 21 | import Record.Studio.SingletonRecord (class SingletonRecord, key, value) 22 | -------------------------------------------------------------------------------- /LICENCES/heterogeneous-extrablatt.LICENCE: -------------------------------------------------------------------------------- 1 | MIT No Attribution 2 | 3 | Copyright 2021 Jan Schulte 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this 6 | software and associated documentation files (the "Software"), to deal in the Software 7 | without restriction, including without limitation the rights to use, copy, modify, 8 | merge, publish, distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so. 10 | 11 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 12 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 13 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 14 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 15 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 16 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 17 | -------------------------------------------------------------------------------- /test/SameKeysSpec.purs: -------------------------------------------------------------------------------- 1 | module SameKeysSpec where 2 | 3 | import Prelude 4 | 5 | import Record.Studio.SameKeys (class SameKeys) 6 | import Test.Spec (Spec, describe, it) 7 | 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 29 | -------------------------------------------------------------------------------- /src/Record/Studio/Keys.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.Keys (class Keys, keys, class KeysRL, keysImpl, recordKeys) where 2 | 3 | import Prelude 4 | 5 | import Data.List (List, (:)) 6 | import Data.List as List 7 | import Data.Symbol (class IsSymbol, reflectSymbol) 8 | import Prim.RowList as RL 9 | import Type.Proxy (Proxy(..)) 10 | 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 18 | keysImpl :: Proxy xs -> List String 19 | 20 | instance KeysRL RL.Nil where 21 | keysImpl _ = mempty 22 | 23 | instance (IsSymbol name, KeysRL tail) => KeysRL (RL.Cons name ty tail) where 24 | keysImpl _ = first : rest 25 | where 26 | first = reflectSymbol (Proxy :: _ name) 27 | rest = keysImpl (Proxy :: _ tail) 28 | 29 | recordKeys :: forall r. Keys r => { | r } -> Array String 30 | recordKeys _ = keys (Proxy :: _ r) 31 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | 17 | - name: Cache PureScript dependencies 18 | uses: actions/cache@v2 19 | # This cache uses the .dhall files to know when it should reinstall 20 | # and rebuild packages. It caches both the installed packages from 21 | # the `.spago` directory and compilation artifacts from the `output` 22 | # directory. When restored the compiler will rebuild any files that 23 | # have changed. If you do not want to cache compiled output, remove 24 | # the `output` path. 25 | with: 26 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 27 | path: | 28 | .spago 29 | output 30 | 31 | - run: spago build 32 | 33 | - run: spago -x test.dhall test 34 | -------------------------------------------------------------------------------- /LICENCES/record-extra.LICENCE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Justin Woo, Adam Saleh 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /test/MapRecordSpec.purs: -------------------------------------------------------------------------------- 1 | module MapRecordSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Record.Studio (mapRecord) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Spec.Assertions (shouldEqual) 9 | 10 | type MapInput = { a :: Int, b :: String, c :: { d :: Maybe String, e :: Int, f :: { g :: Boolean, h :: Int } }, i :: Int } 11 | 12 | type MapOutput = { a :: String, b :: String, c :: { d :: Maybe String, e :: String, f :: { g :: Boolean, h :: String } }, i :: String } 13 | 14 | spec :: Spec Unit 15 | spec = 16 | describe "mapRecord" do 17 | it "should recursively map a function over a record" do 18 | let 19 | input :: MapInput 20 | input = 21 | { a: 10 22 | , b: "hello" 23 | , c: 24 | { d: Just "world" 25 | , e: 20 26 | , f: { g: true, h: 30 } 27 | } 28 | , i: 40 29 | } 30 | 31 | f :: Int -> String 32 | f i = show (i + 1) 33 | 34 | expected :: MapOutput 35 | expected = 36 | { a: "11" 37 | , b: "hello" 38 | , c: 39 | { d: Just "world" 40 | , e: "21" 41 | , f: { g: true, h: "31" } 42 | } 43 | , i: "41" 44 | } 45 | (mapRecord f input) `shouldEqual` expected 46 | -------------------------------------------------------------------------------- /test/MapRecordKindSpec.purs: -------------------------------------------------------------------------------- 1 | module MapRecordKindSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..), hush) 6 | import Data.Maybe (Maybe(..)) 7 | import Record.Studio (mapRecordKind) 8 | import Test.Spec (Spec, describe, it) 9 | import Test.Spec.Assertions (shouldEqual) 10 | 11 | type MapKindInput = { a :: Either String Int, b :: String, c :: { d :: Either String String, e :: Int, f :: { g :: Either String Boolean, h :: Either String Int } }, i :: Maybe Int } 12 | 13 | type MapKindOutput = { a :: Maybe Int, b :: String, c :: { d :: Maybe String, e :: Int, f :: { g :: Maybe Boolean, h :: Maybe Int } }, i :: Maybe Int } 14 | 15 | spec :: Spec Unit 16 | spec = 17 | describe "mapRecordKind" do 18 | it "should recursively a natural transformation over a record" do 19 | let 20 | input :: MapKindInput 21 | input = 22 | { a: Right 10 23 | , b: "hello" 24 | , c: 25 | { d: Left "world" 26 | , e: 20 27 | , f: { g: Right true, h: Left "broken" } 28 | } 29 | , i: Just 40 30 | } 31 | 32 | nt :: Either String ~> Maybe 33 | nt = hush 34 | 35 | expected :: MapKindOutput 36 | expected = 37 | { a: Just 10 38 | , b: "hello" 39 | , c: 40 | { d: Nothing 41 | , e: 20 42 | , f: { g: Just true, h: Nothing } 43 | } 44 | , i: Just 40 45 | } 46 | (mapRecordKind nt input) `shouldEqual` expected 47 | -------------------------------------------------------------------------------- /src/Record/Studio/MapUniform.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.MapUniform where 2 | 3 | import Prelude 4 | 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 48 | -------------------------------------------------------------------------------- /src/Record/Studio/SameKeys.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.SameKeys (class SameKeys, class SameKeysRL) where 2 | 3 | import Data.Symbol (class IsSymbol) 4 | import Prim.Row (class Lacks) 5 | import Prim.RowList (class RowToList) 6 | import Prim.RowList as RL 7 | import Prim.TypeError (class Fail, Beside, Quote, Text) 8 | import Type.RowList (class ListToRow) 9 | 10 | class SameKeys (r1 :: Row Type) (r2 :: Row Type) 11 | 12 | instance (RowToList r1 rl1, RowToList r2 rl2, SameKeysRL rl1 rl2) => SameKeys r1 r2 13 | 14 | class SameKeysRL (xs :: RL.RowList Type) (ys :: RL.RowList Type) 15 | 16 | instance SameKeysRL RL.Nil RL.Nil 17 | instance 18 | ( IsSymbol name 19 | , SameKeysRL tail1 tail2 20 | ) => 21 | SameKeysRL (RL.Cons name ty1 tail1) (RL.Cons name ty2 tail2) 22 | else instance 23 | ( ListToRow RL.Nil r 24 | , Fail (Beside (Text "The key ") (Beside (Quote name) (Text " is missing from the second record"))) 25 | ) => 26 | SameKeysRL (RL.Cons name ty tail) RL.Nil 27 | else instance 28 | ( ListToRow RL.Nil r 29 | , Fail (Beside (Text "The key ") (Beside (Quote name) (Text " is missing from the first record"))) 30 | ) => 31 | SameKeysRL RL.Nil (RL.Cons name ty tail) 32 | else instance 33 | ( ListToRow (RL.Cons name2 ty1 tail1) r 34 | , Lacks name1 r 35 | , Fail (Beside (Text "The key ") (Beside (Quote name1) (Text " is missing from the second record"))) 36 | ) => 37 | SameKeysRL (RL.Cons name1 ty1 tail1) (RL.Cons name2 ty2 tail2) 38 | else instance 39 | ( ListToRow (RL.Cons name1 ty1 tail1) r 40 | , Lacks name2 r 41 | , Fail (Beside (Text "The key ") (Beside (Quote name2) (Text " is missing from the first record"))) 42 | ) => 43 | SameKeysRL (RL.Cons name1 ty1 tail1) (RL.Cons name2 ty2 tail2) 44 | -------------------------------------------------------------------------------- /test/SequenceSpec.purs: -------------------------------------------------------------------------------- 1 | module SequenceRecordSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Record.Studio (sequenceRecord) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Spec.Assertions (shouldEqual) 9 | 10 | type SequenceInput = { a :: Maybe Int, b :: String, c :: { d :: Maybe String, e :: Boolean, f :: { g :: Maybe Boolean } }, h :: Int } 11 | 12 | type SequenceOutput = { a :: Int, b :: String, c :: { d :: String, e :: Boolean, f :: { g :: Boolean } }, h :: Int } 13 | 14 | spec :: Spec Unit 15 | spec = 16 | describe "sequenceRecord" do 17 | it "should recursively sequence a valid record" do 18 | let 19 | input :: SequenceInput 20 | input = 21 | { a: Just 10 22 | , b: "hello" 23 | , c: 24 | { d: Just "world" 25 | , e: true 26 | , f: { g: Just true } 27 | } 28 | , h: 10 29 | } 30 | 31 | expected :: Maybe SequenceOutput 32 | expected = Just 33 | { a: 10 34 | , b: "hello" 35 | , c: 36 | { d: "world" 37 | , e: true 38 | , f: { g: true } 39 | } 40 | , h: 10 41 | } 42 | (sequenceRecord input) `shouldEqual` expected 43 | it "should recursively sequence an invalid record" do 44 | let 45 | input :: SequenceInput 46 | input = 47 | { a: Just 10 48 | , b: "hello" 49 | , c: 50 | { d: Just "world" 51 | , e: true 52 | , f: { g: Nothing } 53 | } 54 | , h: 10 55 | } 56 | 57 | expected :: Maybe SequenceOutput 58 | expected = Nothing 59 | (sequenceRecord input) `shouldEqual` expected 60 | -------------------------------------------------------------------------------- /src/Record/Studio/SequenceUniform.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.SequenceUniform where 2 | 3 | import Prelude 4 | 5 | import Data.Symbol (class IsSymbol) 6 | import Prim.Row as Row 7 | import Prim.RowList as RL 8 | import Record as R 9 | import Record.Builder (Builder) 10 | import Record.Builder as Builder 11 | import Type.Proxy (Proxy(..)) 12 | 13 | sequenceUniformRecord 14 | :: forall row row' rl m 15 | . RL.RowToList row rl 16 | => SequenceUniformRecord rl row () row' m 17 | => Record row 18 | -> m (Record row') 19 | sequenceUniformRecord a = Builder.build <@> {} <$> builder 20 | where 21 | builder = sequenceUniformRecordImpl (Proxy :: _ rl) a 22 | 23 | class 24 | Functor m <= 25 | SequenceUniformRecord (rl :: RL.RowList Type) row from to m 26 | | rl -> row from to m 27 | where 28 | sequenceUniformRecordImpl :: Proxy rl -> Record row -> m (Builder { | from } { | to }) 29 | 30 | instance 31 | ( IsSymbol name 32 | , Row.Cons name (m ty) trash row 33 | , Functor m 34 | , Row.Lacks name () 35 | , Row.Cons name ty () to 36 | ) => 37 | SequenceUniformRecord (RL.Cons name (m ty) RL.Nil) row () to m where 38 | sequenceUniformRecordImpl _ a = 39 | Builder.insert namep <$> valA 40 | where 41 | namep = Proxy :: _ name 42 | valA = R.get namep a 43 | 44 | else instance 45 | ( IsSymbol name 46 | , Row.Cons name (m ty) trash row 47 | , Apply m 48 | , SequenceUniformRecord tail row from from' m 49 | , Row.Lacks name from' 50 | , Row.Cons name ty from' to 51 | ) => 52 | SequenceUniformRecord (RL.Cons name (m ty) tail) row from to m where 53 | sequenceUniformRecordImpl _ a = 54 | fn <$> valA <*> rest 55 | where 56 | namep = Proxy :: _ name 57 | valA = R.get namep a 58 | tailp = Proxy :: _ tail 59 | rest = sequenceUniformRecordImpl tailp a 60 | fn valA' rest' = Builder.insert namep valA' <<< rest' 61 | 62 | instance Applicative m => SequenceUniformRecord RL.Nil row () () m where 63 | sequenceUniformRecordImpl _ _ = pure identity 64 | -------------------------------------------------------------------------------- /src/Record/Studio/SingletonRecord.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.SingletonRecord 2 | ( class SingletonRecord 3 | , class SingletonRecordFields 4 | , key 5 | , value 6 | , singletonRecordFields 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Data.Symbol (class IsSymbol) 12 | import Prim.Row as Row 13 | import Prim.RowList (class RowToList) 14 | import Prim.RowList as RL 15 | import Prim.TypeError (class Fail, Beside, Quote, QuoteLabel, Text) 16 | import Type.Proxy (Proxy(..)) 17 | import Unsafe.Coerce (unsafeCoerce) 18 | 19 | class SingletonRecord :: forall k1 k2. k1 -> Type -> Row Type -> k2 -> Constraint 20 | class SingletonRecord key value rec recRL | rec -> key value recRL where 21 | -- | Get the key of a record with only one field as a `Proxy` 22 | key :: Record rec -> Proxy key 23 | value :: Record rec -> value 24 | 25 | foreign import unsafeGetFirstField :: forall r a. { | r } -> a 26 | 27 | instance 28 | ( RowToList rec recRL 29 | , SingletonRecordFields key a rec recRL 30 | ) => 31 | SingletonRecord key a rec rl where 32 | key = singletonRecordFields (Proxy :: Proxy recRL) 33 | value = unsafeGetFirstField 34 | else instance (Fail (Text "The record must have exactly one field")) => SingletonRecord key a rec recRL where 35 | key _ = unsafeCoerce unit 36 | value _ = unsafeCoerce unit 37 | 38 | class SingletonRecordFields :: forall k1 k2. k1 -> Type -> Row Type -> k2 -> Constraint 39 | class 40 | SingletonRecordFields key value rec recRL 41 | | rec -> key value 42 | where 43 | singletonRecordFields :: Proxy recRL -> { | rec } -> Proxy key 44 | 45 | instance 46 | ( RowToList rec (RL.Cons key a RL.Nil) 47 | , Row.Cons key a () rec 48 | , IsSymbol key 49 | ) => 50 | SingletonRecordFields key a rec (RL.Cons key a RL.Nil) where 51 | singletonRecordFields _ _ = (Proxy :: Proxy key) 52 | 53 | instance 54 | ( Fail (Beside ErrorMsg (Text "instead of {}")) 55 | ) => 56 | SingletonRecordFields key a rec RL.Nil where 57 | singletonRecordFields _ _ = unsafeCoerce unit 58 | 59 | else instance 60 | ( Fail 61 | ( ErrorMsg 62 | ++ ButReceivedStart 63 | ++ (QuoteLabel key ++ DblCol ++ Quote a) 64 | ++ Comma 65 | ++ (QuoteLabel key1 ++ DblCol ++ Quote a1) 66 | ++ ButReceivedEnd 67 | ) 68 | ) => 69 | SingletonRecordFields key a rec (RL.Cons key a (RL.Cons key1 a1 rl)) where 70 | singletonRecordFields _ _ = unsafeCoerce unit 71 | 72 | type ErrorMsg = (Text "Must provide a record with exactly one field ") 73 | type ButReceivedStart = (Text "instead of { ") 74 | type ButReceivedEnd = (Text ", ... }") 75 | type DblCol = (Text " :: ") 76 | type Comma = (Text ", ") 77 | 78 | infixl 3 type Beside as ++ 79 | -------------------------------------------------------------------------------- /src/Record/Studio/Map.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.Map where 2 | 3 | import Prelude 4 | import Data.Symbol (class IsSymbol) 5 | import Heterogeneous.Folding (class FoldingWithIndex, class FoldlRecord, class HFoldlWithIndex, hfoldlWithIndex) 6 | import Prim.Row as Row 7 | import Prim.RowList (class RowToList) 8 | import Record.Builder (Builder) 9 | import Record.Builder as Builder 10 | import Type.Proxy (Proxy) 11 | 12 | -- Helper for type inference 13 | data MapRecord a b = MapRecord (a -> b) 14 | 15 | -- Matches if the type of the current field in the record is a and therefore needs to be mapped. 16 | instance 17 | ( IsSymbol sym 18 | , Row.Lacks sym rb 19 | , Row.Cons sym b rb rc 20 | ) => 21 | FoldingWithIndex 22 | (MapRecord a b) 23 | (Proxy sym) 24 | (Builder { | ra } { | rb }) 25 | a 26 | (Builder { | ra } { | rc }) where 27 | foldingWithIndex (MapRecord f) prop rin a = (rin >>> Builder.insert prop (f a)) 28 | 29 | -- Matches if the type of the current field in the record is another record and therefore needs to be recursed. 30 | else instance 31 | ( IsSymbol sym 32 | , Row.Lacks sym rb 33 | , RowToList x xRL 34 | , Row.Cons sym { | y } rb rc 35 | , FoldlRecord 36 | (MapRecord a b) 37 | (Builder (Record ()) (Record ())) 38 | xRL 39 | x 40 | (Builder (Record ()) (Record y)) 41 | ) => 42 | FoldingWithIndex 43 | (MapRecord a b) 44 | (Proxy sym) 45 | (Builder { | ra } { | rb }) 46 | { | x } 47 | (Builder { | ra } { | rc }) where 48 | foldingWithIndex (MapRecord f) prop rin x = (rin >>> Builder.insert prop fx) 49 | where 50 | fx = mapRecord f x 51 | 52 | -- Matches if the type of the current field in the record is any other type independent of mapping. 53 | else instance 54 | ( IsSymbol sym 55 | , Row.Lacks sym rb 56 | , Row.Cons sym x rb rc 57 | ) => 58 | FoldingWithIndex 59 | (MapRecord a b) 60 | (Proxy sym) 61 | (Builder { | ra } { | rb }) 62 | x 63 | (Builder { | ra } { | rc }) where 64 | foldingWithIndex _ prop rin x = (rin >>> Builder.insert prop x) 65 | 66 | -- | Recursively maps a record using a function f. 67 | -- | ```purescript 68 | -- | let 69 | -- | f :: Int -> String 70 | -- | f i = show (i + 1) 71 | -- | mapRecord f { a : { b : 10, c : { d: 20, e : Just "hello" }}, f : 30 } 72 | -- | -- { a : { b : "11", c : { d: "21", e : Just "hello" }, f : "31" } 73 | -- | ``` 74 | mapRecord 75 | :: forall a b rin rout 76 | . HFoldlWithIndex (MapRecord a b) (Builder {} {}) { | rin } (Builder {} { | rout }) 77 | => (a -> b) 78 | -> { | rin } 79 | -> { | rout } 80 | mapRecord f = 81 | (flip Builder.build {}) 82 | <<< hfoldlWithIndex (MapRecord f :: MapRecord a b) (identity :: Builder {} {}) 83 | -------------------------------------------------------------------------------- /src/Record/Studio/Sequence.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.Sequence where 2 | 3 | import Prelude 4 | 5 | import Data.Symbol (class IsSymbol) 6 | import Heterogeneous.Folding (class FoldingWithIndex, class FoldlRecord, class HFoldlWithIndex, hfoldlWithIndex) 7 | import Prim.Row as Row 8 | import Prim.RowList (class RowToList) 9 | import Record.Builder (Builder) 10 | import Record.Builder as Builder 11 | import Type.Proxy (Proxy) 12 | 13 | -- Helper for type inference 14 | data SequenceRecord (f :: Type -> Type) = SequenceRecord 15 | 16 | -- Matches if the type of the current field in the record is f a and therefore needs to be sequenced. 17 | instance 18 | ( Applicative f 19 | , IsSymbol sym 20 | , Row.Lacks sym rb 21 | , Row.Cons sym a rb rc 22 | ) => 23 | FoldingWithIndex 24 | (SequenceRecord f) 25 | (Proxy sym) 26 | (f (Builder { | ra } { | rb })) 27 | (f a) 28 | (f (Builder { | ra } { | rc })) where 29 | foldingWithIndex _ prop rin a = (>>>) <$> rin <*> (Builder.insert prop <$> a) 30 | 31 | -- Matches if the type of the current field in the record is another record and therefore needs to be recursed. 32 | else instance 33 | ( Applicative f 34 | , IsSymbol sym 35 | , Row.Lacks sym rb 36 | , RowToList x xRL 37 | , Row.Cons sym { | y } rb rc 38 | , FoldlRecord 39 | (SequenceRecord f) 40 | (f (Builder (Record ()) (Record ()))) 41 | xRL 42 | x 43 | (f (Builder (Record ()) (Record y))) 44 | ) => 45 | FoldingWithIndex 46 | (SequenceRecord f) 47 | (Proxy sym) 48 | (f (Builder { | ra } { | rb })) 49 | { | x } 50 | (f (Builder { | ra } { | rc })) where 51 | foldingWithIndex _ prop rin x = (>>>) <$> rin <*> (fx <#> Builder.insert prop) 52 | where 53 | fx = sequenceRecord x 54 | 55 | -- Matches if the type of the current field in the record is any other type independent of sequencing. 56 | else instance 57 | ( Applicative f 58 | , IsSymbol sym 59 | , Row.Lacks sym rb 60 | , Row.Cons sym x rb rc 61 | ) => 62 | FoldingWithIndex 63 | (SequenceRecord f) 64 | (Proxy sym) 65 | (f (Builder { | ra } { | rb })) 66 | x 67 | (f (Builder { | ra } { | rc })) where 68 | foldingWithIndex _ prop rin x = (_ >>> Builder.insert prop x) <$> rin 69 | 70 | -- | Recursively sequence a record. E.g. 71 | -- | ```purescript 72 | -- | sequenceRecord { a : { b : { c : { d: Just 10, e : Just "hello" }, f : Just true } 73 | -- | -- Just { a : { b : { c : { d: 10, e : "hello" }, f : true } 74 | -- | ``` 75 | sequenceRecord 76 | :: forall f rin rout 77 | . Applicative f 78 | => HFoldlWithIndex (SequenceRecord f) (f (Builder {} {})) { | rin } (f (Builder {} { | rout })) 79 | => { | rin } 80 | -> f { | rout } 81 | sequenceRecord = 82 | map (flip Builder.build {}) 83 | <<< hfoldlWithIndex (SequenceRecord :: SequenceRecord f) (pure identity :: f (Builder {} {})) 84 | -------------------------------------------------------------------------------- /src/Record/Studio/MapKind.purs: -------------------------------------------------------------------------------- 1 | module Record.Studio.MapKind where 2 | 3 | import Prelude 4 | import Data.Symbol (class IsSymbol) 5 | import Heterogeneous.Folding (class FoldingWithIndex, class FoldlRecord, class HFoldlWithIndex, hfoldlWithIndex) 6 | import Prim.Row as Row 7 | import Prim.RowList (class RowToList) 8 | import Record.Builder (Builder) 9 | import Record.Builder as Builder 10 | import Type.Proxy (Proxy) 11 | 12 | -- Helper for type inference 13 | data MapRecordKind :: forall k. (k -> Type) -> (k -> Type) -> Type 14 | data MapRecordKind f g = MapRecordKind (f ~> g) 15 | 16 | -- Matches if the type of the current field in the record is f a and therefore needs to be naturally transformed. 17 | instance 18 | ( IsSymbol sym 19 | , Row.Lacks sym rb 20 | , Row.Cons sym (g a) rb rc 21 | ) => 22 | FoldingWithIndex 23 | (MapRecordKind f g) 24 | (Proxy sym) 25 | (Builder { | ra } { | rb }) 26 | (f a) 27 | (Builder { | ra } { | rc }) where 28 | foldingWithIndex (MapRecordKind nt) prop rin fa = (rin >>> Builder.insert prop (nt fa)) 29 | 30 | -- Matches if the type of the current field in the record is another record and therefore needs to be recursed. 31 | else instance 32 | ( IsSymbol sym 33 | , Row.Lacks sym rb 34 | , RowToList x xRL 35 | , Row.Cons sym { | y } rb rc 36 | , FoldlRecord 37 | (MapRecordKind f g) 38 | (Builder (Record ()) (Record ())) 39 | xRL 40 | x 41 | (Builder (Record ()) (Record y)) 42 | ) => 43 | FoldingWithIndex 44 | (MapRecordKind f g) 45 | (Proxy sym) 46 | (Builder { | ra } { | rb }) 47 | { | x } 48 | (Builder { | ra } { | rc }) where 49 | foldingWithIndex (MapRecordKind nt) prop rin x = (rin >>> Builder.insert prop fx) 50 | where 51 | fx = mapRecordKind nt x 52 | 53 | -- Matches if the type of the current field in the record is any other type independent of the natural transformation. 54 | else instance 55 | ( IsSymbol sym 56 | , Row.Lacks sym rb 57 | , Row.Cons sym x rb rc 58 | ) => 59 | FoldingWithIndex 60 | (MapRecordKind f g) 61 | (Proxy sym) 62 | (Builder { | ra } { | rb }) 63 | x 64 | (Builder { | ra } { | rc }) where 65 | foldingWithIndex _ prop rin x = (rin >>> Builder.insert prop x) 66 | 67 | -- | Recursively mapK a record using a natural transformation. E.g. 68 | -- | ```purescript 69 | -- | let 70 | -- | nt :: Either String ~> Maybe 71 | -- | nt = hush 72 | -- | mapRecordKind { a : { b : { c : { d: Right 10, e : Left "hello" }, f : Right true } 73 | -- | -- Just { a : { b : { c : { d: Just 10, e : Nothing }, f : Just true } 74 | -- | ``` 75 | mapRecordKind 76 | :: forall f g rin rout 77 | . HFoldlWithIndex (MapRecordKind f g) (Builder {} {}) { | rin } (Builder {} { | rout }) 78 | => (f ~> g) 79 | -> { | rin } 80 | -> { | rout } 81 | mapRecordKind nt = 82 | (flip Builder.build {}) 83 | <<< hfoldlWithIndex (MapRecordKind nt :: MapRecordKind f g) (identity :: Builder {} {}) 84 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-record-studio 📀📀📀 2 | 3 | You finally scored a record deal. 4 | 5 | ## Usage guide 6 | 7 | ### Assert two records have the same keys with `SameKeys` 8 | 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 | 17 | ### Merge records with `//` 18 | Easily merge two records: 19 | 20 | ```purescript 21 | { a: 5, b: "B" } // { b: false, c: "c" } 22 | -- { a: 5, b: false, c: "c" } 23 | ``` 24 | 25 | This is similar to the `...` operator in ES6: 26 | 27 | PureScript: 28 | ```purescript 29 | import Record.Studio ((//)) 30 | rec1 = { a: 1 } 31 | rec2 = { b: 4, c: 8 } 32 | result = rec1 // rec2 33 | ``` 34 | 35 | JS: 36 | ```js 37 | const rec1 = { a: 1 } 38 | const rec2 = { b: 4, c: 8 } 39 | const result = { ...rec1, ...rec2 } 40 | ``` 41 | 42 | ### Shrink records with `shrink` 43 | Easily adjust a record with too many keys: 44 | ```purescript 45 | import Record.Studio (shrink) 46 | -- We want to call this 47 | -- fn :: { a :: Int } -> Int 48 | 49 | -- We have this 50 | myRec :: { a :: Int, b :: String } 51 | myRec = { a: 4, b: "Hello!" } 52 | 53 | -- Use shrink! 54 | result = fn (shrink myRec) 55 | ``` 56 | 57 | ### Get a record's keys at runtime with `keys` 58 | ```purescript 59 | import Record.Studio (keys) 60 | 61 | theKeys :: Array String 62 | theKeys = keys { a: 3, b: "ooh" } 63 | -- ["a", "b"] 64 | ``` 65 | 66 | ### `sequenceRecord` 67 | Recursively sequence a type constructor out of a record. 68 | 69 | ```purescript 70 | let 71 | input :: SequenceInput 72 | input = 73 | { a: Just 10 74 | , b: "hello" 75 | , c: 76 | { d: Just "world" 77 | , e: true 78 | , f: { g: Just true } 79 | } 80 | , h: 10 81 | } 82 | 83 | expected :: Maybe SequenceOutput 84 | expected = Just 85 | { a: 10 86 | , b: "hello" 87 | , c: 88 | { d: "world" 89 | , e: true 90 | , f: { g: true } 91 | } 92 | , h: 10 93 | } 94 | (sequenceRecord input) `shouldEqual` expected 95 | ``` 96 | 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 | 105 | ### `mapRecord` 106 | 107 | Recursively map a function over a record. 108 | ```purescript 109 | let 110 | input :: MapInput 111 | input = 112 | { a: 10 113 | , b: "hello" 114 | , c: 115 | { d: Just "world" 116 | , e: 20 117 | , f: { g: true, h: 30 } 118 | } 119 | , i: 40 120 | } 121 | 122 | f :: Int -> String 123 | f i = show (i + 1) 124 | 125 | expected :: MapOutput 126 | expected = 127 | { a: "11" 128 | , b: "hello" 129 | , c: 130 | { d: Just "world" 131 | , e: "21" 132 | , f: { g: true, h: "31" } 133 | } 134 | , i: "41" 135 | } 136 | (mapRecord f input) `shouldEqual` expected 137 | ``` 138 | 139 | ### `mapRecordKind` 140 | 141 | Recursively map a natural transformation over a record. 142 | 143 | ```purescript 144 | let 145 | input :: MapKInput 146 | input = 147 | { a: Right 10 148 | , b: "hello" 149 | , c: 150 | { d: Left "world" 151 | , e: 20 152 | , f: { g: Right true, h: Left "broken" } 153 | } 154 | , i: Just 40 155 | } 156 | 157 | nt :: Either String ~> Maybe 158 | nt = hush 159 | 160 | expected :: MapKOutput 161 | expected = 162 | { a: Just 10 163 | , b: "hello" 164 | , c: 165 | { d: Nothing 166 | , e: 20 167 | , f: { g: Just true, h: Nothing } 168 | } 169 | , i: Just 40 170 | } 171 | (mapRecordKind nt input) `shouldEqual` expected 172 | ``` 173 | 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 | 182 | ## Licence 183 | This 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). 184 | It 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). 185 | --------------------------------------------------------------------------------