{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveTraversable #-}
module Codec.Candid.Types where

import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Word
import Data.Int
import Numeric.Natural
import Control.Monad
import Data.Bifunctor
import Data.Void
import Data.Scientific
import Data.Char
import Numeric

import Prettyprinter

import Codec.Candid.Data
import Codec.Candid.FieldName

data Type a
    -- prim types
    = NatT | Nat8T | Nat16T | Nat32T | Nat64T
    | IntT | Int8T | Int16T | Int32T | Int64T
    | Float32T | Float64T
    | BoolT
    | TextT
    | NullT
    | ReservedT
    | EmptyT
    -- constructors
    | OptT (Type a)
    | VecT (Type a)
    | RecT (Fields a)
    | VariantT (Fields a)
    -- reference
    | FuncT (MethodType a)
    | ServiceT [(T.Text, MethodType a)]
    | PrincipalT
    -- short-hands
    | BlobT
      -- ^ a short-hand for 'VecT' 'Nat8T'
    -- future types
    | FutureT
    -- for recursive types
    | RefT a -- ^ A reference to a named type
  deriving (Int -> Type a -> ShowS
[Type a] -> ShowS
Type a -> String
(Int -> Type a -> ShowS)
-> (Type a -> String) -> ([Type a] -> ShowS) -> Show (Type a)
forall a. Show a => Int -> Type a -> ShowS
forall a. Show a => [Type a] -> ShowS
forall a. Show a => Type a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type a] -> ShowS
$cshowList :: forall a. Show a => [Type a] -> ShowS
show :: Type a -> String
$cshow :: forall a. Show a => Type a -> String
showsPrec :: Int -> Type a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Type a -> ShowS
Show, Type a -> Type a -> Bool
(Type a -> Type a -> Bool)
-> (Type a -> Type a -> Bool) -> Eq (Type a)
forall a. Eq a => Type a -> Type a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type a -> Type a -> Bool
$c/= :: forall a. Eq a => Type a -> Type a -> Bool
== :: Type a -> Type a -> Bool
$c== :: forall a. Eq a => Type a -> Type a -> Bool
Eq, Eq (Type a)
Eq (Type a)
-> (Type a -> Type a -> Ordering)
-> (Type a -> Type a -> Bool)
-> (Type a -> Type a -> Bool)
-> (Type a -> Type a -> Bool)
-> (Type a -> Type a -> Bool)
-> (Type a -> Type a -> Type a)
-> (Type a -> Type a -> Type a)
-> Ord (Type a)
Type a -> Type a -> Bool
Type a -> Type a -> Ordering
Type a -> Type a -> Type a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Type a)
forall a. Ord a => Type a -> Type a -> Bool
forall a. Ord a => Type a -> Type a -> Ordering
forall a. Ord a => Type a -> Type a -> Type a
min :: Type a -> Type a -> Type a
$cmin :: forall a. Ord a => Type a -> Type a -> Type a
max :: Type a -> Type a -> Type a
$cmax :: forall a. Ord a => Type a -> Type a -> Type a
>= :: Type a -> Type a -> Bool
$c>= :: forall a. Ord a => Type a -> Type a -> Bool
> :: Type a -> Type a -> Bool
$c> :: forall a. Ord a => Type a -> Type a -> Bool
<= :: Type a -> Type a -> Bool
$c<= :: forall a. Ord a => Type a -> Type a -> Bool
< :: Type a -> Type a -> Bool
$c< :: forall a. Ord a => Type a -> Type a -> Bool
compare :: Type a -> Type a -> Ordering
$ccompare :: forall a. Ord a => Type a -> Type a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Type a)
Ord, a -> Type b -> Type a
(a -> b) -> Type a -> Type b
(forall a b. (a -> b) -> Type a -> Type b)
-> (forall a b. a -> Type b -> Type a) -> Functor Type
forall a b. a -> Type b -> Type a
forall a b. (a -> b) -> Type a -> Type b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Type b -> Type a
$c<$ :: forall a b. a -> Type b -> Type a
fmap :: (a -> b) -> Type a -> Type b
$cfmap :: forall a b. (a -> b) -> Type a -> Type b
Functor, Type a -> Bool
(a -> m) -> Type a -> m
(a -> b -> b) -> b -> Type a -> b
(forall m. Monoid m => Type m -> m)
-> (forall m a. Monoid m => (a -> m) -> Type a -> m)
-> (forall m a. Monoid m => (a -> m) -> Type a -> m)
-> (forall a b. (a -> b -> b) -> b -> Type a -> b)
-> (forall a b. (a -> b -> b) -> b -> Type a -> b)
-> (forall b a. (b -> a -> b) -> b -> Type a -> b)
-> (forall b a. (b -> a -> b) -> b -> Type a -> b)
-> (forall a. (a -> a -> a) -> Type a -> a)
-> (forall a. (a -> a -> a) -> Type a -> a)
-> (forall a. Type a -> [a])
-> (forall a. Type a -> Bool)
-> (forall a. Type a -> Int)
-> (forall a. Eq a => a -> Type a -> Bool)
-> (forall a. Ord a => Type a -> a)
-> (forall a. Ord a => Type a -> a)
-> (forall a. Num a => Type a -> a)
-> (forall a. Num a => Type a -> a)
-> Foldable Type
forall a. Eq a => a -> Type a -> Bool
forall a. Num a => Type a -> a
forall a. Ord a => Type a -> a
forall m. Monoid m => Type m -> m
forall a. Type a -> Bool
forall a. Type a -> Int
forall a. Type a -> [a]
forall a. (a -> a -> a) -> Type a -> a
forall m a. Monoid m => (a -> m) -> Type a -> m
forall b a. (b -> a -> b) -> b -> Type a -> b
forall a b. (a -> b -> b) -> b -> Type a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Type a -> a
$cproduct :: forall a. Num a => Type a -> a
sum :: Type a -> a
$csum :: forall a. Num a => Type a -> a
minimum :: Type a -> a
$cminimum :: forall a. Ord a => Type a -> a
maximum :: Type a -> a
$cmaximum :: forall a. Ord a => Type a -> a
elem :: a -> Type a -> Bool
$celem :: forall a. Eq a => a -> Type a -> Bool
length :: Type a -> Int
$clength :: forall a. Type a -> Int
null :: Type a -> Bool
$cnull :: forall a. Type a -> Bool
toList :: Type a -> [a]
$ctoList :: forall a. Type a -> [a]
foldl1 :: (a -> a -> a) -> Type a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Type a -> a
foldr1 :: (a -> a -> a) -> Type a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Type a -> a
foldl' :: (b -> a -> b) -> b -> Type a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldl :: (b -> a -> b) -> b -> Type a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldr' :: (a -> b -> b) -> b -> Type a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldr :: (a -> b -> b) -> b -> Type a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldMap' :: (a -> m) -> Type a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Type a -> m
foldMap :: (a -> m) -> Type a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Type a -> m
fold :: Type m -> m
$cfold :: forall m. Monoid m => Type m -> m
Foldable, Functor Type
Foldable Type
Functor Type
-> Foldable Type
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Type a -> f (Type b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Type (f a) -> f (Type a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Type a -> m (Type b))
-> (forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a))
-> Traversable Type
(a -> f b) -> Type a -> f (Type b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
sequence :: Type (m a) -> m (Type a)
$csequence :: forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
mapM :: (a -> m b) -> Type a -> m (Type b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
sequenceA :: Type (f a) -> f (Type a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
traverse :: (a -> f b) -> Type a -> f (Type b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
$cp2Traversable :: Foldable Type
$cp1Traversable :: Functor Type
Traversable)

tupT :: [Type a] -> Type a
tupT :: [Type a] -> Type a
tupT = Fields a -> Type a
forall a. Fields a -> Type a
RecT (Fields a -> Type a)
-> ([Type a] -> Fields a) -> [Type a] -> Type a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Type a -> (FieldName, Type a))
-> [Word32] -> [Type a] -> Fields a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Word32
n Type a
t -> (Word32 -> FieldName
hashedField Word32
n, Type a
t)) [Word32
0..]

instance Applicative Type where
    pure :: a -> Type a
pure = a -> Type a
forall a. a -> Type a
RefT
    <*> :: Type (a -> b) -> Type a -> Type b
(<*>) = Type (a -> b) -> Type a -> Type b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Type where
    return :: a -> Type a
return = a -> Type a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Type a
NatT >>= :: Type a -> (a -> Type b) -> Type b
>>= a -> Type b
_ = Type b
forall a. Type a
NatT
    Type a
Nat8T >>= a -> Type b
_ = Type b
forall a. Type a
Nat8T
    Type a
Nat16T >>= a -> Type b
_ = Type b
forall a. Type a
Nat16T
    Type a
Nat32T >>= a -> Type b
_ = Type b
forall a. Type a
Nat32T
    Type a
Nat64T >>= a -> Type b
_ = Type b
forall a. Type a
Nat64T
    Type a
IntT >>= a -> Type b
_ = Type b
forall a. Type a
IntT
    Type a
Int8T >>= a -> Type b
_ = Type b
forall a. Type a
Int8T
    Type a
Int16T >>= a -> Type b
_ = Type b
forall a. Type a
Int16T
    Type a
Int32T >>= a -> Type b
_ = Type b
forall a. Type a
Int32T
    Type a
Int64T >>= a -> Type b
_ = Type b
forall a. Type a
Int64T
    Type a
Float32T >>= a -> Type b
_ = Type b
forall a. Type a
Float32T
    Type a
Float64T >>= a -> Type b
_ = Type b
forall a. Type a
Float64T
    Type a
BoolT >>= a -> Type b
_ = Type b
forall a. Type a
BoolT
    Type a
TextT >>= a -> Type b
_ = Type b
forall a. Type a
TextT
    Type a
NullT >>= a -> Type b
_ = Type b
forall a. Type a
NullT
    Type a
ReservedT >>= a -> Type b
_ = Type b
forall a. Type a
ReservedT
    Type a
EmptyT >>= a -> Type b
_ = Type b
forall a. Type a
EmptyT
    Type a
BlobT >>= a -> Type b
_ = Type b
forall a. Type a
BlobT
    Type a
FutureT >>= a -> Type b
_ = Type b
forall a. Type a
FutureT
    Type a
PrincipalT >>= a -> Type b
_ = Type b
forall a. Type a
PrincipalT
    OptT Type a
t >>= a -> Type b
f = Type b -> Type b
forall a. Type a -> Type a
OptT (Type a
t Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f)
    VecT Type a
t >>= a -> Type b
f = Type b -> Type b
forall a. Type a -> Type a
VecT (Type a
t Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f)
    RecT Fields a
fs >>= a -> Type b
f = Fields b -> Type b
forall a. Fields a -> Type a
RecT (((FieldName, Type a) -> (FieldName, Type b))
-> Fields a -> Fields b
forall a b. (a -> b) -> [a] -> [b]
map ((Type a -> Type b) -> (FieldName, Type a) -> (FieldName, Type b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f)) Fields a
fs)
    VariantT Fields a
fs >>= a -> Type b
f = Fields b -> Type b
forall a. Fields a -> Type a
VariantT (((FieldName, Type a) -> (FieldName, Type b))
-> Fields a -> Fields b
forall a b. (a -> b) -> [a] -> [b]
map ((Type a -> Type b) -> (FieldName, Type a) -> (FieldName, Type b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f)) Fields a
fs)
    FuncT MethodType a
mt >>= a -> Type b
f = MethodType b -> Type b
forall a. MethodType a -> Type a
FuncT ((a -> Type b) -> MethodType a -> MethodType b
forall a b. (a -> Type b) -> MethodType a -> MethodType b
bindMethodType a -> Type b
f MethodType a
mt)
    ServiceT [(Text, MethodType a)]
ms >>= a -> Type b
f = [(Text, MethodType b)] -> Type b
forall a. [(Text, MethodType a)] -> Type a
ServiceT (((Text, MethodType a) -> (Text, MethodType b))
-> [(Text, MethodType a)] -> [(Text, MethodType b)]
forall a b. (a -> b) -> [a] -> [b]
map ((MethodType a -> MethodType b)
-> (Text, MethodType a) -> (Text, MethodType b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((a -> Type b) -> MethodType a -> MethodType b
forall a b. (a -> Type b) -> MethodType a -> MethodType b
bindMethodType a -> Type b
f)) [(Text, MethodType a)]
ms)
    RefT a
x >>= a -> Type b
f = a -> Type b
f a
x

bindMethodType :: (a -> Type b) -> MethodType a -> MethodType b
bindMethodType :: (a -> Type b) -> MethodType a -> MethodType b
bindMethodType a -> Type b
f (MethodType [Type a]
as [Type a]
bs Bool
q Bool
cq Bool
ow) =
   [Type b] -> [Type b] -> Bool -> Bool -> Bool -> MethodType b
forall a.
[Type a] -> [Type a] -> Bool -> Bool -> Bool -> MethodType a
MethodType ((Type a -> Type b) -> [Type a] -> [Type b]
forall a b. (a -> b) -> [a] -> [b]
map (Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f) [Type a]
as) ((Type a -> Type b) -> [Type a] -> [Type b]
forall a b. (a -> b) -> [a] -> [b]
map (Type a -> (a -> Type b) -> Type b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Type b
f) [Type a]
bs) Bool
q Bool
cq Bool
ow


type Fields a = [(FieldName, Type a)]

type Args a = [Type a]

instance Pretty a => Pretty (Type a) where
    pretty :: Type a -> Doc ann
pretty Type a
NatT = Doc ann
"nat"
    pretty Type a
Nat8T = Doc ann
"nat8"
    pretty Type a
Nat16T = Doc ann
"nat16"
    pretty Type a
Nat32T = Doc ann
"nat32"
    pretty Type a
Nat64T = Doc ann
"nat64"
    pretty Type a
IntT = Doc ann
"int"
    pretty Type a
Int8T = Doc ann
"int8"
    pretty Type a
Int16T = Doc ann
"int16"
    pretty Type a
Int32T = Doc ann
"int32"
    pretty Type a
Int64T = Doc ann
"int64"
    pretty Type a
Float32T = Doc ann
"float32"
    pretty Type a
Float64T = Doc ann
"float64"
    pretty Type a
BoolT = Doc ann
"bool"
    pretty Type a
TextT = Doc ann
"text"
    pretty Type a
NullT = Doc ann
"null"
    pretty Type a
ReservedT = Doc ann
"reserved"
    pretty Type a
EmptyT = Doc ann
"empty"
    pretty (OptT Type a
t) = Doc ann
"opt" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type a
t
    pretty (VecT Type a
t) = Doc ann
"vec" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type a
t
    pretty (RecT Fields a
fs) = Doc ann
"record" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Fields a -> Doc ann
forall a ann. Pretty a => Bool -> Fields a -> Doc ann
prettyFields Bool
False Fields a
fs
    pretty (VariantT Fields a
fs) = Doc ann
"variant" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Fields a -> Doc ann
forall a ann. Pretty a => Bool -> Fields a -> Doc ann
prettyFields Bool
True Fields a
fs
    pretty (RefT a
a) = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a
    pretty Type a
BlobT = Doc ann
"blob"
    pretty (FuncT MethodType a
mt) = Doc ann
"func" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MethodType a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MethodType a
mt
    pretty (ServiceT [(Text, MethodType a)]
s) =
        Doc ann
"service" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text, MethodType a) -> Doc ann
forall a ann. Pretty a => (Text, MethodType a) -> Doc ann
prettyMeth ((Text, MethodType a) -> Doc ann)
-> [(Text, MethodType a)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, MethodType a)]
s)))
    pretty Type a
PrincipalT = Doc ann
"principal"
    pretty Type a
FutureT = Doc ann
"future"

    prettyList :: [Type a] -> Doc ann
prettyList = Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
forall ann. Doc ann
lparen Doc ann
forall ann. Doc ann
rparen (Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) ([Doc ann] -> Doc ann)
-> ([Type a] -> [Doc ann]) -> [Type a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type a -> Doc ann) -> [Type a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Type a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

prettyFields :: Pretty a => Bool -> Fields a -> Doc ann
prettyFields :: Bool -> Fields a -> Doc ann
prettyFields Bool
in_variant Fields a
fs = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyBraceSemi ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((FieldName, Type a) -> Doc ann) -> Fields a -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> (FieldName, Type a) -> Doc ann
forall a ann. Pretty a => Bool -> (FieldName, Type a) -> Doc ann
prettyField Bool
in_variant) Fields a
fs

prettyBraceSemi :: [Doc ann] -> Doc ann
prettyBraceSemi :: [Doc ann] -> Doc ann
prettyBraceSemi = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi

prettyField :: Pretty a => Bool -> (FieldName, Type a) -> Doc ann
prettyField :: Bool -> (FieldName, Type a) -> Doc ann
prettyField Bool
True (FieldName
f, Type a
NullT) = FieldName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f
prettyField Bool
_ (FieldName
f, Type a
t) = FieldName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type a
t -- TODO: encode field names

data Value
  = NumV Scientific -- used when parsing at an unknown numeric type
  | NatV Natural
  | Nat8V Word8
  | Nat16V Word16
  | Nat32V Word32
  | Nat64V Word64
  | IntV Integer
  | Int8V Int8
  | Int16V Int16
  | Int32V Int32
  | Int64V Int64
  | Float32V Float
  | Float64V Double
  | BoolV Bool
  | TextV T.Text
  | NullV
  | ReservedV
  | OptV (Maybe Value)
  | RepeatV Int Value -- for space bomb protection
  | VecV (V.Vector Value)
  | RecV [(FieldName, Value)]
  | TupV [Value]
  | VariantV FieldName Value
  | FuncV Principal T.Text
  | ServiceV Principal
  | PrincipalV Principal
  | BlobV BS.ByteString
  | AnnV Value (Type Void)
  | FutureV -- ^ An opaque value of a future type
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
$cp1Ord :: Eq Value
Ord, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

instance Pretty Value where
  pretty :: Value -> Doc ann
pretty (NumV Scientific
v) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Scientific -> String
forall a. Show a => a -> String
show Scientific
v)
  pretty (NatV Natural
v) = Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
v
  pretty (IntV Integer
v) | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
v
                  | Bool
otherwise = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
v
  pretty (Nat8V Word8
v) = Word8 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Word8
v Type Void
forall a. Type a
Nat8T
  pretty (Nat16V Word16
v) = Word16 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Word16
v Type Void
forall a. Type a
Nat16T
  pretty (Nat32V Word32
v) = Word32 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Word32
v Type Void
forall a. Type a
Nat32T
  pretty (Nat64V Word64
v) = Word64 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Word64
v Type Void
forall a. Type a
Nat64T
  pretty (Int8V Int8
v) = Int8 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Int8
v Type Void
forall a. Type a
Int8T
  pretty (Int16V Int16
v) = Int16 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Int16
v Type Void
forall a. Type a
Int16T
  pretty (Int32V Int32
v) = Int32 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Int32
v Type Void
forall a. Type a
Int32T
  pretty (Int64V Int64
v) = Int64 -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Int64
v Type Void
forall a. Type a
Int64T
  pretty (Float32V Float
v) = Float -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Float
v Type Void
forall a. Type a
Float32T
  pretty (Float64V Double
v) = Double -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Double
v Type Void
forall a. Type a
Float64T
  pretty (BoolV Bool
True) = Doc ann
"true"
  pretty (BoolV Bool
False) = Doc ann
"false"
  pretty (TextV Text
v) = Text -> Doc ann
forall ann. Text -> Doc ann
prettyText Text
v
  pretty Value
NullV = Doc ann
"null"
  pretty Value
ReservedV = Text -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn (Text
"null"::T.Text) Type Void
forall a. Type a
ReservedT
  pretty (FuncV Principal
b Text
m) = Doc ann
"func" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyText (Principal -> Text
prettyPrincipal Principal
b) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyText Text
m
  pretty (ServiceV Principal
b) = Doc ann
"service" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyText (Principal -> Text
prettyPrincipal Principal
b)
  pretty (PrincipalV Principal
b) = Doc ann
"principal" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyText (Principal -> Text
prettyPrincipal Principal
b)
  pretty (BlobV ByteString
b) = Doc ann
"blob" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ByteString -> Doc ann
forall ann. ByteString -> Doc ann
prettyBlob ByteString
b
  pretty (OptV Maybe Value
Nothing) = Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
NullV
  pretty (OptV (Just Value
v)) = Doc ann
"opt" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v
  pretty (RepeatV Int
n Value
v)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 = Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Vector Value -> Value
VecV (Int -> Value -> Vector Value
forall a. Int -> a -> Vector a
V.replicate Int
n Value
v))
    | Bool
otherwise = Doc ann
"vec" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyBraceSemi [Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v, Doc ann
"…"]
  pretty (VecV Vector Value
vs) = Doc ann
"vec" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyBraceSemi ((Value -> Doc ann) -> [Value] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
vs))
  pretty (TupV [Value]
vs) = Doc ann
"record" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyBraceSemi ((Value -> Doc ann) -> [Value] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Value]
vs)
  pretty (RecV [(FieldName, Value)]
vs) = Doc ann
"record" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyBraceSemi (((FieldName, Value) -> Doc ann)
-> [(FieldName, Value)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, Value) -> Doc ann
forall a a ann. (Pretty a, Pretty a) => (a, a) -> Doc ann
go [(FieldName, Value)]
vs)
    where go :: (a, a) -> Doc ann
go (a
fn, a
v) = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
fn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
v
  pretty (VariantV FieldName
f Value
NullV) = Doc ann
"variant" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (FieldName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f)
  pretty (VariantV FieldName
f Value
v) = Doc ann
"variant" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (FieldName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FieldName
f Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v)
  pretty (AnnV Value
v Type Void
t) = Value -> Type Void -> Doc ann
forall a ann. Pretty a => a -> Type Void -> Doc ann
prettyAnn Value
v Type Void
t
  pretty Value
FutureV = Doc ann
"future"

  prettyList :: [Value] -> Doc ann
prettyList = Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
forall ann. Doc ann
lparen Doc ann
forall ann. Doc ann
rparen (Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) ([Doc ann] -> Doc ann)
-> ([Value] -> [Doc ann]) -> [Value] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Doc ann) -> [Value] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

prettyAnn :: Pretty a => a -> Type Void -> Doc ann
prettyAnn :: a -> Type Void -> Doc ann
prettyAnn a
v Type Void
t = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
v Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type Void -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type Void
t

prettyBlob :: BS.ByteString -> Doc ann
prettyBlob :: ByteString -> Doc ann
prettyBlob = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann)
-> (ByteString -> Doc ann) -> ByteString -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (ByteString -> Text) -> ByteString -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> (ByteString -> [Text]) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Text) -> [Word8] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Text
forall a. (Integral a, Show a) => a -> Text
go ([Word8] -> [Text])
-> (ByteString -> [Word8]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  where
    go :: a -> Text
go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'\t' = Text
"\\t"
    go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'\n' = Text
"\\n"
    go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'\r' = Text
"\\r"
    go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'"'  = Text
"\\\""
    go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'\'' = Text
"\\\'"
    go a
b | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
ord Char
'\\' = Text
"\\\\"
    go a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x20 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x7f = Char -> Text
T.singleton (Int -> Char
chr (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b))
    go a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x10 = Text
"\\0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex a
b String
"")
    go a
b = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex a
b String
"")

prettyText :: T.Text -> Doc ann
prettyText :: Text -> Doc ann
prettyText = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> (Text -> Doc ann) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (Text -> Text) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go
  where
    go :: Char -> Text
go Char
'\t' = Text
"\\t"
    go Char
'\n' = Text
"\\n"
    go Char
'\r' = Text
"\\r"
    go Char
'"'  = Text
"\\\""
    go Char
'\'' = Text
"\\\'"
    go Char
'\\' = Text
"\\\\"
    go Char
c | Char -> Bool
isControl Char
c = Text
"\\u{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
c) String
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
    go Char
c = Char -> Text
T.singleton Char
c

tupV :: [Value] -> Value
tupV :: [Value] -> Value
tupV = [(FieldName, Value)] -> Value
RecV ([(FieldName, Value)] -> Value)
-> ([Value] -> [(FieldName, Value)]) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Value -> (FieldName, Value))
-> [Word32] -> [Value] -> [(FieldName, Value)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Word32
n Value
t -> (Word32 -> FieldName
hashedField Word32
n, Value
t)) [Word32
0..]


-- Put here because used for both decoding and encoding
primTyp :: Integer -> Maybe (Type a)
primTyp :: Integer -> Maybe (Type a)
primTyp (-1)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
NullT
primTyp (-2)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
BoolT
primTyp (-3)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
NatT
primTyp (-4)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
IntT
primTyp (-5)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Nat8T
primTyp (-6)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Nat16T
primTyp (-7)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Nat32T
primTyp (-8)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Nat64T
primTyp (-9)  = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Int8T
primTyp (-10) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Int16T
primTyp (-11) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Int32T
primTyp (-12) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Int64T
primTyp (-13) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Float32T
primTyp (-14) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
Float64T
primTyp (-15) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
TextT
primTyp (-16) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
ReservedT
primTyp (-17) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
EmptyT
primTyp (-24) = Type a -> Maybe (Type a)
forall a. a -> Maybe a
Just Type a
forall a. Type a
PrincipalT
primTyp Integer
_     = Maybe (Type a)
forall a. Maybe a
Nothing

-- | The type of a candid method
data MethodType a = MethodType
    { MethodType a -> [Type a]
methParams :: [Type a]
    , MethodType a -> [Type a]
methResults :: [Type a]
    , MethodType a -> Bool
methQuery :: Bool
    , MethodType a -> Bool
methCompQuery :: Bool
    , MethodType a -> Bool
methOneway :: Bool
    }
  deriving (MethodType a -> MethodType a -> Bool
(MethodType a -> MethodType a -> Bool)
-> (MethodType a -> MethodType a -> Bool) -> Eq (MethodType a)
forall a. Eq a => MethodType a -> MethodType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodType a -> MethodType a -> Bool
$c/= :: forall a. Eq a => MethodType a -> MethodType a -> Bool
== :: MethodType a -> MethodType a -> Bool
$c== :: forall a. Eq a => MethodType a -> MethodType a -> Bool
Eq, Eq (MethodType a)
Eq (MethodType a)
-> (MethodType a -> MethodType a -> Ordering)
-> (MethodType a -> MethodType a -> Bool)
-> (MethodType a -> MethodType a -> Bool)
-> (MethodType a -> MethodType a -> Bool)
-> (MethodType a -> MethodType a -> Bool)
-> (MethodType a -> MethodType a -> MethodType a)
-> (MethodType a -> MethodType a -> MethodType a)
-> Ord (MethodType a)
MethodType a -> MethodType a -> Bool
MethodType a -> MethodType a -> Ordering
MethodType a -> MethodType a -> MethodType a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (MethodType a)
forall a. Ord a => MethodType a -> MethodType a -> Bool
forall a. Ord a => MethodType a -> MethodType a -> Ordering
forall a. Ord a => MethodType a -> MethodType a -> MethodType a
min :: MethodType a -> MethodType a -> MethodType a
$cmin :: forall a. Ord a => MethodType a -> MethodType a -> MethodType a
max :: MethodType a -> MethodType a -> MethodType a
$cmax :: forall a. Ord a => MethodType a -> MethodType a -> MethodType a
>= :: MethodType a -> MethodType a -> Bool
$c>= :: forall a. Ord a => MethodType a -> MethodType a -> Bool
> :: MethodType a -> MethodType a -> Bool
$c> :: forall a. Ord a => MethodType a -> MethodType a -> Bool
<= :: MethodType a -> MethodType a -> Bool
$c<= :: forall a. Ord a => MethodType a -> MethodType a -> Bool
< :: MethodType a -> MethodType a -> Bool
$c< :: forall a. Ord a => MethodType a -> MethodType a -> Bool
compare :: MethodType a -> MethodType a -> Ordering
$ccompare :: forall a. Ord a => MethodType a -> MethodType a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (MethodType a)
Ord, Int -> MethodType a -> ShowS
[MethodType a] -> ShowS
MethodType a -> String
(Int -> MethodType a -> ShowS)
-> (MethodType a -> String)
-> ([MethodType a] -> ShowS)
-> Show (MethodType a)
forall a. Show a => Int -> MethodType a -> ShowS
forall a. Show a => [MethodType a] -> ShowS
forall a. Show a => MethodType a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodType a] -> ShowS
$cshowList :: forall a. Show a => [MethodType a] -> ShowS
show :: MethodType a -> String
$cshow :: forall a. Show a => MethodType a -> String
showsPrec :: Int -> MethodType a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MethodType a -> ShowS
Show, a -> MethodType b -> MethodType a
(a -> b) -> MethodType a -> MethodType b
(forall a b. (a -> b) -> MethodType a -> MethodType b)
-> (forall a b. a -> MethodType b -> MethodType a)
-> Functor MethodType
forall a b. a -> MethodType b -> MethodType a
forall a b. (a -> b) -> MethodType a -> MethodType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MethodType b -> MethodType a
$c<$ :: forall a b. a -> MethodType b -> MethodType a
fmap :: (a -> b) -> MethodType a -> MethodType b
$cfmap :: forall a b. (a -> b) -> MethodType a -> MethodType b
Functor, MethodType a -> Bool
(a -> m) -> MethodType a -> m
(a -> b -> b) -> b -> MethodType a -> b
(forall m. Monoid m => MethodType m -> m)
-> (forall m a. Monoid m => (a -> m) -> MethodType a -> m)
-> (forall m a. Monoid m => (a -> m) -> MethodType a -> m)
-> (forall a b. (a -> b -> b) -> b -> MethodType a -> b)
-> (forall a b. (a -> b -> b) -> b -> MethodType a -> b)
-> (forall b a. (b -> a -> b) -> b -> MethodType a -> b)
-> (forall b a. (b -> a -> b) -> b -> MethodType a -> b)
-> (forall a. (a -> a -> a) -> MethodType a -> a)
-> (forall a. (a -> a -> a) -> MethodType a -> a)
-> (forall a. MethodType a -> [a])
-> (forall a. MethodType a -> Bool)
-> (forall a. MethodType a -> Int)
-> (forall a. Eq a => a -> MethodType a -> Bool)
-> (forall a. Ord a => MethodType a -> a)
-> (forall a. Ord a => MethodType a -> a)
-> (forall a. Num a => MethodType a -> a)
-> (forall a. Num a => MethodType a -> a)
-> Foldable MethodType
forall a. Eq a => a -> MethodType a -> Bool
forall a. Num a => MethodType a -> a
forall a. Ord a => MethodType a -> a
forall m. Monoid m => MethodType m -> m
forall a. MethodType a -> Bool
forall a. MethodType a -> Int
forall a. MethodType a -> [a]
forall a. (a -> a -> a) -> MethodType a -> a
forall m a. Monoid m => (a -> m) -> MethodType a -> m
forall b a. (b -> a -> b) -> b -> MethodType a -> b
forall a b. (a -> b -> b) -> b -> MethodType a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MethodType a -> a
$cproduct :: forall a. Num a => MethodType a -> a
sum :: MethodType a -> a
$csum :: forall a. Num a => MethodType a -> a
minimum :: MethodType a -> a
$cminimum :: forall a. Ord a => MethodType a -> a
maximum :: MethodType a -> a
$cmaximum :: forall a. Ord a => MethodType a -> a
elem :: a -> MethodType a -> Bool
$celem :: forall a. Eq a => a -> MethodType a -> Bool
length :: MethodType a -> Int
$clength :: forall a. MethodType a -> Int
null :: MethodType a -> Bool
$cnull :: forall a. MethodType a -> Bool
toList :: MethodType a -> [a]
$ctoList :: forall a. MethodType a -> [a]
foldl1 :: (a -> a -> a) -> MethodType a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MethodType a -> a
foldr1 :: (a -> a -> a) -> MethodType a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MethodType a -> a
foldl' :: (b -> a -> b) -> b -> MethodType a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MethodType a -> b
foldl :: (b -> a -> b) -> b -> MethodType a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MethodType a -> b
foldr' :: (a -> b -> b) -> b -> MethodType a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MethodType a -> b
foldr :: (a -> b -> b) -> b -> MethodType a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MethodType a -> b
foldMap' :: (a -> m) -> MethodType a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MethodType a -> m
foldMap :: (a -> m) -> MethodType a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MethodType a -> m
fold :: MethodType m -> m
$cfold :: forall m. Monoid m => MethodType m -> m
Foldable, Functor MethodType
Foldable MethodType
Functor MethodType
-> Foldable MethodType
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MethodType a -> f (MethodType b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MethodType (f a) -> f (MethodType a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MethodType a -> m (MethodType b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MethodType (m a) -> m (MethodType a))
-> Traversable MethodType
(a -> f b) -> MethodType a -> f (MethodType b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MethodType (m a) -> m (MethodType a)
forall (f :: * -> *) a.
Applicative f =>
MethodType (f a) -> f (MethodType a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MethodType a -> m (MethodType b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MethodType a -> f (MethodType b)
sequence :: MethodType (m a) -> m (MethodType a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MethodType (m a) -> m (MethodType a)
mapM :: (a -> m b) -> MethodType a -> m (MethodType b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MethodType a -> m (MethodType b)
sequenceA :: MethodType (f a) -> f (MethodType a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MethodType (f a) -> f (MethodType a)
traverse :: (a -> f b) -> MethodType a -> f (MethodType b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MethodType a -> f (MethodType b)
$cp2Traversable :: Foldable MethodType
$cp1Traversable :: Functor MethodType
Traversable)
type TypeName = T.Text
type DidService a = [(T.Text, MethodType a)]
type DidDef a = (a, Type a)
data DidFile = DidFile
    { DidFile -> [DidDef Text]
defs :: [ DidDef TypeName ]
    , DidFile -> DidService Text
service :: DidService TypeName
    }
  deriving (DidFile -> DidFile -> Bool
(DidFile -> DidFile -> Bool)
-> (DidFile -> DidFile -> Bool) -> Eq DidFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidFile -> DidFile -> Bool
$c/= :: DidFile -> DidFile -> Bool
== :: DidFile -> DidFile -> Bool
$c== :: DidFile -> DidFile -> Bool
Eq, Int -> DidFile -> ShowS
[DidFile] -> ShowS
DidFile -> String
(Int -> DidFile -> ShowS)
-> (DidFile -> String) -> ([DidFile] -> ShowS) -> Show DidFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidFile] -> ShowS
$cshowList :: [DidFile] -> ShowS
show :: DidFile -> String
$cshow :: DidFile -> String
showsPrec :: Int -> DidFile -> ShowS
$cshowsPrec :: Int -> DidFile -> ShowS
Show)

instance Pretty a => Pretty (MethodType a) where
  pretty :: MethodType a -> Doc ann
pretty (MethodType [Type a]
params [Type a]
results Bool
q Bool
cq Bool
o) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [ [Type a] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Type a]
params
      , Doc ann
"->"
      , [Type a] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Type a]
results
      ] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<>
      [ Doc ann
"query" | Bool
q ] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<>
      [ Doc ann
"composite_query" | Bool
cq ] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<>
      [ Doc ann
"oneway" | Bool
o ]

prettyDef :: Pretty a => DidDef a -> Doc ann
prettyDef :: DidDef a -> Doc ann
prettyDef (a
tn, Type a
t) = Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
tn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Type a
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi

prettyMeth :: Pretty a => (T.Text, MethodType a) -> Doc ann
prettyMeth :: (Text, MethodType a) -> Doc ann
prettyMeth (Text
n, MethodType a
t) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MethodType a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MethodType a
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi

instance Pretty DidFile where
  pretty :: DidFile -> Doc ann
pretty (DidFile [DidDef Text]
defs DidService Text
s) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
    (DidDef Text -> Doc ann
forall a ann. Pretty a => DidDef a -> Doc ann
prettyDef (DidDef Text -> Doc ann) -> [DidDef Text] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DidDef Text]
defs) [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++
    [ Doc ann
"service" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text, MethodType Text) -> Doc ann
forall a ann. Pretty a => (Text, MethodType a) -> Doc ann
prettyMeth ((Text, MethodType Text) -> Doc ann)
-> DidService Text -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DidService Text
s))) ]