Skip to content

Add encoding options for which tag & values keys to use #15

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 1 commit into from
Nov 12, 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
32 changes: 21 additions & 11 deletions src/Data/Argonaut/Decode/Generic/Rep.purs
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,17 @@ module Data.Argonaut.Decode.Generic.Rep (
class DecodeRepArgs,
class DecodeLiteral,
decodeRep,
decodeRepWith,
decodeRepArgs,
genericDecodeJson,
genericDecodeJsonWith,
decodeLiteralSum,
decodeLiteralSumWithTransform,
decodeLiteral
) where

import Prelude
import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)

import Control.Alt ((<|>))
import Data.Argonaut.Core (Json, toArray, toObject, toString)
Expand All @@ -26,28 +29,31 @@ import Partial.Unsafe (unsafeCrashWith)
import Prim.TypeError (class Fail, Text)

class DecodeRep r where
decodeRep :: Json -> Either String r
decodeRepWith :: Encoding -> Json -> Either String r

decodeRep :: forall r. DecodeRep r => Json -> Either String r
decodeRep = decodeRepWith defaultEncoding

instance decodeRepNoConstructors :: DecodeRep Rep.NoConstructors where
decodeRep _ = Left "Cannot decode empty data type"
decodeRepWith e _ = Left "Cannot decode empty data type"

instance decodeRepSum :: (DecodeRep a, DecodeRep b) => DecodeRep (Rep.Sum a b) where
decodeRep j = Rep.Inl <$> decodeRep j <|> Rep.Inr <$> decodeRep j
decodeRepWith e j = Rep.Inl <$> decodeRepWith e j <|> Rep.Inr <$> decodeRepWith e j

instance decodeRepConstructor :: (IsSymbol name, DecodeRepArgs a) => DecodeRep (Rep.Constructor name a) where
decodeRep j = do
decodeRepWith e j = do
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") (FO.lookup "tag" jObj)
tag <- mFail (decodingErr "'tag' property is not a string") (toString jTag)
jTag <- mFail (decodingErr $ "'" <> e.tagKey <> "' property is missing") (FO.lookup e.tagKey jObj)
tag <- mFail (decodingErr $ "'" <> e.tagKey <> "' 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") (FO.lookup "values" jObj)
values <- mFail (decodingErr "'values' property is not an array") (toArray jValues)
Left $ decodingErr $ "'" <> e.tagKey <> "' property has an incorrect value"
jValues <- mFail (decodingErr $ "'" <> e.valuesKey <> "' property is missing") (FO.lookup e.valuesKey jObj)
values <- mFail (decodingErr $ "'" <> e.valuesKey <> "' property is not an array") (toArray jValues)
{init, rest} <- lmap decodingErr $ decodeRepArgs values
when (rest /= []) $
Left $ decodingErr "'values' property had too many values"
Left $ decodingErr $ "'" <> e.valuesKey <> "' property had too many values"
pure $ Rep.Constructor init

class DecodeRepArgs r where
Expand All @@ -69,7 +75,11 @@ instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument

-- | 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
genericDecodeJson = map Rep.to <<< decodeRep
genericDecodeJson = genericDecodeJsonWith defaultEncoding

-- | Decode `Json` representation of a value which has a `Generic` type.
genericDecodeJsonWith :: forall a r. Rep.Generic a r => DecodeRep r => Encoding -> Json -> Either String a
genericDecodeJsonWith e = map Rep.to <<< decodeRepWith e

mFail :: forall a. String -> Maybe a -> Either String a
mFail msg = maybe (Left msg) Right
Expand Down
26 changes: 18 additions & 8 deletions src/Data/Argonaut/Encode/Generic/Rep.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,15 +4,18 @@ module Data.Argonaut.Encode.Generic.Rep (
class EncodeRepFields,
class EncodeLiteral,
encodeRep,
encodeRepWith,
encodeRepArgs,
encodeRepFields,
genericEncodeJson,
genericEncodeJsonWith,
encodeLiteralSum,
encodeLiteralSumWithTransform,
encodeLiteral
) where

import Prelude
import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)

import Data.Argonaut.Core (Json, fromArray, fromObject, fromString)
import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
Expand All @@ -23,20 +26,23 @@ import Partial.Unsafe (unsafeCrashWith)
import Prim.TypeError (class Fail, Text)

class EncodeRep r where
encodeRep :: r -> Json
encodeRepWith :: Encoding -> r -> Json

encodeRep :: forall r. EncodeRep r => r -> Json
encodeRep = encodeRepWith defaultEncoding

instance encodeRepNoConstructors :: EncodeRep Rep.NoConstructors where
encodeRep r = encodeRep r
encodeRepWith e = encodeRepWith e

instance encodeRepSum :: (EncodeRep a, EncodeRep b) => EncodeRep (Rep.Sum a b) where
encodeRep (Rep.Inl a) = encodeRep a
encodeRep (Rep.Inr b) = encodeRep b
encodeRepWith e (Rep.Inl a) = encodeRepWith e a
encodeRepWith e (Rep.Inr b) = encodeRepWith e b

instance encodeRepConstructor :: (IsSymbol name, EncodeRepArgs a) => EncodeRep (Rep.Constructor name a) where
encodeRep (Rep.Constructor a) =
encodeRepWith e (Rep.Constructor a) =
fromObject
$ FO.insert "tag" (fromString (reflectSymbol (SProxy :: SProxy name)))
$ FO.insert "values" (fromArray (encodeRepArgs a))
$ FO.insert e.tagKey (fromString (reflectSymbol (SProxy :: SProxy name)))
$ FO.insert e.valuesKey (fromArray (encodeRepArgs a))
$ FO.empty

class EncodeRepArgs r where
Expand All @@ -61,7 +67,11 @@ instance encodeRepFieldsProduct :: (EncodeRepFields a, EncodeRepFields b) => Enc

-- | Encode any `Generic` data structure into `Json`.
genericEncodeJson :: forall a r. Rep.Generic a r => EncodeRep r => a -> Json
genericEncodeJson = encodeRep <<< Rep.from
genericEncodeJson = genericEncodeJsonWith defaultEncoding

-- | Encode any `Generic` data structure into `Json`.
genericEncodeJsonWith :: forall a r. Rep.Generic a r => EncodeRep r => Encoding -> a -> Json
genericEncodeJsonWith e = encodeRepWith e <<< Rep.from

-- | A function for encoding `Generic` sum types using string literal representations
encodeLiteralSum :: forall a r. Rep.Generic a r => EncodeLiteral r => a -> Json
Expand Down
16 changes: 16 additions & 0 deletions src/Data/Argonaut/Types/Generic/Rep.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
module Data.Argonaut.Types.Generic.Rep (
Encoding(..),
defaultEncoding
) where

type Encoding =
{ tagKey :: String
, valuesKey :: String
}

defaultEncoding :: Encoding
defaultEncoding =
{ tagKey: "tag"
, valuesKey: "values"
}

23 changes: 21 additions & 2 deletions test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,10 @@ import Effect (Effect)
import Effect.Console (log)
import Data.Argonaut.Core (stringify)
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
import Data.Argonaut.Decode.Generic.Rep (class DecodeLiteral, decodeLiteralSumWithTransform, genericDecodeJson)
import Data.Argonaut.Decode.Generic.Rep (class DecodeLiteral, decodeLiteralSumWithTransform, genericDecodeJson, genericDecodeJsonWith)
import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
import Data.Argonaut.Encode.Generic.Rep (class EncodeLiteral, encodeLiteralSumWithTransform, genericEncodeJson)
import Data.Argonaut.Encode.Generic.Rep (class EncodeLiteral, encodeLiteralSumWithTransform, genericEncodeJson, genericEncodeJsonWith)
import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..), fromRight)
import Data.Generic.Rep (class Generic)
Expand Down Expand Up @@ -48,6 +49,22 @@ instance encodeJsonLiteralStringExample :: EncodeJson LiteralStringExample where
instance decodeJsonLiteralStringExample :: DecodeJson LiteralStringExample where
decodeJson a = decodeLiteralSumWithTransform identity a

diffEncodingOptions :: Encoding
diffEncodingOptions = defaultEncoding
{ tagKey = "type"
, valuesKey = "value"
}

data DiffEncoding = A | B Int
derive instance eqDiffEncoding :: Eq DiffEncoding
derive instance genericDiffEncoding :: Generic DiffEncoding _
instance showDiffENcoding :: Show DiffEncoding where
show a = genericShow a
instance encodeJsonDiffEncoding :: EncodeJson DiffEncoding where
encodeJson a = genericEncodeJsonWith diffEncodingOptions a
instance decodeJsonDiffEncoding :: DecodeJson DiffEncoding where
decodeJson a = genericDecodeJsonWith diffEncodingOptions a

main :: Effect Unit
main = do
example $ Either $ Left "foo"
Expand All @@ -56,6 +73,8 @@ main = do
example $ Nested {foo: {nested: 42}, bar: "bar"}
example $ Product 1 2 $ Either $ Left "foo"
example $ Frikandel
example $ A
example $ B 42
testLiteralSumWithTransform identity Frikandel "\"Frikandel\""
testLiteralSumWithTransform toUpper Frikandel "\"FRIKANDEL\""
testLiteralSumWithTransform toLower Frikandel "\"frikandel\""
Expand Down