Skip to content

Compiler/0.12 #18

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
Jun 8, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
language: node_js
dist: trusty
sudo: required
node_js: 6
node_js: stable
install:
- npm install -g bower
- npm install
Expand Down
8 changes: 4 additions & 4 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
}
8 changes: 4 additions & 4 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
}
74 changes: 43 additions & 31 deletions src/Data/Argonaut/JCursor.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
7 changes: 2 additions & 5 deletions src/Data/Argonaut/JCursor/Gen.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
16 changes: 9 additions & 7 deletions src/Data/Argonaut/Prisms.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
14 changes: 7 additions & 7 deletions src/Data/Argonaut/Traversals.purs
Original file line number Diff line number Diff line change
@@ -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
11 changes: 5 additions & 6 deletions test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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