Merge pull request #43 from purescript-contrib/compiler/0.12

Compiler/0.12

Author: kritzcreek

.travis.yml

@@ -1,17 +1,22 @@
+
 language: node_js
-dist: trusty
 sudo: required
-node_js: stable
+dist: trusty
+node_js: 8
+env:
+  - PATH=$HOME/purescript:$PATH
 install:
+  - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p')
+  - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz
+  - tar -xvf $HOME/purescript.tar.gz -C $HOME/
+  - chmod a+x $HOME/purescript
   - npm install -g bower
   - npm install
 script:
-  - bower install --production
-  - npm run -s build
   - bower install
-  - npm -s test
+  - pulp test
 after_success:
 - >-
   test $TRAVIS_TAG &&
   echo $GITHUB_TOKEN | pulp login &&
-  echo y | pulp publish --no-push
+  echo y | pulp publish --no-push

bower.json

@@ -22,12 +22,13 @@
   },
   "license": "MIT",
   "dependencies": {
-    "purescript-argonaut-core": "^3.0.0",
-    "purescript-generics": "^4.0.0",
-    "purescript-integers": "^3.0.0",
-    "purescript-maybe": "^3.0.0"
+    "purescript-argonaut-core": "^4.0.0",
+    "purescript-integers": "^4.0.0",
+    "purescript-maybe": "^4.0.0",
+    "purescript-ordered-collections": "^1.0.0",
+    "purescript-foreign-object": "^1.0.0"
   },
   "devDependencies": {
-    "purescript-strongcheck": "^3.1.0"
+    "purescript-quickcheck": "^5.0.0"
   }
 }

package.json

@@ -6,9 +6,8 @@
     "test": "pulp test"
   },
   "devDependencies": {
-    "pulp": "^11.0.0",
-    "purescript-psa": "^0.5.0",
-    "purescript": "^0.11.1",
+    "pulp": "^12.2.0",
+    "purescript-psa": "^0.6.0",
     "rimraf": "^2.6.1"
   }
-}
+}

src/Data/Argonaut/Decode/Class.purs

@@ -5,17 +5,17 @@ module Data.Argonaut.Decode.Class
 
 import Prelude
 
-import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toObject, toString)
+import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify)
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.Int (fromNumber)
 import Data.List (List(..), (:), fromFoldable)
 import Data.Map as M
 import Data.Maybe (maybe, Maybe(..))
-import Data.String (charAt)
-import Data.StrMap as SM
+import Data.String (CodePoint, codePointAt)
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
+import Foreign.Object as FO
 
 class DecodeJson a where
   decodeJson :: Json -> Either String a
@@ -35,21 +35,21 @@ instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either
   decodeJson json =
     lmap ("Couldn't decode Either: " <> _) $
       decodeJObject json >>= \obj -> do
-        tag <- maybe (Left "Expected field 'tag'") Right $ SM.lookup "tag" obj
-        val <- maybe (Left "Expected field 'value'") Right $ SM.lookup "value" obj
+        tag <- maybe (Left "Expected field 'tag'") Right $ FO.lookup "tag" obj
+        val <- maybe (Left "Expected field 'value'") Right $ FO.lookup "value" obj
         case toString tag of
           Just "Right" -> Right <$> decodeJson val
           Just "Left" -> Left <$> decodeJson val
           _ -> Left "'tag' field was not \"Left\" or \"Right\""
 
 instance decodeJsonNull :: DecodeJson Unit where
-  decodeJson = foldJsonNull (Left "Value is not a null") (const $ Right unit)
+  decodeJson = caseJsonNull (Left "Value is not a null") (const $ Right unit)
 
 instance decodeJsonBoolean :: DecodeJson Boolean where
-  decodeJson = foldJsonBoolean (Left "Value is not a Boolean") Right
+  decodeJson = caseJsonBoolean (Left "Value is not a Boolean") Right
 
 instance decodeJsonNumber :: DecodeJson Number where
-  decodeJson = foldJsonNumber (Left "Value is not a Number") Right
+  decodeJson = caseJsonNumber (Left "Value is not a Number") Right
 
 instance decodeJsonInt :: DecodeJson Int where
   decodeJson
@@ -58,19 +58,19 @@ instance decodeJsonInt :: DecodeJson Int where
     <=< decodeJson
 
 instance decodeJsonString :: DecodeJson String where
-  decodeJson = foldJsonString (Left "Value is not a String") Right
+  decodeJson = caseJsonString (Left "Value is not a String") Right
 
 instance decodeJsonJson :: DecodeJson Json where
   decodeJson = Right
 
-instance decodeJsonChar :: DecodeJson Char where
+instance decodeJsonChar :: DecodeJson CodePoint where
   decodeJson j =
-    maybe (Left $ "Expected character but found: " <> show j) Right
-      =<< charAt 0 <$> decodeJson j
+    maybe (Left $ "Expected character but found: " <> stringify j) Right
+      =<< codePointAt 0 <$> decodeJson j
 
-instance decodeStrMap :: DecodeJson a => DecodeJson (SM.StrMap a) where
+instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where
   decodeJson
-    = lmap ("Couldn't decode StrMap: " <> _)
+    = lmap ("Couldn't decode ForeignObject: " <> _)
     <<< (traverse decodeJson <=< decodeJObject)
 
 instance decodeArray :: DecodeJson a => DecodeJson (Array a) where
@@ -89,8 +89,8 @@ instance decodeMap :: (Ord a, DecodeJson a, DecodeJson b) => DecodeJson (M.Map a
 instance decodeVoid :: DecodeJson Void where
   decodeJson _ = Left "Value cannot be Void"
 
-decodeJArray :: Json -> Either String JArray
+decodeJArray :: Json -> Either String (Array Json)
 decodeJArray = maybe (Left "Value is not an Array") Right <<< toArray
 
-decodeJObject :: Json -> Either String JObject
+decodeJObject :: Json -> Either String (FO.Object Json)
 decodeJObject = maybe (Left "Value is not an Object") Right <<< toObject

src/Data/Argonaut/Decode/Combinators.purs

@@ -2,27 +2,27 @@ module Data.Argonaut.Decode.Combinators where
 
 import Prelude
 
-import Data.Argonaut.Core (JObject)
+import Data.Argonaut.Core (Json)
 import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
-import Data.StrMap as SM
+import Foreign.Object as FO
 
-getField :: forall a. DecodeJson a => JObject -> String -> Either String a
+getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either String a
 getField o s =
   maybe
     (Left $ "Expected field " <> show s)
     decodeJson
-    (SM.lookup s o)
+    (FO.lookup s o)
 
 infix 7 getField as .?
 
-getFieldOptional :: forall a. DecodeJson a => JObject -> String -> Either String (Maybe a)
+getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a)
 getFieldOptional o s =
   maybe
     (pure Nothing)
     decode
-    (SM.lookup s o)
+    (FO.lookup s o)
   where
     decode json = Just <$> decodeJson json
 

src/Data/Argonaut/Encode/Class.purs

@@ -8,9 +8,11 @@ import Data.Int (toNumber)
 import Data.List (List(..), (:), toUnfoldable)
 import Data.Map as M
 import Data.Maybe (Maybe(..))
-import Data.String (singleton)
-import Data.StrMap as SM
+import Data.String (CodePoint)
+import Data.String.CodePoints as CP
+import Data.String.CodeUnits as CU
 import Data.Tuple (Tuple(..))
+import Foreign.Object as FO
 
 class EncodeJson a where
   encodeJson :: a -> Json
@@ -27,7 +29,7 @@ instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either
     where
     obj :: forall c. EncodeJson c => String -> c -> Json
     obj tag x =
-      fromObject $ SM.fromFoldable $
+      fromObject $ FO.fromFoldable $
         Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil
 
 instance encodeJsonUnit :: EncodeJson Unit where
@@ -46,18 +48,21 @@ instance encodeJsonJString :: EncodeJson String where
   encodeJson = fromString
 
 instance encodeJsonJson :: EncodeJson Json where
-  encodeJson = id
+  encodeJson = identity
+
+instance encodeJsonCodePoint :: EncodeJson CodePoint where
+  encodeJson = encodeJson <<< CP.singleton
 
 instance encodeJsonChar :: EncodeJson Char where
-  encodeJson = encodeJson <<< singleton
+  encodeJson = encodeJson <<< CU.singleton
 
 instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where
   encodeJson json = fromArray (encodeJson <$> json)
 
 instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where
   encodeJson = fromArray <<< map encodeJson <<< toUnfoldable
 
-instance encodeStrMap :: EncodeJson a => EncodeJson (SM.StrMap a) where
+instance encodeForeignObject :: EncodeJson a => EncodeJson (FO.Object a) where
   encodeJson = fromObject <<< map encodeJson
 
 instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where

src/Data/Argonaut/Encode/Combinators.purs

@@ -11,41 +11,46 @@ module Data.Argonaut.Encode.Combinators where
 
 import Prelude
 
-import Data.Argonaut.Core (Json, JAssoc, foldJsonObject, fromObject, jsonSingletonObject)
+import Data.Argonaut.Core (Json, caseJsonObject, fromObject, jsonSingletonObject)
 import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
 import Data.Maybe (Maybe(..))
-import Data.StrMap as SM
 import Data.Tuple (Tuple(..))
+import Foreign.Object as FO
 
--- | Creates a `JAssoc` entry, representing a key/value pair for an object.
+-- | Creates a `Tuple String Json` entry, representing a key/value pair for an object.
 infix 7 assoc as :=
 
 -- | The named implementation of the `(:=)` operator.
-assoc :: forall a. EncodeJson a => String -> a -> JAssoc
+assoc :: forall a. EncodeJson a => String -> a -> Tuple String Json
 assoc k = Tuple k <<< encodeJson
 
--- | Creates an optional `JAssoc` entry, representing an optional key/value pair for an object.
+-- | Creates an optional `Tuple String Json` entry, representing an optional key/value pair for an object.
 infix 7 assocOptional as :=?
 
 -- | The named implementation of the `(:=?)` operator.
-assocOptional :: forall a. EncodeJson a => String -> Maybe a -> Maybe JAssoc
+assocOptional
+  :: forall a
+   . EncodeJson a
+  => String
+  -> Maybe a
+  -> Maybe (Tuple String Json)
 assocOptional k = (<$>) (((:=) k) <<< encodeJson)
 
--- | Extends a Json object with a `JAssoc` property.
+-- | Extends a Json object with a `Tuple String Json` property.
 infixr 6 extend as ~>
 
 -- | The named implementation of the `(~>)` operator.
-extend :: forall a. EncodeJson a => JAssoc -> a -> Json
+extend :: forall a. EncodeJson a => Tuple String Json -> a -> Json
 extend (Tuple k v) =
-  foldJsonObject
+  caseJsonObject
     (jsonSingletonObject k v)
-    (SM.insert k v >>> fromObject)
+    (FO.insert k v >>> fromObject)
     <<< encodeJson
 
--- | Optionally extends a Json object with an optional `JAssoc` property.
+-- | Optionally extends a Json object with an optional `Tuple String Json` property.
 infixr 6 extendOptional as ~>?
 
 -- | The named implementation of the `(~>?)` operator.
-extendOptional :: forall a. EncodeJson a => Maybe JAssoc -> a -> Json
+extendOptional :: forall a. EncodeJson a => Maybe (Tuple String Json) -> a -> Json
 extendOptional (Just kv) = (~>) kv
-extendOptional Nothing = encodeJson
+extendOptional Nothing = encodeJson