{-# 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 :: forall a. CandidArg a => a -> ByteString
encode = Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. CandidArg a => a -> Builder
encodeBuilder a
x = SeqDesc -> [Value] -> Builder
encodeValues (forall a. CandidArg a => SeqDesc
seqDesc @a) (forall a. CandidArg a => a -> [Value]
toCandidVals a
x)

-- | Decode to Haskell type
decode :: forall a. CandidArg a => BS.ByteString -> Either String a
decode :: forall a. CandidArg a => 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 (forall k. (Pretty k, Ord k) => [Type (Ref k Type)] -> SeqDesc
buildSeqDesc (forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple 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 :: forall a. CandidArg a => [Value] -> Either String a
fromCandidVals = forall a. CandidSeq a => [Value] -> Either String a
fromVals forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. CandidArg a => a -> [Value]
toCandidVals = forall a. CandidSeq a => a -> [Value]
seqVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. CandidArg a => SeqDesc
seqDesc = forall k. (Pretty k, Ord k) => [Type (Ref k Type)] -> SeqDesc
buildSeqDesc (forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple a))

typeGraph :: forall a. Candid a => Type (Ref TypeRep Type)
typeGraph :: forall a. Candid a => Type (Ref TypeRep Type)
typeGraph = 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 :: forall a. Candid a => Type Void
typeDesc = forall a. Candid a => Type (Ref TypeRep Type)
typeGraph @a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref k m -> m b
go

instance Pretty TypeRep where
    pretty :: forall ann. TypeRep -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return () -- Subtyping

instance Candid a => CandidSeq (Unary a) where
    asTypes :: [Type (Ref TypeRep Type)]
asTypes = [forall a. Candid a => Type (Ref TypeRep Type)
asType' @a]
    seqVal :: Unary a -> [Value]
seqVal (Unary a
x) = [ forall a. Candid a => a -> Value
toCandidVal a
x ]
    fromVals :: [Value] -> Either String (Unary a)
fromVals (Value
x:[Value]
_) = forall a. a -> Unary a
Unary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Candid a => Value -> Either String a
fromCandidVal Value
x -- Subtyping
    fromVals [Value]
_ = 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 :: forall a.
a -> Either DeserializeError a -> Either DeserializeError a
recoverWith a
x (Left DeserializeError
e) | DeserializeError -> Bool
isRecoverable DeserializeError
e = 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a ann. Pretty a => a -> Doc ann
pretty Value
v) forall a. [a] -> [a] -> [a]
++ String
" into " forall a. [a] -> [a] -> [a]
++ String
t
    MissingFieldError FieldName
f -> String
"Missing field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f)
    UnexpectedTagError FieldName
f -> String
"Unexpected tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f)

cannotDecode :: String -> Either DeserializeError a
cannotDecode :: forall a. String -> Either DeserializeError a
cannotDecode String
s = forall a b. a -> Either a b
Left (String -> DeserializeError
DecodeError String
s)
cannotCoerce :: String -> Value -> Either DeserializeError a
cannotCoerce :: forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
t Value
v = forall a b. a -> Either a b
Left (String -> Value -> DeserializeError
CoerceError String
t Value
v)
missingField :: FieldName -> Either DeserializeError a
missingField :: forall a. FieldName -> Either DeserializeError a
missingField FieldName
f = forall a b. a -> Either a b
Left (FieldName -> DeserializeError
MissingFieldError FieldName
f)
unexpectedTag :: FieldName -> Either DeserializeError a
unexpectedTag :: forall a. FieldName -> Either DeserializeError a
unexpectedTag FieldName
f = 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 = 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 = forall a. a -> a
id
    default fromCandid :: a ~ AsCandid a => AsCandid a -> a
    fromCandid = forall a. a -> a
id

toCandidVal :: Candid a => a -> Value
toCandidVal :: forall a. Candid a => a -> Value
toCandidVal = forall a. CandidVal a => a -> Value
toCandidVal' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Candid a => a -> AsCandid a
toCandid

fromCandidVal :: Candid a => Value -> Either String a
fromCandidVal :: forall a. Candid a => Value -> Either String a
fromCandidVal = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserializeError -> String
showDeserializeError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal''

fromCandidVal'' :: Candid a => Value -> Either DeserializeError a
fromCandidVal'' :: forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Candid a => AsCandid a -> a
fromCandid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CandidVal a => Value -> Either DeserializeError a
fromCandidVal'

asType' :: forall a.  Candid a => Type (Ref TypeRep Type)
asType' :: forall a. Candid a => Type (Ref TypeRep Type)
asType' = forall a. a -> Type a
RefT (forall k (f :: * -> *). k -> f (Ref k f) -> Ref k f
Ref (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @(AsCandid a))) (forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a)))

instance Candid Bool
instance CandidVal Bool where
    asType :: Type (Ref TypeRep Type)
asType = forall a. Type a
BoolT
    toCandidVal' :: Bool -> Value
toCandidVal' = Bool -> Value
BoolV
    fromCandidVal' :: Value -> Either DeserializeError Bool
fromCandidVal' (BoolV Bool
b) = forall a b. b -> Either a b
Right Bool
b
    fromCandidVal' Value
v = 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 = forall a. Type a
NatT
    toCandidVal' :: Natural -> Value
toCandidVal' = Natural -> Value
NatV
    fromCandidVal' :: Value -> Either DeserializeError Natural
fromCandidVal' (NumV Scientific
n)
        | Scientific
n forall a. Ord a => a -> a -> Bool
>= Scientific
0, Right Natural
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a b. b -> Either a b
Right Natural
i
        | Bool
otherwise = forall a. String -> Either DeserializeError a
cannotDecode forall a b. (a -> b) -> a -> b
$ String
"Not a natural number: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n
    fromCandidVal' (NatV Natural
n) = forall a b. b -> Either a b
Right Natural
n
    fromCandidVal' Value
v = forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"nat" Value
v

inBounds :: forall a. (Integral a, Bounded a) => Integer -> Either DeserializeError a
inBounds :: forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    | forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Integer
i
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a) forall a. Ord a => a -> a -> Bool
>= Integer
i
    = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
    | Bool
otherwise
    = forall a. String -> Either DeserializeError a
cannotDecode forall a b. (a -> b) -> a -> b
$ String
"Out of bounds: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i

instance Candid Word8
instance CandidVal Word8 where
    asType :: Type (Ref TypeRep Type)
asType = forall a. Type a
Nat8T
    toCandidVal' :: Word8 -> Value
toCandidVal' = Word8 -> Value
Nat8V
    fromCandidVal' :: Value -> Either DeserializeError Word8
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Nat8V Word8
n) = forall a b. b -> Either a b
Right Word8
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Nat16T
    toCandidVal' :: Word16 -> Value
toCandidVal' = Word16 -> Value
Nat16V
    fromCandidVal' :: Value -> Either DeserializeError Word16
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Nat16V Word16
n) = forall a b. b -> Either a b
Right Word16
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Nat32T
    toCandidVal' :: Word32 -> Value
toCandidVal' = Word32 -> Value
Nat32V
    fromCandidVal' :: Value -> Either DeserializeError Word32
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Nat32V Word32
n) = forall a b. b -> Either a b
Right Word32
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Nat64T
    toCandidVal' :: Word64 -> Value
toCandidVal' = Word64 -> Value
Nat64V
    fromCandidVal' :: Value -> Either DeserializeError Word64
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Nat64V Word64
n) = forall a b. b -> Either a b
Right Word64
n
    fromCandidVal' Value
v = 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 = forall a. Type a
IntT
    toCandidVal' :: Integer -> Value
toCandidVal' = Integer -> Value
IntV
    fromCandidVal' :: Value -> Either DeserializeError Integer
fromCandidVal' (NumV Scientific
n)
        | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a b. b -> Either a b
Right Integer
i
        | Bool
otherwise = forall a. String -> Either DeserializeError a
cannotDecode forall a b. (a -> b) -> a -> b
$ String
"Not an integer: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n
    fromCandidVal' (NatV Natural
n) = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
    fromCandidVal' (IntV Integer
n) = forall a b. b -> Either a b
Right Integer
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Int8T
    toCandidVal' :: Int8 -> Value
toCandidVal' = Int8 -> Value
Int8V
    fromCandidVal' :: Value -> Either DeserializeError Int8
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Int8V Int8
n) = forall a b. b -> Either a b
Right Int8
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Int16T
    toCandidVal' :: Int16 -> Value
toCandidVal' = Int16 -> Value
Int16V
    fromCandidVal' :: Value -> Either DeserializeError Int16
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Int16V Int16
n) = forall a b. b -> Either a b
Right Int16
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Int32T
    toCandidVal' :: Int32 -> Value
toCandidVal' = Int32 -> Value
Int32V
    fromCandidVal' :: Value -> Either DeserializeError Int32
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Int32V Int32
n) = forall a b. b -> Either a b
Right Int32
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Int64T
    toCandidVal' :: Int64 -> Value
toCandidVal' = Int64 -> Value
Int64V
    fromCandidVal' :: Value -> Either DeserializeError Int64
fromCandidVal' (NumV Scientific
n) | Right Integer
i <- forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger @Double Scientific
n = forall a.
(Integral a, Bounded a) =>
Integer -> Either DeserializeError a
inBounds Integer
i
    fromCandidVal' (Int64V Int64
n) = forall a b. b -> Either a b
Right Int64
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Float32T
    toCandidVal' :: Float -> Value
toCandidVal' = Float -> Value
Float32V
    fromCandidVal' :: Value -> Either DeserializeError Float
fromCandidVal' (NumV Scientific
n) = forall a b. b -> Either a b
Right (forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n)
    fromCandidVal' (Float32V Float
n) = forall a b. b -> Either a b
Right Float
n
    fromCandidVal' Value
v = 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 = forall a. Type a
Float64T
    toCandidVal' :: Double -> Value
toCandidVal' = Double -> Value
Float64V
    fromCandidVal' :: Value -> Either DeserializeError Double
fromCandidVal' (NumV Scientific
n) = forall a b. b -> Either a b
Right (forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n)
    fromCandidVal' (Float64V Double
n) = forall a b. b -> Either a b
Right Double
n
    fromCandidVal' Value
v = 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 = forall a. Type a
EmptyT
    toCandidVal' :: Void -> Value
toCandidVal' = forall a. Void -> a
absurd
    fromCandidVal' :: Value -> Either DeserializeError Void
fromCandidVal' Value
v = 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 = forall a. Type a
TextT
    toCandidVal' :: Text -> Value
toCandidVal' = Text -> Value
TextV
    fromCandidVal' :: Value -> Either DeserializeError Text
fromCandidVal' (TextV Text
t) = forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
    fromCandidVal' Value
v = 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vec.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' @Word8) Vector Value
v
    fromCandidVal' (BlobV ByteString
t) = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
t
    fromCandidVal' Value
v = 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 = forall a. Type a
PrincipalT
    toCandidVal' :: Principal -> Value
toCandidVal' = Principal -> Value
PrincipalV
    fromCandidVal' :: Value -> Either DeserializeError Principal
fromCandidVal' (PrincipalV Principal
t) = forall (m :: * -> *) a. Monad m => a -> m a
return Principal
t
    fromCandidVal' Value
v = 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 = forall a. [(Text, MethodType a)] -> Type a
ServiceT (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) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (r :: Row (*)). Principal -> ServiceRef r
ServiceRef Principal
p)
    fromCandidVal' Value
v = 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 = forall a. MethodType a -> Type a
FuncT (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) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall r. Principal -> Text -> FuncRef r
FuncRef Principal
p Text
n)
    fromCandidVal' Value
v = 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 = forall a. Type a
ReservedT
    toCandidVal' :: Reserved -> Value
toCandidVal' Reserved
Reserved = Value
ReservedV
    fromCandidVal' :: Value -> Either DeserializeError Reserved
fromCandidVal' Value
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Reserved
Reserved
    fromMissingField :: Maybe Reserved
fromMissingField = 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 = forall a. Type a -> Type a
OptT (forall a. Candid a => Type (Ref TypeRep Type)
asType' @a)
    toCandidVal' :: Maybe a -> Value
toCandidVal' = Maybe Value -> Value
OptV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Candid a => a -> Value
toCandidVal
    fromCandidVal' :: Value -> Either DeserializeError (Maybe a)
fromCandidVal' (OptV Maybe Value
x) = forall a.
a -> Either DeserializeError a -> Either DeserializeError a
recoverWith forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Maybe Value
x
    fromCandidVal' Value
NullV = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    fromCandidVal' Value
ReservedV = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    fromCandidVal' Value
v = case forall a. CandidVal a => Type (Ref TypeRep Type)
asType @(AsCandid a) of
        OptT Type (Ref TypeRep Type)
_    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        Type (Ref TypeRep Type)
NullT     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        Type (Ref TypeRep Type)
ReservedT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        Type (Ref TypeRep Type)
_         -> forall a.
a -> Either DeserializeError a -> Either DeserializeError a
recoverWith forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
            forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
    fromMissingField :: Maybe (Maybe a)
fromMissingField = forall a. a -> Maybe a
Just 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 = forall a. Type a -> Type a
VecT (forall a. Candid a => Type (Ref TypeRep Type)
asType' @a)
    toCandidVal' :: Vector a -> Value
toCandidVal' = Vector Value -> Value
VecV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Candid a => a -> Value
toCandidVal
    fromCandidVal' :: Value -> Either DeserializeError (Vector a)
fromCandidVal' (VecV Vector Value
x) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Vector Value
x
    fromCandidVal' (BlobV ByteString
b) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Value
Nat8V) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vec.fromList forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
b
    fromCandidVal' Value
v = 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 = forall a. Type a
NullT
    toCandidVal' :: () -> Value
toCandidVal' () = Value
NullV
    fromCandidVal' :: Value -> Either DeserializeError ()
fromCandidVal' Value
NullV = forall a b. b -> Either a b
Right ()
    fromCandidVal' Value
v = 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 :: forall (r :: Row (*)). Forall r Candid => Fields (Ref TypeRep Type)
fieldsOfRow = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ 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 forall {k} (t :: k). Proxy t
Proxy forall {a} {a}.
Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil forall (l :: Symbol) t (r :: Row (*)).
(KnownSymbol l, Candid t, HasType l t r) =>
Label l -> Const () r -> (Const () (r .- l), Proxy t)
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)
doCons (forall {k} a (b :: k). a -> Const a b
Const ())
      where
        doNil :: Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
        doNil :: forall {a} {a}.
Const () Empty -> Const (Fields (Ref TypeRep Type)) Empty
doNil = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall (l :: Symbol) t (r :: Row (*)).
(KnownSymbol l, Candid t, HasType l t r) =>
Label l -> Const () r -> (Const () (r .- l), Proxy t)
doUncons Label l
_ Const () r
_ = (forall {k} a (b :: k). a -> Const a b
Const (), 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 :: 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)
doCons Label l
l (Const Fields (Ref TypeRep Type)
lst, Proxy t
Proxy) = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ (Text -> FieldName
unescapeFieldName (forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l), forall a. Candid a => Type (Ref TypeRep Type)
asType' @t) 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 o) => CandidMethodType (a, b, q, o) where
    asMethodType :: MethodType (Ref TypeRep Type)
asMethodType = forall a. [Type a] -> [Type a] -> Bool -> Bool -> MethodType a
MethodType (forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple a)) (forall a. CandidSeq a => [Type (Ref TypeRep Type)]
asTypes @(AsTuple b)) (forall {k} (a :: k). KnownAnnotation a => Bool
isTrue @q) (forall {k} (a :: k). KnownAnnotation a => Bool
isTrue @o)

methodsOfRow :: forall r. Forall r CandidMethodType => [(T.Text, MethodType (Ref TypeRep Type))]
methodsOfRow :: forall {k} (r :: Row k).
Forall r CandidMethodType =>
[(Text, MethodType (Ref TypeRep Type))]
methodsOfRow = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ 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 forall {k} (t :: k). Proxy t
Proxy 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)
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)
doCons (forall {k} a (b :: k). a -> Const a b
Const ())
      where
        doNil :: Const () Empty -> Const [(T.Text, MethodType (Ref TypeRep Type))] Empty
        doNil :: forall {a} {a}.
Const () Empty
-> Const [(Text, MethodType (Ref TypeRep Type))] Empty
doNil = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: 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)
doUncons Label l
_ Const () r
_ = (forall {k} a (b :: k). a -> Const a b
Const (), 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 :: 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)
doCons Label l
l (Const [(Text, MethodType (Ref TypeRep Type))]
lst, Proxy t
Proxy) = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ (forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l, forall {k} (a :: k).
CandidMethodType a =>
MethodType (Ref TypeRep Type)
asMethodType @t) 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 = forall a. Fields a -> Type a
RecT forall a b. (a -> b) -> a -> b
$ forall (r :: Row (*)). Forall r Candid => Fields (Ref TypeRep Type)
fieldsOfRow @r

    toCandidVal' :: Rec r -> Value
toCandidVal' = do
        [(FieldName, Value)] -> Value
RecV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> FieldName
unescapeFieldName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall {ρ :: Row (*)}.
(AllUniqueLabels ρ, Forall ρ Candid) =>
[(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec [(FieldName, Value)]
m
        TupV [Value]
m -> forall {ρ :: Row (*)}.
(AllUniqueLabels ρ, Forall ρ Candid) =>
[(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Word32 -> FieldName
hashedField [Word32
0..]) [Value]
m)
        Value
v -> forall a. String -> Value -> Either DeserializeError a
cannotCoerce String
"record" Value
v
      where
        toRowRec :: [(FieldName, Value)] -> Either DeserializeError (Rec ρ)
toRowRec [(FieldName, Value)]
m = 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 a b. (a -> b) -> a -> b
$ \Label l
l ->
            let fn :: FieldName
fn = Text -> FieldName
unescapeFieldName (forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l) in
            case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FieldName
fn [(FieldName, Value)]
m of
                Just Value
v -> forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
                Maybe Value
Nothing -> case forall a. CandidVal a => Maybe a
fromMissingField of
                    Just AsCandid a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Candid a => AsCandid a -> a
fromCandid AsCandid a
v)
                    Maybe (AsCandid a)
Nothing -> 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 = forall a. Fields a -> Type a
VariantT forall a b. (a -> b) -> a -> b
$ 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 (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  <-
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. FieldName -> Either DeserializeError a
unexpectedTag FieldName
f) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            (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 a b. (a -> b) -> a -> b
$ \Label l
l -> do
                forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FieldName
f forall a. Eq a => a -> a -> Bool
== Text -> FieldName
unescapeFieldName (forall (s :: Symbol). KnownSymbol s => Label s -> Text
R.toKey Label l
l))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Candid a => Value -> Either DeserializeError a
fromCandidVal'' Value
v
            )
        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 = 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
BS.fromStrict
    fromCandid :: AsCandid ByteString -> ByteString
fromCandid = 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) = forall a. IsLabel "_0_" a => a
#_0_ forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== a
a forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ forall a. IsLabel "_1_" a => a
#_1_ 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 = (AsCandid (a, b)
r forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "_0_" a => a
#_0_, AsCandid (a, b)
r forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "_1_" a => a
#_1_)

instance (Candid a, Candid b) => CandidSeq (a, b) where
    asTypes :: [Type (Ref TypeRep Type)]
asTypes = [forall a. Candid a => Type (Ref TypeRep Type)
asType' @a, forall a. Candid a => Type (Ref TypeRep Type)
asType' @b]
    seqVal :: (a, b) -> [Value]
seqVal (a
x, b
y) = [ forall a. Candid a => a -> Value
toCandidVal a
x, forall a. Candid a => a -> Value
toCandidVal b
y ]
    fromVals :: [Value] -> Either String (a, b)
fromVals (Value
x:Value
y:[Value]
_) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Candid a => Value -> Either String a
fromCandidVal Value
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Candid a => Value -> Either String a
fromCandidVal Value
y
    fromVals [Value]
_ = 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 = forall a. [a] -> Vector a
Vec.fromList
    fromCandid :: AsCandid [a] -> [a]
fromCandid = 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) = forall (l :: Symbol) (r :: Row (*)).
(AllUniqueLabels r, KnownSymbol l) =>
Label l -> (r .! l) -> Var r
IsJust (forall (s :: Symbol). Label s
Label @"Left") a
x
    toCandid (Right b
x) = forall (l :: Symbol) (r :: Row (*)).
(AllUniqueLabels r, KnownSymbol l) =>
Label l -> (r .! l) -> Var r
IsJust (forall (s :: Symbol). Label s
Label @"Right") b
x
    fromCandid :: AsCandid (Either a b) -> Either a b
fromCandid AsCandid (Either a b)
v = forall (v :: Row (*)) (r :: Row (*)) x.
BiForall r v (AppliesTo x) =>
Var v -> Rec r -> x
switch AsCandid (Either a b)
v forall a b. (a -> b) -> a -> b
$ Rec ('R '[])
empty
        forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ forall (s :: Symbol). Label s
Label @"Left" forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== forall a b. a -> Either a b
Left
        forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ forall (s :: Symbol). Label s
Label @"Right" forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== forall a b. b -> Either a b
Right