├── .github └── workflows │ └── build.yml ├── .gitignore ├── AUTHORS ├── LICENSE ├── README.md ├── bower.json ├── package-lock.json ├── package.json ├── packages.dhall ├── spago.dhall ├── src └── Data │ └── Undefined │ ├── NoProblem.js │ ├── NoProblem.purs │ └── NoProblem │ ├── Closed.purs │ └── Open.purs └── test ├── Main.purs ├── PolymorphicFields.purs └── PseudoMap.purs /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | - uses: actions/cache@v2 17 | with: 18 | path: | 19 | .spago 20 | output 21 | node_modules 22 | key: build-atrifacts-v1-${{ hashFiles('spago.dhall', 'packages.dhall') }} 23 | - uses: actions/setup-node@v2 24 | with: 25 | node-version: 16.15.0 26 | - run: npm i 27 | - run: npm run test 28 | 29 | -------------------------------------------------------------------------------- /.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 | test/README.purs 12 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Fyodor Soikin 2 | Tomasz Rybarczyk (aka paluh) 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2022, Tomasz Rybarczyk (aka paluh) 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-undefined-is-not-a-problem 2 | 3 | Handling optional record fields with `undefined | a` values and typesafe zero cost coercion. 4 | 5 | ## About 6 | 7 | The main idea behind this lib was taken from [_purescript-untagged-union_ library by @jvliwanag](https://github.com/jvliwanag/purescript-oneof) so all __the credits__ should __go to @jvliwanag__. _untagged-union_ provides a really interesting implementation of untagged unions for PureScript especially useful in the context of FFI bindings, so please check it out. 8 | 9 | I've narrowed this idea down to handle only unions with `undefined` type. I really focus on optional record fields here. 10 | 11 | ## Limitations 12 | 13 | You can encounter slow compilation time if you are going to process really large record types with the lib. I mean records with more than 80 or 100 fields can have an significant impact on module build time. Please note that this is compilation time is not behaving in a linear fashion - processing 10 records with 10 properties won't be a problem! 14 | [Here](https://discourse.purescript.org/t/rowlist-iteration-seems-to-be-relatively-slow/1492/4) you can find a related PS discourse thread for reference. 15 | 16 | ## Usage 17 | 18 | There are two coercing strategies provided by this lib. Don't worry they are both easy to use and the distinction between them is quite simple. I'm going to discuss this difference along the way. 19 | 20 | Let me start with imports. This is a literate PureScript example (run as a part of the test suite) so we need them. 21 | 22 | ```purescript 23 | module Test.README where 24 | 25 | import Prelude 26 | 27 | import Data.Undefined.NoProblem (opt, Opt, (?), (!)) 28 | import Data.Undefined.NoProblem.Closed (coerce) as Closed 29 | import Data.Undefined.NoProblem.Open (class Coerce, coerce) as Open 30 | import Effect (Effect) 31 | import Effect.Random (random) 32 | import Test.Assert (assert) 33 | ``` 34 | 35 | An API author specifies a `Record` type with all the fields which are optional (wrapped in `Opt`) so the user can skip these record properties when calling a function. 36 | 37 | ```purescript 38 | type SimpleOptions = 39 | { a ∷ String 40 | , b ∷ Opt Number 41 | , c ∷ Opt 42 | { d ∷ 43 | { e ∷ Opt 44 | { f ∷ Opt String 45 | , g ∷ Opt Number 46 | , h ∷ String 47 | } 48 | } 49 | } 50 | } 51 | ``` 52 | 53 | To work with optional values we have some handy operators at our disposal: 54 | 55 | * a value accessor `! ∷ Opt a → a → a` which expects a default value 56 | 57 | * a "pseudo bind": `? ∷ Opt a → (a → Opt b) → Opt b` opertor which allows us to dive for example into optional record values. 58 | 59 | ### `Open.coerce` 60 | 61 | Let me start with `Open.coerce` function. We are going to build a function which internally works with the `SimpleOptions` record value defined above. Both `coerce` functions (`Open.coerce` and `Closed.coerce`) are able to "fill" missing fields in a given record (recursively) with `Opt a` if that is a part of the initial type and transform proper values to `Opt` ones if it is needed. This is a purely typelevel transformation. 62 | 63 | ```purescript 64 | -- | This signature is optional 65 | consumer ∷ ∀ r. Open.Coerce r SimpleOptions ⇒ r → Number 66 | consumer r = 67 | let 68 | -- | We should provide an info to which type we try to coerce 69 | opts = Open.coerce r ∷ SimpleOptions 70 | 71 | -- | We can access and traverse optional values using "pseudoBind" function. 72 | -- | Side note: we can also close such a chain with `# toMaybe` easily. 73 | g = opts.c ? _.d.e ? _.g ! 0.0 74 | in 75 | opts.b ! 0.0 + g 76 | ``` 77 | 78 | The `Coerce` constraint checks if we can use `coerce` safely. 79 | 80 | ### Calling our `consumer` 81 | 82 | Now we are ready to use our function. As you can see our `argument` value lacks multiple fields and uses values directly in the places where `Opt` are really expected in the `SimpleOptions` type (like `c` should be `Opt {... }` and `g` should have type `Opt Number`): 83 | 84 | ```purescript 85 | recordCoerce ∷ Effect Unit 86 | recordCoerce = do 87 | let 88 | argument = 89 | { a: "test" 90 | , c: 91 | { d: 92 | { e: { g: 8.0, h: "test" }} 93 | } 94 | } 95 | 96 | result = consumer argument 97 | assert (result == 8.0) 98 | ``` 99 | 100 | ### Optionality is just a value 101 | 102 | It is worth nothing that optional field value is just a value. Its type is extended with additional resident - `undefined`. There are two constructor provided for `Opt`: `opt ∷ ∀ a. a → Opt a` and `undefined ∷ ∀ a. Opt a`. 103 | 104 | You can accept or build and assemble these values on the way and pass them down to the consumers below. 105 | 106 | ```purescript 107 | optValues :: Effect Unit 108 | optValues = do 109 | -- | Under some circumstances we want 110 | -- | to setup part of the record 111 | setup ← (_ < 0.5) <$> random 112 | 113 | let 114 | { b, g } = if setup 115 | -- | Could be also done with `coerce`. 116 | then { b: opt 20.0, g: opt 5.0 } 117 | -- | Could be also just `{ b: undefined, g: undefined }` 118 | -- | like above. 119 | -- | But sometimes we would need annotations here.. 120 | -- | when types is not fully determined by the 121 | -- | above two `opt` in record. 122 | else Closed.coerce { } 123 | 124 | assert 125 | $ (consumer { a: "test", b, c: { d: { e: { g, h: "test" }}}}) 126 | == (if setup then 25.0 else 0.0) 127 | ``` 128 | 129 | ### `NoProblem.Open.*` approach 130 | 131 | #### Cons 132 | 133 | There is an inherent problem with coercing polymorphic types in this case. Internally I'm just not able to match a polymorphic type like `a` with expected type like `Int` because I don't want to close the instance chains and commit to a given type (using something like `TypeEquals`) in this case. 134 | 135 | In other words when you use `Open.coerce` and `Open.Coerce` then whenever the user provides values like `Nothing` or `[]` as a part of the argument value these pieces should be annotated. 136 | 137 | ```purescript 138 | type OptionsWithArrayValue = { x :: Opt (Array Int) } 139 | 140 | openCoerceArray ∷ Effect Unit 141 | openCoerceArray = do 142 | let 143 | -- | This `Array Int` signature is required 144 | argument = { x: [] :: Array Int } 145 | 146 | v = Open.coerce argument ∷ OptionsWithArrayValue 147 | 148 | assert $ (v.x ! [1] == []) 149 | ``` 150 | 151 | #### Pros 152 | 153 | You can always provide an `Open.Coerce` instance for your types and allow coercing of its "internals". Please check examples in the `NoProblem.Open` module where you can find instances for `Array`, `Maybe` etc. 154 | 155 | ### `NoProblem.Closed.*` approach 156 | 157 | There is really no difference in the API provided by this module so we have `Coerce` class and `coerce` function here. The only difference is that I'm closing the instance chain and trying to force unification in the last instance. 158 | 159 | #### Pros 160 | 161 | When you reach for this type of coercing you can expect a better behavior in the case of polymorphic values. The previous example works now without annotation for the array in `x` prop: 162 | 163 | ```purescript 164 | closedCoerceArray ∷ Effect Unit 165 | closedCoerceArray = do 166 | let 167 | -- We hope that this annotation is temporary and could be dropped when the PS constraint 168 | -- solver issue mentioned above is solved. 169 | argument = { x: [] } 170 | 171 | r = (Closed.coerce argument :: OptionsWithArrayValue) 172 | 173 | -- | We can retrive the empty array value which has now type `Array Int` 174 | assert (r.x ! [8] == []) 175 | ``` 176 | 177 | #### Cons 178 | 179 | The downside of the `Closed.Coerce` class is that you are not able to provide more instances for it. Because we are closing here an instance chain with this unification case `instance coerceUnify :: (TypeEquals a b) => Coerce a b` there is no way for you to provide additional instances. 180 | 181 | ### Debugging 182 | 183 | #### `NoProblem.Open.Coerce` 184 | 185 | I try to provide some debug info which should help when there is a type mismatch. For example this kind of polymorphic array value in the `z` field causes problem: 186 | 187 | ```purescript 188 | type NestedError = 189 | { l :: Array { x :: Opt Int, y :: Int, z :: Opt (Array Int) }} 190 | 191 | x = coerce { l: [{ y: 9, z: [] }]} :: NestedError 192 | ``` 193 | 194 | and we can get quite informative compile time error message with property path like: 195 | 196 | ```shell 197 | Type mismatch on the path: { l."Array".z."Array" }. Expecting 198 | 199 | Int 200 | 201 | but got 202 | 203 | t172 204 | 205 | If one of the types above is a type variable like `t2` or `t37` 206 | it probably means that you should provide type annotation to some 207 | parts of your value. Something like `[] ∷ Array Int` or `Nothing ∷ Maybe String`. 208 | ``` 209 | 210 | I'm trying to cover as many cases as I can but it is of course possible that you are going to get just generic compiler error. 211 | 212 | #### `NoProblem.Closed.Coerce` 213 | 214 | In the case of `Closed` constraint errors I think that I'm not able to properly format and render errors like I've done in the previous case. So I have included the type path of the properties in the typeclass parameters and it can be somewhat extracted from the generic error. The path is currently provided in the reverse order. 215 | In the below case we see that the unification problem is related to the property type on the path `(SCons "Array" (SCons "x" SNil))` which translates into something like "`x.Array.__`". 216 | 217 | ``` 218 | 219 | Could not match type 220 | 221 | String 222 | 223 | with type 224 | 225 | Int 226 | 227 | 228 | while solving type class constraint 229 | 230 | Data.Undefined.NoProblem.Closed.TypeEqualsOnPath String 231 | Int 232 | (SCons "Array" (SCons "x" SNil)) 233 | 234 | while applying a function coerce 235 | ``` 236 | 237 | 254 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-undefined-is-not-a-problem", 3 | "license": [ 4 | "BSD-3-Clause" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/paluh/purescript-undefined-is-not-a-problem.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-assert": "^v6.0.0", 18 | "purescript-console": "^v6.0.0", 19 | "purescript-effect": "^v4.0.0", 20 | "purescript-foreign": "^v7.0.0", 21 | "purescript-prelude": "^v6.0.0", 22 | "purescript-psci-support": "^v6.0.0", 23 | "purescript-random": "^v6.0.0", 24 | "purescript-typelevel-prelude": "^v7.0.0", 25 | "purescript-unsafe-coerce": "^v6.0.0" 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-undefined-is-not-a-problem", 3 | "dependencies": { 4 | "autocannon": "^5.0.1" 5 | }, 6 | "devDependencies": { 7 | "github-release-notes": "^0.17.1", 8 | "paluh-litps": "^0.1.4", 9 | "pulp": "^16.0.0", 10 | "purescript": "^0.15.2", 11 | "spago": "^0.20.9" 12 | }, 13 | "scripts": { 14 | "pretest": "paluh-litps compile --file README.md; mv README.purs test/README.purs", 15 | "test": "spago test" 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.0-20220516/src/packages.dhall 3 | sha256:b0bf932de16a10b7d69c6bbbb31ec9ca575237c43a999fa32e59e35eb8c024a1 4 | 5 | in upstream 6 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "undefined-is-not-a-problem" 2 | , dependencies = 3 | [ "arrays" 4 | , "assert" 5 | , "effect" 6 | , "either" 7 | , "foreign" 8 | , "identity" 9 | , "maybe" 10 | , "newtype" 11 | , "prelude" 12 | , "random" 13 | , "tuples" 14 | , "type-equality" 15 | , "unsafe-coerce" 16 | ] 17 | , license = "BSD-3-Clause" 18 | , packages = ./packages.dhall 19 | , repository = "https://github.com/paluh/purescript-undefined-is-not-a-problem.git" 20 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 21 | } 22 | -------------------------------------------------------------------------------- /src/Data/Undefined/NoProblem.js: -------------------------------------------------------------------------------- 1 | const undefinedImpl = undefined 2 | export { undefinedImpl as undefined } 3 | -------------------------------------------------------------------------------- /src/Data/Undefined/NoProblem.purs: -------------------------------------------------------------------------------- 1 | module Data.Undefined.NoProblem where 2 | 3 | import Prelude 4 | 5 | import Data.Eq (class Eq1, eq1) 6 | import Data.Maybe (Maybe(..), maybe) 7 | import Data.Newtype (class Newtype) 8 | import Foreign (Foreign) 9 | import Foreign (isUndefined) as Foreign 10 | import Prim.TypeError (Above, Beside, Quote, QuoteLabel, Text, Doc) 11 | import Unsafe.Coerce (unsafeCoerce) 12 | 13 | -- | Denotes a required record field, the opposite of `Opt`. Note that using 14 | -- | this type is only required for polymorphic fields, due to complicated type 15 | -- | system reasons. Fields that have concrete types are not required to use 16 | -- | `Req`. For example: 17 | -- | 18 | -- | type Args a = 19 | -- | { polymorphicField :: Req a -- `Req` is needed here 20 | -- | , optionalField :: Opt a 21 | -- | , concreteTypedField :: Int -- no need for `Req` here 22 | -- | } 23 | -- | 24 | newtype Req a = Req a 25 | derive instance Newtype (Req a) _ 26 | derive newtype instance Show a => Show (Req a) 27 | 28 | -- | Denotes an optional value, typically a record field, allowing the consumer 29 | -- | to omit such field when passing the parameter, but still allowing the 30 | -- | receiving function to work with the field. 31 | foreign import data Opt ∷ Type → Type 32 | 33 | instance eqOpt ∷ Eq a ⇒ Eq (Opt a) where 34 | eq u1 u2 = toMaybe u1 == toMaybe u2 35 | 36 | instance eq1Opt ∷ Eq a ⇒ Eq1 Opt where 37 | eq1 u1 u2 = eq1 (toMaybe u1) (toMaybe u2) 38 | 39 | instance ordOpt ∷ Ord a ⇒ Ord (Opt a) where 40 | compare u1 u2 = toMaybe u1 `compare` toMaybe u2 41 | 42 | instance showOpt ∷ Show a ⇒ Show (Opt a) where 43 | show = maybe "undefined" ("Opt " <> _) <<< map show <<< toMaybe 44 | 45 | foreign import undefined ∷ ∀ a. Opt a 46 | 47 | opt ∷ ∀ a. a → Opt a 48 | opt = unsafeCoerce 49 | 50 | -- | Let's be consistent with `fromMaybe` args order here 51 | fromOpt ∷ ∀ a. a → Opt a → a 52 | fromOpt = flip fromOptFlipped 53 | 54 | fromOptFlipped ∷ ∀ a. Opt a → a → a 55 | fromOptFlipped o default = 56 | if isUndefined o then 57 | default 58 | else 59 | unsafeCoerce o 60 | 61 | infixl 9 fromOptFlipped as ! 62 | 63 | toMaybe ∷ ∀ a. Opt a → Maybe a 64 | toMaybe o = 65 | if isUndefined o then 66 | Nothing 67 | else 68 | Just (unsafeUnwrap o) 69 | 70 | fromMaybe :: forall a. Maybe a -> Opt a 71 | fromMaybe = maybe undefined opt 72 | 73 | isUndefined ∷ ∀ a. Opt a → Boolean 74 | isUndefined undef = Foreign.isUndefined (unsafeCoerce undef ∷ Foreign) 75 | 76 | unsafeUnwrap ∷ ∀ a. Opt a → a 77 | unsafeUnwrap = unsafeCoerce 78 | 79 | -- | This is not dedicated for providing `bind`. 80 | -- | We are not able to have `Monad` here. 81 | -- | 82 | -- | It is only to provide nice operator: 83 | -- | (coerce {}) ? _.a ? _.b ? _.c.d ! "default" 84 | pseudoBind :: forall a b. Opt a -> (a -> Opt b) -> Opt b 85 | pseudoBind o f = 86 | if isUndefined o then 87 | undefined 88 | else 89 | f (unsafeUnwrap o) 90 | 91 | infixl 9 pseudoBind as ? 92 | 93 | pseudoMap :: forall a b. (a -> b) -> Opt a -> Opt b 94 | pseudoMap f o = 95 | if isUndefined o then 96 | undefined 97 | else 98 | opt (f (unsafeUnwrap o)) 99 | 100 | -- | Ripped from typelevel-eval 101 | infixr 2 type Beside as <> 102 | 103 | infixr 1 type Above as |> 104 | 105 | -- | Ripped from record-extra 106 | data SList 107 | 108 | foreign import data SCons ∷ Symbol → SList → SList 109 | 110 | foreign import data SNil ∷ SList 111 | 112 | infixr 6 type SCons as ::: 113 | 114 | class RenderPath (path ∷ SList) (render ∷ Doc) | path → render 115 | 116 | instance renderPathEnd ∷ RenderPath SNil (Text "") 117 | else instance renderPathLast ∷ RenderPath (n ::: SNil) (QuoteLabel n) 118 | else instance renderPathSegment ∷ 119 | (RenderPath tail p) ⇒ 120 | RenderPath (segment ::: tail) (p <> Text "." <> QuoteLabel segment) 121 | 122 | class TypeMismatchErr (given :: Type) (expected :: Type) (path ∷ SList) (msg ∷ Doc) | path expected given → msg 123 | 124 | instance typeMismatchErr ∷ 125 | (RenderPath p p') ⇒ 126 | TypeMismatchErr given expected p ( Text "Type mismatch on the path: { " <> p' <> Text " }. Expecting" 127 | |> Text "" 128 | |> Quote expected 129 | |> Text "" 130 | |> Text "but got" 131 | |> Text "" 132 | |> Quote given 133 | |> Text "" 134 | |> Text "If one of the types above is a type variable like `t2` or `r172`" 135 | |> Text "it probably means that you should provide type annotation to some" 136 | |> Text "parts of your value (like `[] ∷ Array Int` or `Nothing ∷ Maybe String`)" 137 | ) 138 | -------------------------------------------------------------------------------- /src/Data/Undefined/NoProblem/Closed.purs: -------------------------------------------------------------------------------- 1 | module Data.Undefined.NoProblem.Closed where 2 | 3 | import Data.Either (Either) 4 | import Data.Maybe (Maybe) 5 | import Data.Tuple (Tuple) 6 | import Data.Undefined.NoProblem (class RenderPath, type (:::), type (<>), type (|>), Opt, Req, SList, SNil) 7 | import Effect (Effect) 8 | import Prim.RowList (class RowToList, Cons, Nil, RowList) 9 | import Prim.TypeError (class Fail, QuoteLabel, Text) 10 | import Unsafe.Coerce (unsafeCoerce) 11 | 12 | class CoerceProps (given ∷ RowList Type) (expected ∷ RowList Type) (debugPath ∷ SList) | given → debugPath 13 | 14 | instance coercePropsNil ∷ 15 | CoerceProps Nil Nil any 16 | else instance coercePropsCons ∷ 17 | (CoerceProp a b (n ::: debugPath), CoerceProps t t' debugPath) ⇒ 18 | CoerceProps (Cons n a t) (Cons n b t') debugPath 19 | -- | Handle missing field using Opt 20 | else instance coercePropsConsU ∷ 21 | (CoerceProps t t' debugPath) ⇒ 22 | CoerceProps t (Cons n (Opt a) t') debugPath 23 | else instance coercePropsMismatch ∷ 24 | ( RenderPath p p' 25 | , Fail 26 | ( Text "Field mismatch on the path " <> p' 27 | |> Text "" 28 | |> Text " * Maybe you have provided an extra field: " 29 | <> QuoteLabel n 30 | <> Text " ?" 31 | |> Text "" 32 | |> Text " * Maybe you have skipped required field: " 33 | <> QuoteLabel m 34 | <> Text " ?" 35 | ) 36 | ) ⇒ 37 | CoerceProps (Cons n b y) (Cons m a x) p 38 | else instance coercePropsMissing ∷ 39 | ( RenderPath (n ::: p) p' 40 | , Fail 41 | ( Text "Missing required field: " <> QuoteLabel n 42 | |> Text "" 43 | |> Text "The full path is: " 44 | <> p' 45 | ) 46 | ) ⇒ 47 | CoerceProps Nil (Cons n a t) p 48 | else instance coercePropsUnexpected ∷ 49 | ( RenderPath p p' 50 | , Fail 51 | ( Text "Unexpected field provided: " 52 | <> QuoteLabel n 53 | |> Text "The full path is: " 54 | <> p' 55 | ) 56 | ) ⇒ 57 | CoerceProps (Cons n a t) Nil p 58 | 59 | -- | Check if given type can be coerced safely to the expected one. 60 | class CoerceProp (given :: Type) (expected :: Type) (debugPath ∷ SList) | expected → debugPath 61 | 62 | -- -- | The most important instances are these three 63 | -- -- | and the last one which passes the type to the 64 | -- -- | compiler for unification. 65 | -- -- | 66 | -- -- | The rest is handling errors and providing intances 67 | -- -- | for well known polymorphic types like `Maybe`, `Either`... 68 | instance coercePropReq ∷ 69 | (TypeEqualsOnPath a b p) ⇒ 70 | CoerceProp a (Req b) p 71 | else instance coercePropOptValuesMatch ∷ 72 | CoerceProp (Opt a) (Opt a) p 73 | else instance coercePropOptValues ∷ 74 | (CoerceProp a b p) ⇒ 75 | CoerceProp (Opt a) (Opt b) p 76 | else instance coercePropOptValue ∷ 77 | (CoerceProp a b p) ⇒ 78 | CoerceProp a (Opt b) p 79 | else instance coercePropRecord ∷ 80 | (RowToList e el, RowToList g gl, CoerceProps gl el p) ⇒ 81 | CoerceProp { | g } { | e } p 82 | -- | These instances are provided to allow coercing over popular types 83 | else instance coercePropArray ∷ 84 | (CoerceProp a b ("Array" ::: p)) ⇒ 85 | CoerceProp (Array a) (Array b) p 86 | else instance coercePropMaybe ∷ 87 | (CoerceProp a b ("Maybe" ::: p)) ⇒ 88 | CoerceProp (Maybe a) (Maybe b) p 89 | else instance coercePropEither ∷ 90 | ( CoerceProp a1 b1 ("Either.Left" ::: p) 91 | , CoerceProp a2 b2 ("Either.Right" ::: p) 92 | ) ⇒ 93 | CoerceProp (Either a1 a2) (Either b1 b2) p 94 | else instance coercePropTuple ∷ 95 | ( CoerceProp a1 b1 ("Tuple.fst" ::: p) 96 | , CoerceProp a2 b2 ("Tuple.snd" ::: p) 97 | ) ⇒ 98 | CoerceProp (Tuple a1 a2) (Tuple b1 b2) p 99 | else instance coercePropEffect ∷ 100 | (CoerceProp a b ("Effect" ::: p)) ⇒ 101 | CoerceProp (Effect a) (Effect b) p 102 | else instance coercePropUnify ∷ 103 | TypeEqualsOnPath a b p ⇒ 104 | CoerceProp a b p 105 | 106 | class TypeEqualsOnPath (a :: Type) (b :: Type) (p ∷ SList) | a → b, b → a 107 | 108 | instance typeEqualsOnPathUnified ∷ TypeEqualsOnPath a a p 109 | 110 | class (CoerceProp given expected SNil) ⇐ Coerce given expected 111 | 112 | instance optsAlias ∷ 113 | (CoerceProp given expected SNil) ⇒ 114 | Coerce given expected 115 | 116 | coerce ∷ 117 | ∀ expected given. 118 | Coerce given expected ⇒ given → expected 119 | coerce = unsafeCoerce 120 | -------------------------------------------------------------------------------- /src/Data/Undefined/NoProblem/Open.purs: -------------------------------------------------------------------------------- 1 | module Data.Undefined.NoProblem.Open where 2 | 3 | import Data.Either (Either) 4 | import Data.Maybe (Maybe) 5 | import Data.Tuple (Tuple) 6 | import Data.Undefined.NoProblem (class RenderPath, class TypeMismatchErr, type (:::), type (<>), type (|>), Opt, Req, SList, SNil) 7 | import Effect (Effect) 8 | import Prim.RowList (class RowToList, Cons, Nil, RowList) 9 | import Prim.TypeError (class Fail, QuoteLabel, Text) 10 | import Type.Equality (class TypeEquals) 11 | import Unsafe.Coerce (unsafeCoerce) 12 | 13 | class CoerceProps 14 | (given ∷ RowList Type) (expected ∷ RowList Type) (debugPath ∷ SList) 15 | | given → debugPath 16 | 17 | instance coercePropsNil 18 | ∷ CoerceProps Nil Nil any 19 | 20 | else instance coercePropsCons 21 | ∷ (CoerceProp a b (n ::: debugPath), CoerceProps t t' debugPath) 22 | ⇒ CoerceProps (Cons n a t) (Cons n b t') debugPath 23 | 24 | -- | Handle missing field using Opt 25 | else instance coercePropsConsU 26 | ∷ (CoerceProps t t' debugPath) 27 | ⇒ CoerceProps t (Cons n (Opt a) t') debugPath 28 | 29 | else instance coercePropsMismatch 30 | ∷ ( RenderPath p p' 31 | , Fail 32 | ( Text "Field mismatch on the path " <> p' 33 | |> Text "" 34 | |> Text " * Maybe you have provided an extra field: " <> QuoteLabel n <> Text " ?" 35 | |> Text "" 36 | |> Text " * Maybe you have skipped required field: " <> QuoteLabel m <> Text " ?" 37 | ) 38 | ) 39 | ⇒ CoerceProps (Cons n b y) (Cons m a x) p 40 | 41 | else instance coercePropsMissing 42 | ∷ ( RenderPath (n ::: p) p' 43 | , Fail 44 | ( Text "Missing required field: " <> QuoteLabel n 45 | |> Text "" 46 | |> Text "The full path is: " <> p' 47 | ) 48 | ) 49 | ⇒ CoerceProps Nil (Cons n a t) p 50 | 51 | else instance coercePropsUnexpected 52 | ∷ ( RenderPath p p' 53 | , Fail 54 | ( Text "Unexpected field provided: " 55 | <> QuoteLabel n 56 | |> Text "The full path is: " 57 | <> p' 58 | ) 59 | ) 60 | ⇒ CoerceProps (Cons n a t) Nil p 61 | 62 | 63 | -- | Check if given type can be coerced safely to the expected one. 64 | class CoerceProp (given :: Type) (expected :: Type) (debugPath ∷ SList) | expected → debugPath 65 | 66 | -- -- | The most important instances are these three 67 | -- -- | and the last one which passes the type to the 68 | -- -- | compiler for unification. 69 | -- -- | 70 | -- -- | The rest is handling errors and providing intances 71 | -- -- | for well known polymorphic types like `Maybe`, `Either`... 72 | instance coercePropReq 73 | ∷ (TypeEquals a b) 74 | ⇒ CoerceProp a (Req b) p 75 | else instance coercePropOptValuesMatch 76 | :: CoerceProp (Opt a) (Opt a) p 77 | else instance coercePropOptValues 78 | ∷ (CoerceProp a b p) 79 | ⇒ CoerceProp (Opt a) (Opt b) p 80 | else instance coercePropOptValue 81 | ∷ (CoerceProp a b p) 82 | ⇒ CoerceProp a (Opt b) p 83 | else instance coercePropRecord 84 | ∷ (RowToList e el, RowToList g gl, CoerceProps gl el p) 85 | ⇒ CoerceProp { | g } { | e } p 86 | 87 | else instance coercePropMatch 88 | :: CoerceProp a a p 89 | 90 | -- | These instances are provided to allow coercing over popular types 91 | 92 | else instance coercePropArray 93 | ∷ (CoerceProp a b ("Array" ::: p)) 94 | ⇒ CoerceProp (Array a) (Array b) p 95 | 96 | else instance coercePropMaybe 97 | ∷ (CoerceProp a b ("Maybe" ::: p)) 98 | ⇒ CoerceProp (Maybe a) (Maybe b) p 99 | 100 | else instance coercePropEither 101 | ∷ ( CoerceProp a1 b1 ("Either.Left" ::: p) 102 | , CoerceProp a2 b2 ("Either.Right" ::: p) 103 | ) 104 | ⇒ CoerceProp (Either a1 a2) (Either b1 b2) p 105 | 106 | else instance coercePropTuple 107 | ∷ ( CoerceProp a1 b1 ("Tuple.fst" ::: p) 108 | , CoerceProp a2 b2 ("Tuple.snd" ::: p) 109 | ) 110 | ⇒ CoerceProp (Tuple a1 a2) (Tuple b1 b2) p 111 | 112 | else instance coercePropEffect 113 | ∷ (CoerceProp a b ("Effect" ::: p)) 114 | ⇒ CoerceProp (Effect a) (Effect b) p 115 | 116 | -- | These instances are provided only for nice debuging experience. 117 | -- | I'm still not sure if I not breaking some polymorphic scenarios 118 | -- | here. 119 | 120 | else instance coercePropIntExpectedMismatch 121 | ∷ (RenderPath p p', TypeMismatchErr a Int p msg, Fail msg) 122 | ⇒ CoerceProp a Int p 123 | 124 | else instance coercePropIntGivenMismatch 125 | ∷ (RenderPath p p', TypeMismatchErr Int a p msg, Fail msg) 126 | ⇒ CoerceProp Int a p 127 | 128 | else instance coercePropStringExpectedMismatch 129 | ∷ (RenderPath p p', TypeMismatchErr a String p msg, Fail msg) 130 | ⇒ CoerceProp a String p 131 | else instance coercePropStringGivenMismatch 132 | ∷ (RenderPath p p', TypeMismatchErr String a p msg, Fail msg) 133 | ⇒ CoerceProp String a p 134 | 135 | else instance coercePropNumberExpectedMismatch 136 | ∷ (RenderPath p p', TypeMismatchErr a Number p msg, Fail msg) 137 | ⇒ CoerceProp a Number p 138 | else instance coercePropNumberGivenMismatch 139 | ∷ (RenderPath p p', TypeMismatchErr Number a p msg, Fail msg) 140 | ⇒ CoerceProp Number a p 141 | 142 | else instance coercePropBooleanExpectedMismatch 143 | ∷ (RenderPath p p', TypeMismatchErr a Boolean p msg, Fail msg) 144 | ⇒ CoerceProp a Boolean p 145 | else instance coercePropBooleanGivenMismatch 146 | ∷ (RenderPath p p', TypeMismatchErr Boolean a p msg, Fail msg) 147 | ⇒ CoerceProp Boolean a p 148 | 149 | -- | Still experimenting with the finall API 150 | 151 | class (CoerceProp given expected SNil) ⇐ Coerce given expected 152 | 153 | instance optsAlias 154 | ∷ (CoerceProp given expected SNil) 155 | ⇒ Coerce given expected 156 | 157 | coerce 158 | ∷ ∀ expected given 159 | . Coerce given expected ⇒ given → expected 160 | coerce = unsafeCoerce 161 | 162 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Test.PolymorphicFields as PolyFields 7 | import Test.PseudoMap (test) as PseudoMap 8 | import Test.README (closedCoerceArray, openCoerceArray, optValues, recordCoerce) as Test.README 9 | 10 | main ∷ Effect Unit 11 | main = do 12 | Test.README.recordCoerce 13 | Test.README.optValues 14 | Test.README.openCoerceArray 15 | Test.README.closedCoerceArray 16 | PolyFields.test 17 | PseudoMap.test 18 | -------------------------------------------------------------------------------- /test/PolymorphicFields.purs: -------------------------------------------------------------------------------- 1 | module Test.PolymorphicFields where 2 | 3 | import Prelude 4 | 5 | import Data.Array (catMaybes) 6 | import Data.Identity (Identity) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Newtype (unwrap) 9 | import Data.Undefined.NoProblem (Opt, Req(..), opt, toMaybe) 10 | import Data.Undefined.NoProblem.Closed as Closed 11 | import Data.Undefined.NoProblem.Open as Open 12 | import Effect (Effect) 13 | import Test.Assert (assert) 14 | import Type.Proxy (Proxy(..)) 15 | 16 | type Args a = { x :: Req a, y :: Opt a, z :: Int } 17 | 18 | closedConsumer :: forall args a. Closed.Coerce args (Args a) => Show a => args -> String 19 | closedConsumer args' = show $ catMaybes [Just (unwrap args.x), toMaybe args.y] 20 | where 21 | args = Closed.coerce args' :: Args a 22 | 23 | openConsumer :: forall args a. Open.Coerce args (Args a) => Show a => args -> String 24 | openConsumer args' = show $ catMaybes [Just (unwrap args.x), toMaybe args.y] 25 | where 26 | args = Open.coerce args' :: Args a 27 | 28 | nestedClosedConsumer :: forall a. Show a => a -> String 29 | nestedClosedConsumer a = closedConsumer { x: a, y: opt a, z: 42 } 30 | 31 | nestedOpenConsumer :: forall a. Show a => a -> String 32 | nestedOpenConsumer a = openConsumer { x: a, y: opt a, z: 42 } 33 | 34 | monoConsumer :: forall args. Closed.Coerce args (Args Int) => args -> String 35 | monoConsumer args' = closedConsumer { x: unwrap args.x, y: args.y, z: args.z } 36 | where 37 | args = Closed.coerce args' :: Args Int 38 | 39 | monoAmbiguousConsumer :: forall args. Closed.Coerce args (Args (Maybe Int)) => args -> String 40 | monoAmbiguousConsumer args' = closedConsumer { x: unwrap args.x, y: args.y, z: args.z } 41 | where 42 | args = Closed.coerce args' :: Args (Maybe Int) 43 | 44 | test :: Effect Unit 45 | test = do 46 | assert $ 47 | closedConsumer { x: "foo", z: 42 } == show ["foo"] 48 | assert $ 49 | closedConsumer { x: "foo", y: "bar", z: 42 } == show ["foo", "bar"] 50 | assert $ 51 | closedConsumer { x: "foo", y: opt "bar", z: 42 } == show ["foo", "bar"] 52 | assert $ 53 | closedConsumer { x: true, z: 42 } == show [true] 54 | assert $ 55 | closedConsumer { x: true, y: false, z: 42 } == show [true, false] 56 | assert $ -- Make sure explicitly wrapping the field in `Req` also works 57 | closedConsumer { x: Req 5, z: 42 } == show [5] 58 | assert $ 59 | nestedClosedConsumer 42 == show [42, 42] 60 | 61 | assert $ 62 | openConsumer { x: "foo", z: 42 } == show ["foo"] 63 | assert $ 64 | openConsumer { x: "foo", y: "bar", z: 42 } == show ["foo", "bar"] 65 | assert $ 66 | openConsumer { x: "foo", y: opt "bar", z: 42 } == show ["foo", "bar"] 67 | assert $ 68 | openConsumer { x: true, z: 42 } == show [true] 69 | assert $ 70 | openConsumer { x: true, y: false, z: 42 } == show [true, false] 71 | assert $ -- Make sure explicitly wrapping the field in `Req` also works 72 | openConsumer { x: Req 5, z: 42 } == show [5] 73 | assert $ 74 | nestedOpenConsumer 42 == show [42, 42] 75 | 76 | assert $ 77 | monoConsumer { x: 42, z: 42 } == show [42] 78 | assert $ 79 | monoConsumer { x: 42, y: 5, z: 42 } == show [42, 5] 80 | assert $ 81 | monoAmbiguousConsumer { x: Just 42, z: 42 } == show [Just 42] 82 | assert $ 83 | monoAmbiguousConsumer { x: Just 42, y: Just 5, z: 42 } == show [Just 42, Just 5] 84 | assert $ 85 | monoAmbiguousConsumer { x: Nothing, y: Just 5, z: 42 } == show [Nothing, Just 5] 86 | assert $ 87 | monoAmbiguousConsumer { x: Just 42, y: Nothing, z: 42 } == show [Just 42, Nothing] 88 | 89 | -- This test explicitly enumerates all coercion use cases that we want to 90 | -- support. If instance resolution breaks, one or more lines in this function 91 | -- will fail to compile. 92 | compileTimeTestClosed :: Identity Unit 93 | compileTimeTestClosed = do 94 | witness (Proxy :: _ Int) (Proxy :: _ Int) 95 | witness (Proxy :: _ (Req Int)) (Proxy :: _ Int) 96 | witness (Proxy :: _ (Opt Int)) (Proxy :: _ Int) 97 | witness (Proxy :: _ (Opt Int)) (Proxy :: _ (Opt Int)) 98 | witness (Proxy :: _ (Opt (Maybe Int))) (Proxy :: _ (Maybe Int)) 99 | witness (Proxy :: _ (Opt (Maybe Int))) (Proxy :: _ (Opt (Maybe Int))) 100 | genericWitness (Proxy :: _ Int) 101 | witness (Proxy :: _ { x :: Req Int, y :: Opt Int }) (Proxy :: _ { x :: Int, y :: Int }) 102 | where 103 | -- This function doesn't do anything at runtime, its whole purpose is to 104 | -- make sure an instance of `Closed.Coerce` can be resolved for the types 105 | -- that we want to support. 106 | witness :: forall expected given. Closed.Coerce given expected => Proxy expected -> Proxy given -> Identity Unit 107 | witness _ _ = pure unit 108 | 109 | -- The case where the use site itself is generic (i.e. "forall a") is not 110 | -- exactly the same as non-generic case. Class instance resolution works a 111 | -- little differently when some type variables are unkown. 112 | genericWitness :: forall a. Proxy a -> Identity Unit 113 | genericWitness _ = do 114 | witness (Proxy :: _ (Req a)) (Proxy :: _ a) 115 | witness (Proxy :: _ (Opt a)) (Proxy :: _ (Opt a)) 116 | witness (Proxy :: _ (Opt (Maybe a))) (Proxy :: _ (Opt (Maybe a))) 117 | 118 | -- DOESN'T COMPILE: witness (Proxy :: _ (Opt a)) (Proxy :: _ a) 119 | -- ^ This case isn't supported. We cannot add a case for matching `a` with 120 | -- `Opt a` for a generic `a`, because it breaks use cases where the args 121 | -- are monomorphic, but the use site passes values of ambiguous types. For 122 | -- example: 123 | -- 124 | -- args definition: type Args = { x :: Opt (Maybe Int) } 125 | -- use site: f { x: Nothing } 126 | -- 127 | -- This would require matching expected type `Opt (Maybe Int)` with given 128 | -- type `Maybe t1` (the type of `Nothing`), and an instance `Coerce a (Opt 129 | -- a)` would be considered "partially overlapping", because it may or may 130 | -- not match depending on the choice of `t1`. 131 | 132 | -- DOESN'T COMPILE: witness (Proxy :: _ { x :: Req a, y :: Opt a }) (Proxy :: _ { x :: a, y :: a }) 133 | -- ^ This case doesn't work due to https://github.com/purescript/purescript/issues/4338 134 | 135 | -- See comments on `compileTimeTestClosed` 136 | compileTimeTestOpen :: Identity Unit 137 | compileTimeTestOpen = do 138 | witness (Proxy :: _ Int) (Proxy :: _ Int) 139 | witness (Proxy :: _ (Req Int)) (Proxy :: _ Int) 140 | witness (Proxy :: _ (Opt Int)) (Proxy :: _ Int) 141 | witness (Proxy :: _ (Opt Int)) (Proxy :: _ (Opt Int)) 142 | witness (Proxy :: _ (Opt (Maybe Int))) (Proxy :: _ (Maybe Int)) 143 | witness (Proxy :: _ (Opt (Maybe Int))) (Proxy :: _ (Opt (Maybe Int))) 144 | genericWitness (Proxy :: _ Int) 145 | witness (Proxy :: _ { x :: Req Int, y :: Opt Int }) (Proxy :: _ { x :: Int, y :: Int }) 146 | where 147 | witness :: forall expected given. Open.Coerce given expected => Proxy expected -> Proxy given -> Identity Unit 148 | witness _ _ = pure unit 149 | 150 | genericWitness :: forall a. Proxy a -> Identity Unit 151 | genericWitness _ = do 152 | witness (Proxy :: _ (Req a)) (Proxy :: _ a) 153 | witness (Proxy :: _ (Opt a)) (Proxy :: _ (Opt a)) 154 | witness (Proxy :: _ (Opt (Maybe a))) (Proxy :: _ (Opt (Maybe a))) 155 | 156 | -- DOESN'T COMPILE: witness (Proxy :: _ (Opt a)) (Proxy :: _ a) 157 | -- DOESN'T COMPILE: witness (Proxy :: _ { x :: Req a, y :: Opt a }) (Proxy :: _ { x :: a, y :: a }) 158 | -------------------------------------------------------------------------------- /test/PseudoMap.purs: -------------------------------------------------------------------------------- 1 | module Test.PseudoMap where 2 | 3 | import Prelude 4 | 5 | import Data.Undefined.NoProblem (Opt, opt, pseudoMap, undefined) 6 | import Effect (Effect) 7 | import Test.Assert (assert) 8 | import Data.Undefined.NoProblem.Closed as Closed 9 | import Data.Undefined.NoProblem.Open as Open 10 | import Data.Undefined.NoProblem.Closed (coerce) 11 | 12 | test :: Effect Unit 13 | test = do 14 | assert $ (undefined # pseudoMap (_ + 1)) == undefined 15 | assert $ (opt 7 # pseudoMap (_ + 1)) == opt 8 16 | assert $ ((coerce {} :: { x :: Opt Int }) # recXPlusOne) == { x: undefined } 17 | assert $ ((coerce { x: 7 } :: { x :: Opt Int }) # recXPlusOne) == { x: opt 8 } 18 | where 19 | recXPlusOne rec = rec { x = pseudoMap (_ + 1) rec.x } 20 | --------------------------------------------------------------------------------