{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# 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 #-}
-- | This (internal) module contains the encoding and decoding, as well
-- as the relevant classes
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 qualified Data.Row.Records as R
import qualified Data.Row.Internal as R
import qualified Data.Row.Variants as V
import Data.Row.Internal (metamorph)
import Control.Monad
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 Prettyprinter
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
import Codec.Candid.Coerce

-- | Encode based on Haskell type
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

-- | Encode to a 'B.Builder' based on Haskell type
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 to Haskell type
decode :: forall a. CandidArg a => BS.ByteString -> Either String a
decode :: ByteString -> Either String a
decode ByteString
b = do
    -- Decode
    (SeqDesc
ts, [Value]
vs) <- ByteString -> Either String (SeqDesc, [Value])
decodeVals ByteString
b
    -- Coerce to expected type
    [Value]
vs' <- [Value] -> SeqDesc -> SeqDesc -> Either String [Value]
coerceSeqDesc [Value]
vs SeqDesc
ts ([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)))
    [Value] -> Either String a
forall a. CandidArg a => [Value] -> Either String a
fromCandidVals [Value]
vs'

-- | Decode (dynamic) values to Haskell type
--
-- This applies some best-effort subtyping/coercion, suitable for liberal
-- parsing of the textual representation, but not the coercion algorithm as
-- specified in the specification, which requires a provided type.
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

-- | Turn haskell types into a dynamic Candid value. This may lose type information.
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

-- Using normal Haskell values

-- | The class of types that can be used as Candid argument sequences.
-- Essentially all types that are in 'Candid', but tuples need to be treated specially.
type CandidArg a = (CandidSeq (AsTuple a), Tuplable a, Typeable a)


class CandidSeq a where
    asTypes :: [Type (Ref TypeRep Type)]
    seqVal :: a -> [Value]
    fromVals :: [Value] -> Either String a

-- | Calculate a Candid type description from a Haskell type. The 'SeqDesc'
-- type is roughly @[Type]@, with extra bookkeeping for recursive types
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))

typeGraph :: forall a. Candid a => Type (Ref TypeRep Type)
typeGraph :: Type (Ref TypeRep Type)
typeGraph = CandidVal (AsCandid a) => Type (Ref TypeRep Type)
forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a)

-- | NB: This will loop with recursive types!
typeDesc :: forall a. Candid a => Type Void
typeDesc :: Type Void
typeDesc = Candid a => Type (Ref TypeRep Type)
forall a. Candid a => Type (Ref TypeRep Type)
typeGraph @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 () -- Subtyping

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 -- Subtyping
    fromVals [Value]
_ = String -> Either String (Unary a)
forall a b. a -> Either a b
Left String
"Not enough arguments"

-- see below for tuple  instances

data DeserializeError
    = DecodeError String -- ^ fatal
    | CoerceError String Value -- ^ can be recovered
    | MissingFieldError FieldName -- ^ can be recovered
    | UnexpectedTagError FieldName -- ^ can be recovered

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)

-- | The internal class of Haskell types that canonically map to Candid.
-- You would add instances to the 'Candid' type class.
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

-- | The class of Haskell types that can be converted to Candid.
--
-- You can create intances of this class for your own types, see the tutorial above for examples. The default instance is mostly for internal use.
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 CandidMethodsRow r => Candid (ServiceRef r)
instance CandidMethodsRow r => CandidVal (ServiceRef r) where
    asType :: Type (Ref TypeRep Type)
asType = [(Text, MethodType (Ref TypeRep Type))] -> Type (Ref TypeRep Type)
forall a. [(Text, MethodType a)] -> Type a
ServiceT (Forall r CandidMethodType =>
[(Text, MethodType (Ref TypeRep Type))]
forall k (r :: Row k).
Forall r CandidMethodType =>
[(Text, MethodType (Ref TypeRep Type))]
methodsOfRow @r)
    toCandidVal' :: ServiceRef r -> Value
toCandidVal' (ServiceRef Principal
p) = Principal -> Value
ServiceV Principal
p
    fromCandidVal' :: Value -> Either DeserializeError (ServiceRef r)
fromCandidVal' (ServiceV Principal
p) = ServiceRef r -> Either DeserializeError (ServiceRef r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Principal -> ServiceRef r
forall (r :: Row *). Principal -> ServiceRef r
ServiceRef Principal
p)
    fromCandidVal' Value
v = String -> Value -> Either DeserializeError (ServiceRef r)
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"service" Value
v

instance (CandidMethodType mt) => Candid (FuncRef mt)
instance (CandidMethodType mt) => CandidVal (FuncRef mt) where
    asType :: Type (Ref TypeRep Type)
asType = MethodType (Ref TypeRep Type) -> Type (Ref TypeRep Type)
forall a. MethodType a -> Type a
FuncT (CandidMethodType mt => MethodType (Ref TypeRep Type)
forall k (a :: k).
CandidMethodType a =>
MethodType (Ref TypeRep Type)
asMethodType @mt)
    toCandidVal' :: FuncRef mt -> Value
toCandidVal' (FuncRef Principal
p Text
n) = Principal -> Text -> Value
FuncV Principal
p Text
n
    fromCandidVal' :: Value -> Either DeserializeError (FuncRef mt)
fromCandidVal' (FuncV Principal
p Text
n) = FuncRef mt -> Either DeserializeError (FuncRef mt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Principal -> Text -> FuncRef mt
forall r. Principal -> Text -> FuncRef r
FuncRef Principal
p Text
n)
    fromCandidVal' Value
v = String -> Value -> Either DeserializeError (FuncRef mt)
forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"func" 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' (RepeatV Int
n Value
x) = Int -> a -> Vector a
forall a. Int -> a -> Vector a
Vec.replicate Int
n (a -> Vector a)
-> Either DeserializeError a -> Either DeserializeError (Vector 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
x
    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

-- | Maybe a bit opinionated, but 'null' seems to be the unit of Candid
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

-- row-types integration

fieldsOfRow :: forall r. Forall r Candid => Fields (Ref TypeRep Type)
fieldsOfRow :: Fields (Ref TypeRep Type)
fieldsOfRow = 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 Proxy, Proxy (,))
-> (Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty)
-> (forall (ℓ :: Symbol) τ (ρ :: Row *).
    (KnownSymbol ℓ, Candid τ, HasType ℓ τ ρ) =>
    Label ℓ -> Const () ρ -> (Const () (ρ .- ℓ), Proxy τ))
-> (forall (ℓ :: Symbol) τ (ρ :: Row *).
    (KnownSymbol ℓ, Candid τ, FrontExtends ℓ τ ρ,
     AllUniqueLabels (Extend ℓ τ ρ)) =>
    Label ℓ
    -> (Const (Fields (Ref TypeRep Type)) ρ, Proxy τ)
    -> Const (Fields (Ref TypeRep Type)) (Extend ℓ τ ρ))
-> Const () r
-> Const (Fields (Ref TypeRep Type)) r
forall k (r :: Row k) (c :: k -> Constraint) (p :: * -> * -> *)
       (f :: Row k -> *) (g :: Row k -> *) (h :: k -> *).
(Forall r c, Bifunctor p) =>
Proxy (Proxy h, Proxy p)
-> (f Empty -> g Empty)
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, c τ, HasType ℓ τ ρ) =>
    Label ℓ -> f ρ -> p (f (ρ .- ℓ)) (h τ))
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, c τ, FrontExtends ℓ τ ρ,
     AllUniqueLabels (Extend ℓ τ ρ)) =>
    Label ℓ -> p (g ρ) (h τ) -> g (Extend ℓ τ ρ))
-> f r
-> g r
metamorph @_ @r @Candid @(,) @(Const ()) @(Const (Fields (Ref TypeRep Type))) @Proxy Proxy (Proxy Proxy, Proxy (,))
forall k (t :: k). Proxy t
Proxy Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
forall a a.
Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil forall (ℓ :: Symbol) τ (ρ :: Row *).
(KnownSymbol ℓ, Candid τ, HasType ℓ τ ρ) =>
Label ℓ -> Const () ρ -> (Const () (ρ .- ℓ), Proxy τ)
doUncons forall (l :: Symbol) t (r :: Row *).
(KnownSymbol l, Candid t) =>
Label l
-> (Const (Fields (Ref TypeRep Type)) r, Proxy t)
-> Const (Fields (Ref TypeRep Type)) (Extend l t r)
forall (ℓ :: Symbol) τ (ρ :: Row *).
(KnownSymbol ℓ, Candid τ, FrontExtends ℓ τ ρ,
 AllUniqueLabels (Extend ℓ τ ρ)) =>
Label ℓ
-> (Const (Fields (Ref TypeRep Type)) ρ, Proxy τ)
-> Const (Fields (Ref TypeRep Type)) (Extend ℓ τ ρ)
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, Candid t, HasType l t r)
                 => Label l -> Const () r -> (Const () (r .- l), Proxy t)
        doUncons :: Label l -> Const () r -> (Const () (r .- l), Proxy t)
doUncons Label l
_ Const () r
_ = (() -> Const () (r .- l)
forall k a (b :: k). a -> Const a b
Const (), Proxy t
forall k (t :: k). Proxy t
Proxy)
        doCons :: forall l t r. (KnownSymbol l, Candid t)
               => Label l -> (Const (Fields (Ref TypeRep Type)) r, Proxy t) -> Const (Fields (Ref TypeRep Type)) (R.Extend l t r)
        doCons :: Label l
-> (Const (Fields (Ref TypeRep Type)) r, Proxy t)
-> Const (Fields (Ref TypeRep Type)) (Extend l t r)
doCons Label l
l (Const Fields (Ref TypeRep Type)
lst, Proxy t
Proxy) = Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) (Extend l t r)
forall k a (b :: k). a -> Const a b
Const (Fields (Ref TypeRep Type)
 -> Const (Fields (Ref TypeRep Type)) (Extend l t r))
-> Fields (Ref TypeRep Type)
-> Const (Fields (Ref TypeRep Type)) (Extend 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

class Typeable a => KnownAnnotation a where isTrue :: Bool
-- | Type-level 'True', to be used in method types annotations
data AnnTrue
-- | Type-level 'False', to be used in method types annotations
data AnnFalse
instance KnownAnnotation AnnTrue where isTrue :: Bool
isTrue = Bool
True
instance KnownAnnotation AnnFalse where isTrue :: Bool
isTrue = Bool
False

class Typeable a => CandidMethodType a where
    asMethodType :: MethodType (Ref TypeRep Type)

instance (CandidArg a, CandidArg b, KnownAnnotation q, KnownAnnotation cq, KnownAnnotation o) => CandidMethodType (a, b, q, cq, o) where
    asMethodType :: MethodType (Ref TypeRep Type)
asMethodType = [Type (Ref TypeRep Type)]
-> [Type (Ref TypeRep Type)]
-> Bool
-> Bool
-> Bool
-> MethodType (Ref TypeRep Type)
forall a.
[Type a] -> [Type a] -> Bool -> Bool -> Bool -> MethodType a
MethodType (CandidSeq (AsTuple a) => [Type (Ref TypeRep Type)]
forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple a)) (CandidSeq (AsTuple b) => [Type (Ref TypeRep Type)]
forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple b)) (KnownAnnotation q => Bool
forall k (a :: k). KnownAnnotation a => Bool
isTrue @q) (KnownAnnotation cq => Bool
forall k (a :: k). KnownAnnotation a => Bool
isTrue @cq) (KnownAnnotation o => Bool
forall k (a :: k). KnownAnnotation a => Bool
isTrue @o)

methodsOfRow :: forall r. Forall r CandidMethodType => [(T.Text, MethodType (Ref TypeRep Type))]
methodsOfRow :: [(Text, MethodType (Ref TypeRep Type))]
methodsOfRow = Const [(Text, MethodType (Ref TypeRep Type))] r
-> [(Text, MethodType (Ref TypeRep Type))]
forall a k (b :: k). Const a b -> a
getConst (Const [(Text, MethodType (Ref TypeRep Type))] r
 -> [(Text, MethodType (Ref TypeRep Type))])
-> Const [(Text, MethodType (Ref TypeRep Type))] r
-> [(Text, MethodType (Ref TypeRep Type))]
forall a b. (a -> b) -> a -> b
$ Proxy (Proxy Proxy, Proxy (,))
-> (Const () Empty
    -> Const [(Text, MethodType (Ref TypeRep Type))] Empty)
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, CandidMethodType τ, HasType ℓ τ ρ) =>
    Label ℓ -> Const () ρ -> (Const () (ρ .- ℓ), Proxy τ))
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, CandidMethodType τ, FrontExtends ℓ τ ρ,
     AllUniqueLabels (Extend ℓ τ ρ)) =>
    Label ℓ
    -> (Const [(Text, MethodType (Ref TypeRep Type))] ρ, Proxy τ)
    -> Const [(Text, MethodType (Ref TypeRep Type))] (Extend ℓ τ ρ))
-> Const () r
-> Const [(Text, MethodType (Ref TypeRep Type))] r
forall k (r :: Row k) (c :: k -> Constraint) (p :: * -> * -> *)
       (f :: Row k -> *) (g :: Row k -> *) (h :: k -> *).
(Forall r c, Bifunctor p) =>
Proxy (Proxy h, Proxy p)
-> (f Empty -> g Empty)
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, c τ, HasType ℓ τ ρ) =>
    Label ℓ -> f ρ -> p (f (ρ .- ℓ)) (h τ))
-> (forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
    (KnownSymbol ℓ, c τ, FrontExtends ℓ τ ρ,
     AllUniqueLabels (Extend ℓ τ ρ)) =>
    Label ℓ -> p (g ρ) (h τ) -> g (Extend ℓ τ ρ))
-> f r
-> g r
metamorph @_ @r @CandidMethodType @(,) @(Const ()) @(Const [(T.Text, MethodType (Ref TypeRep Type))]) @Proxy Proxy (Proxy Proxy, Proxy (,))
forall k (t :: k). Proxy t
Proxy Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
forall a a.
Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
doNil forall k (l :: Symbol) (t :: k) (r :: Row k).
(KnownSymbol l, CandidMethodType t, HasType l t r) =>
Label l -> Const () r -> (Const () (r .- l), Proxy t)
forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
(KnownSymbol ℓ, CandidMethodType τ, HasType ℓ τ ρ) =>
Label ℓ -> Const () ρ -> (Const () (ρ .- ℓ), Proxy τ)
doUncons forall k (l :: Symbol) (t :: k) (r :: Row k).
(KnownSymbol l, CandidMethodType t) =>
Label l
-> (Const [(Text, MethodType (Ref TypeRep Type))] r, Proxy t)
-> Const [(Text, MethodType (Ref TypeRep Type))] (Extend l t r)
forall (ℓ :: Symbol) (τ :: k) (ρ :: Row k).
(KnownSymbol ℓ, CandidMethodType τ, FrontExtends ℓ τ ρ,
 AllUniqueLabels (Extend ℓ τ ρ)) =>
Label ℓ
-> (Const [(Text, MethodType (Ref TypeRep Type))] ρ, Proxy τ)
-> Const [(Text, MethodType (Ref TypeRep Type))] (Extend ℓ τ ρ)
doCons (() -> Const () r
forall k a (b :: k). a -> Const a b
Const ())
      where
        doNil :: Const () Empty -> Const [(T.Text, MethodType (Ref TypeRep Type))] Empty
        doNil :: Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
doNil = Const [(Text, MethodType (Ref TypeRep Type))] Empty
-> Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
forall a b. a -> b -> a
const (Const [(Text, MethodType (Ref TypeRep Type))] Empty
 -> Const () Empty
 -> Const [(Text, MethodType (Ref TypeRep Type))] Empty)
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
-> Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
forall a b. (a -> b) -> a -> b
$ [(Text, MethodType (Ref TypeRep Type))]
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
forall k a (b :: k). a -> Const a b
Const []
        doUncons :: forall l t r. (KnownSymbol l, CandidMethodType t, HasType l t r)
                 => Label l -> Const () r -> (Const () (r .- l), Proxy t)
        doUncons :: Label l -> Const () r -> (Const () (r .- l), Proxy t)
doUncons Label l
_ Const () r
_ = (() -> Const () (r .- l)
forall k a (b :: k). a -> Const a b
Const (), Proxy t
forall k (t :: k). Proxy t
Proxy)
        doCons :: forall l t r. (KnownSymbol l, CandidMethodType t)
               => Label l -> (Const [(T.Text, MethodType (Ref TypeRep Type))] r, Proxy t) -> Const [(T.Text, MethodType (Ref TypeRep Type))] (R.Extend l t r)
        doCons :: Label l
-> (Const [(Text, MethodType (Ref TypeRep Type))] r, Proxy t)
-> Const [(Text, MethodType (Ref TypeRep Type))] (Extend l t r)
doCons Label l
l (Const [(Text, MethodType (Ref TypeRep Type))]
lst, Proxy t
Proxy) = [(Text, MethodType (Ref TypeRep Type))]
-> Const [(Text, MethodType (Ref TypeRep Type))] (Extend l t r)
forall k a (b :: k). a -> Const a b
Const ([(Text, MethodType (Ref TypeRep Type))]
 -> Const [(Text, MethodType (Ref TypeRep Type))] (Extend l t r))
-> [(Text, MethodType (Ref TypeRep Type))]
-> Const [(Text, MethodType (Ref TypeRep Type))] (Extend l t r)
forall a b. (a -> b) -> a -> b
$ (Label l -> Text
forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l, CandidMethodType t => MethodType (Ref TypeRep Type)
forall k (a :: k).
CandidMethodType a =>
MethodType (Ref TypeRep Type)
asMethodType @t) (Text, MethodType (Ref TypeRep Type))
-> [(Text, MethodType (Ref TypeRep Type))]
-> [(Text, MethodType (Ref TypeRep Type))]
forall a. a -> [a] -> [a]
: [(Text, MethodType (Ref TypeRep Type))]
lst

type CandidRow r = (Typeable r, AllUniqueLabels r, AllUniqueLabels (V.Map (Either String) r), Forall r Candid, Forall r R.Unconstrained1)
type CandidMethodsRow r = (Typeable r, AllUniqueLabels r, AllUniqueLabels (V.Map (Either String) r), Forall r CandidMethodType, 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)
fieldsOfRow @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)
fieldsOfRow @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
        Var (Map (Either DeserializeError) r)
needle  <-
            Either DeserializeError (Var (Map (Either DeserializeError) r))
-> (Var (Map (Either DeserializeError) r)
    -> Either DeserializeError (Var (Map (Either DeserializeError) r)))
-> Maybe (Var (Map (Either DeserializeError) r))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 (Map (Either DeserializeError) r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Var (Map (Either DeserializeError) r))
 -> Either DeserializeError (Var (Map (Either DeserializeError) r)))
-> Maybe (Var (Map (Either DeserializeError) r))
-> Either DeserializeError (Var (Map (Either DeserializeError) r))
forall a b. (a -> b) -> a -> b
$
            ((Alternative Maybe, Forall r Candid, AllUniqueLabels r) =>
(forall (l :: Symbol) a1.
 (KnownSymbol l, Candid a1) =>
 Label l -> Maybe (Either DeserializeError a1))
-> Maybe (Var (Map (Either DeserializeError) r))
forall a (c :: a -> Constraint) (f :: * -> *) (g :: a -> *)
       (ρ :: Row a).
(Alternative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) (a1 :: a).
 (KnownSymbol l, c a1) =>
 Label l -> f (g a1))
-> f (Var (Map g ρ))
V.fromLabelsMap @Candid @_ @_ @r ((forall (l :: Symbol) a1.
  (KnownSymbol l, Candid a1) =>
  Label l -> Maybe (Either DeserializeError a1))
 -> Maybe (Var (Map (Either DeserializeError) r)))
-> (forall (l :: Symbol) a1.
    (KnownSymbol l, Candid a1) =>
    Label l -> Maybe (Either DeserializeError a1))
-> Maybe (Var (Map (Either DeserializeError) r))
forall a b. (a -> b) -> a -> b
$ \Label l
l -> do
                Bool -> Maybe ()
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 a1 -> Maybe (Either DeserializeError a1)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DeserializeError a1 -> Maybe (Either DeserializeError a1))
-> Either DeserializeError a1 -> Maybe (Either DeserializeError a1)
forall a b. (a -> b) -> a -> b
$ Value -> Either DeserializeError a1
forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
            )
        Var (Map (Either DeserializeError) r)
-> Either DeserializeError (Var r)
forall (f :: * -> *) (r :: Row *).
(FreeForall r, Functor 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


-- Derived forms

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

-- Tuples, generated by TH

-- This is what it looks like:
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 *).
FreeForall l =>
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"

$(
  let tupT ts  = foldl appT (tupleT (length ts)) ts in
  let fieldLabelT n = litT $ strTyLit ("_" ++ show (n::Int) ++ "_") in
  let fieldLabelE n = labelE ("_" ++ show (n::Int) ++ "_") in

  fmap concat . sequence $
  [
    let names = take n $ map (mkName . (:[])) ['a'..]
        tvs = map varT names
        pvs = map varP names
        vs  = map varE names
    in [d|
      instance  $(tupT [ [t|Candid $v |] | v <- tvs ]) => Candid $(tupT tvs) where
        type AsCandid $(tupT tvs) =
          Rec $(
            foldr1 (\a b -> [t| $a .+ $b |])
              [ [t| $(fieldLabelT n) .== $b |]
              | (n,b) <- zip [0..] tvs ])
        toCandid $(tupP pvs) =
          $( foldr1 (\a b -> [| $a .+ $b |])
              [ [| $(fieldLabelE n) .== $b |]
              | (n,b) <- zip [0..] vs ])
        fromCandid $(varP (mkName "r")) =
          $( tupE [ [| $(varE (mkName "r")) .! $(fieldLabelE n) |]
                  | (n,_) <- zip [0..] vs])

      instance  $(tupT [ [t|Candid $v |] | v <- tvs ]) => CandidSeq $(tupT tvs) where
        asTypes = $(listE [ [| asType' @($v) |] | v <- tvs ])
        seqVal $(tupP pvs) = $(listE [ [| toCandidVal $v |] | v <- vs ])
        fromVals $(foldr (`infixP` '(:)) wildP pvs)
          = $( foldl (`uInfixE` varE '(<*>))
                [| pure $(conE (tupleDataName n)) |]
                [ [| fromCandidVal $v |] | v <- vs ] )
        fromVals _ = Left "Not enough arguments"
     |]
  | n <- [3..15]
  ]
 )


instance Candid a => Candid [a] where
    type AsCandid [a] = Vec.Vector a
    toCandid :: [a] -> AsCandid [a]
toCandid = [a] -> AsCandid [a]
forall a. [a] -> Vector a
Vec.fromList
    fromCandid :: AsCandid [a] -> [a]
fromCandid = AsCandid [a] -> [a]
forall a. Vector a -> [a]
Vec.toList


instance (Candid a, Candid b) => Candid (Either a b) where
    type AsCandid (Either a b) = V.Var ("Left" V..== a V..+ "Right" V..== b)
    toCandid :: Either a b -> AsCandid (Either a b)
toCandid (Left a
x) = Label "Left"
-> ('R '[ "Left" ':-> a, "Right" ':-> b] .! "Left")
-> Var ('R '[ "Left" ':-> a, "Right" ':-> b])
forall (l :: Symbol) (r :: Row *).
(AllUniqueLabels r, KnownSymbol l) =>
Label l -> (r .! l) -> Var r
IsJust (Label "Left"
forall (s :: Symbol). Label s
Label @"Left") a
'R '[ "Left" ':-> a, "Right" ':-> b] .! "Left"
x
    toCandid (Right b
x) = Label "Right"
-> ('R '[ "Left" ':-> a, "Right" ':-> b] .! "Right")
-> Var ('R '[ "Left" ':-> a, "Right" ':-> b])
forall (l :: Symbol) (r :: Row *).
(AllUniqueLabels r, KnownSymbol l) =>
Label l -> (r .! l) -> Var r
IsJust (Label "Right"
forall (s :: Symbol). Label s
Label @"Right") b
'R '[ "Left" ':-> a, "Right" ':-> b] .! "Right"
x
    fromCandid :: AsCandid (Either a b) -> Either a b
fromCandid AsCandid (Either a b)
v = Var ('R '[ "Left" ':-> a, "Right" ':-> b])
-> Rec
     ('R
        '[ "Left" ':-> (a -> Either a b), "Right" ':-> (b -> Either a b)])
-> Either a b
forall (v :: Row *) (r :: Row *) x.
BiForall r v (AppliesTo x) =>
Var v -> Rec r -> x
switch Var ('R '[ "Left" ':-> a, "Right" ':-> b])
AsCandid (Either a b)
v (Rec
   ('R
      '[ "Left" ':-> (a -> Either a b), "Right" ':-> (b -> Either a b)])
 -> Either a b)
-> Rec
     ('R
        '[ "Left" ':-> (a -> Either a b), "Right" ':-> (b -> Either a b)])
-> Either a b
forall a b. (a -> b) -> a -> b
$ Rec Empty
empty
        Rec Empty
-> Rec ('R '[ "Left" ':-> (a -> Either a b)])
-> Rec (Empty .+ 'R '[ "Left" ':-> (a -> Either a b)])
forall (l :: Row *) (r :: Row *).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "Left"
forall (s :: Symbol). Label s
Label @"Left" Label "Left"
-> (a -> Either a b) -> Rec ("Left" .== (a -> Either a b))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== a -> Either a b
forall a b. a -> Either a b
Left
        Rec ('R '[ "Left" ':-> (a -> Either a b)])
-> Rec ('R '[ "Right" ':-> (b -> Either a b)])
-> Rec
     ('R '[ "Left" ':-> (a -> Either a b)]
      .+ 'R '[ "Right" ':-> (b -> Either a b)])
forall (l :: Row *) (r :: Row *).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "Right"
forall (s :: Symbol). Label s
Label @"Right" Label "Right"
-> (b -> Either a b) -> Rec ("Right" .== (b -> Either a b))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== b -> Either a b
forall a b. b -> Either a b
Right