From db152b53ddf21fcdba3595a09993946e28f36b24 Mon Sep 17 00:00:00 2001 From: Brian Sermons Date: Fri, 8 Jul 2016 05:44:15 -0500 Subject: [PATCH 1/2] Update TypeMismatch for multiple possible types. --- src/Data/Foreign.purs | 16 ++++++++++------ src/Data/Foreign/Index.purs | 2 +- src/Data/Foreign/Keys.purs | 6 +++--- 3 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/Data/Foreign.purs b/src/Data/Foreign.purs index a75f6ca..48b5de4 100644 --- a/src/Data/Foreign.purs +++ b/src/Data/Foreign.purs @@ -44,16 +44,20 @@ foreign import data Foreign :: * -- | A type for runtime type errors data ForeignError - = TypeMismatch String String + = TypeMismatch (Array String) String | ErrorAtIndex Int ForeignError | ErrorAtProperty String ForeignError | JSONError String instance showForeignError :: Show ForeignError where - show (TypeMismatch exp act) = "Type mismatch: expected " <> exp <> ", found " <> act show (ErrorAtIndex i e) = "Error at array index " <> show i <> ": " <> show e show (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> show e show (JSONError s) = "JSON error: " <> s + show (TypeMismatch exps act) = "Type mismatch: expected " <> to_s exps <> ", found " <> act + where + to_s [] = "???" + to_s [typ] = typ + to_s typs = "one of " <> show typs instance eqForeignError :: Eq ForeignError where eq (TypeMismatch a b) (TypeMismatch a' b') = a == a' && b == b' @@ -90,7 +94,7 @@ foreign import tagOf :: Foreign -> String -- | value. unsafeReadTagged :: forall a. String -> Foreign -> F a unsafeReadTagged tag value | tagOf value == tag = pure (unsafeFromForeign value) -unsafeReadTagged tag value = Left (TypeMismatch tag (tagOf value)) +unsafeReadTagged tag value = Left (TypeMismatch [tag] (tagOf value)) -- | Test whether a foreign value is null foreign import isNull :: Foreign -> Boolean @@ -113,7 +117,7 @@ readChar value = either (const error) fromString (readString value) fromString = maybe error pure <<< toChar error :: F Char - error = Left $ TypeMismatch "Char" (tagOf value) + error = Left $ TypeMismatch ["Char"] (tagOf value) -- | Attempt to coerce a foreign value to a `Boolean`. readBoolean :: Foreign -> F Boolean @@ -131,9 +135,9 @@ readInt value = either (const error) fromNumber (readNumber value) fromNumber = maybe error pure <<< Int.fromNumber error :: F Int - error = Left $ TypeMismatch "Int" (tagOf value) + error = Left $ TypeMismatch ["Int"] (tagOf value) -- | Attempt to coerce a foreign value to an array. readArray :: Foreign -> F (Array Foreign) readArray value | isArray value = pure $ unsafeFromForeign value -readArray value = Left (TypeMismatch "array" (tagOf value)) +readArray value = Left (TypeMismatch ["array"] (tagOf value)) diff --git a/src/Data/Foreign/Index.purs b/src/Data/Foreign/Index.purs index 5e525ac..dbe5d5c 100644 --- a/src/Data/Foreign/Index.purs +++ b/src/Data/Foreign/Index.purs @@ -31,7 +31,7 @@ infixl 9 ix as ! foreign import unsafeReadPropImpl :: forall r k. Fn4 r (Foreign -> r) k Foreign (F Foreign) unsafeReadProp :: forall k. k -> Foreign -> F Foreign -unsafeReadProp k value = runFn4 unsafeReadPropImpl (Left (TypeMismatch "object" (typeOf value))) pure k value +unsafeReadProp k value = runFn4 unsafeReadPropImpl (Left (TypeMismatch ["object"] (typeOf value))) pure k value -- | Attempt to read a value from a foreign value property prop :: String -> Foreign -> F Foreign diff --git a/src/Data/Foreign/Keys.purs b/src/Data/Foreign/Keys.purs index 652361c..13c73f5 100644 --- a/src/Data/Foreign/Keys.purs +++ b/src/Data/Foreign/Keys.purs @@ -14,7 +14,7 @@ foreign import unsafeKeys :: Foreign -> Array String -- | Get an array of the properties defined on a foreign value keys :: Foreign -> F (Array String) -keys value | isNull value = Left $ TypeMismatch "object" "null" -keys value | isUndefined value = Left $ TypeMismatch "object" "undefined" +keys value | isNull value = Left $ TypeMismatch ["object"] "null" +keys value | isUndefined value = Left $ TypeMismatch ["object"] "undefined" keys value | typeOf value == "object" = Right $ unsafeKeys value -keys value = Left $ TypeMismatch "object" (typeOf value) +keys value = Left $ TypeMismatch ["object"] (typeOf value) From d138a3029fd4af32321784aabe1db934804ccccf Mon Sep 17 00:00:00 2001 From: Brian Sermons Date: Mon, 11 Jul 2016 09:41:52 -0500 Subject: [PATCH 2/2] Fix ForeignError Show instance. --- src/Data/Foreign.purs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Data/Foreign.purs b/src/Data/Foreign.purs index 48b5de4..4638284 100644 --- a/src/Data/Foreign.purs +++ b/src/Data/Foreign.purs @@ -50,14 +50,10 @@ data ForeignError | JSONError String instance showForeignError :: Show ForeignError where - show (ErrorAtIndex i e) = "Error at array index " <> show i <> ": " <> show e - show (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> show e - show (JSONError s) = "JSON error: " <> s - show (TypeMismatch exps act) = "Type mismatch: expected " <> to_s exps <> ", found " <> act - where - to_s [] = "???" - to_s [typ] = typ - to_s typs = "one of " <> show typs + show (ErrorAtIndex i e) = "(ErrorAtIndex " <> show i <> " " <> show e <> ")" + show (ErrorAtProperty prop e) = "(ErrorAtProperty " <> show prop <> " " <> show e <> ")" + show (JSONError s) = "(JSONError " <> show s <> ")" + show (TypeMismatch exps act) = "(TypeMismatch " <> show exps <> " " <> show act <> ")" instance eqForeignError :: Eq ForeignError where eq (TypeMismatch a b) (TypeMismatch a' b') = a == a' && b == b' @@ -66,6 +62,16 @@ instance eqForeignError :: Eq ForeignError where eq (JSONError s) (JSONError s') = s == s' eq _ _ = false +renderForeignError :: ForeignError -> String +renderForeignError (ErrorAtIndex i e) = "Error at array index " <> show i <> ": " <> show e +renderForeignError (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> show e +renderForeignError (JSONError s) = "JSON error: " <> s +renderForeignError (TypeMismatch exps act) = "Type mismatch: expected " <> to_s exps <> ", found " <> act + where + to_s [] = "???" + to_s [typ] = typ + to_s typs = "one of " <> show typs + -- | An error monad, used in this library to encode possible failure when -- | dealing with foreign data. type F = Either ForeignError