Skip to content

Compiler/0.12 #43

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 11 commits into from
Jun 4, 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
17 changes: 11 additions & 6 deletions .travis.yml
Original file line number Diff line number Diff line change
@@ -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
11 changes: 6 additions & 5 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
}
7 changes: 3 additions & 4 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
}
}
32 changes: 16 additions & 16 deletions src/Data/Argonaut/Decode/Class.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
12 changes: 6 additions & 6 deletions src/Data/Argonaut/Decode/Combinators.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
17 changes: 11 additions & 6 deletions src/Data/Argonaut/Encode/Class.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
31 changes: 18 additions & 13 deletions src/Data/Argonaut/Encode/Combinators.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading