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

Compiler/0.12

Author: kritzcreek

.travis.yml

@@ -1,7 +1,7 @@
 language: node_js
 dist: trusty
 sudo: required
-node_js: 6
+node_js: stable
 install:
   - npm install -g bower
   - npm install

bower.json

@@ -21,11 +21,11 @@
   },
   "license": "MIT",
   "dependencies": {
-    "purescript-argonaut-core": "^3.1.0",
-    "purescript-argonaut-codecs": "^3.0.0",
-    "purescript-profunctor-lenses": "^3.0.0"
+    "purescript-argonaut-core": "^4.0.0",
+    "purescript-argonaut-codecs": "^4.0.0",
+    "purescript-profunctor-lenses": "^4.0.0"
   },
   "devDependencies": {
-    "purescript-strongcheck": "^3.0.0"
+    "purescript-quickcheck": "^5.0.0"
   }
 }

package.json

@@ -6,9 +6,9 @@
     "test": "pulp test"
   },
   "devDependencies": {
-    "pulp": "^11.0.0",
-    "purescript-psa": "^0.5.0",
-    "purescript": "^0.11.0",
-    "rimraf": "^2.5.4"
+    "pulp": "^12.2.0",
+    "purescript": "^0.12.0",
+    "purescript-psa": "^0.6.0",
+    "rimraf": "^2.6.2"
   }
 }

src/Data/Argonaut/JCursor.purs

@@ -7,14 +7,13 @@ import Data.Argonaut.Decode (class DecodeJson, decodeJson)
 import Data.Argonaut.Encode (class EncodeJson, encodeJson)
 import Data.Array as A
 import Data.Either (Either(..))
-import Data.Unfoldable (replicate)
 import Data.Foldable (foldl)
 import Data.Int as I
 import Data.List (List(), zipWith, range, head, singleton, fromFoldable)
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
-import Data.Monoid (class Monoid)
-import Data.StrMap as M
 import Data.Tuple (Tuple(..), fst, snd)
+import Data.Unfoldable (replicate)
+import Foreign.Object as FO
 
 data JCursor
   = JCursorTop
@@ -49,28 +48,41 @@ instance encodeJsonJCursor :: EncodeJson JCursor where
     loop (JField i c) = [encodeJson i] <> loop c
     loop (JIndex i c) = [encodeJson i] <> loop c
 
-newtype JsonPrim = JsonPrim (forall a. (J.JNull -> a) -> (J.JBoolean -> a) -> (J.JNumber -> a) -> (J.JString -> a) -> a)
-
-runJsonPrim :: JsonPrim -> (forall a. (J.JNull -> a) -> (J.JBoolean -> a) -> (J.JNumber -> a) -> (J.JString -> a) -> a)
+newtype JsonPrim = JsonPrim
+  ( forall a
+   . (Unit -> a)
+  -> (Boolean -> a)
+  -> (Number -> a)
+  -> (String -> a)
+  -> a)
+
+runJsonPrim
+  :: JsonPrim
+  -> ( forall a
+      . (Unit -> a)
+     -> (Boolean -> a)
+     -> (Number -> a)
+     -> (String -> a)
+     -> a)
 runJsonPrim (JsonPrim p) = p
 
 instance showJsonPrim :: Show JsonPrim where
   show p = runJsonPrim p show show show show
 
 primNull :: JsonPrim
-primNull = JsonPrim (\f _ _ _ -> f J.jNull)
+primNull = JsonPrim (\f _ _ _ -> f unit)
 
-primBool :: J.JBoolean -> JsonPrim
+primBool :: Boolean -> JsonPrim
 primBool v = JsonPrim (\_ f _ _ -> f v)
 
-primNum :: J.JNumber -> JsonPrim
+primNum :: Number -> JsonPrim
 primNum v = JsonPrim (\_ _ f _ -> f v)
 
-primStr :: J.JString -> JsonPrim
+primStr :: String -> JsonPrim
 primStr v = JsonPrim (\_ _ _ f -> f v)
 
 primToJson :: JsonPrim -> J.Json
-primToJson p = runJsonPrim p J.fromNull J.fromBoolean J.fromNumber J.fromString
+primToJson p = runJsonPrim p (const J.jsonNull) J.fromBoolean J.fromNumber J.fromString
 
 insideOut :: JCursor -> JCursor
 insideOut JCursorTop = JCursorTop
@@ -91,8 +103,8 @@ downIndex i = downIndex' where
 
 cursorGet :: JCursor -> J.Json -> Maybe J.Json
 cursorGet JCursorTop = Just
-cursorGet (JField i c) = J.foldJsonObject Nothing (cursorGet c <=< M.lookup i)
-cursorGet (JIndex i c) = J.foldJsonArray Nothing (cursorGet c <=< (_ A.!! i))
+cursorGet (JField i c) = J.caseJsonObject Nothing (cursorGet c <=< FO.lookup i)
+cursorGet (JIndex i c) = J.caseJsonArray Nothing (cursorGet c <=< (_ A.!! i))
 
 inferEmpty :: JCursor -> J.Json
 inferEmpty JCursorTop   = J.jsonNull
@@ -101,25 +113,25 @@ inferEmpty (JIndex _ _) = J.jsonEmptyArray
 
 cursorSet :: JCursor -> J.Json -> J.Json -> Maybe J.Json
 cursorSet JCursorTop v = pure <<< const v
-cursorSet (JField i c) v = J.foldJsonObject defaultObj mergeObjs
+cursorSet (JField i c) v = J.caseJsonObject defaultObj mergeObjs
   where
   defaultObj :: Maybe J.Json
-  defaultObj = J.fromObject <<< M.singleton i <$> cursorSet c v (inferEmpty c)
-  mergeObjs :: J.JObject -> Maybe J.Json
+  defaultObj = J.fromObject <<< FO.singleton i <$> cursorSet c v (inferEmpty c)
+  mergeObjs :: FO.Object J.Json -> Maybe J.Json
   mergeObjs m
     = J.fromObject
-    <<< flip (M.insert i) m
-    <$> cursorSet c v (fromMaybe (inferEmpty c) (M.lookup i m))
-cursorSet (JIndex i c) v = J.foldJsonArray defaultArr mergeArrs
+    <<< flip (FO.insert i) m
+    <$> cursorSet c v (fromMaybe (inferEmpty c) (FO.lookup i m))
+cursorSet (JIndex i c) v = J.caseJsonArray defaultArr mergeArrs
   where
   defaultArr :: Maybe J.Json
   defaultArr
     = J.fromArray
     <$> (flip (A.updateAt i) (replicate (i + 1) J.jsonNull) =<< cursorSet c v (inferEmpty c))
-  mergeArrs :: J.JArray -> Maybe J.Json
+  mergeArrs :: Array J.Json -> Maybe J.Json
   mergeArrs a =
     setArr a i =<< cursorSet c v (fromMaybe (inferEmpty c) (a A.!! i))
-  setArr :: J.JArray -> Int -> J.Json -> Maybe J.Json
+  setArr :: Array J.Json -> Int -> J.Json -> Maybe J.Json
   setArr xs i' v' =
     let len = A.length xs
     in if i' < 0
@@ -129,31 +141,31 @@ cursorSet (JIndex i c) v = J.foldJsonArray defaultArr mergeArrs
             else J.fromArray <$> A.updateAt i' v' xs
 
 toPrims :: J.Json -> List (Tuple JCursor JsonPrim)
-toPrims = J.foldJson nullFn boolFn numFn strFn arrFn objFn
+toPrims = J.caseJson nullFn boolFn numFn strFn arrFn objFn
   where
   mkTop :: JsonPrim -> List (Tuple JCursor JsonPrim)
   mkTop p = singleton $ Tuple JCursorTop p
-  nullFn :: J.JNull -> List (Tuple JCursor JsonPrim)
+  nullFn :: Unit -> List (Tuple JCursor JsonPrim)
   nullFn _ = mkTop primNull
-  boolFn :: J.JBoolean -> List (Tuple JCursor JsonPrim)
+  boolFn :: Boolean -> List (Tuple JCursor JsonPrim)
   boolFn b = mkTop $ primBool b
-  numFn :: J.JNumber -> List (Tuple JCursor JsonPrim)
+  numFn :: Number -> List (Tuple JCursor JsonPrim)
   numFn n = mkTop $ primNum n
-  strFn :: J.JString -> List (Tuple JCursor JsonPrim)
+  strFn :: String -> List (Tuple JCursor JsonPrim)
   strFn s = mkTop $ primStr s
-  arrFn :: J.JArray -> List (Tuple JCursor JsonPrim)
+  arrFn :: Array J.Json -> List (Tuple JCursor JsonPrim)
   arrFn arr =
     let zipped :: List (Tuple Int J.Json)
         zipped = zipWith Tuple (range 0 (A.length arr - 1)) (fromFoldable arr)
     in zipped >>= arrFn'
   arrFn' :: Tuple Int J.Json -> List (Tuple JCursor JsonPrim)
   arrFn' (Tuple i j) =
     fromFoldable ((\t -> Tuple (JIndex i (fst t)) (snd t)) <$> toPrims j)
-  objFn :: J.JObject -> List (Tuple JCursor JsonPrim)
+  objFn :: FO.Object J.Json -> List (Tuple JCursor JsonPrim)
   objFn obj =
     let f :: Tuple String J.Json -> List (Tuple JCursor JsonPrim)
         f (Tuple i j) = (\t -> Tuple (JField i (fst t)) (snd t)) <$> toPrims j
-    in M.toUnfoldable obj >>= f
+    in FO.toUnfoldable obj >>= f
 
 fromPrims :: List (Tuple JCursor JsonPrim) -> Maybe J.Json
 fromPrims lst = foldl f (inferEmpty <<< fst <$> head lst) lst
@@ -173,7 +185,7 @@ instance decodeJsonJCursor :: DecodeJson JCursor where
     goLoop :: Tuple J.Json (Array J.Json) -> Either String JCursor
     goLoop (Tuple x xs) = do
       c <- loop xs
-      J.foldJson fail fail (goNum c) (Right <<< flip JField c) fail fail x
-    goNum :: JCursor -> J.JNumber -> Either String JCursor
+      J.caseJson fail fail (goNum c) (Right <<< flip JField c) (map J.stringify >>> fail) (map J.stringify >>> fail) x
+    goNum :: JCursor -> Number -> Either String JCursor
     goNum c =
       maybe (Left "Not an Int") (Right <<< flip JIndex c) <<< I.fromNumber

src/Data/Argonaut/JCursor/Gen.purs

@@ -8,16 +8,13 @@ import Control.Monad.Gen as Gen
 import Control.Monad.Rec.Class (class MonadRec)
 
 import Data.Argonaut.JCursor (JCursor(..))
-import Data.Char as C
-import Data.String as S
+import Data.String.Gen (genUnicodeString)
 
 genJCursor :: forall m. MonadGen m => MonadRec m => Lazy (m JCursor) => m JCursor
 genJCursor = Gen.resize (min 10) $ Gen.sized genJCursor'
   where
   genJCursor' size
     | size > 0 = Gen.resize (_ - 1) (Gen.choose genField genIndex)
     | otherwise = pure JCursorTop
-  genField = JField <$> genString <*> defer \_ -> genJCursor
+  genField = JField <$> genUnicodeString <*> defer \_ -> genJCursor
   genIndex = JIndex <$> Gen.chooseInt 0 1000 <*> defer \_ -> genJCursor
-  genString = S.fromCharArray <$> Gen.unfoldable genChar
-  genChar = C.fromCharCode <$> Gen.chooseInt 0 65535

src/Data/Argonaut/Prisms.purs

@@ -2,21 +2,23 @@ module Data.Argonaut.Prisms where
 
 import Data.Argonaut.Core
 import Data.Lens (Prism', prism')
+import Foreign.Object as FO
+import Prelude (Unit, const)
 
-_Null :: Prism' Json JNull
-_Null = prism' fromNull toNull
+_Null :: Prism' Json Unit
+_Null = prism' (const jsonNull) toNull
 
-_Boolean :: Prism' Json JBoolean
+_Boolean :: Prism' Json Boolean
 _Boolean = prism' fromBoolean toBoolean
 
-_Number :: Prism' Json JNumber
+_Number :: Prism' Json Number
 _Number = prism' fromNumber toNumber
 
-_String :: Prism' Json JString
+_String :: Prism' Json String
 _String = prism' fromString toString
 
-_Array :: Prism' Json JArray
+_Array :: Prism' Json (Array Json)
 _Array = prism' fromArray toArray
 
-_Object :: Prism' Json JObject
+_Object :: Prism' Json (FO.Object Json)
 _Object = prism' fromObject toObject

src/Data/Argonaut/Traversals.purs

@@ -1,23 +1,23 @@
 module Data.Argonaut.Traversals where
 
-import Prelude ((<<<), id)
+import Prelude ((<<<), identity)
 import Data.Argonaut.Core
 import Data.Lens (Traversal', filtered)
 
 _JsonNull :: Traversal' Json Json
-_JsonNull = id <<< filtered isNull
+_JsonNull = identity <<< filtered isNull
 
 _JsonBoolean :: Traversal' Json Json
-_JsonBoolean = id <<< filtered isBoolean
+_JsonBoolean = identity <<< filtered isBoolean
 
 _JsonNumber :: Traversal' Json Json
-_JsonNumber = id <<< filtered isNumber
+_JsonNumber = identity <<< filtered isNumber
 
 _JsonString :: Traversal' Json Json
-_JsonString = id <<< filtered isString
+_JsonString = identity <<< filtered isString
 
 _JsonArray :: Traversal' Json Json
-_JsonArray = id <<< filtered isArray
+_JsonArray = identity <<< filtered isArray
 
 _JsonObject :: Traversal' Json Json
-_JsonObject = id <<< filtered isObject
+_JsonObject = identity <<< filtered isObject

test/Test/Main.purs

@@ -2,22 +2,21 @@ module Test.Main where
 
 import Prelude
 
-import Control.Monad.Eff.Console (log)
-
 import Data.Argonaut.Decode (decodeJson)
 import Data.Argonaut.Encode (encodeJson)
 import Data.Argonaut.JCursor.Gen (genJCursor)
 import Data.Either (Either(..))
-
-import Test.StrongCheck (SC, Result, quickCheck, (<?>))
-import Test.StrongCheck.Gen (Gen)
+import Effect (Effect)
+import Effect.Console (log)
+import Test.QuickCheck (Result, quickCheck, (<?>))
+import Test.QuickCheck.Gen (Gen)
 
 prop_jcursor_serialization :: Gen Result
 prop_jcursor_serialization = do
   c <- genJCursor
   pure $ (decodeJson (encodeJson c) == Right c) <?> "JCursor: " <> show c
 
-main :: SC () Unit
+main :: Effect Unit
 main = do
   log "Testing JCursor serialization"
   quickCheck prop_jcursor_serialization