Skip to content

updated to PureScript 0.12 #8

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
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
Expand Up @@ -12,4 +12,4 @@ after_success:
- >-
test $TRAVIS_TAG &&
echo $GITHUB_TOKEN | pulp login &&
echo y | pulp publish --no-push
echo y | pulp publish --no-push
14 changes: 7 additions & 7 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -16,13 +16,13 @@
},
"license": "MIT",
"dependencies": {
"purescript-generics": "^4.0.0",
"purescript-argonaut-core": "^3.1.0",
"purescript-argonaut-codecs": "^3.0.0",
"purescript-generics-rep": "^5.1.0"
"purescript-argonaut-core": "^4.0.1",
"purescript-argonaut-codecs": "^4.0.1",
"purescript-generics-rep": "^6.0.0",
"purescript-record": "^1.0.0"
},
"devDependencies": {
"purescript-assert": "^3.0.0",
"purescript-console": "^3.0.0"
"purescript-assert": "^4.0.0",
"purescript-console": "^4.1.0"
}
}
}
6 changes: 3 additions & 3 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",
"pulp": "^12.2.0",
"purescript-psa": "^0.5.0",
"purescript": "^0.11.1",
"purescript": "^0.12.0",
"rimraf": "^2.6.1"
}
}
}
58 changes: 0 additions & 58 deletions src/Data/Argonaut/Decode/Generic.purs

This file was deleted.

98 changes: 73 additions & 25 deletions src/Data/Argonaut/Decode/Generic/Rep.purs
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
module Data.Argonaut.Decode.Generic.Rep (
class DecodeRep,
class DecodeRepArgs,
class DecodeRepFields,
class DecodeRepRowList,
class DecodeLiteral,
decodeRep,
decodeRepArgs,
decodeRepFields,
decodeRepRowList,
genericDecodeJson,
decodeLiteralSum,
decodeLiteralSumWithTransform,
Expand All @@ -21,10 +21,16 @@ import Data.Array (uncons)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Generic.Rep as Rep
import Data.Maybe (Maybe, maybe)
import Data.StrMap as SM
import Data.Maybe (Maybe(..), maybe)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Foreign.Object as FO
import Partial.Unsafe (unsafeCrashWith)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
import Prim.TypeError (class Fail, Text)
import Record.Builder (Builder)
import Record.Builder as Builder
import Type.Data.RowList (RLProxy(..))

class DecodeRep r where
decodeRep :: Json -> Either String r
Expand All @@ -40,11 +46,11 @@ instance decodeRepConstructor :: (IsSymbol name, DecodeRepArgs a) => DecodeRep (
let name = reflectSymbol (SProxy :: SProxy name)
let decodingErr msg = "When decoding a " <> name <> ": " <> msg
jObj <- mFail (decodingErr "expected an object") (toObject j)
jTag <- mFail (decodingErr "'tag' property is missing") (SM.lookup "tag" jObj)
jTag <- mFail (decodingErr "'tag' property is missing") (FO.lookup "tag" jObj)
tag <- mFail (decodingErr "'tag' property is not a string") (toString jTag)
when (tag /= name) $
Left $ decodingErr "'tag' property has an incorrect value"
jValues <- mFail (decodingErr "'values' property is missing") (SM.lookup "values" jObj)
jValues <- mFail (decodingErr "'values' property is missing") (FO.lookup "values" jObj)
values <- mFail (decodingErr "'values' property is not an array") (toArray jValues)
{init, rest} <- lmap decodingErr $ decodeRepArgs values
when (rest /= []) $
Expand All @@ -63,28 +69,68 @@ instance decodeRepArgsProduct :: (DecodeRepArgs a, DecodeRepArgs b) => DecodeRep
{init: b, rest: js''} <- decodeRepArgs js'
pure {init: Rep.Product a b, rest: js''}

instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument a) where
instance decodeRepRecordArgument ::
( RowToList row rl
, DecodeRepRowList rl () row
) => DecodeRepArgs (Rep.Argument (Record row)) where
decodeRepArgs js = do
{head, tail} <- mFail "too few values were present" (uncons js)
{init: _, rest: tail} <<< Rep.Argument <$> decodeJson head

instance decodeRepArgsRec :: (DecodeRepFields fields) => DecodeRepArgs (Rep.Rec fields) where
{head, tail} <- mFail "to few values were present" (uncons js)
obj <- mFail "no json object" (toObject head)
steps <- decodeRepRowList rlp obj
let arg = Rep.Argument $ Builder.build steps {}
pure {init: arg, rest: tail}
where
rlp :: RLProxy rl
rlp = RLProxy

else instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument a) where
decodeRepArgs js = do
{head, tail} <- mFail "too few values were present" (uncons js)
jObj <- mFail "record is not encoded as an object" (toObject head)
{init: _, rest: tail} <<< Rep.Rec <$> decodeRepFields jObj

class DecodeRepFields r where
decodeRepFields :: SM.StrMap Json -> Either String r
{init: _, rest: tail} <<< Rep.Argument <$> decodeJson head

instance decodeRepFieldsProduct :: (DecodeRepFields a, DecodeRepFields b) => DecodeRepFields (Rep.Product a b) where
decodeRepFields js = Rep.Product <$> decodeRepFields js <*> decodeRepFields js

instance decodeRepFieldsField :: (IsSymbol field, DecodeJson a) => DecodeRepFields (Rep.Field field a) where
decodeRepFields js = do
let name = reflectSymbol (SProxy :: SProxy field)
value <- mFail ("the field '" <> name <> "' is not present") (SM.lookup name js)
Rep.Field <$> decodeJson value
-- | a `DecodeRepRowList` represents a relation between a `RowList` and a record you
-- | can build from it by deserializing it's fields from a JSON `Object`
-- |
-- | this one is strictly internal to help out `decodeRepRecordArgument` handling records
-- |
-- | a `RowList` on the type level is very similar to a *cons-list* on the value level
-- | so the two instances handle all possible `RowList`s
-- |
-- | the idea is to use `Builder` to convert a `RowList` into a record at the type-level
-- | and have `decodeRepRowList` as witness on the value level that will try to decode
-- | JSON in to the resulting record value
-- |
-- | `from` and `to` are two helper types - using these `decodeRepRowListCons` can
-- | recursively create `Builder`-steps and make sure that every *symbol* in `rl`
-- | can only occur once (the fields in the records must be unique)
-- | (see `Row.Lacks`)
class DecodeRepRowList (rl :: RowList) (from :: #Type) (to :: #Type) | rl -> from to where
decodeRepRowList :: forall g . g rl -> FO.Object Json -> Either String (Builder (Record from) (Record to))

instance decodeRepRowListNil :: DecodeRepRowList Nil () () where
decodeRepRowList _ _ = pure identity

instance decodeRepRowListCons ::
( DecodeJson ty
, IsSymbol name
, DecodeRepRowList tail from from'
, Row.Lacks name from'
, Row.Cons name ty from' to
) => DecodeRepRowList (Cons name ty tail) from to where
decodeRepRowList _ obj = do
value :: ty <- (error $ FO.lookup name obj) >>= decodeJson
rest <- decodeRepRowList tailp obj
let
first :: Builder (Record from') (Record to)
first = Builder.insert namep value
pure $ first <<< rest
where
namep = SProxy :: SProxy name
tailp = RLProxy :: RLProxy tail
name = reflectSymbol namep
error Nothing = Left ("error while decoding field " <> name)
error (Just a) = Right a

-- | Decode `Json` representation of a value which has a `Generic` type.
genericDecodeJson :: forall a r. Rep.Generic a r => DecodeRep r => Json -> Either String a
Expand All @@ -95,7 +141,7 @@ mFail msg = maybe (Left msg) Right

-- | A function for decoding `Generic` sum types using string literal representations
decodeLiteralSum :: forall a r. Rep.Generic a r => DecodeLiteral r => Json -> Either String a
decodeLiteralSum = decodeLiteralSumWithTransform id
decodeLiteralSum = decodeLiteralSumWithTransform identity

-- | A function for decoding `Generic` sum types using string literal representations
-- | Takes a function for transforming the tag name in encoding
Expand All @@ -117,7 +163,9 @@ instance decodeLiteralConstructor :: (IsSymbol name) => DecodeLiteral (Rep.Const
Left $ decodingErr "string literal " <> tag <> " had an incorrect value."
pure $ Rep.Constructor (Rep.NoArguments)

type FailMessage = """`decodeLiteralSum` can only be used with sum types, where all of the constructors are nullary. This is because a string literal cannot be encoded into a product type."""

type FailMessage =
Text "`decodeLiteralSum` can only be used with sum types, where all of the constructors are nullary. This is because a string literal cannot be encoded into a product type."

instance decodeLiteralConstructorCannotTakeProduct
:: Fail FailMessage
Expand Down
38 changes: 0 additions & 38 deletions src/Data/Argonaut/Encode/Generic.purs

This file was deleted.

Loading