{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wno-orphans -Wno-deprecations #-}
module Codec.Candid.Class where
import Numeric.Natural
import qualified Data.Vector as Vec
import qualified Data.Text as T
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Builder as B
import Data.Row
import Data.Row.Internal (Row(R), LT((:->)), metamorph)
import qualified Data.Row.Records as R
import qualified Data.Row.Internal as R
import qualified Data.Row.Variants as V
import Control.Monad.State.Lazy
import Control.Monad.Trans.Error
import Control.Applicative ((<|>), Alternative)
import Data.Functor.Const
import Data.Bifunctor
import Data.Proxy
import Data.Typeable
import Data.Scientific
import Data.Word
import Data.Int
import Data.Void
import Data.Text.Prettyprint.Doc
import Data.Constraint ((\\))
import Language.Haskell.TH (mkName, tupleDataName)
import Language.Haskell.TH.Lib
( appT, tupleT, varT, litT, strTyLit
, tupP, varP, wildP, infixP
, labelE, varE, conE, tupE, listE, uInfixE
)
import Codec.Candid.Tuples
import Codec.Candid.Data
import Codec.Candid.TypTable
import Codec.Candid.Types
import Codec.Candid.FieldName
import Codec.Candid.Decode
import Codec.Candid.Encode
encode :: CandidArg a => a -> BS.ByteString
encode :: a -> ByteString
encode = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. CandidArg a => a -> Builder
encodeBuilder
encodeBuilder :: forall a. CandidArg a => a -> B.Builder
encodeBuilder :: a -> Builder
encodeBuilder a
x = SeqDesc -> [Value] -> Builder
encodeValues (CandidArg a => SeqDesc
forall a. CandidArg a => SeqDesc
seqDesc @a) (a -> [Value]
forall a. CandidArg a => a -> [Value]
toCandidVals a
x)
decode :: forall a. CandidArg a => BS.ByteString -> Either String a
decode :: ByteString -> Either String a
decode = ByteString -> Either String [Value]
decodeVals (ByteString -> Either String [Value])
-> ([Value] -> Either String a) -> ByteString -> Either String a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Value] -> Either String a
forall a. CandidArg a => [Value] -> Either String a
fromCandidVals
fromCandidVals :: CandidArg a => [Value] -> Either String a
fromCandidVals :: [Value] -> Either String a
fromCandidVals = [Value] -> Either String (If (IsTuple a) a (Unary a))
forall a. CandidSeq a => [Value] -> Either String a
fromVals ([Value] -> Either String (If (IsTuple a) a (Unary a)))
-> (If (IsTuple a) a (Unary a) -> Either String a)
-> [Value]
-> Either String a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either String a)
-> (If (IsTuple a) a (Unary a) -> a)
-> If (IsTuple a) a (Unary a)
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. If (IsTuple a) a (Unary a) -> a
forall a (b :: Bool). AsTuple_ a b => AsTuple a -> a
fromTuple
toCandidVals :: CandidArg a => a -> [Value]
toCandidVals :: a -> [Value]
toCandidVals = If (IsTuple a) a (Unary a) -> [Value]
forall a. CandidSeq a => a -> [Value]
seqVal (If (IsTuple a) a (Unary a) -> [Value])
-> (a -> If (IsTuple a) a (Unary a)) -> a -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> If (IsTuple a) a (Unary a)
forall a (b :: Bool). AsTuple_ a b => a -> AsTuple a
asTuple
type CandidArg a = (CandidSeq (AsTuple a), Tuplable a)
class CandidSeq a where
asTypes :: [Type (Ref TypeRep Type)]
seqVal :: a -> [Value]
fromVals :: [Value] -> Either String a
seqDesc :: forall a. CandidArg a => SeqDesc
seqDesc :: SeqDesc
seqDesc = [Type (Ref TypeRep Type)] -> SeqDesc
forall k. (Pretty k, Ord k) => [Type (Ref k Type)] -> SeqDesc
buildSeqDesc (CandidSeq (AsTuple a) => [Type (Ref TypeRep Type)]
forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple a))
typeDesc :: forall a. Candid a => Type Void
typeDesc :: Type Void
typeDesc = CandidVal (AsCandid a) => Type (Ref TypeRep Type)
forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a) Type (Ref TypeRep Type)
-> (Ref TypeRep Type -> Type Void) -> Type Void
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref TypeRep Type -> Type Void
forall (m :: * -> *) k b. Monad m => Ref k m -> m b
go
where go :: Ref k m -> m b
go (Ref k
_ m (Ref k m)
t) = m (Ref k m)
t m (Ref k m) -> (Ref k m -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref k m -> m b
go
instance Pretty TypeRep where
pretty :: TypeRep -> Doc ann
pretty = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (TypeRep -> String) -> TypeRep -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show
instance CandidSeq () where
asTypes :: [Type (Ref TypeRep Type)]
asTypes = []
seqVal :: () -> [Value]
seqVal () = []
fromVals :: [Value] -> Either String ()
fromVals [Value]
_ = () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Candid a => CandidSeq (Unary a) where
asTypes :: [Type (Ref TypeRep Type)]
asTypes = [Candid a => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @a]
seqVal :: Unary a -> [Value]
seqVal (Unary a
x) = [ a -> Value
forall a. Candid a => a -> Value
toCandidVal a
x ]
fromVals :: [Value] -> Either String (Unary a)
fromVals (Value
x:[Value]
_) = a -> Unary a
forall a. a -> Unary a
Unary (a -> Unary a) -> Either String a -> Either String (Unary a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. Candid a => Value -> Either String a
fromCandidVal Value
x
fromVals [Value]
_ = String -> Either String (Unary a)
forall a b. a -> Either a b
Left String
"Not enough arguments"
data DeserializeError
= DecodeError String
| CoerceError String Value
| MissingFieldError FieldName
| UnexpectedTagError FieldName
instance Error DeserializeError where strMsg :: String -> DeserializeError
strMsg = String -> DeserializeError
DecodeError
isRecoverable :: DeserializeError -> Bool
isRecoverable :: DeserializeError -> Bool
isRecoverable (DecodeError String
_) = Bool
False
isRecoverable DeserializeError
_ = Bool
True
recoverWith :: a -> Either DeserializeError a -> Either DeserializeError a
recoverWith :: a -> Either DeserializeError a -> Either DeserializeError a
recoverWith a
x (Left DeserializeError
e) | DeserializeError -> Bool
isRecoverable DeserializeError
e = a -> Either DeserializeError a
forall a b. b -> Either a b
Right a
x
recoverWith a
_ Either DeserializeError a
y = Either DeserializeError a
y
showDeserializeError :: DeserializeError -> String
showDeserializeError :: DeserializeError -> String
showDeserializeError DeserializeError
e = case DeserializeError
e of
DecodeError String
err -> String
err
CoerceError String
t Value
v -> String
"Cannot coerce " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (Value -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Value
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
MissingFieldError FieldName
f -> String
"Missing field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (FieldName -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f)
UnexpectedTagError FieldName
f -> String
"Unexpected tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (FieldName -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f)
cannotDecode :: String -> Either DeserializeError a
cannotDecode :: String -> Either DeserializeError a
cannotDecode String
s = DeserializeError -> Either DeserializeError a
forall a b. a -> Either a b
Left (String -> DeserializeError
DecodeError String
s)
cannotCoerce :: String -> Value -> Either DeserializeError a
cannotCoerce :: String -> Value -> Either DeserializeError a
cannotCoerce String
t Value
v = DeserializeError -> Either DeserializeError a
forall a b. a -> Either a b
Left (String -> Value -> DeserializeError
CoerceError String
t Value
v)
missingField :: FieldName -> Either DeserializeError a
missingField :: FieldName -> Either DeserializeError a
missingField FieldName
f = DeserializeError -> Either DeserializeError a
forall a b. a -> Either a b
Left (FieldName -> DeserializeError
MissingFieldError FieldName
f)
unexpectedTag :: FieldName -> Either DeserializeError a
unexpectedTag :: FieldName -> Either DeserializeError a
unexpectedTag FieldName
f = DeserializeError -> Either DeserializeError a
forall a b. a -> Either a b
Left (FieldName -> DeserializeError
UnexpectedTagError FieldName
f)
class Typeable a => CandidVal a where
asType :: Type (Ref TypeRep Type)
toCandidVal' :: a -> Value
fromCandidVal' :: Value -> Either DeserializeError a
fromMissingField :: Maybe a
fromMissingField = Maybe a
forall a. Maybe a
Nothing
class (Typeable a, CandidVal (AsCandid a)) => Candid a where
type AsCandid a
toCandid :: a -> AsCandid a
fromCandid :: AsCandid a -> a
type AsCandid a = a
default toCandid :: a ~ AsCandid a => a -> AsCandid a
toCandid = a -> AsCandid a
forall a. a -> a
id
default fromCandid :: a ~ AsCandid a => AsCandid a -> a
fromCandid = AsCandid a -> a
forall a. a -> a
id
toCandidVal :: Candid a => a -> Value
toCandidVal :: a -> Value
toCandidVal = AsCandid a -> Value
forall a. CandidVal a => a -> Value
toCandidVal' (AsCandid a -> Value) -> (a -> AsCandid a) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AsCandid a
forall a. Candid a => a -> AsCandid a
toCandid
fromCandidVal :: Candid a => Value -> Either String a
fromCandidVal :: Value -> Either String a
fromCandidVal = (DeserializeError -> String)
-> Either DeserializeError a -> Either String a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserializeError -> String
showDeserializeError (Either DeserializeError a -> Either String a)
-> (Value -> Either DeserializeError a) -> Value -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal''
fromCandidVal'' :: Candid a => Value -> Either DeserializeError a
fromCandidVal'' :: Value -> Either DeserializeError a
fromCandidVal'' = (AsCandid a -> a)
-> Either DeserializeError (AsCandid a)
-> Either DeserializeError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AsCandid a -> a
forall a. Candid a => AsCandid a -> a
fromCandid (Either DeserializeError (AsCandid a) -> Either DeserializeError a)
-> (Value -> Either DeserializeError (AsCandid a))
-> Value
-> Either DeserializeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either DeserializeError (AsCandid a)
forall a. CandidVal a => Value -> Either DeserializeError a
fromCandidVal'
asType' :: forall a. Candid a => Type (Ref TypeRep Type)
asType' :: Type (Ref TypeRep Type)
asType' = Ref TypeRep Type -> Type (Ref TypeRep Type)
forall a. a -> Type a
RefT (TypeRep -> Type (Ref TypeRep Type) -> Ref TypeRep Type
forall k (f :: * -> *). k -> f (Ref k f) -> Ref k f
Ref (Proxy (AsCandid a) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (AsCandid a)
forall k (t :: k). Proxy t
Proxy @(AsCandid a))) (CandidVal (AsCandid a) => Type (Ref TypeRep Type)
forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a)))
instance Candid Bool
instance CandidVal Bool where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
BoolT
toCandidVal' :: Bool -> Value
toCandidVal' = Bool -> Value
BoolV
fromCandidVal' :: Value -> Either DeserializeError Bool
fromCandidVal' (BoolV Bool
b) = Bool -> Either DeserializeError Bool
forall a b. b -> Either a b
Right Bool
b
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Bool
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"bool" Value
v
instance Candid Natural
instance CandidVal Natural where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
NatT
toCandidVal' :: Natural -> Value
toCandidVal' = Natural -> Value
NatV
fromCandidVal' :: Value -> Either DeserializeError Natural
fromCandidVal' (NumV Scientific
n)
| Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
0, Right Natural
i <- Scientific -> Either Double Natural
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Natural -> Either DeserializeError Natural
forall a b. b -> Either a b
Right Natural
i
| Bool
otherwise = String -> Either DeserializeError Natural
forall a. String -> Either DeserializeError a
cannotDecode (String -> Either DeserializeError Natural)
-> String -> Either DeserializeError Natural
forall a b. (a -> b) -> a -> b
$ String
"Not a natural number: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n
fromCandidVal' (NatV Natural
n) = Natural -> Either DeserializeError Natural
forall a b. b -> Either a b
Right Natural
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Natural
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"nat" Value
v
inBounds :: forall a. (Integral a, Bounded a) => Integer -> Either DeserializeError a
inBounds :: Integer -> Either DeserializeError a
inBounds Integer
i
| a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i
, a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i
= a -> Either DeserializeError a
forall a b. b -> Either a b
Right (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
| Bool
otherwise
= String -> Either DeserializeError a
forall a. String -> Either DeserializeError a
cannotDecode (String -> Either DeserializeError a)
-> String -> Either DeserializeError a
forall a b. (a -> b) -> a -> b
$ String
"Out of bounds: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i
instance Candid Word8
instance CandidVal Word8 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Nat8T
toCandidVal' :: Word8 -> Value
toCandidVal' = Word8 -> Value
Nat8V
fromCandidVal' :: Value -> Either DeserializeError Word8
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Word8
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Nat8V Word8
n) = Word8 -> Either DeserializeError Word8
forall a b. b -> Either a b
Right Word8
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Word8
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"word8" Value
v
instance Candid Word16
instance CandidVal Word16 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Nat16T
toCandidVal' :: Word16 -> Value
toCandidVal' = Word16 -> Value
Nat16V
fromCandidVal' :: Value -> Either DeserializeError Word16
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Word16
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Nat16V Word16
n) = Word16 -> Either DeserializeError Word16
forall a b. b -> Either a b
Right Word16
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Word16
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"word16" Value
v
instance Candid Word32
instance CandidVal Word32 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Nat32T
toCandidVal' :: Word32 -> Value
toCandidVal' = Word32 -> Value
Nat32V
fromCandidVal' :: Value -> Either DeserializeError Word32
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Word32
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Nat32V Word32
n) = Word32 -> Either DeserializeError Word32
forall a b. b -> Either a b
Right Word32
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Word32
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"word32" Value
v
instance Candid Word64
instance CandidVal Word64 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Nat64T
toCandidVal' :: Word64 -> Value
toCandidVal' = Word64 -> Value
Nat64V
fromCandidVal' :: Value -> Either DeserializeError Word64
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Word64
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Nat64V Word64
n) = Word64 -> Either DeserializeError Word64
forall a b. b -> Either a b
Right Word64
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Word64
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"word64" Value
v
instance Candid Integer
instance CandidVal Integer where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
IntT
toCandidVal' :: Integer -> Value
toCandidVal' = Integer -> Value
IntV
fromCandidVal' :: Value -> Either DeserializeError Integer
fromCandidVal' (NumV Scientific
n)
| Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Integer
forall a b. b -> Either a b
Right Integer
i
| Bool
otherwise = String -> Either DeserializeError Integer
forall a. String -> Either DeserializeError a
cannotDecode (String -> Either DeserializeError Integer)
-> String -> Either DeserializeError Integer
forall a b. (a -> b) -> a -> b
$ String
"Not an integer: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n
fromCandidVal' (NatV Natural
n) = Integer -> Either DeserializeError Integer
forall a b. b -> Either a b
Right (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
fromCandidVal' (IntV Integer
n) = Integer -> Either DeserializeError Integer
forall a b. b -> Either a b
Right Integer
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Integer
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"int" Value
v
instance Candid Int8
instance CandidVal Int8 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Int8T
toCandidVal' :: Int8 -> Value
toCandidVal' = Int8 -> Value
Int8V
fromCandidVal' :: Value -> Either DeserializeError Int8
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Int8
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Int8V Int8
n) = Int8 -> Either DeserializeError Int8
forall a b. b -> Either a b
Right Int8
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Int8
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"int8" Value
v
instance Candid Int16
instance CandidVal Int16 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Int16T
toCandidVal' :: Int16 -> Value
toCandidVal' = Int16 -> Value
Int16V
fromCandidVal' :: Value -> Either DeserializeError Int16
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Int16
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Int16V Int16
n) = Int16 -> Either DeserializeError Int16
forall a b. b -> Either a b
Right Int16
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Int16
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"int16" Value
v
instance Candid Int32
instance CandidVal Int32 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Int32T
toCandidVal' :: Int32 -> Value
toCandidVal' = Int32 -> Value
Int32V
fromCandidVal' :: Value -> Either DeserializeError Int32
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Int32
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Int32V Int32
n) = Int32 -> Either DeserializeError Int32
forall a b. b -> Either a b
Right Int32
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Int32
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"int32" Value
v
instance Candid Int64
instance CandidVal Int64 where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Int64T
toCandidVal' :: Int64 -> Value
toCandidVal' = Int64 -> Value
Int64V
fromCandidVal' :: Value -> Either DeserializeError Int64
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = Integer -> Either DeserializeError Int64
forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
fromCandidVal' (Int64V Int64
n) = Int64 -> Either DeserializeError Int64
forall a b. b -> Either a b
Right Int64
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Int64
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"int64" Value
v
instance Candid Float
instance CandidVal Float where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Float32T
toCandidVal' :: Float -> Value
toCandidVal' = Float -> Value
Float32V
fromCandidVal' :: Value -> Either DeserializeError Float
fromCandidVal' (NumV Scientific
n) = Float -> Either DeserializeError Float
forall a b. b -> Either a b
Right (Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n)
fromCandidVal' (Float32V Float
n) = Float -> Either DeserializeError Float
forall a b. b -> Either a b
Right Float
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Float
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"float32" Value
v
instance Candid Double
instance CandidVal Double where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
Float64T
toCandidVal' :: Double -> Value
toCandidVal' = Double -> Value
Float64V
fromCandidVal' :: Value -> Either DeserializeError Double
fromCandidVal' (NumV Scientific
n) = Double -> Either DeserializeError Double
forall a b. b -> Either a b
Right (Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n)
fromCandidVal' (Float64V Double
n) = Double -> Either DeserializeError Double
forall a b. b -> Either a b
Right Double
n
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Double
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"float64" Value
v
instance Candid Void
instance CandidVal Void where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
EmptyT
toCandidVal' :: Void -> Value
toCandidVal' = Void -> Value
forall a. Void -> a
absurd
fromCandidVal' :: Value -> Either DeserializeError Void
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Void
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"void" Value
v
instance Candid T.Text
instance CandidVal T.Text where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
TextT
toCandidVal' :: Text -> Value
toCandidVal' = Text -> Value
TextV
fromCandidVal' :: Value -> Either DeserializeError Text
fromCandidVal' (TextV Text
t) = Text -> Either DeserializeError Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Text
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"text" Value
v
instance Candid BS.ByteString
instance CandidVal BS.ByteString where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
BlobT
toCandidVal' :: ByteString -> Value
toCandidVal' = ByteString -> Value
BlobV
fromCandidVal' :: Value -> Either DeserializeError ByteString
fromCandidVal' (VecV Vector Value
v) = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (Vector Word8 -> [Word8]) -> Vector Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> [Word8]
forall a. Vector a -> [a]
Vec.toList (Vector Word8 -> ByteString)
-> Either DeserializeError (Vector Word8)
-> Either DeserializeError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either DeserializeError Word8)
-> Vector Value -> Either DeserializeError (Vector Word8)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Candid Word8 => Value -> Either DeserializeError Word8
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' @Word8) Vector Value
v
fromCandidVal' (BlobV ByteString
t) = ByteString -> Either DeserializeError ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
t
fromCandidVal' Value
v = String -> Value -> Either DeserializeError ByteString
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"blob" Value
v
instance Candid Principal
instance CandidVal Principal where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
PrincipalT
toCandidVal' :: Principal -> Value
toCandidVal' = Principal -> Value
PrincipalV
fromCandidVal' :: Value -> Either DeserializeError Principal
fromCandidVal' (PrincipalV Principal
t) = Principal -> Either DeserializeError Principal
forall (m :: * -> *) a. Monad m => a -> m a
return Principal
t
fromCandidVal' Value
v = String -> Value -> Either DeserializeError Principal
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"principal" Value
v
instance Candid Reserved
instance CandidVal Reserved where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
ReservedT
toCandidVal' :: Reserved -> Value
toCandidVal' Reserved
Reserved = Value
ReservedV
fromCandidVal' :: Value -> Either DeserializeError Reserved
fromCandidVal' Value
_ = Reserved -> Either DeserializeError Reserved
forall (m :: * -> *) a. Monad m => a -> m a
return Reserved
Reserved
fromMissingField :: Maybe Reserved
fromMissingField = Reserved -> Maybe Reserved
forall a. a -> Maybe a
Just Reserved
Reserved
instance Candid a => Candid (Maybe a)
instance Candid a => CandidVal (Maybe a) where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a. Type a -> Type a
OptT (Candid a => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @a)
toCandidVal' :: Maybe a -> Value
toCandidVal' = Maybe Value -> Value
OptV (Maybe Value -> Value)
-> (Maybe a -> Maybe Value) -> Maybe a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. Candid a => a -> Value
toCandidVal
fromCandidVal' :: Value -> Either DeserializeError (Maybe a)
fromCandidVal' (OptV Maybe Value
x) = Maybe a
-> Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a)
forall a.
a -> Either DeserializeError a -> Either DeserializeError a
recoverWith Maybe a
forall a. Maybe a
Nothing (Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a))
-> Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a)
forall a b. (a -> b) -> a -> b
$
(Value -> Either DeserializeError a)
-> Maybe Value -> Either DeserializeError (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Maybe Value
x
fromCandidVal' Value
NullV = Maybe a -> Either DeserializeError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
fromCandidVal' Value
ReservedV = Maybe a -> Either DeserializeError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
fromCandidVal' Value
v = case CandidVal (AsCandid a) => Type (Ref TypeRep Type)
forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a) of
OptT Type (Ref TypeRep Type)
_ -> Maybe a -> Either DeserializeError (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Type (Ref TypeRep Type)
NullT -> Maybe a -> Either DeserializeError (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Type (Ref TypeRep Type)
ReservedT -> Maybe a -> Either DeserializeError (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Type (Ref TypeRep Type)
_ -> Maybe a
-> Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a)
forall a.
a -> Either DeserializeError a -> Either DeserializeError a
recoverWith Maybe a
forall a. Maybe a
Nothing (Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a))
-> Either DeserializeError (Maybe a)
-> Either DeserializeError (Maybe a)
forall a b. (a -> b) -> a -> b
$
a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either DeserializeError a -> Either DeserializeError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
fromMissingField :: Maybe (Maybe a)
fromMissingField = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
instance Candid a => Candid (Vec.Vector a)
instance Candid a => CandidVal (Vec.Vector a) where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a. Type a -> Type a
VecT (Candid a => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @a)
toCandidVal' :: Vector a -> Value
toCandidVal' = Vector Value -> Value
VecV (Vector Value -> Value)
-> (Vector a -> Vector Value) -> Vector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Vector Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. Candid a => a -> Value
toCandidVal
fromCandidVal' :: Value -> Either DeserializeError (Vector a)
fromCandidVal' (VecV Vector Value
x) = (Value -> Either DeserializeError a)
-> Vector Value -> Either DeserializeError (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Vector Value
x
fromCandidVal' (BlobV ByteString
b) = (Word8 -> Either DeserializeError a)
-> Vector Word8 -> Either DeserializeError (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' (Value -> Either DeserializeError a)
-> (Word8 -> Value) -> Word8 -> Either DeserializeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Value
Nat8V) (Vector Word8 -> Either DeserializeError (Vector a))
-> Vector Word8 -> Either DeserializeError (Vector a)
forall a b. (a -> b) -> a -> b
$ [Word8] -> Vector Word8
forall a. [a] -> Vector a
Vec.fromList ([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
b
fromCandidVal' Value
v = String -> Value -> Either DeserializeError (Vector a)
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"vec" Value
v
instance Candid ()
instance CandidVal () where
asType :: Type (Ref TypeRep Type)
asType = Type (Ref TypeRep Type)
forall a. Type a
NullT
toCandidVal' :: () -> Value
toCandidVal' () = Value
NullV
fromCandidVal' :: Value -> Either DeserializeError ()
fromCandidVal' Value
NullV = () -> Either DeserializeError ()
forall a b. b -> Either a b
Right ()
fromCandidVal' Value
v = String -> Value -> Either DeserializeError ()
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"null" Value
v
fieldOfRow :: forall r. Forall r Candid => Fields (Ref TypeRep Type)
fieldOfRow :: Fields (Ref TypeRep Type)
fieldOfRow = Const (Fields (Ref TypeRep Type)) r -> Fields (Ref TypeRep Type)
forall a k (b :: k). Const a b -> a
getConst (Const (Fields (Ref TypeRep Type)) r -> Fields (Ref TypeRep Type))
-> Const (Fields (Ref TypeRep Type)) r -> Fields (Ref TypeRep Type)
forall a b. (a -> b) -> a -> b
$ Proxy Proxy
-> (Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty)
-> (forall (ℓ :: Symbol) τ (ρ :: [LT *]).
(KnownSymbol ℓ, Candid τ) =>
Label ℓ
-> Const () ('R ((ℓ ':-> τ) : ρ)) -> (Proxy τ, Const () ('R ρ)))
-> (forall (ℓ :: Symbol) τ (ρ :: [LT *]).
(KnownSymbol ℓ, Candid τ) =>
Label ℓ
-> Proxy τ
-> Const (Fields (Ref TypeRep Type)) ('R ρ)
-> Const (Fields (Ref TypeRep Type)) ('R ((ℓ ':-> τ) : ρ)))
-> Const () r
-> Const (Fields (Ref TypeRep Type)) r
forall k (r :: Row k) (c :: k -> Constraint) (f :: Row k -> *)
(g :: Row k -> *) (h :: k -> *).
Forall r c =>
Proxy h
-> (f Empty -> g Empty)
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: [LT k]).
(KnownSymbol ℓ, c τ) =>
Label ℓ -> f ('R ((ℓ ':-> τ) : ρ)) -> (h τ, f ('R ρ)))
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: [LT k]).
(KnownSymbol ℓ, c τ) =>
Label ℓ -> h τ -> g ('R ρ) -> g ('R ((ℓ ':-> τ) : ρ)))
-> f r
-> g r
metamorph @_ @r @Candid @(Const ()) @(Const (Fields (Ref TypeRep Type))) @Proxy Proxy Proxy
forall k (t :: k). Proxy t
Proxy Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil forall (l :: Symbol) t (r :: [LT *]).
KnownSymbol l =>
Label l
-> Const () ('R ((l ':-> t) : r)) -> (Proxy t, Const () ('R r))
forall (ℓ :: Symbol) τ (ρ :: [LT *]).
(KnownSymbol ℓ, Candid τ) =>
Label ℓ
-> Const () ('R ((ℓ ':-> τ) : ρ)) -> (Proxy τ, Const () ('R ρ))
doUncons forall (ℓ :: Symbol) τ (ρ :: [LT *]).
(KnownSymbol ℓ, Candid τ) =>
Label ℓ
-> Proxy τ
-> Const (Fields (Ref TypeRep Type)) ('R ρ)
-> Const (Fields (Ref TypeRep Type)) ('R ((ℓ ':-> τ) : ρ))
doCons (() -> Const () r
forall k a (b :: k). a -> Const a b
Const ())
where
doNil :: Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil :: Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil = Const (Fields (Ref TypeRep Type)) Empty
-> Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
forall a b. a -> b -> a
const (Const (Fields (Ref TypeRep Type)) Empty
-> Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty)
-> Const (Fields (Ref TypeRep Type)) Empty
-> Const () Empty
-> Const (Fields (Ref TypeRep Type)) Empty
forall a b. (a -> b) -> a -> b
$ Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) Empty
forall k a (b :: k). a -> Const a b
Const []
doUncons :: forall l t r. (KnownSymbol l)
=> Label l -> Const () ('R (l ':-> t ': r)) -> (Proxy t, Const () ('R r))
doUncons :: Label l
-> Const () ('R ((l ':-> t) : r)) -> (Proxy t, Const () ('R r))
doUncons Label l
_ Const () ('R ((l ':-> t) : r))
_ = (Proxy t
forall k (t :: k). Proxy t
Proxy, () -> Const () ('R r)
forall k a (b :: k). a -> Const a b
Const ())
doCons :: forall l t r. (KnownSymbol l, Candid t)
=> Label l -> Proxy t -> Const (Fields (Ref TypeRep Type)) ('R r) -> Const (Fields (Ref TypeRep Type)) ('R (l ':-> t ': r))
doCons :: Label l
-> Proxy t
-> Const (Fields (Ref TypeRep Type)) ('R r)
-> Const (Fields (Ref TypeRep Type)) ('R ((l ':-> t) : r))
doCons Label l
l Proxy t
Proxy (Const Fields (Ref TypeRep Type)
lst) = Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) ('R ((l ':-> t) : r))
forall k a (b :: k). a -> Const a b
Const (Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) ('R ((l ':-> t) : r)))
-> Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) ('R ((l ':-> t) : r))
forall a b. (a -> b) -> a -> b
$ (Text -> FieldName
unescapeFieldName (Label l -> Text
forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l), Candid t => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @t) (FieldName, Type (Ref TypeRep Type))
-> Fields (Ref TypeRep Type) -> Fields (Ref TypeRep Type)
forall a. a -> [a] -> [a]
: Fields (Ref TypeRep Type)
lst
type CandidRow r = (Typeable r, AllUniqueLabels r, AllUniqueLabels (V.Map (Either String) r), Forall r Candid, Forall r R.Unconstrained1)
instance CandidRow r => Candid (Rec r)
instance CandidRow r => CandidVal (Rec r) where
asType :: Type (Ref TypeRep Type)
asType = Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a. Fields a -> Type a
RecT (Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type))
-> Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a b. (a -> b) -> a -> b
$ Forall r Candid => Fields (Ref TypeRep Type)
forall (r :: Row *). Forall r Candid => Fields (Ref TypeRep Type)
fieldOfRow @r
toCandidVal' :: Rec r -> Value
toCandidVal' = do
[(FieldName, Value)] -> Value
RecV ([(FieldName, Value)] -> Value)
-> (Rec r -> [(FieldName, Value)]) -> Rec r -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> (FieldName, Value))
-> [(Text, Value)] -> [(FieldName, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> FieldName) -> (Text, Value) -> (FieldName, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> FieldName
unescapeFieldName) ([(Text, Value)] -> [(FieldName, Value)])
-> (Rec r -> [(Text, Value)]) -> Rec r -> [(FieldName, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Candid a => a -> Value) -> Rec r -> [(Text, Value)]
forall (c :: * -> Constraint) (ρ :: Row *) s b.
(Forall ρ c, IsString s) =>
(forall a. c a => a -> b) -> Rec ρ -> [(s, b)]
R.eraseWithLabels @Candid @r @T.Text @Value forall a. Candid a => a -> Value
toCandidVal
fromCandidVal' :: Value -> Either DeserializeError (Rec r)
fromCandidVal' = \case
RecV [(FieldName, Value)]
m -> [(FieldName, Value)] -> Either DeserializeError (Rec r)
forall (ρ :: Row *).
(AllUniqueLabels ρ, Forall ρ Candid) =>
[(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec [(FieldName, Value)]
m
TupV [Value]
m -> [(FieldName, Value)] -> Either DeserializeError (Rec r)
forall (ρ :: Row *).
(AllUniqueLabels ρ, Forall ρ Candid) =>
[(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec ([FieldName] -> [Value] -> [(FieldName, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Word32 -> FieldName) -> [Word32] -> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> FieldName
hashedField [Word32
0..]) [Value]
m)
Value
v -> String -> Value -> Either DeserializeError (Rec r)
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"record" Value
v
where
toRowRec :: [(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec [(FieldName, Value)]
m = forall (f :: * -> *) (ρ :: Row *).
(Applicative f, Forall ρ Candid, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> f a)
-> f (Rec ρ)
forall (c :: * -> Constraint) (f :: * -> *) (ρ :: Row *).
(Applicative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> f a)
-> f (Rec ρ)
R.fromLabelsA @Candid ((forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> Either DeserializeError a)
-> Either DeserializeError (Rec ρ))
-> (forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> Either DeserializeError a)
-> Either DeserializeError (Rec ρ)
forall a b. (a -> b) -> a -> b
$ \Label l
l ->
let fn :: FieldName
fn = Text -> FieldName
unescapeFieldName (Label l -> Text
forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l) in
case FieldName -> [(FieldName, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FieldName
fn [(FieldName, Value)]
m of
Just Value
v -> Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
Maybe Value
Nothing -> case Maybe (AsCandid a)
forall a. CandidVal a => Maybe a
fromMissingField of
Just AsCandid a
v -> a -> Either DeserializeError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AsCandid a -> a
forall a. Candid a => AsCandid a -> a
fromCandid AsCandid a
v)
Maybe (AsCandid a)
Nothing -> FieldName -> Either DeserializeError a
forall a. FieldName -> Either DeserializeError a
missingField FieldName
fn
instance CandidRow r => Candid (V.Var r)
instance CandidRow r => CandidVal (V.Var r) where
asType :: Type (Ref TypeRep Type)
asType = Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a. Fields a -> Type a
VariantT (Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type))
-> Fields (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a b. (a -> b) -> a -> b
$ Forall r Candid => Fields (Ref TypeRep Type)
forall (r :: Row *). Forall r Candid => Fields (Ref TypeRep Type)
fieldOfRow @r
toCandidVal' :: Var r -> Value
toCandidVal' Var r
v = FieldName -> Value -> Value
VariantV (Text -> FieldName
unescapeFieldName Text
t) Value
val
where (Text
t, Value
val) = (forall a. Candid a => a -> Value) -> Var r -> (Text, Value)
forall (c :: * -> Constraint) (ρ :: Row *) s b.
(Forall ρ c, IsString s) =>
(forall a. c a => a -> b) -> Var ρ -> (s, b)
V.eraseWithLabels @Candid forall a. Candid a => a -> Value
toCandidVal Var r
v
fromCandidVal' :: Value -> Either DeserializeError (Var r)
fromCandidVal' (VariantV FieldName
f Value
v) = do
needle :: V.Var (V.Map (Either DeserializeError) r) <-
((Alternative (Either DeserializeError), Forall r Candid,
AllUniqueLabels r) =>
(forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> Either DeserializeError (Either DeserializeError a))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *)
(ρ :: Row *).
(Alternative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a.
(KnownSymbol l, c a) =>
Label l -> f (g a))
-> f (Var (Map g ρ))
fromLabelsMapA @Candid @_ @_ @r ((forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> Either DeserializeError (Either DeserializeError a))
-> Either DeserializeError (Var (Map (Either DeserializeError) r)))
-> (forall (l :: Symbol) a.
(KnownSymbol l, Candid a) =>
Label l -> Either DeserializeError (Either DeserializeError a))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall a b. (a -> b) -> a -> b
$ \Label l
l -> do
Bool -> Either DeserializeError ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FieldName
f FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> FieldName
unescapeFieldName (Label l -> Text
forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l))
Either DeserializeError a
-> Either DeserializeError (Either DeserializeError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DeserializeError a
-> Either DeserializeError (Either DeserializeError a))
-> Either DeserializeError a
-> Either DeserializeError (Either DeserializeError a)
forall a b. (a -> b) -> a -> b
$ Value -> Either DeserializeError a
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
) Either DeserializeError (Var (Map (Either DeserializeError) r))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FieldName
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall a. FieldName -> Either DeserializeError a
unexpectedTag FieldName
f
Var (Map (Either DeserializeError) r)
-> Either DeserializeError (Var r)
forall (f :: * -> *) (r :: Row *).
(Forall r Unconstrained1, Applicative f) =>
Var (Map f r) -> f (Var r)
V.sequence (Var (Map (Either DeserializeError) r)
needle :: V.Var (V.Map (Either DeserializeError) r))
fromCandidVal' Value
v = String -> Value -> Either DeserializeError (Var r)
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"variant" Value
v
fromLabelsMapA :: forall c f g ρ. (Alternative f, Forall ρ c, AllUniqueLabels ρ)
=> (forall l a. (KnownSymbol l, c a) => Label l -> f (g a)) -> f (V.Var (V.Map g ρ))
fromLabelsMapA :: (forall (l :: Symbol) a.
(KnownSymbol l, c a) =>
Label l -> f (g a))
-> f (Var (Map g ρ))
fromLabelsMapA forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> f (g a)
f = (forall (l :: Symbol) a.
(KnownSymbol l, IsA c g a) =>
Label l -> f a)
-> f (Var (Map g ρ))
forall (c :: * -> Constraint) (ρ :: Row *) (f :: * -> *).
(Alternative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> f a)
-> f (Var ρ)
V.fromLabels @(R.IsA c g) @(V.Map g ρ) @f forall (l :: Symbol) a.
(KnownSymbol l, IsA c g a) =>
Label l -> f a
inner
(Forall (Map g ρ) (IsA c g) => f (Var (Map g ρ)))
-> (Forall ρ c :- Forall (Map g ρ) (IsA c g)) -> f (Var (Map g ρ))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Forall ρ c :- Forall (Map g ρ) (IsA c g)
forall k1 k2 (f :: k1 -> k2) (c :: k1 -> Constraint) (ρ :: Row k1).
Forall ρ c :- Forall (Map f ρ) (IsA c f)
R.mapForall @g @c @ρ
(AllUniqueLabels (Map g ρ) => f (Var (Map g ρ)))
-> (AllUniqueLabels ρ :- AllUniqueLabels (Map g ρ))
-> f (Var (Map g ρ))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ AllUniqueLabels ρ :- AllUniqueLabels (Map g ρ)
forall a k (f :: a -> k) (ρ :: Row a).
AllUniqueLabels ρ :- AllUniqueLabels (Map f ρ)
R.uniqueMap @g @ρ
where inner :: forall l a. (KnownSymbol l, R.IsA c g a) => Label l -> f a
inner :: Label l -> f a
inner Label l
l = case IsA c g a => As c g a
forall k k1 (c :: k -> Constraint) (f :: k -> k1) (a :: k1).
IsA c f a =>
As c f a
R.as @c @g @a of As c g a
R.As -> Label l -> f (g t)
forall (l :: Symbol) a. (KnownSymbol l, c a) => Label l -> f (g a)
f Label l
l
instance Candid SBS.ByteString where
type AsCandid SBS.ByteString = BS.ByteString
toCandid :: ByteString -> AsCandid ByteString
toCandid = ByteString -> ByteString
ByteString -> AsCandid ByteString
BS.fromStrict
fromCandid :: AsCandid ByteString -> ByteString
fromCandid = ByteString -> ByteString
AsCandid ByteString -> ByteString
BS.toStrict
instance (Candid a, Candid b) => Candid (a, b) where
type AsCandid (a,b) = Rec ("_0_" .== a .+ "_1_" .== b)
toCandid :: (a, b) -> AsCandid (a, b)
toCandid (a
a,b
b) = IsLabel "_0_" (Label "_0_")
Label "_0_"
#_0_ Label "_0_" -> a -> Rec ("_0_" .== a)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== a
a Rec ('R '[ "_0_" ':-> a])
-> Rec ('R '[ "_1_" ':-> b])
-> Rec ('R '[ "_0_" ':-> a] .+ 'R '[ "_1_" ':-> b])
forall (l :: Row *) (r :: Row *). Rec l -> Rec r -> Rec (l .+ r)
.+ IsLabel "_1_" (Label "_1_")
Label "_1_"
#_1_ Label "_1_" -> b -> Rec ("_1_" .== b)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== b
b
fromCandid :: AsCandid (a, b) -> (a, b)
fromCandid AsCandid (a, b)
r = (Rec ('R '[ "_0_" ':-> a, "_1_" ':-> b])
AsCandid (a, b)
r Rec ('R '[ "_0_" ':-> a, "_1_" ':-> b])
-> Label "_0_" -> 'R '[ "_0_" ':-> a, "_1_" ':-> b] .! "_0_"
forall (l :: Symbol) (r :: Row *).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! IsLabel "_0_" (Label "_0_")
Label "_0_"
#_0_, Rec ('R '[ "_0_" ':-> a, "_1_" ':-> b])
AsCandid (a, b)
r Rec ('R '[ "_0_" ':-> a, "_1_" ':-> b])
-> Label "_1_" -> 'R '[ "_0_" ':-> a, "_1_" ':-> b] .! "_1_"
forall (l :: Symbol) (r :: Row *).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! IsLabel "_1_" (Label "_1_")
Label "_1_"
#_1_)
instance (Candid a, Candid b) => CandidSeq (a, b) where
asTypes :: [Type (Ref TypeRep Type)]
asTypes = [Candid a => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @a, Candid b => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
asType' @b]
seqVal :: (a, b) -> [Value]
seqVal (a
x, b
y) = [ a -> Value
forall a. Candid a => a -> Value
toCandidVal a
x, b -> Value
forall a. Candid a => a -> Value
toCandidVal b
y ]
fromVals :: [Value] -> Either String (a, b)
fromVals (Value
x:Value
y:[Value]
_) = (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. Candid a => Value -> Either String a
fromCandidVal Value
x Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String b
forall a. Candid a => Value -> Either String a
fromCandidVal Value
y
fromVals [Value]
_ = String -> Either String (a, b)
forall a b. a -> Either a b
Left String
"Not enough arguments"
$(