{-# LANGUAGE BangPatterns #-}
module Data.API.JSONToCBOR
( serialiseJSONWithSchema
, jsonToCBORWithSchema
, deserialiseJSONWithSchema
, postprocessJSON
) where
import Data.API.Changes
import Data.API.JSON
import Data.API.Time
import Data.API.Types
import Data.API.Utils
import Control.Applicative
import Data.Aeson hiding (encode)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HMap
import qualified Data.Map as Map
import Data.Traversable
import qualified Data.Vector as Vec
import Codec.Serialise as CBOR
import Data.Binary.Serialise.CBOR.JSON (cborToJson, jsonToCbor)
import Codec.CBOR.Term
import Data.Fixed (Pico)
import Data.Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock.POSIX
import Data.Time (UTCTime(UTCTime))
import Prelude
serialiseJSONWithSchema :: API -> TypeName -> Value -> LBS.ByteString
serialiseJSONWithSchema :: API -> TypeName -> Value -> ByteString
serialiseJSONWithSchema API
api TypeName
tn Value
v = Term -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Term -> ByteString) -> Term -> ByteString
forall a b. (a -> b) -> a -> b
$ API -> TypeName -> Value -> Term
jsonToCBORWithSchema API
api TypeName
tn Value
v
jsonToCBORWithSchema :: API -> TypeName -> Value -> Term
jsonToCBORWithSchema :: API -> TypeName -> Value -> Term
jsonToCBORWithSchema = NormAPI -> TypeName -> Value -> Term
jsonToCBORTypeName (NormAPI -> TypeName -> Value -> Term)
-> (API -> NormAPI) -> API -> TypeName -> Value -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. API -> NormAPI
apiNormalForm
jsonToCBORTypeName :: NormAPI -> TypeName -> Value -> Term
jsonToCBORTypeName :: NormAPI -> TypeName -> Value -> Term
jsonToCBORTypeName NormAPI
napi TypeName
tn Value
v =
case TypeName -> NormAPI -> Maybe NormTypeDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeName
tn NormAPI
napi of
Just (NRecordType NormRecordType
nrt) -> NormAPI -> NormRecordType -> Value -> Term
jsonToCBORRecord NormAPI
napi NormRecordType
nrt Value
v
Just (NUnionType NormRecordType
nut) -> NormAPI -> NormRecordType -> Value -> Term
jsonToCBORUnion NormAPI
napi NormRecordType
nut Value
v
Just (NEnumType NormEnumType
net) -> NormAPI -> NormEnumType -> Value -> Term
jsonToCBOREnum NormAPI
napi NormEnumType
net Value
v
Just (NTypeSynonym APIType
ty) -> NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty Value
v
Just (NNewtype BasicType
bt) -> BasicType -> Value -> Term
jsonToCBORBasic BasicType
bt Value
v
Maybe NormTypeDecl
Nothing -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ [Char]
"serialiseJSONWithSchema: missing definition for type "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (TypeName -> Text
_TypeName TypeName
tn)
jsonToCBORType :: NormAPI -> APIType -> Value -> Term
jsonToCBORType :: NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty0 Value
v = case (APIType
ty0, Value
v) of
(TyList APIType
ty, Array Array
arr) | Array -> Bool
forall a. Vector a -> Bool
Vec.null Array
arr -> [Term] -> Term
TList []
| Bool
otherwise -> [Term] -> Term
TListI ([Term] -> Term) -> [Term] -> Term
forall a b. (a -> b) -> a -> b
$ (Value -> Term) -> [Value] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty) (Array -> [Value]
forall a. Vector a -> [a]
Vec.toList Array
arr)
(TyList APIType
_ , Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected array"
(TyMaybe APIType
_ , Value
Null) -> [Term] -> Term
TList []
(TyMaybe APIType
ty, Value
_) -> [Term] -> Term
TList [NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty Value
v]
(TyName TypeName
tn, Value
_) -> NormAPI -> TypeName -> Value -> Term
jsonToCBORTypeName NormAPI
napi TypeName
tn Value
v
(TyBasic BasicType
bt, Value
_) -> BasicType -> Value -> Term
jsonToCBORBasic BasicType
bt Value
v
(APIType
TyJSON , Value
_) -> Value -> Term
jsonToCbor Value
v
jsonToCBORRecord :: NormAPI -> NormRecordType -> Value -> Term
jsonToCBORRecord :: NormAPI -> NormRecordType -> Value -> Term
jsonToCBORRecord NormAPI
napi NormRecordType
nrt Value
v = case Value
v of
Object Object
hm -> [(Term, Term)] -> Term
TMap ([(Term, Term)] -> Term) -> [(Term, Term)] -> Term
forall a b. (a -> b) -> a -> b
$ ((FieldName, APIType) -> (Term, Term))
-> [(FieldName, APIType)] -> [(Term, Term)]
forall a b. (a -> b) -> [a] -> [b]
map (Object -> (FieldName, APIType) -> (Term, Term)
f Object
hm) ([(FieldName, APIType)] -> [(Term, Term)])
-> [(FieldName, APIType)] -> [(Term, Term)]
forall a b. (a -> b) -> a -> b
$ NormRecordType -> [(FieldName, APIType)]
forall k a. Map k a -> [(k, a)]
Map.toAscList NormRecordType
nrt
Value
_ -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected object"
where
f :: Object -> (FieldName, APIType) -> (Term, Term)
f Object
hm (FieldName
fn, APIType
ty) = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup (FieldName -> Text
_FieldName FieldName
fn) Object
hm of
Maybe Value
Nothing -> [Char] -> (Term, Term)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Term, Term)) -> [Char] -> (Term, Term)
forall a b. (a -> b) -> a -> b
$ [Char]
"serialiseJSONWithSchema: missing field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (FieldName -> Text
_FieldName FieldName
fn)
Just Value
v' -> (Text -> Term
TString (FieldName -> Text
_FieldName FieldName
fn), NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty Value
v')
jsonToCBORUnion :: NormAPI -> NormUnionType -> Value -> Term
jsonToCBORUnion :: NormAPI -> NormRecordType -> Value -> Term
jsonToCBORUnion NormAPI
napi NormRecordType
nut Value
v = case Value
v of
Object Object
hm | [(Text
k, Value
r)] <- Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
hm -> case FieldName -> NormRecordType -> Maybe APIType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> FieldName
FieldName Text
k) NormRecordType
nut of
Just APIType
ty -> [(Term, Term)] -> Term
TMap [(Text -> Term
TString Text
k, NormAPI -> APIType -> Value -> Term
jsonToCBORType NormAPI
napi APIType
ty Value
r)]
Maybe APIType
Nothing -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: unexpected alternative in union"
Value
_ -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected single-field object"
jsonToCBOREnum :: NormAPI -> NormEnumType -> Value -> Term
jsonToCBOREnum :: NormAPI -> NormEnumType -> Value -> Term
jsonToCBOREnum NormAPI
_ NormEnumType
_ Value
v = case Value
v of
String Text
t -> Text -> Term
TString Text
t
Value
_ -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected string"
jsonToCBORBasic :: BasicType -> Value -> Term
jsonToCBORBasic :: BasicType -> Value -> Term
jsonToCBORBasic BasicType
bt Value
v = case (BasicType
bt, Value
v) of
(BasicType
BTstring, String Text
t) -> Text -> Term
TString Text
t
(BasicType
BTstring, Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected string"
(BasicType
BTbinary, String Text
t) -> case ByteString -> Either [Char] ByteString
B64.decode (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t of
Left [Char]
err-> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ [Char]
"serialiseJSONWithSchema: base64-decoding failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
Right ByteString
bs -> ByteString -> Term
TBytes ByteString
bs
(BasicType
BTbinary, Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected string"
(BasicType
BTbool , Bool Bool
b) -> Bool -> Term
TBool Bool
b
(BasicType
BTbool , Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected bool"
(BasicType
BTint , Number Scientific
n) | Right Int
i <- (Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Int) -> Int -> Term
TInt Int
i
(BasicType
BTint , Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected integer"
(BasicType
BTutc , String Text
t) ->
Word64 -> Term -> Term
TTagged Word64
1000 ([(Term, Term)] -> Term
TMap [ (Int -> Term
TInt Int
1, Int -> Term
TInt Int
secs)
, (Int -> Term
TInt (-Int
12), Int -> Term
TInt Int
psecs) ])
where
(Int
secs, POSIXTime
frac) = case POSIXTime -> (Int, POSIXTime)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (POSIXTime -> (Int, POSIXTime)) -> POSIXTime -> (Int, POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc of
(Int
secs', POSIXTime
frac')
| POSIXTime
frac' POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
< POSIXTime
0 -> (Int
secs' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, POSIXTime
frac' POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
1)
| Bool
otherwise -> (Int
secs', POSIXTime
frac')
psecs :: Int
psecs = POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> POSIXTime -> Int
forall a b. (a -> b) -> a -> b
$ POSIXTime
frac POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000000000000
utc :: UTCTime
utc = HasCallStack => Text -> UTCTime
Text -> UTCTime
unsafeParseUTC Text
t
(BasicType
BTutc , Value
_) -> [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"serialiseJSONWithSchema: expected string"
deserialiseJSONWithSchema :: API -> TypeName -> LBS.ByteString -> Value
deserialiseJSONWithSchema :: API -> TypeName -> ByteString -> Value
deserialiseJSONWithSchema API
api TypeName
tn ByteString
bs = case API -> TypeName -> Value -> Either ValueError Value
postprocessJSON API
api TypeName
tn (Term -> Value
cborToJson (ByteString -> Term
forall a. Serialise a => ByteString -> a
deserialise ByteString
bs)) of
Right Value
v -> Value
v
Left ValueError
err -> [Char] -> Value
forall a. HasCallStack => [Char] -> a
error ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ [Char]
"deserialiseJSONWithSchema could not post-process: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ValueError -> [Char]
prettyValueError ValueError
err
postprocessJSON :: API -> TypeName -> Value -> Either ValueError Value
postprocessJSON :: API -> TypeName -> Value -> Either ValueError Value
postprocessJSON API
api = NormAPI -> TypeName -> Value -> Either ValueError Value
postprocessJSONTypeName (API -> NormAPI
apiNormalForm API
api)
postprocessJSONTypeName :: NormAPI -> TypeName -> Value -> Either ValueError Value
postprocessJSONTypeName :: NormAPI -> TypeName -> Value -> Either ValueError Value
postprocessJSONTypeName NormAPI
napi TypeName
tn Value
v = do
NormTypeDecl
t <- TypeName -> NormAPI -> Maybe NormTypeDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeName
tn NormAPI
napi Maybe NormTypeDecl -> ValueError -> Either ValueError NormTypeDecl
forall a e. Maybe a -> e -> Either e a
?! ApplyFailure -> ValueError
InvalidAPI (TypeName -> ApplyFailure
TypeDoesNotExist TypeName
tn)
case NormTypeDecl
t of
NRecordType NormRecordType
nrt -> NormAPI -> NormRecordType -> Value -> Either ValueError Value
postprocessJSONRecord NormAPI
napi NormRecordType
nrt Value
v
NUnionType NormRecordType
nut -> NormAPI -> NormRecordType -> Value -> Either ValueError Value
postprocessJSONUnion NormAPI
napi NormRecordType
nut Value
v
NEnumType NormEnumType
_ -> Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
NTypeSynonym APIType
ty -> NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty Value
v
NNewtype BasicType
bt -> NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi (BasicType -> APIType
TyBasic BasicType
bt) Value
v
postprocessJSONType :: NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType :: NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty0 Value
v = case APIType
ty0 of
TyList APIType
ty -> case Value
v of
Array Array
arr -> Array -> Value
Array (Array -> Value)
-> Either ValueError Array -> Either ValueError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either ValueError Value)
-> Array -> Either ValueError Array
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty) Array
arr
Value
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedArray Value
v
TyMaybe APIType
ty -> case Value
v of
Array Array
arr -> case Array -> [Value]
forall a. Vector a -> [a]
Vec.toList Array
arr of
[] -> Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
[Value
v1] -> NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty Value
v1
Value
_:Value
_:[Value]
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ [Char] -> JSONError
SyntaxError [Char]
"over-long array when converting Maybe value"
Value
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedArray Value
v
TyName TypeName
tn -> NormAPI -> TypeName -> Value -> Either ValueError Value
postprocessJSONTypeName NormAPI
napi TypeName
tn Value
v
TyBasic BasicType
BTutc -> case Value
v of
Object Object
obj -> case Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
obj of
[(Text
k1, Number Scientific
v0), (Text
km12, Number Scientific
v1)]
| Text -> [Char]
T.unpack Text
k1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"1" Bool -> Bool -> Bool
&& Text -> [Char]
T.unpack Text
km12 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-12" ->
let psecs :: Pico
psecs :: Pico
psecs = Scientific -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
v1 Pico -> Pico -> Pico
forall a. Fractional a => a -> a -> a
/ Pico
1000000000000
dt :: POSIXTime
dt :: POSIXTime
dt = Scientific -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
v0 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Pico -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
psecs
in Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either ValueError Value)
-> Value -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$! Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$! UTCTime -> Text
printUTC (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$! UTCTime -> UTCTime
forceUTCTime (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
dt)
[(Text, Value)]
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError JSONError
UnexpectedField
String Text
t -> case Text -> Maybe UTCTime
parseUTC Text
t of
Maybe UTCTime
Nothing -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ [Char] -> JSONError
SyntaxError ([Char] -> JSONError) -> [Char] -> JSONError
forall a b. (a -> b) -> a -> b
$
[Char]
"UTC time in wrong format: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
Just UTCTime
utcTime -> Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either ValueError Value)
-> Value -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$! Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$! UTCTime -> Text
printUTC (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$! UTCTime -> UTCTime
forceUTCTime UTCTime
utcTime
Value
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedObject Value
v
TyBasic BasicType
_ -> Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
APIType
TyJSON -> Value -> Either ValueError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
forceUTCTime :: UTCTime -> UTCTime
forceUTCTime :: UTCTime -> UTCTime
forceUTCTime t :: UTCTime
t@(UTCTime !Day
_day !DiffTime
_daytime) = UTCTime
t
postprocessJSONRecord :: NormAPI -> NormRecordType -> Value -> Either ValueError Value
postprocessJSONRecord :: NormAPI -> NormRecordType -> Value -> Either ValueError Value
postprocessJSONRecord NormAPI
napi NormRecordType
nrt Value
v = case Value
v of
Object Object
hm -> Object -> Value
Object (Object -> Value)
-> Either ValueError Object -> Either ValueError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Value -> Either ValueError Value)
-> Object -> Either ValueError Object
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HMap.traverseWithKey Text -> Value -> Either ValueError Value
f Object
hm
Value
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedObject Value
v
where
f :: Text -> Value -> Either ValueError Value
f Text
t Value
v' = do APIType
ty <- FieldName -> NormRecordType -> Maybe APIType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> FieldName
FieldName Text
t) NormRecordType
nrt Maybe APIType -> ValueError -> Either ValueError APIType
forall a e. Maybe a -> e -> Either e a
?! JSONError -> ValueError
JSONError JSONError
UnexpectedField
NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty Value
v'
postprocessJSONUnion :: NormAPI -> NormUnionType -> Value -> Either ValueError Value
postprocessJSONUnion :: NormAPI -> NormRecordType -> Value -> Either ValueError Value
postprocessJSONUnion NormAPI
napi NormRecordType
nut Value
v = case Value
v of
Object Object
hm | [(Text
k, Value
r)] <- Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
hm
, Just APIType
ty <- FieldName -> NormRecordType -> Maybe APIType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> FieldName
FieldName Text
k) NormRecordType
nut
-> Object -> Value
Object (Object -> Value) -> (Value -> Object) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HMap.singleton Text
k (Value -> Value)
-> Either ValueError Value -> Either ValueError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NormAPI -> APIType -> Value -> Either ValueError Value
postprocessJSONType NormAPI
napi APIType
ty Value
r
Value
_ -> ValueError -> Either ValueError Value
forall a b. a -> Either a b
Left (ValueError -> Either ValueError Value)
-> ValueError -> Either ValueError Value
forall a b. (a -> b) -> a -> b
$ JSONError -> ValueError
JSONError (JSONError -> ValueError) -> JSONError -> ValueError
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedObject Value
v