Support for polymorphic fields

Author: fsoikin

README.md

@@ -24,7 +24,7 @@ module Test.README where
 
 import Prelude
 
-import Data.Undefined.NoProblem (opt, Opt, undefined, (?), (!))
+import Data.Undefined.NoProblem (opt, Opt, (?), (!))
 import Data.Undefined.NoProblem.Closed (coerce) as Closed
 import Data.Undefined.NoProblem.Open (class Coerce, coerce) as Open
 import Effect (Effect)
@@ -123,7 +123,7 @@ optValues = do
 
   assert
     $ (consumer { a: "test", b, c: { d: { e: { g, h: "test" }}}})
-    == (if setup then 45.0 else 0.0)
+    == (if setup then 25.0 else 0.0)
 ```
 
 ### `NoProblem.Open.*` approach
@@ -164,7 +164,7 @@ When you reach for this type of coercing you can expect a better behavior in the
 closedCoerceArray ∷ Effect Unit
 closedCoerceArray = do
   let
-    argument = { x: [] :: Array Int }
+    argument = { x: [] }
 
     r = (Closed.coerce argument :: OptionsWithArrayValue)
 

packages.dhall

@@ -1,24 +1,5 @@
-let upstream =
-      https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall
-        sha256:b1c6d06132b7cbf1e93b1e5343044fba1604b50bfbe02d8f80a3002e71569c59
-
-in  upstream
-  with spec =
-    { repo = "https://github.com/purescript-spec/purescript-spec.git"
-    , version = "master"
-    , dependencies =
-      [ "aff"
-      , "ansi"
-      , "avar"
-      , "console"
-      , "exceptions"
-      , "foldable-traversable"
-      , "fork"
-      , "now"
-      , "pipes"
-      , "prelude"
-      , "strings"
-      , "transformers"
-      ]
-    }
-  with metadata.version = "v0.15.0-alpha-05"
+let upstream =
+      https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.0-20220516/src/packages.dhall
+        sha256:b0bf932de16a10b7d69c6bbbb31ec9ca575237c43a999fa32e59e35eb8c024a1
+
+in  upstream

spago.dhall

@@ -1,13 +1,16 @@
 { name = "undefined-is-not-a-problem"
 , dependencies =
-  [ "assert"
+  [ "arrays"
+  , "assert"
   , "effect"
   , "either"
   , "foreign"
   , "maybe"
+  , "newtype"
   , "prelude"
   , "random"
   , "tuples"
+  , "type-equality"
   , "unsafe-coerce"
   ]
 , license = "BSD-3-Clause"

src/Data/Undefined/NoProblem.purs

@@ -1,13 +1,33 @@
 module Data.Undefined.NoProblem where
 
 import Prelude
+
 import Data.Eq (class Eq1, eq1)
 import Data.Maybe (Maybe(..), maybe)
+import Data.Newtype (class Newtype)
 import Foreign (Foreign)
 import Foreign (isUndefined) as Foreign
 import Prim.TypeError (Above, Beside, Quote, QuoteLabel, Text, Doc)
 import Unsafe.Coerce (unsafeCoerce)
 
+-- | Denotes a required record field, the opposite of `Opt`. Note that using
+-- | this type is only required for polymorphic fields, due to complicated type
+-- | system reasons. Fields that have concrete types are not required to use
+-- | `Req`. For example:
+-- |
+-- |     type Args a =
+-- |       { polymorphicField :: Req a  -- `Req` is needed here
+-- |       , optionalField :: Opt a
+-- |       , concreteTypedField :: Int  -- no need for `Req` here
+-- |       }
+-- |
+newtype Req a = Req a
+derive instance Newtype (Req a) _
+derive newtype instance Show a => Show (Req a)
+
+-- | Denotes an optional value, typically a record field, allowing the consumer
+-- | to omit such field when passing the parameter, but still allowing the
+-- | receiving function to work with the field.
 foreign import data Opt ∷ Type → Type
 
 instance eqOpt ∷ Eq a ⇒ Eq (Opt a) where

src/Data/Undefined/NoProblem/Closed.purs

@@ -3,7 +3,7 @@ module Data.Undefined.NoProblem.Closed where
 import Data.Either (Either)
 import Data.Maybe (Maybe)
 import Data.Tuple (Tuple)
-import Data.Undefined.NoProblem (class RenderPath, type (:::), type (<>), type (|>), Opt, SNil, SList)
+import Data.Undefined.NoProblem (class RenderPath, type (:::), type (<>), type (|>), Opt, Req, SList, SNil)
 import Effect (Effect)
 import Prim.RowList (class RowToList, Cons, Nil, RowList)
 import Prim.TypeError (class Fail, QuoteLabel, Text)
@@ -65,8 +65,9 @@ class CoerceProp (given :: Type) (expected :: Type) (debugPath ∷ SList) | expe
 -- -- |
 -- -- | The rest is handling errors and providing intances
 -- -- | for well known polymorphic types like `Maybe`, `Either`...
-instance coercePropMatch ::
-  CoerceProp a a p
+instance coercePropReq ∷
+  (TypeEqualsOnPath a b p) ⇒
+  CoerceProp a (Req b) p
 else instance coercePropOptValues ∷
   (CoerceProp a b p) ⇒
   CoerceProp (Opt a) (Opt b) p
@@ -97,7 +98,7 @@ else instance coercePropEffect ∷
   (CoerceProp a b ("Effect" ::: p)) ⇒
   CoerceProp (Effect a) (Effect b) p
 else instance coercePropUnify ∷
-  (TypeEqualsOnPath a b p) ⇒
+  TypeEqualsOnPath a b p ⇒
   CoerceProp a b p
 
 class TypeEqualsOnPath (a :: Type) (b :: Type) (p ∷ SList) | a → b, b → a

src/Data/Undefined/NoProblem/Open.purs

@@ -3,10 +3,11 @@ module Data.Undefined.NoProblem.Open where
 import Data.Either (Either)
 import Data.Maybe (Maybe)
 import Data.Tuple (Tuple)
-import Data.Undefined.NoProblem (class RenderPath, class TypeMismatchErr, type (:::), type (<>), type (|>), Opt, SNil, SList)
+import Data.Undefined.NoProblem (class RenderPath, class TypeMismatchErr, type (:::), type (<>), type (|>), Opt, Req, SList, SNil)
 import Effect (Effect)
 import Prim.RowList (class RowToList, Cons, Nil, RowList)
 import Prim.TypeError (class Fail, QuoteLabel, Text)
+import Type.Equality (class TypeEquals)
 import Unsafe.Coerce (unsafeCoerce)
 
 class CoerceProps
@@ -68,7 +69,10 @@ class CoerceProp (given :: Type) (expected :: Type) (debugPath ∷ SList) | expe
 -- -- |
 -- -- | The rest is handling errors and providing intances
 -- -- | for well known polymorphic types like `Maybe`, `Either`...
-instance coercePropOptValues
+instance coercePropReq
+  ∷ (TypeEquals a b)
+  ⇒ CoerceProp a (Req b) p
+else instance coercePropOptValues
   ∷ (CoerceProp a b p)
   ⇒ CoerceProp (Opt a) (Opt b) p
 else instance coercePropOptValue

test/Main.purs

@@ -1,7 +1,9 @@
 module Test.Main where
 
 import Prelude
+
 import Effect (Effect)
+import Test.PolymorphicFields as PolyFields
 import Test.README (closedCoerceArray, openCoerceArray, optValues, recordCoerce) as Test.README
 
 main ∷ Effect Unit
@@ -10,3 +12,4 @@ main = do
   Test.README.optValues
   Test.README.openCoerceArray
   Test.README.closedCoerceArray
+  PolyFields.test

test/PolymorphicFields.purs

@@ -0,0 +1,48 @@
+module Test.PolymorphicFields where
+
+import Prelude
+
+import Data.Array (catMaybes)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
+import Data.Undefined.NoProblem (Opt, Req(..), toMaybe)
+import Data.Undefined.NoProblem.Closed as Closed
+import Data.Undefined.NoProblem.Open as Open
+import Effect (Effect)
+import Test.Assert (assert)
+
+type Args a = { x :: Req a, y :: Opt a, z :: Int }
+
+closedConsumer :: forall args a. Closed.Coerce args (Args a) => Show a => args -> String
+closedConsumer args' = show $ catMaybes [Just (unwrap args.x), toMaybe args.y]
+  where
+    args = Closed.coerce args' :: Args a
+
+openConsumer :: forall args a. Open.Coerce args (Args a) => Show a => args -> String
+openConsumer args' = show $ catMaybes [Just (unwrap args.x), toMaybe args.y]
+  where
+    args = Open.coerce args' :: Args a
+
+test :: Effect Unit
+test = do
+  assert $
+    closedConsumer { x: "foo", z: 42 } == show ["foo"]
+  assert $
+    closedConsumer { x: "foo", y: "bar", z: 42 } == show ["foo", "bar"]
+  assert $
+    closedConsumer { x: true, z: 42 } == show [true]
+  assert $
+    closedConsumer { x: true, y: false, z: 42 } == show [true, false]
+  assert $ -- Make sure explicitly wrapping the field in `Req` also works
+    closedConsumer { x: Req 5, z: 42 } == show [5]
+
+  assert $
+    openConsumer { x: "foo", z: 42 } == show ["foo"]
+  assert $
+    openConsumer { x: "foo", y: "bar", z: 42 } == show ["foo", "bar"]
+  assert $
+    openConsumer { x: true, z: 42 } == show [true]
+  assert $
+    openConsumer { x: true, y: false, z: 42 } == show [true, false]
+  assert $ -- Make sure explicitly wrapping the field in `Req` also works
+    openConsumer { x: Req 5, z: 42 } == show [5]