Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 19 additions & 9 deletions src/Data/Foreign.purs
Original file line number Diff line number Diff line change
Expand Up @@ -44,16 +44,16 @@ 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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

While we're breaking things here, we should make this into a valid Show instance, and move this into a renderForeignError function.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure I understand, what makes this an invalid Show instance?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's an informal rule that Show should print purescript code, so like "(TypeMismatch " <> show exp <> show act <> ")" style, for each case.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah I see, thanks.

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 (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'
Expand All @@ -62,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
Expand Down Expand Up @@ -90,7 +100,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
Expand All @@ -113,7 +123,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
Expand All @@ -131,9 +141,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))
2 changes: 1 addition & 1 deletion src/Data/Foreign/Index.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/Data/Foreign/Keys.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)