From fa1d4f0358c157b8880f8b8d77fe293bdb443212 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 15 Mar 2022 17:47:24 -0500 Subject: [PATCH 1/3] Use ExceptT (NonEmptyList ForeignError) directly --- examples/Applicative.purs | 7 ++++--- examples/Complex.purs | 9 +++++---- examples/Objects.purs | 7 ++++--- examples/ParseErrors.purs | 7 ++++--- examples/Union.purs | 7 ++++--- examples/Util/Value.purs | 6 ++++-- src/Foreign.purs | 24 ++++++++++++------------ src/Foreign/Index.purs | 12 ++++++------ src/Foreign/Keys.purs | 6 ++++-- 9 files changed, 47 insertions(+), 38 deletions(-) diff --git a/examples/Applicative.purs b/examples/Applicative.purs index 9f9f5c3..52961c6 100755 --- a/examples/Applicative.purs +++ b/examples/Applicative.purs @@ -2,11 +2,12 @@ module Example.Applicative where import Prelude -import Control.Monad.Except (runExcept) +import Control.Monad.Except (Except, runExcept) +import Data.List.NonEmpty (NonEmptyList) import Effect (Effect) import Effect.Console (logShow) import Example.Util.Value (foreignValue) -import Foreign (F, Foreign, readNumber) +import Foreign (Foreign, ForeignError, readNumber) import Foreign.Index ((!)) data Point = Point Number Number Number @@ -14,7 +15,7 @@ data Point = Point Number Number Number instance showPoint :: Show Point where show (Point x y z) = "(Point " <> show [x, y, z] <> ")" -readPoint :: Foreign -> F Point +readPoint :: Foreign -> Except (NonEmptyList ForeignError) Point readPoint value = do Point <$> (value ! "x" >>= readNumber) diff --git a/examples/Complex.purs b/examples/Complex.purs index 0a96a4d..68b6875 100755 --- a/examples/Complex.purs +++ b/examples/Complex.purs @@ -2,13 +2,14 @@ module Example.Complex where import Prelude -import Control.Monad.Except (runExcept) +import Control.Monad.Except (Except, runExcept) +import Data.List.NonEmpty (NonEmptyList) import Data.Maybe (Maybe) import Data.Traversable (traverse) import Effect (Effect) import Effect.Console (logShow) import Example.Util.Value (foreignValue) -import Foreign (F, Foreign, readArray, readBoolean, readNumber, readString, readNullOrUndefined) +import Foreign (Foreign, ForeignError, readArray, readBoolean, readNumber, readString, readNullOrUndefined) import Foreign.Index ((!)) type SomeObject = @@ -18,7 +19,7 @@ type SomeObject = , list :: Array ListItem } -readSomeObject :: Foreign -> F SomeObject +readSomeObject :: Foreign -> Except (NonEmptyList ForeignError) SomeObject readSomeObject value = do foo <- value ! "foo" >>= readString bar <- value ! "bar" >>= readBoolean @@ -32,7 +33,7 @@ type ListItem = , z :: Maybe Number } -readListItem :: Foreign -> F ListItem +readListItem :: Foreign -> Except (NonEmptyList ForeignError) ListItem readListItem value = do x <- value ! "x" >>= readNumber y <- value ! "y" >>= readNumber diff --git a/examples/Objects.purs b/examples/Objects.purs index 3a9893b..d2fdca9 100755 --- a/examples/Objects.purs +++ b/examples/Objects.purs @@ -2,16 +2,17 @@ module Example.Objects where import Prelude -import Control.Monad.Except (runExcept) +import Control.Monad.Except (Except, runExcept) +import Data.List.NonEmpty (NonEmptyList) import Effect (Effect) import Effect.Console (logShow) import Example.Util.Value (foreignValue) -import Foreign (F, Foreign, readNumber) +import Foreign (Foreign, ForeignError, readNumber) import Foreign.Index ((!)) type Point = { x :: Number, y :: Number } -readPoint :: Foreign -> F Point +readPoint :: Foreign -> Except (NonEmptyList ForeignError) Point readPoint value = do x <- value ! "x" >>= readNumber y <- value ! "y" >>= readNumber diff --git a/examples/ParseErrors.purs b/examples/ParseErrors.purs index 52faf30..1a4c60a 100755 --- a/examples/ParseErrors.purs +++ b/examples/ParseErrors.purs @@ -2,12 +2,13 @@ module Example.ParseErrors where import Prelude -import Control.Monad.Except (runExcept) +import Control.Monad.Except (Except, runExcept) +import Data.List.NonEmpty (NonEmptyList) import Data.Traversable (traverse) import Effect (Effect) import Effect.Console (logShow) import Example.Util.Value (foreignValue) -import Foreign (F, Foreign, readArray, readBoolean, readNumber, readString) +import Foreign (Foreign, ForeignError, readArray, readBoolean, readNumber, readString) import Foreign.Index ((!)) newtype Point = Point { x :: Number, y :: Number } @@ -15,7 +16,7 @@ newtype Point = Point { x :: Number, y :: Number } instance showPoint :: Show Point where show (Point o) = "(Point { x: " <> show o.x <> ", y: " <> show o.y <> " })" -readPoint :: Foreign -> F Point +readPoint :: Foreign -> Except (NonEmptyList ForeignError) Point readPoint value = do x <- value ! "x" >>= readNumber y <- value ! "y" >>= readNumber diff --git a/examples/Union.purs b/examples/Union.purs index 06504da..feee5d1 100755 --- a/examples/Union.purs +++ b/examples/Union.purs @@ -2,11 +2,12 @@ module Example.Union where import Prelude -import Control.Monad.Except (runExcept) +import Control.Monad.Except (Except, runExcept) +import Data.List.NonEmpty (NonEmptyList) import Effect (Effect) import Effect.Console (logShow) import Example.Util.Value (foreignValue) -import Foreign (F, Foreign, readBoolean, readString) +import Foreign (Foreign, ForeignError, readBoolean, readString) import Foreign.Index ((!)) data StringList = Nil | Cons String StringList @@ -15,7 +16,7 @@ instance showStringList :: Show StringList where show Nil = "Nil" show (Cons s l) = "(Cons " <> show s <> " " <> show l <> ")" -readStringList :: Foreign -> F StringList +readStringList :: Foreign -> Except (NonEmptyList ForeignError) StringList readStringList value = value ! "nil" >>= readBoolean >>= diff --git a/examples/Util/Value.purs b/examples/Util/Value.purs index 50f7b8f..f70cc40 100644 --- a/examples/Util/Value.purs +++ b/examples/Util/Value.purs @@ -2,11 +2,13 @@ module Example.Util.Value where import Prelude +import Control.Monad.Except (Except) import Data.Function.Uncurried (Fn3, runFn3) +import Data.List.NonEmpty (NonEmptyList) -import Foreign (F, Foreign, ForeignError(..), fail) +import Foreign (Foreign, ForeignError(..), fail) foreign import foreignValueImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r -foreignValue :: String -> F Foreign +foreignValue :: String -> Except (NonEmptyList ForeignError) Foreign foreignValue json = runFn3 foreignValueImpl (fail <<< ForeignError) pure json diff --git a/src/Foreign.purs b/src/Foreign.purs index 0873909..c9a0166 100644 --- a/src/Foreign.purs +++ b/src/Foreign.purs @@ -107,7 +107,7 @@ foreign import tagOf :: Foreign -> String -- | Unsafely coerce a `Foreign` value when the value has a particular `tagOf` -- | value. -unsafeReadTagged :: forall m a. Monad m => String -> Foreign -> FT m a +unsafeReadTagged :: forall m a. Monad m => String -> Foreign -> ExceptT (NonEmptyList ForeignError) m a unsafeReadTagged tag value | tagOf value == tag = pure (unsafeFromForeign value) | otherwise = fail $ TypeMismatch tag (tagOf value) @@ -122,52 +122,52 @@ foreign import isUndefined :: Foreign -> Boolean foreign import isArray :: Foreign -> Boolean -- | Attempt to coerce a foreign value to a `String`. -readString :: forall m. Monad m => Foreign -> FT m String +readString :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m String readString = unsafeReadTagged "String" -- | Attempt to coerce a foreign value to a `Char`. -readChar :: forall m. Monad m => Foreign -> FT m Char +readChar :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Char readChar value = mapExceptT (map $ either (const error) fromString) (readString value) where fromString = maybe error pure <<< toChar error = Left $ NEL.singleton $ TypeMismatch "Char" (tagOf value) -- | Attempt to coerce a foreign value to a `Boolean`. -readBoolean :: forall m. Monad m => Foreign -> FT m Boolean +readBoolean :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Boolean readBoolean = unsafeReadTagged "Boolean" -- | Attempt to coerce a foreign value to a `Number`. -readNumber :: forall m. Monad m => Foreign -> FT m Number +readNumber :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Number readNumber = unsafeReadTagged "Number" -- | Attempt to coerce a foreign value to an `Int`. -readInt :: forall m. Monad m => Foreign -> FT m Int +readInt :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Int readInt value = mapExceptT (map $ either (const error) fromNumber) (readNumber value) where fromNumber = maybe error pure <<< Int.fromNumber error = Left $ NEL.singleton $ TypeMismatch "Int" (tagOf value) -- | Attempt to coerce a foreign value to an array. -readArray :: forall m. Monad m => Foreign -> FT m (Array Foreign) +readArray :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Array Foreign) readArray value | isArray value = pure $ unsafeFromForeign value | otherwise = fail $ TypeMismatch "array" (tagOf value) -readNull :: forall m. Monad m => Foreign -> FT m (Maybe Foreign) +readNull :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign) readNull value | isNull value = pure Nothing | otherwise = pure (Just value) -readUndefined :: forall m. Monad m => Foreign -> FT m (Maybe Foreign) +readUndefined :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign) readUndefined value | isUndefined value = pure Nothing | otherwise = pure (Just value) -readNullOrUndefined :: forall m. Monad m => Foreign -> FT m (Maybe Foreign) +readNullOrUndefined :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign) readNullOrUndefined value | isNull value || isUndefined value = pure Nothing | otherwise = pure (Just value) --- | Throws a failure error in `FT`. -fail :: forall m a. Monad m => ForeignError -> FT m a +-- | Throws a failure error in `ExceptT (NonEmptyList ForeignError) m`. +fail :: forall m a. Monad m => ForeignError -> ExceptT (NonEmptyList ForeignError) m a fail = throwError <<< NEL.singleton diff --git a/src/Foreign/Index.purs b/src/Foreign/Index.purs index 5e4150a..994db83 100644 --- a/src/Foreign/Index.purs +++ b/src/Foreign/Index.purs @@ -17,7 +17,7 @@ import Prelude import Control.Monad.Except.Trans (ExceptT) -import Foreign (Foreign, FT, ForeignError(..), typeOf, isUndefined, isNull, fail) +import Foreign (Foreign, ForeignError(..), typeOf, isUndefined, isNull, fail) import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) import Data.List.NonEmpty (NonEmptyList) @@ -25,28 +25,28 @@ import Data.List.NonEmpty (NonEmptyList) -- | -- | The canonical instances are for `String`s and `Int`s. class Index i m | i -> m where - index :: Foreign -> i -> FT m Foreign + index :: Foreign -> i -> ExceptT (NonEmptyList ForeignError) m Foreign hasProperty :: i -> Foreign -> Boolean hasOwnProperty :: i -> Foreign -> Boolean errorAt :: i -> ForeignError -> ForeignError class Indexable a m | a -> m where - ix :: forall i. Index i m => a -> i -> FT m Foreign + ix :: forall i. Index i m => a -> i -> ExceptT (NonEmptyList ForeignError) m Foreign infixl 9 ix as ! foreign import unsafeReadPropImpl :: forall r k. Fn4 r (Foreign -> r) k Foreign r -unsafeReadProp :: forall k m. Monad m => k -> Foreign -> FT m Foreign +unsafeReadProp :: forall k m. Monad m => k -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign unsafeReadProp k value = runFn4 unsafeReadPropImpl (fail (TypeMismatch "object" (typeOf value))) pure k value -- | Attempt to read a value from a foreign value property -readProp :: forall m. Monad m => String -> Foreign -> FT m Foreign +readProp :: forall m. Monad m => String -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign readProp = unsafeReadProp -- | Attempt to read a value from a foreign value at the specified numeric index -readIndex :: forall m. Monad m => Int -> Foreign -> FT m Foreign +readIndex :: forall m. Monad m => Int -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign readIndex = unsafeReadProp foreign import unsafeHasOwnProperty :: forall k. Fn2 k Foreign Boolean diff --git a/src/Foreign/Keys.purs b/src/Foreign/Keys.purs index 546c4d6..bca6595 100644 --- a/src/Foreign/Keys.purs +++ b/src/Foreign/Keys.purs @@ -7,12 +7,14 @@ module Foreign.Keys import Prelude -import Foreign (FT, Foreign, ForeignError(..), typeOf, isUndefined, isNull, fail) +import Foreign (Foreign, ForeignError(..), typeOf, isUndefined, isNull, fail) +import Control.Monad.Except (ExceptT) +import Data.List.NonEmpty (NonEmptyList) foreign import unsafeKeys :: Foreign -> Array String -- | Get an array of the properties defined on a foreign value -keys :: forall m. Monad m => Foreign -> FT m (Array String) +keys :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Array String) keys value | isNull value = fail $ TypeMismatch "object" "null" | isUndefined value = fail $ TypeMismatch "object" "undefined" From 9bac834845966ca58bcd61b16bea5a441148ca35 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 15 Mar 2022 17:47:45 -0500 Subject: [PATCH 2/3] Copy doc comments to module; discourage usage --- src/Foreign.purs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Foreign.purs b/src/Foreign.purs index c9a0166..e655e25 100644 --- a/src/Foreign.purs +++ b/src/Foreign.purs @@ -1,6 +1,11 @@ -- | This module defines types and functions for working with _foreign_ -- | data. - +-- | +-- | `ExceptT (NonEmptyList ForeignError) m` is used in this library +-- | to encode possible failures when dealing with foreign data. +-- | +-- | The `Alt` instance for `ExceptT` allows us to accumulate errors, +-- | unlike `Either`, which preserves only the last error. module Foreign ( Foreign , ForeignError(..) @@ -76,12 +81,20 @@ renderForeignError (ErrorAtIndex i e) = "Error at array index " <> show i <> ": renderForeignError (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> renderForeignError e renderForeignError (TypeMismatch exp act) = "Type mismatch: expected " <> exp <> ", found " <> act +-- | While this alias is not deprecated, it is recommended +-- | that one use `Except (NonEmptyList ForeignError)` directly +-- | for all future usages rather than this type alias. +-- | -- | An error monad, used in this library to encode possible failures when -- | dealing with foreign data. -- | -- | The `Alt` instance for `Except` allows us to accumulate errors, -- | unlike `Either`, which preserves only the last error. type F = Except MultipleErrors + +-- | While this alias is not deprecated, it is recommended +-- | that one use `ExceptT (NonEmptyList ForeignError)` directly +-- | for all future usages rather than this type alias. type FT = ExceptT MultipleErrors -- | Coerce any value to the a `Foreign` value. From 0a7fb351c1e7ebbd40c7dbd3163bf73a1c8a85b0 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 15 Mar 2022 17:50:20 -0500 Subject: [PATCH 3/3] Added changelog entry --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ce8361b..5ea7e14 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,11 @@ New features: Bugfixes: Other improvements: +- Replace all usages of `F` and `FT` with `Except`/`ExceptT (NonEmptyList ForeignError)` (#87 by @JordanMartinez) + + Often times, the `F` and `FT` aliases did more to hinder usage of this library than help. These aliases + haven't been deprecated, but usage of them is now discouraged. All code in the library now uses + the full type that is aliased by `F` and `FT`. ## [v6.0.1](https://github.com/purescript/purescript-foreign/releases/tag/v6.0.1) - 2021-04-20