Merge pull request #46 from purescript/bump

garyb · web-flow · commit b73e22facf38 · 2016-10-13T20:49:32.000+01:00
Prepare for 2.0 release
diff --git a/bower.json b/bower.json
@@ -26,7 +26,9 @@
     "purescript-foldable-traversable": "^2.0.0",
     "purescript-functions": "^2.0.0",
     "purescript-integers": "^2.0.0",
-    "purescript-strings": "^2.0.0"
+    "purescript-lists": "^2.1.0",
+    "purescript-strings": "^2.0.0",
+    "purescript-transformers": "^2.0.0"
   },
   "devDependencies": {
     "purescript-console": "^2.0.0"
diff --git a/examples/Applicative.purs b/examples/Applicative.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (class IsForeign, readJSON, readProp)
@@ -19,5 +20,5 @@ instance pointIsForeign :: IsForeign Point where
                      <*> readProp "z" value
 
 main :: Eff (console :: CONSOLE) Unit
-main = logShow $
+main = logShow $ runExcept $
   readJSON """{ "x": 1, "y": 2, "z": 3 }""" :: F Point
diff --git a/examples/Complex.purs b/examples/Complex.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (class IsForeign, readJSON, readProp)
@@ -52,4 +53,4 @@ instance listItemIsForeign :: IsForeign ListItem where
 main :: Eff (console :: CONSOLE) Unit
 main = do
   let json = """{"foo":"hello","bar":true,"baz":1,"list":[{"x":1,"y":2},{"x":3,"y":4,"z":999}]}"""
-  logShow $ readJSON json :: F SomeObject
+  logShow $ runExcept $ readJSON json :: F SomeObject
diff --git a/examples/Either.purs b/examples/Either.purs
@@ -1,14 +1,15 @@
 module Examples.Either where
 
 import Prelude
+
 import Control.Monad.Eff (Eff)
-import Data.Either (Either)
+import Control.Monad.Eff.Console (logShow, CONSOLE)
+import Control.Monad.Except (runExcept)
 
+import Data.Either (Either)
 import Data.Foreign (F, parseJSON)
 import Data.Foreign.Class (class IsForeign, readEitherR, readProp)
 
-import Control.Monad.Eff.Console (logShow, CONSOLE)
-
 data Point = Point Number Number Number
 
 instance showPoint :: Show Point where
@@ -23,10 +24,10 @@ type Response = Either (Array String) Point
 
 main :: forall eff. Eff (console :: CONSOLE | eff) Unit
 main = do
-  logShow do
+  logShow $ runExcept do
     json <- parseJSON """{ "x":1, "y": 2, "z": 3}"""
     readEitherR json :: F Response
 
-  logShow do
+  logShow $ runExcept do
     json <- parseJSON """["Invalid parse", "Not a valid y point"]"""
     readEitherR json :: F Response
diff --git a/examples/JSONArrays.purs b/examples/JSONArrays.purs
@@ -4,11 +4,12 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (readJSON)
 
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow $ readJSON """["hello", "world"]""" :: F (Array String)
-  logShow $ readJSON """[1, 2, 3, 4]""" :: F (Array Number)
+  logShow $ runExcept $ readJSON """["hello", "world"]""" :: F (Array String)
+  logShow $ runExcept $ readJSON """[1, 2, 3, 4]""" :: F (Array Number)
diff --git a/examples/JSONSimpleTypes.purs b/examples/JSONSimpleTypes.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F, unsafeFromForeign)
 import Data.Foreign.Class (readJSON, write)
@@ -12,9 +13,9 @@ import Data.Foreign.Class (readJSON, write)
 -- out of the box.
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow $ readJSON "\"a JSON string\"" :: F String
-  logShow $ readJSON "42" :: F Number
-  logShow $ readJSON "true" :: F Boolean
+  logShow $ runExcept $ readJSON "\"a JSON string\"" :: F String
+  logShow $ runExcept $ readJSON "42" :: F Number
+  logShow $ runExcept $ readJSON "true" :: F Boolean
   log $ unsafeFromForeign $ write "a JSON string"
   log $ unsafeFromForeign $ write 42.0
   log $ unsafeFromForeign $ write true
diff --git a/examples/MaybeNullable.purs b/examples/MaybeNullable.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F, unsafeFromForeign)
 import Data.Foreign.Class (readJSON, write)
@@ -14,7 +15,7 @@ import Data.Maybe (Maybe(..))
 -- using Maybe types.
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow $ unNull <$> readJSON "null" :: F (Null Boolean)
-  logShow $ unNull <$> readJSON "true" :: F (Null Boolean)
+  logShow $ unNull <$> runExcept (readJSON "null" :: F (Null Boolean))
+  logShow $ unNull <$> runExcept (readJSON "true" :: F (Null Boolean))
   log $ unsafeFromForeign $ write $ Null Nothing :: Null Boolean
   log $ unsafeFromForeign $ write $ Null $ Just true
diff --git a/examples/Nested.purs b/examples/Nested.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (class IsForeign, readJSON, readProp)
@@ -32,4 +33,4 @@ instance fooIsForeign :: IsForeign Foo where
 
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow $ readJSON """{ "foo": { "bar": "bar", "baz": 1 } }""" :: F Foo
+  logShow $ runExcept $ readJSON """{ "foo": { "bar": "bar", "baz": 1 } }""" :: F Foo
diff --git a/examples/Objects.purs b/examples/Objects.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F, writeObject, unsafeFromForeign)
 import Data.Foreign.Class (class AsForeign, class IsForeign, (.=), readJSON, readProp, write)
@@ -31,5 +32,5 @@ instance pointIsForeign :: IsForeign Point where
 
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow $ readJSON """{ "x": 1, "y": 2 }""" :: F Point
+  logShow $ runExcept $ readJSON """{ "x": 1, "y": 2 }""" :: F Point
   log $ unsafeFromForeign $ write $ Point { x: 1.0, y: 2.0 }
diff --git a/examples/ParseErrors.purs b/examples/ParseErrors.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (class IsForeign, readJSON, readProp)
@@ -26,15 +27,15 @@ main = do
 
   -- When trying to parse invalid JSON we catch an exception from
   -- `JSON.parse` and pass it on.
-  logShow $ readJSON "not even JSON" :: F String
+  logShow $ runExcept $ readJSON "not even JSON" :: F String
 
   -- When attempting to coerce one type to another we get an error.
-  logShow $ readJSON "26" :: F Boolean
+  logShow $ runExcept $ readJSON "26" :: F Boolean
 
   -- When parsing fails in an array, we're told at which index the value that
   -- failed to parse was, along with the reason the value didn't parse.
-  logShow $ readJSON "[1, true, 3]" :: F (Array Boolean)
+  logShow $ runExcept $ readJSON "[1, true, 3]" :: F (Array Boolean)
 
   -- When parsing fails in an object, we're the name of the property which
   -- failed to parse was, along with the reason the value didn't parse.
-  logShow $ readJSON """{ "x": 1, "y": false }""" :: F Point
+  logShow $ runExcept $ readJSON """{ "x": 1, "y": false }""" :: F Point
diff --git a/examples/Union.purs b/examples/Union.purs
@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Except (runExcept)
 
 import Data.Foreign (F)
 import Data.Foreign.Class (class IsForeign, readJSON, readProp)
@@ -25,7 +26,7 @@ instance stringListIsForeign :: IsForeign StringList where
 main :: Eff (console :: CONSOLE) Unit
 main = do
 
-  logShow $ readJSON """
+  logShow $ runExcept $ readJSON """
     { "nil": false
     , "head": "Hello"
     , "tail":
@@ -37,7 +38,7 @@ main = do
     }
     """ :: F StringList
 
-  logShow $ readJSON """
+  logShow $ runExcept $ readJSON """
     { "nil": false
     , "head": "Hello"
     , "tail":
diff --git a/src/Data/Foreign.purs b/src/Data/Foreign.purs
@@ -4,6 +4,7 @@
 module Data.Foreign
   ( Foreign
   , ForeignError(..)
+  , MultipleErrors(..)
   , Prop(..)
   , F
   , parseJSON
@@ -21,14 +22,19 @@ module Data.Foreign
   , readNumber
   , readInt
   , readArray
+  , fail
   , writeObject
   ) where
 
 import Prelude
 
+import Control.Monad.Except (Except, throwError, mapExcept)
+
 import Data.Either (Either(..), either)
 import Data.Function.Uncurried (Fn3, runFn3)
 import Data.Int as Int
+import Data.List.NonEmpty (NonEmptyList)
+import Data.List.NonEmpty as NEL
 import Data.Maybe (maybe)
 import Data.String (toChar)
 
@@ -44,31 +50,43 @@ import Data.String (toChar)
 -- | - To integrate with external JavaScript libraries.
 foreign import data Foreign :: *
 
--- | A type for runtime type errors
+-- | A type for foreign type errors
 data ForeignError
-  = TypeMismatch String String
+  = ForeignError String
+  | TypeMismatch 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
-
 derive instance eqForeignError :: Eq ForeignError
 derive instance ordForeignError :: Ord ForeignError
 
--- | An error monad, used in this library to encode possible failure when
+instance showForeignError :: Show ForeignError where
+  show (ForeignError msg) = "(ForeignError " <> msg <> ")"
+  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 <> ")"
+
+-- | A type for accumulating multiple `ForeignError`s.
+type MultipleErrors = NonEmptyList ForeignError
+
+renderForeignError :: ForeignError -> String
+renderForeignError (ForeignError msg) = msg
+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 exp act) = "Type mismatch: expected " <> exp <> ", found " <> act
+
+-- | An error monad, used in this library to encode possible failures when
 -- | dealing with foreign data.
-type F = Either ForeignError
+type F a = Except MultipleErrors a
 
 foreign import parseJSONImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r
 
 -- | Attempt to parse a JSON string, returning the result as foreign data.
 parseJSON :: String -> F Foreign
-parseJSON json = runFn3 parseJSONImpl (Left <<< JSONError) Right json
+parseJSON json = runFn3 parseJSONImpl (fail <<< JSONError) pure json
 
 -- | Coerce any value to the a `Foreign` value.
 foreign import toForeign :: forall a. a -> Foreign
@@ -87,8 +105,9 @@ foreign import tagOf :: Foreign -> String
 -- | Unsafely coerce a `Foreign` value when the value has a particular `tagOf`
 -- | 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
+  | tagOf value == tag = pure (unsafeFromForeign value)
+  | otherwise = fail $ TypeMismatch tag (tagOf value)
 
 -- | Test whether a foreign value is null
 foreign import isNull :: Foreign -> Boolean
@@ -105,13 +124,10 @@ readString = unsafeReadTagged "String"
 
 -- | Attempt to coerce a foreign value to a `Char`.
 readChar :: Foreign -> F Char
-readChar value = either (const error) fromString (readString value)
+readChar value = mapExcept (either (const error) fromString) (readString value)
   where
-  fromString :: String -> F Char
   fromString = maybe error pure <<< toChar
-
-  error :: F Char
-  error = Left $ TypeMismatch "Char" (tagOf value)
+  error = Left $ NEL.singleton $ TypeMismatch "Char" (tagOf value)
 
 -- | Attempt to coerce a foreign value to a `Boolean`.
 readBoolean :: Foreign -> F Boolean
@@ -123,18 +139,20 @@ readNumber = unsafeReadTagged "Number"
 
 -- | Attempt to coerce a foreign value to an `Int`.
 readInt :: Foreign -> F Int
-readInt value = either (const error) fromNumber (readNumber value)
+readInt value = mapExcept (either (const error) fromNumber) (readNumber value)
   where
-  fromNumber :: Number -> F Int
   fromNumber = maybe error pure <<< Int.fromNumber
-
-  error :: F Int
-  error = Left $ TypeMismatch "Int" (tagOf value)
+  error = Left $ NEL.singleton $ 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
+  | isArray value = pure $ unsafeFromForeign value
+  | otherwise = fail $ TypeMismatch "array" (tagOf value)
+
+-- | Throws a failure error in `F`.
+fail :: forall a. ForeignError -> F a
+fail = throwError <<< NEL.singleton
 
 -- | A key/value pair for an object to be written as a `Foreign` value.
 newtype Prop = Prop { key :: String, value :: Foreign }
diff --git a/src/Data/Foreign/Class.purs b/src/Data/Foreign/Class.purs
@@ -16,15 +16,18 @@ module Data.Foreign.Class
 import Prelude
 
 import Control.Alt ((<|>))
+import Control.Monad.Except (Except, mapExcept)
+
 import Data.Array (range, zipWith, length)
-import Data.Either (Either(..), either)
-import Data.Foreign (F, Foreign, ForeignError(..), Prop(..), parseJSON, readArray, readInt, readNumber, readBoolean, readChar, readString, toForeign)
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
+import Data.Foreign (F, Foreign, MultipleErrors, ForeignError(..), Prop(..), toForeign, parseJSON, readArray, readInt, readNumber, readBoolean, readChar, readString)
 import Data.Foreign.Index (class Index, errorAt, (!))
 import Data.Foreign.Null (Null(..), readNull, writeNull)
 import Data.Foreign.NullOrUndefined (NullOrUndefined(..), readNullOrUndefined)
 import Data.Foreign.Undefined (Undefined(..), readUndefined, writeUndefined)
-import Data.Traversable (sequence)
 import Data.Maybe (maybe)
+import Data.Traversable (sequence)
 
 -- | A type class instance for this class can be written for a type if it
 -- | is possible to attempt to _safely_ coerce a `Foreign` value to that
@@ -60,7 +63,7 @@ instance arrayIsForeign :: IsForeign a => IsForeign (Array a) where
     readElements arr = sequence (zipWith readElement (range zero (length arr)) arr)
 
     readElement :: Int -> Foreign -> F a
-    readElement i value = readWith (ErrorAtIndex i) value
+    readElement i value = readWith (map (ErrorAtIndex i)) value
 
 instance nullIsForeign :: IsForeign a => IsForeign (Null a) where
   read = readNull read
@@ -76,12 +79,12 @@ readJSON :: forall a. IsForeign a => String -> F a
 readJSON json = parseJSON json >>= read
 
 -- | Attempt to read a foreign value, handling errors using the specified function
-readWith :: forall a e. IsForeign a => (ForeignError -> e) -> Foreign -> Either e a
-readWith f value = either (Left <<< f) Right (read value)
+readWith :: forall a e. IsForeign a => (MultipleErrors -> e) -> Foreign -> Except e a
+readWith f = mapExcept (lmap f) <<< read
 
 -- | Attempt to read a property of a foreign value at the specified index
 readProp :: forall a i. (IsForeign a, Index i) => i -> Foreign -> F a
-readProp prop value = value ! prop >>= readWith (errorAt prop)
+readProp prop value = value ! prop >>= readWith (map (errorAt prop))
 
 -- | A type class to convert to a `Foreign` value.
 -- |
diff --git a/src/Data/Foreign/Index.purs b/src/Data/Foreign/Index.purs
diff --git a/src/Data/Foreign/Keys.purs b/src/Data/Foreign/Keys.purs
