{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Codec.Candid.TH
 ( candid, candidFile
 , candidType, candidTypeQ
 , candidDefs, candidDefsFile
 , generateCandidDefs
 ) where

import qualified Data.Map as M
import qualified Data.Row.Records as R
import qualified Data.Row.Variants as V
import qualified Data.Text as T
import qualified Data.Vector as V
import Numeric.Natural
import Data.Word
import Data.Int
import Data.Void
import Data.Foldable
import Data.Traversable
import Data.List
import Data.Graph (stronglyConnComp, SCC(..))
import Control.Monad
import qualified Data.ByteString.Lazy as BS

import qualified Language.Haskell.TH.Syntax as TH (Name)
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax (Q, lookupTypeName, newName, Dec, mkName)

import Codec.Candid.Parse
import Codec.Candid.Data
import Codec.Candid.Tuples
import Codec.Candid.Types
import Codec.Candid.FieldName
import Codec.Candid.Class (Candid, AnnTrue, AnnFalse)

-- | This quasi-quoter turns a Candid service description into a Haskell type. It assumes a type variable @m@ to be in scope, and uses that as the monad for the service's methods.
--
-- Recursive types are not supported.
candid :: QuasiQuoter
candid :: QuasiQuoter
candid = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quotePat :: String -> Q Pat
quotePat = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quoteDec :: String -> Q [Dec]
quoteDec = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quoteType :: String -> Q Type
quoteType = String -> Q Type
quoteCandidService }
  where err :: p -> m a
err p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"[candid| … |] can only be used as a type"

-- | As 'candid', but takes a filename
candidFile :: QuasiQuoter
candidFile :: QuasiQuoter
candidFile = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
candid

-- | This quasi-quoter turns all type definitions of a Canddi file into Haskell types, as one 'Row'. The @service@ of the candid file is ignored.
--
-- Recursive types are not supported.
-- 
-- This quasi-quoter works differently depending on context:
--
-- As a _type_, it expands to a row-types record with one entry per type
-- defined in the Candid file:
--
-- > type MyDefs = [candidDefs|type t = text; ... |]
-- >
-- > foo :: MyDefs .! "t"
--
-- As a _declaration_ (i.e. the module top level), it generates one type
-- synonym (@type Foo = ...@) per definition. This only works if the candid
-- type name is a valid Haskell type name (in particular, upper case). This may
-- improve in the future.
--
-- > [candidDefs|type Foo = text; ... |]
-- >
-- > foo :: Foo
--
-- You can use `-ddump-splices` to see the generated code.
candidDefs :: QuasiQuoter
candidDefs :: QuasiQuoter
candidDefs = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quotePat :: String -> Q Pat
quotePat = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
quoteCandidDefsSym, quoteType :: String -> Q Type
quoteType = String -> Q Type
quoteCandidDefs }
  where err :: p -> m a
err p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"[candidDefs| … |] can only be used as a type or as declarations"

-- | As 'candid', but takes a filename
candidDefsFile :: QuasiQuoter
candidDefsFile :: QuasiQuoter
candidDefsFile = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
candidDefs

-- | This quasi-quoter turns works on individual candid types, e.g.
--
-- > type InstallMode = [candidType| variant {install : null; reinstall : null; upgrade : null}; |]
candidType :: QuasiQuoter
candidType :: QuasiQuoter
candidType = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quotePat :: String -> Q Pat
quotePat = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quoteDec :: String -> Q [Dec]
quoteDec = forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
err, quoteType :: String -> Q Type
quoteType = String -> Q Type
quoteCandidType }
  where err :: p -> m a
err p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"[candidType| … |] can only be used as a type"

-- | Turns all candid type definitions into newtypes
-- Used, so far, only in the Candid test suite runner
generateCandidDefs :: T.Text -> [DidDef TypeName] -> Q ([Dec], TypeName -> Q TH.Name)
generateCandidDefs :: TypeName -> [DidDef TypeName] -> Q ([Dec], TypeName -> Q Name)
generateCandidDefs TypeName
prefix [DidDef TypeName]
defs = do
    [(TypeName, Name)]
assocs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [DidDef TypeName]
defs forall a b. (a -> b) -> a -> b
$ \(TypeName
tn, Type TypeName
_) -> do
        Name
thn <- forall (m :: * -> *). Quote m => String -> m Name
newName (String
"Candid_" forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
prefix forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
tn)
        forall (m :: * -> *) a. Monad m => a -> m a
return (TypeName
tn, Name
thn)

    let m :: Map TypeName Name
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(TypeName, Name)]
assocs
    let resolve :: TypeName -> m Name
resolve TypeName
tn = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TypeName
tn Map TypeName Name
m of
            Just Name
thn -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
thn
            Maybe Name
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not find type " forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
tn
    [Dec]
decls <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [DidDef TypeName]
defs forall a b. (a -> b) -> a -> b
$ \(TypeName
tn, Type TypeName
t) -> do
          Type Name
t' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. MonadFail m => TypeName -> m Name
resolve Type TypeName
t
          Name
n <- forall {m :: * -> *}. MonadFail m => TypeName -> m Name
resolve TypeName
tn
          Name
dn <- forall (m :: * -> *). Quote m => String -> m Name
newName (String
"Candid_" forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
prefix forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
tn)
          forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt []) Name
n [] forall a. Maybe a
Nothing
            (forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
dn [forall (m :: * -> *). Quote m => m Bang -> m Type -> m BangType
bangType (forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness) (Type Name -> Q Type
typ Type Name
t')])
            [forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause forall a. Maybe a
Nothing [forall (m :: * -> *). Quote m => Name -> m Type
conT ''Candid, forall (m :: * -> *). Quote m => Name -> m Type
conT ''Eq, forall (m :: * -> *). Quote m => Name -> m Type
conT ''Show]]
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec]
decls, forall {m :: * -> *}. MonadFail m => TypeName -> m Name
resolve)

-- | Inlines all candid type definitions, after checking for loops
inlineDefs :: forall k.  (Show k, Ord k) => [DidDef k] -> Q ([(k, Type Void)], k -> Q (), k -> Type Void)
inlineDefs :: forall k.
(Show k, Ord k) =>
[DidDef k] -> Q ([(k, Type Void)], k -> Q (), k -> Type Void)
inlineDefs [DidDef k]
defs = do
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[k]]
sccs forall a b. (a -> b) -> a -> b
$ \[k]
scc ->
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cyclic type definitions not supported: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [k]
scc)
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DidDef k]
defs forall a b. (a -> b) -> a -> b
$ \(k
_, Type k
t) -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Type k
t forall {f :: * -> *}. MonadFail f => k -> f ()
checkKey
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a -> [(k, a)]
M.toList Map k (Type Void)
m, forall {f :: * -> *}. MonadFail f => k -> f ()
checkKey, k -> Type Void
f)
  where
    sccs :: [[k]]
sccs = [ [k]
tns | CyclicSCC [k]
tns <-
        forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [ (k
tn, k
tn, forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Type k
t) | (k
tn, Type k
t) <- [DidDef k]
defs ] ]
    f :: k -> Type Void
    f :: k -> Type Void
f k
k = Map k (Type Void)
m forall k a. Ord k => Map k a -> k -> a
M.! k
k
    m :: M.Map k (Type Void)
    m :: Map k (Type Void)
m = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= k -> Type Void
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [DidDef k]
defs
    checkKey :: k -> f ()
checkKey k
tn = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (k
tn forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map k (Type Void)
m) forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
unboundErr k
tn
    unboundErr :: a -> m a
unboundErr a
k = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unbound type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
k


quoteCandidService :: String -> TypeQ
quoteCandidService :: String -> Q Type
quoteCandidService String
s = case String -> Either String DidFile
parseDid String
s of
  Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
  Right DidFile{ service :: DidFile -> DidService TypeName
service = []} -> [t|R.Empty|]
  Right DidFile{ defs :: DidFile -> [DidDef TypeName]
defs = [DidDef TypeName]
ds, service :: DidFile -> DidService TypeName
service = DidService TypeName
s} -> do
    Just Name
m <- String -> Q (Maybe Name)
lookupTypeName String
"m"
    ([(TypeName, Type Void)]
_ds', TypeName -> Q ()
check, TypeName -> Type Void
inline) <- forall k.
(Show k, Ord k) =>
[DidDef k] -> Q ([(k, Type Void)], k -> Q (), k -> Type Void)
inlineDefs [DidDef TypeName]
ds
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ DidService TypeName
s forall a b. (a -> b) -> a -> b
$ \(TypeName, MethodType TypeName)
m -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (TypeName, MethodType TypeName)
m (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeName -> Q ()
check)
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Q Type
a Q Type
b -> [t|$(a) R..+ $(b)|])
        [ [t|  $(litT (strTyLit (T.unpack methName)))
               R..== ($(candidTypeQ params) -> $(varT m) $(candidTypeQ results)) |]
        | (TypeName
methName, MethodType{Bool
[Type TypeName]
methOneway :: forall a. MethodType a -> Bool
methQuery :: forall a. MethodType a -> Bool
methResults :: forall a. MethodType a -> [Type a]
methParams :: forall a. MethodType a -> [Type a]
methOneway :: Bool
methQuery :: Bool
methResults :: [Type TypeName]
methParams :: [Type TypeName]
..}) <- DidService TypeName
s
        , let params :: [Type b]
params = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Void -> a
absurd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> Type Void
inline)) [Type TypeName]
methParams
        , let results :: [Type b]
results = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Void -> a
absurd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> Type Void
inline)) [Type TypeName]
methResults
        -- TODO annotations
        ]

quoteCandidDefs :: String -> TypeQ
quoteCandidDefs :: String -> Q Type
quoteCandidDefs String
s = case String -> Either String DidFile
parseDid String
s of
  Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
  Right DidFile{ defs :: DidFile -> [DidDef TypeName]
defs = []} -> [t|R.Empty|]
  Right DidFile{ defs :: DidFile -> [DidDef TypeName]
defs = [DidDef TypeName]
ds } -> do
    ([(TypeName, Type Void)]
ds', TypeName -> Q ()
_check, TypeName -> Type Void
_inline) <- forall k.
(Show k, Ord k) =>
[DidDef k] -> Q ([(k, Type Void)], k -> Q (), k -> Type Void)
inlineDefs [DidDef TypeName]
ds
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Q Type
a Q Type
b -> [t|$(a) R..+ $(b)|])
        [ [t|  $(litT (strTyLit (T.unpack n))) R..== $(typ (absurd <$> t)) |]
        | (TypeName
n, Type Void
t) <- [(TypeName, Type Void)]
ds'
        ]

quoteCandidDefsSym :: String -> DecsQ
quoteCandidDefsSym :: String -> Q [Dec]
quoteCandidDefsSym String
s = case String -> Either String DidFile
parseDid String
s of
  Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
  Right DidFile{ defs :: DidFile -> [DidDef TypeName]
defs = [DidDef TypeName]
ds } ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DidDef TypeName]
ds forall a b. (a -> b) -> a -> b
$ \(TypeName
n,Type TypeName
t) -> forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr ()] -> m Type -> m Dec
tySynD (TypeName -> Name
mangle TypeName
n) [] (Type Name -> Q Type
typ (TypeName -> Name
mangle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type TypeName
t))
  where
    mangle :: T.Text -> TH.Name
    mangle :: TypeName -> Name
mangle = String -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> String
T.unpack

quoteCandidType :: String -> TypeQ
quoteCandidType :: String -> Q Type
quoteCandidType String
s = case String -> Either String (Type TypeName)
parseDidType String
s of
  Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
  Right Type TypeName
t -> Type Name -> Q Type
typ (forall {a}. TypeName -> a
err forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type TypeName
t)
   where
     err :: TypeName -> a
err TypeName
s = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Type name in stand-alone Candid type: " forall a. [a] -> [a] -> [a]
++ TypeName -> String
T.unpack TypeName
s

candidTypeQ :: [Type TH.Name] -> TypeQ
candidTypeQ :: [Type Name] -> Q Type
candidTypeQ [] = [t| () |]
candidTypeQ [Type Name
NullT] = [t| Unary () |]
candidTypeQ [t :: Type Name
t@(RecT Fields Name
fs)] | forall b. [(FieldName, b)] -> Bool
isTuple Fields Name
fs = [t| Unary $(typ t) |]
candidTypeQ [Type Name
t] = Type Name -> Q Type
typ Type Name
t
candidTypeQ [Type Name]
ts = [Q Type] -> Q Type
mkTupleT (forall a b. (a -> b) -> [a] -> [b]
map Type Name -> Q Type
typ [Type Name]
ts)


row :: TypeQ -> TypeQ -> TypeQ -> Fields TH.Name -> TypeQ
row :: Q Type -> Q Type -> Q Type -> Fields Name -> Q Type
row Q Type
eq Q Type
add = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(FieldName
fn, Type Name
t) Q Type
rest -> [t|
    $add ($eq $(fieldName fn) $(typ t)) $rest
  |])
  where
    fieldName :: FieldName -> TypeQ
    fieldName :: FieldName -> Q Type
fieldName FieldName
f = forall (m :: * -> *). Quote m => m TyLit -> m Type
litT (forall (m :: * -> *). Quote m => String -> m TyLit
strTyLit (TypeName -> String
T.unpack (FieldName -> TypeName
escapeFieldName FieldName
f)))

mrow :: TypeQ -> TypeQ -> TypeQ -> [(T.Text, MethodType TH.Name)] -> TypeQ
mrow :: Q Type
-> Q Type -> Q Type -> [(TypeName, MethodType Name)] -> Q Type
mrow Q Type
eq Q Type
add = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(TypeName
m, MethodType Name
mt) Q Type
rest -> [t|
    $add ($eq $(methodName m) $(methodType mt)) $rest
  |])
  where
    methodName :: T.Text -> TypeQ
    methodName :: TypeName -> Q Type
methodName TypeName
f = forall (m :: * -> *). Quote m => m TyLit -> m Type
litT (forall (m :: * -> *). Quote m => String -> m TyLit
strTyLit (TypeName -> String
T.unpack TypeName
f))

methodType :: MethodType TH.Name -> TypeQ
methodType :: MethodType Name -> Q Type
methodType (MethodType [Type Name]
a [Type Name]
b Bool
q Bool
o) =
    [t| ($(candidTypeQ a), $(candidTypeQ b), $(ann q), $(ann o)) |]
  where
    ann :: Bool -> m Type
ann Bool
True = [t|AnnTrue|]
    ann Bool
False = [t|AnnFalse|]

mkTupleT :: [TypeQ] -> TypeQ
mkTupleT :: [Q Type] -> Q Type
mkTupleT [Q Type]
ts = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (forall (m :: * -> *). Quote m => Int -> m Type
tupleT (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Q Type]
ts)) [Q Type]
ts


typ :: Type TH.Name -> TypeQ
typ :: Type Name -> Q Type
typ Type Name
NatT = [t| Natural |]
typ Type Name
Nat8T = [t| Word8 |]
typ Type Name
Nat16T = [t| Word16 |]
typ Type Name
Nat32T = [t| Word32 |]
typ Type Name
Nat64T = [t| Word64 |]
typ Type Name
IntT = [t| Integer |]
typ Type Name
Int8T = [t| Int8 |]
typ Type Name
Int16T = [t| Int16 |]
typ Type Name
Int32T = [t| Int32 |]
typ Type Name
Int64T = [t| Int64 |]
typ Type Name
Float32T = [t| Float |]
typ Type Name
Float64T = [t| Double |]
typ Type Name
BoolT = [t| Bool |]
typ Type Name
TextT = [t| T.Text |]
typ Type Name
NullT = [t| () |]
typ Type Name
ReservedT = [t| Reserved |]
typ Type Name
EmptyT = [t| Void |]
typ Type Name
PrincipalT = [t| Principal |]
typ Type Name
BlobT = [t| BS.ByteString|]
typ (OptT Type Name
t) = [t| Maybe $( typ t ) |]
typ (VecT Type Name
t) = [t| V.Vector $( typ t ) |]
typ (RecT Fields Name
fs)
 | forall b. [(FieldName, b)] -> Bool
isTuple Fields Name
fs = [Q Type] -> Q Type
mkTupleT (forall a b. (a -> b) -> [a] -> [b]
map (Type Name -> Q Type
typ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Fields Name
fs)
 | Bool
otherwise = [t| R.Rec $(row [t| (R..==) |] [t| (R..+) |] [t| R.Empty |] fs) |]
typ (VariantT Fields Name
fs) = [t| V.Var $(row [t| (V..==) |] [t| (V..+) |] [t| V.Empty |] fs) |]
typ (FuncT MethodType Name
mt) = [t| FuncRef $(methodType mt) |]
typ (ServiceT [(TypeName, MethodType Name)]
ms) = [t| ServiceRef $(mrow [t| (R..==) |] [t| (R..+) |] [t| R.Empty |] ms) |]
typ Type Name
FutureT = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot represent a future Candid type as a Haskell type"
typ (RefT Name
v) = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
v

isTuple :: [(FieldName, b)] -> Bool
isTuple :: forall b. [(FieldName, b)] -> Bool
isTuple [(FieldName, b)]
fs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FieldName, b)]
fs forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(==) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(FieldName, b)]
fs) (forall a b. (a -> b) -> [a] -> [b]
map Word32 -> FieldName
hashedField [Word32
0..]))