updates for 0.10

Author: paf31

.gitignore

@@ -1,3 +1,5 @@
-bower_components
-output
 .psci*
+bower_components/
+output/
+.psc-package
+.psc-ide-port

bower.json

@@ -15,16 +15,17 @@
     "url": "git://github.com/paf31/purescript-foreign-generic.git"
   },
   "dependencies": {
-    "purescript-console": "^1.0.0",
-    "purescript-eff": "^1.0.0",
-    "purescript-exceptions": "^1.0.0",
-    "purescript-foreign": "^1.0.0",
-    "purescript-generics": "^1.0.0",
-    "purescript-globals": "^1.0.0",
-    "purescript-maps": "^1.0.0",
-    "purescript-nullable": "^1.0.0"
+    "purescript-console": "^2.0.0",
+    "purescript-eff": "^2.0.0",
+    "purescript-exceptions": "^2.0.0",
+    "purescript-foreign": "^3.0.0",
+    "purescript-generics": "^3.0.0",
+    "purescript-globals": "^2.0.0",
+    "purescript-maps": "^2.0.0",
+    "purescript-nullable": "^2.0.0",
+    "purescript-symbols": "^1.0.1"
   },
   "devDependencies": {
-    "purescript-assert": "^1.0.0"
+    "purescript-assert": "^2.0.0"
   }
 }

psc-package.json

@@ -0,0 +1,15 @@
+{
+    "name": "foreign-generic",
+    "source": "https://github.com/purescript/package-sets.git",
+    "set": "psc-0.10.1",
+    "depends": [
+      "console",
+      "eff",
+      "exceptions",
+      "foreign",
+      "generics",
+      "globals",
+      "maps",
+      "nullable"
+    ]
+}

src/Data/Foreign/Generic.purs

@@ -2,19 +2,15 @@ module Data.Foreign.Generic where
 
 import Prelude
 
-import Control.Bind ((>=>))
 import Control.Monad.Eff.Exception.Unsafe (unsafeThrow)
 import Data.Array (zipWith, zipWithA, sortBy)
-import Data.Either (Either(..))
 import Data.Foldable (find)
-import Data.Foreign (F, Foreign, ForeignError(..), parseJSON, toForeign, readArray,
-                     readString, isUndefined, isNull, readBoolean, readChar, readInt,
-                     readNumber)
+import Data.Foreign (F, Foreign, ForeignError(..), fail, parseJSON, toForeign,
+                     readArray, readString, isUndefined, isNull, readBoolean,
+                     readChar, readInt, readNumber)
 import Data.Foreign.Index (prop, (!))
 import Data.Function (on)
-import Data.Generic (class Generic, GenericSignature(..), GenericSpine(..), toSpine,
-                     toSignature, fromSpine)
-import Data.List as L
+import Data.Generic (class Generic, GenericSignature(..), GenericSpine(..), toSpine, toSignature, fromSpine)
 import Data.Maybe (Maybe(..))
 import Data.Nullable (toNullable)
 import Data.StrMap as S
@@ -98,13 +94,13 @@ readGeneric { sumEncoding
         x <- go (_1 unit) a
         y <- go (_2 unit) b
         pure $ SProd "Data.Tuple.Tuple" [\_ -> x, \_ -> y]
-      _ -> Left (TypeMismatch "array of length 2" "array")
+      _ -> fail (TypeMismatch "array of length 2" "array")
   go (SigProd _ alts) f =
     case sumEncoding of
       TaggedObject { tagFieldName, contentsFieldName } -> do
         tag <- prop tagFieldName f >>= readString
         case find (\alt -> alt.sigConstructor == tag) alts of
-          Nothing -> Left (TypeMismatch ("one of " <> show (map _.sigConstructor alts)) tag)
+          Nothing -> fail (TypeMismatch ("one of " <> show (map _.sigConstructor alts)) tag)
           Just { sigValues: [] } -> pure (SProd tag [])
           Just { sigValues: [sig] } | unwrapSingleArgumentConstructors -> do
             val <- prop contentsFieldName f
@@ -131,7 +127,7 @@ toForeignGeneric { sumEncoding
   go _ (SString s)  = toForeign s
   go _ (SBoolean b) = toForeign b
   go (SigArray sig) (SArray arr) = toForeign (map (go (sig unit) <<< (_ $ unit)) arr)
-  go (SigRecord sigs) (SRecord sps) = toForeign (S.fromList (L.fromFoldable pairs))
+  go (SigRecord sigs) (SRecord sps) = toForeign (S.fromFoldable pairs)
     where
     pairs :: Array (Tuple String Foreign)
     pairs = zipWith pair (sortBy (compare `on` _.recLabel) sigs)
@@ -151,14 +147,14 @@ toForeignGeneric { sumEncoding
           Nothing -> unsafeThrow ("No signature for data constructor " <> tag)
           Just { sigValues } ->
             case zipWith (\sig sp -> go (sig unit) (sp unit)) sigValues sps of
-              [] -> toForeign (S.fromList (L.singleton (Tuple tagFieldName (toForeign tag))))
+              [] -> toForeign (S.singleton tagFieldName (toForeign tag))
               [f] | unwrapSingleArgumentConstructors ->
-                    toForeign (S.fromList (L.fromFoldable [ Tuple tagFieldName (toForeign tag)
-                                                          , Tuple contentsFieldName f
-                                                          ]))
-              fs -> toForeign (S.fromList (L.fromFoldable [ Tuple tagFieldName (toForeign tag)
-                                                          , Tuple contentsFieldName (toForeign fs)
-                                                          ]))
+                    toForeign (S.fromFoldable [ Tuple tagFieldName (toForeign tag)
+                                              , Tuple contentsFieldName f
+                                              ])
+              fs -> toForeign (S.fromFoldable [ Tuple tagFieldName (toForeign tag)
+                                              , Tuple contentsFieldName (toForeign fs)
+                                                        ])
   go _ _ = unsafeThrow "Invalid spine for signature"
 
 -- | Read a value which has a `Generic` type from a JSON String

test/Main.purs

@@ -1,16 +1,16 @@
 module Test.Main where
 
 import Prelude
-
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Except (runExcept)
 import Data.Bifunctor (bimap)
 import Data.Either (Either(..))
 import Data.Foreign (F)
 import Data.Foreign.Generic (Options, defaultOptions, readJSONGeneric, toJSONGeneric)
 import Data.Generic (class Generic, gEq, gShow)
 import Data.Tuple (Tuple(..))
-import Test.Assert (assert, assert', ASSERT())
+import Test.Assert (assert, assert', ASSERT)
 
 -- | Balanced binary leaf trees
 data Tree a = Leaf a | Branch (Tree (Tuple a a))
@@ -71,7 +71,7 @@ testTree
 testTree = do
   let json = writeTree tree
   log json
-  case readTree json of
+  case runExcept (readTree json) of
     Right tree1 -> do
       log (gShow tree1)
       assert (gEq tree tree1)
@@ -93,7 +93,7 @@ test thing = do
   log ""
   let json = toJSONGeneric defaultOptions thing
   log json
-  case readJSONGeneric defaultOptions json :: F a of
+  case runExcept (readJSONGeneric defaultOptions json :: F a) of
     Right thing1 -> do
       log ("result: " <> gShow thing1)
       assert (gEq thing thing1)