{-# LANGUAGE DeriveTraversable #-}
module Codec.Candid.Parse
  ( DidFile(..)
  , DidDef
  , TypeName
  , parseDid
  , parseDidType
  , parseValue
  , parseValues
  , CandidTestFile(..)
  , CandidTest(..)
  , TestInput(..)
  , TestAssertion(..)
  , parseCandidTests
  )  where

import qualified Data.ByteString.Lazy as BS
import qualified Data.Text.Encoding as T
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Set as Set
import Text.Megaparsec
import Text.Megaparsec.Char
import Control.Applicative.Permutations
import Data.Bifunctor
import Data.Char
import Data.Functor
import Data.Word
import Numeric.Natural
import Numeric
import Control.Monad
import Data.Void
import Text.Read (readMaybe)
import Data.Scientific

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

type Parser = Parsec Void String

-- | Parses a Candid description (@.did@) from a string
parseDid :: String -> Either String DidFile
parseDid :: String -> Either String DidFile
parseDid = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a. Parser a -> Parser a
allInput Parser DidFile
fileP) String
"Candid service"

parseDidType :: String -> Either String (Type TypeName)
parseDidType :: String -> Either String (Type TypeName)
parseDidType = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a. Parser a -> Parser a
allInput Parser (Type TypeName)
dataTypeP) String
"Candid type"

-- | Parses a Candid textual value from a string
parseValue :: String -> Either String Value
parseValue :: String -> Either String Value
parseValue = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a. Parser a -> Parser a
allInput Parser Value
valueP) String
"Candid value"

-- | Parses a sequence of  Candid textual values from a string
parseValues :: String -> Either String [Value]
parseValues :: String -> Either String [Value]
parseValues = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a. Parser a -> Parser a
allInput Parser [Value]
valuesP) String
"Candid values (argument sequence)"

allInput :: Parser a -> Parser a
allInput :: forall a. Parser a -> Parser a
allInput = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between Parser ()
theVoid forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

fileP :: Parser DidFile
fileP :: Parser DidFile
fileP = [DidDef TypeName] -> DidService TypeName -> DidFile
DidFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [DidDef TypeName]
defsP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (DidService TypeName)
actorP

defsP :: Parser [DidDef TypeName]
defsP :: Parser [DidDef TypeName]
defsP = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser [DidDef TypeName]
defP

defP :: Parser [DidDef TypeName]
defP :: Parser [DidDef TypeName]
defP = (Parser [DidDef TypeName]
typeP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [DidDef TypeName]
importP) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
";"

typeP :: Parser [DidDef TypeName]
typeP :: Parser [DidDef TypeName]
typeP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$
    (,) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"type" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TypeName
idP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
"=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Type TypeName)
dataTypeP

importP :: Parser [DidDef TypeName]
importP :: Parser [DidDef TypeName]
importP = forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate (forall a b. a -> b -> a
const (forall a b. a -> Either a b
Left String
"imports not yet supported")) forall a b. (a -> b) -> a -> b
$
    [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"import"

-- NOTE: This discards "init" arguments:
-- https://github.com/dfinity/candid/blob/master/spec/Candid.md#core-grammar
-- See also https://github.com/nomeata/haskell-candid/issues/16
actorP :: Parser (DidService TypeName)
actorP :: Parser (DidService TypeName)
actorP = String -> Parser ()
k String
"service" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TypeName
idP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser ()
s String
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Type TypeName]
seqP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser ()
sString
"->") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (DidService TypeName)
actorTypeP -- TODO could be a type id

actorTypeP :: Parser (DidService TypeName)
actorTypeP :: Parser (DidService TypeName)
actorTypeP = forall a. Parser a -> Parser [a]
braceSemi Parser (TypeName, MethodType TypeName)
methP

methP :: Parser (T.Text, MethodType TypeName)
methP :: Parser (TypeName, MethodType TypeName)
methP = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
nameP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (MethodType TypeName)
funcTypeP

funcTypeP :: Parser (MethodType TypeName)
funcTypeP :: Parser (MethodType TypeName)
funcTypeP = do
    [Type TypeName]
ts1 <- Parser [Type TypeName]
seqP
    String -> Parser ()
s String
"->"
    [Type TypeName]
ts2 <- Parser [Type TypeName]
seqP
    (Bool
q,Bool
o) <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$
         (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
"query")
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
"oneway")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Type a] -> [Type a] -> Bool -> Bool -> MethodType a
MethodType [Type TypeName]
ts1 [Type TypeName]
ts2 Bool
q Bool
o

nameP :: Parser T.Text
nameP :: Parser TypeName
nameP = Parser TypeName
textP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TypeName
idP forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"name"

textP :: Parser T.Text
textP :: Parser TypeName
textP = String -> TypeName
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
l (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Char
stringElem)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"text"

blobP :: Parser BS.ByteString
blobP :: Parser ByteString
blobP = [ByteString] -> ByteString
BS.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
l (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ByteString
blobElem)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blob"

blobElem :: Parser BS.ByteString
blobElem :: Parser ByteString
blobElem = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser Char
hexdigit) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
        String
raw <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Parser Char
hexdigit
        case forall a. (Eq a, Num a) => ReadS a
readHex String
raw of
            [(Integer
n,String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ByteString
BS.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n::Integer)))
            [(Integer, String)]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Internal parsing error parsing hex digits"
    , ByteString -> ByteString
BS.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TypeName
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
stringElem
    ]

stringElem :: Parser Char
stringElem :: Parser Char
stringElem = (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
go) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"\""
  where
    go :: Parser Char
    go :: Parser Char
go = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Char
'\t' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
't'
        , Char
'\n' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'n'
        , Char
'\r' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'r'
        , Char
'\"' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\"'
        , Char
'\'' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\''
        , Char
'\\' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\'
        , forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"u{") (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"}") Parser Char
hexnum
        ]

    hexnum :: Parser Char
    hexnum :: Parser Char
hexnum = do
        String
raw <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Parser Char
hexdigit)
        case forall a. (Eq a, Num a) => ReadS a
readHex String
raw of
            [(Int
n,String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr Int
n)
            [(Int, String)]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid hex string " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
raw

hexdigit :: Parser Char
hexdigit :: Parser Char
hexdigit = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
"0123456789ABCDEFabcdef" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
hexdigit -- slightly too liberal: allows leading _

seqP :: Parser [Type TypeName]
seqP :: Parser [Type TypeName]
seqP = forall a. Parser a -> Parser [a]
parenComma Parser (Type TypeName)
argTypeP

argTypeP :: Parser (Type TypeName)
argTypeP :: Parser (Type TypeName)
argTypeP = (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser TypeName
nameP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser ()
s String
":") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Type TypeName)
dataTypeP) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Type TypeName)
dataTypeP

dataTypeP :: Parser (Type TypeName)
dataTypeP :: Parser (Type TypeName)
dataTypeP = Parser (Type TypeName)
primTypeP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Type TypeName)
constTypeP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Type TypeName)
refTypeP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> Type a
RefT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
idP)-- TODO: reftypes

primTypeP :: Parser (Type TypeName)
primTypeP :: Parser (Type TypeName)
primTypeP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. Type a
NatT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"nat"
    , forall a. Type a
Nat8T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"nat8"
    , forall a. Type a
Nat16T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"nat16"
    , forall a. Type a
Nat32T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"nat32"
    , forall a. Type a
Nat64T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"nat64"
    , forall a. Type a
IntT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"int"
    , forall a. Type a
Int8T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"int8"
    , forall a. Type a
Int16T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"int16"
    , forall a. Type a
Int32T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"int32"
    , forall a. Type a
Int64T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"int64"
    , forall a. Type a
Float32T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"float32"
    , forall a. Type a
Float64T forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"float64"
    , forall a. Type a
BoolT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"bool"
    , forall a. Type a
TextT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"text"
    , forall a. Type a
NullT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"null"
    , forall a. Type a
ReservedT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"reserved"
    , forall a. Type a
EmptyT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"empty"
    , forall a. Type a
BlobT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"blob"
    , forall a. Type a
PrincipalT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"principal"
    ]

constTypeP :: Parser (Type TypeName)
constTypeP :: Parser (Type TypeName)
constTypeP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ forall a. Type a -> Type a
OptT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"opt" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Type TypeName)
dataTypeP
  , forall a. Type a -> Type a
VecT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"vec" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Type TypeName)
dataTypeP
  , forall a. Fields a -> Type a
RecT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"record" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
braceSemi Parser (Word32 -> (FieldName, Type TypeName))
recordFieldTypeP
  , forall a. Fields a -> Type a
VariantT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"variant" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
braceSemi Parser (FieldName, Type TypeName)
variantFieldTypeP
  ]

refTypeP :: Parser (Type TypeName)
refTypeP :: Parser (Type TypeName)
refTypeP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall a. MethodType a -> Type a
FuncT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"func" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (MethodType TypeName)
funcTypeP
    , forall a. [(TypeName, MethodType a)] -> Type a
ServiceT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"service" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (DidService TypeName)
actorTypeP
    ]

fieldLabelP :: Parser FieldName
fieldLabelP :: Parser FieldName
fieldLabelP  =
    Word32 -> FieldName
hashedField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Natural
natP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    TypeName -> FieldName
labledField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
nameP

variantFieldTypeP :: Parser (FieldName, Type TypeName)
variantFieldTypeP :: Parser (FieldName, Type TypeName)
variantFieldTypeP =
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldName
fieldLabelP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Parser ()
s String
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Type TypeName)
dataTypeP) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Type a
NullT)

resolveShorthand :: [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand :: forall a. [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand = forall {b}.
Word32 -> [Word32 -> (FieldName, b)] -> [(FieldName, b)]
go Word32
0
  where
    go :: Word32 -> [Word32 -> (FieldName, b)] -> [(FieldName, b)]
go Word32
_ [] = []
    go Word32
n (Word32 -> (FieldName, b)
f:[Word32 -> (FieldName, b)]
fs) =
        let f' :: (FieldName, b)
f' = Word32 -> (FieldName, b)
f Word32
n in
        (FieldName, b)
f' forall a. a -> [a] -> [a]
: Word32 -> [Word32 -> (FieldName, b)] -> [(FieldName, b)]
go (forall a. Enum a => a -> a
succ (FieldName -> Word32
fieldHash (forall a b. (a, b) -> a
fst (FieldName, b)
f'))) [Word32 -> (FieldName, b)]
fs

recordFieldTypeP :: Parser (Word32 -> (FieldName, Type TypeName))
recordFieldTypeP :: Parser (Word32 -> (FieldName, Type TypeName))
recordFieldTypeP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    FieldName
l <- Parser FieldName
fieldLabelP
    String -> Parser ()
s String
":"
    Type TypeName
t <- Parser (Type TypeName)
dataTypeP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (FieldName
l,Type TypeName
t)
  , do
    Type TypeName
t <- Parser (Type TypeName)
dataTypeP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Word32
next -> (Word32 -> FieldName
hashedField Word32
next, Type TypeName
t)
  ]

idP :: Parser T.Text
idP :: Parser TypeName
idP = String -> TypeName
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
l ((:)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Char -> Bool
isAscii Token String
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Token String
c Bool -> Bool -> Bool
|| Token String
c forall a. Eq a => a -> a -> Bool
== Char
'_')
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Char -> Bool
isAscii Token String
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Token String
c Bool -> Bool -> Bool
|| Token String
c forall a. Eq a => a -> a -> Bool
== Char
'_'))
  ) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"id"

valuesP :: Parser [Value]
valuesP :: Parser [Value]
valuesP = (forall a. Parser a -> Parser [a]
parenComma Parser Value
annValueP forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"argument sequence")
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Value
annValueP) -- for convenience

annValueP :: Parser Value
annValueP :: Parser Value
annValueP =
  forall a. Parser a -> Parser a
parens Parser Value
annValueP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do -- this parser allows extra parentheses
      Value
v <- Parser Value
valueP
      String -> Parser ()
s String
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
            Type TypeName
t <- Parser (Type TypeName)
dataTypeP
            Value -> Type TypeName -> Parser Value
smartAnnV Value
v Type TypeName
t
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Value
v

smartAnnV :: Value -> Type TypeName -> Parser Value
smartAnnV :: Value -> Type TypeName -> Parser Value
smartAnnV (NumV Scientific
n) Type TypeName
Nat8T = Word8 -> Value
Nat8V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat16T = Word16 -> Value
Nat16V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat32T = Word32 -> Value
Nat32V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat64T = Word64 -> Value
Nat64V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int8T = Int8 -> Value
Int8V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int16T = Int16 -> Value
Int16V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int32T = Int32 -> Value
Int32V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int64T = Int64 -> Value
Int64V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Float32T = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> Value
Float32V forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Float64T = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Value
Float64V forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
smartAnnV Value
v Type TypeName
ReservedT = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Type Void -> Value
AnnV Value
v forall a. Type a
ReservedT
smartAnnV Value
_ Type TypeName
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Annotations are only supported around number literals"

toBounded :: (Integral a, Bounded a) => Scientific -> Parser a
toBounded :: forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. ParsecT Void String Identity a
err forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
v
  where err :: ParsecT Void String Identity a
err = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Number literal out of bounds: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
v

numP :: Parser Scientific
numP :: Parser Scientific
numP = forall a. Parser a -> Parser a
l ParsecT Void String Identity [Token String]
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
conv forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"number"
  where
    p :: ParsecT Void String Identity [Token String]
p =(:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
"-+0123456789" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
"-+.0123456789eE_")
    conv :: String -> m a
conv String
raw = case forall a. Read a => String -> Maybe a
readMaybe (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'_') (String -> String
handle_trailing_perdiod String
raw)) of
        Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invald number literal: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
raw
        Just a
s -> forall (m :: * -> *) a. Monad m => a -> m a
return a
s
    -- 1. is allowed by candid, but not by scientific
    handle_trailing_perdiod :: String -> String
handle_trailing_perdiod String
s =
        if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) Bool -> Bool -> Bool
&& forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'.' then String
s forall a. [a] -> [a] -> [a]
++ String
"0" else String
s

valueP :: Parser Value
valueP :: Parser Value
valueP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ forall a. Parser a -> Parser a
parens Parser Value
annValueP
  , Scientific -> Value
NumV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Scientific
numP
  , Bool -> Value
BoolV Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"true"
  , Bool -> Value
BoolV Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"false"
  , TypeName -> Value
TextV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
textP
  , Value
NullV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"null"
  , Maybe Value -> Value
OptV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"opt" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Value
valueP
  , Vector Value -> Value
VecV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"vec" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
braceSemi Parser Value
annValueP
  , [(FieldName, Value)] -> Value
RecV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"record" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
braceSemi Parser (Word32 -> (FieldName, Value))
recordFieldValP
  , forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FieldName -> Value -> Value
VariantV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"variant" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
braces Parser (FieldName, Value)
variantFieldValP
  , Principal -> TypeName -> Value
FuncV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"func" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate TypeName -> Either String Principal
parsePrincipal Parser TypeName
textP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
"." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TypeName
nameP
  , Principal -> Value
ServiceV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"service" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate TypeName -> Either String Principal
parsePrincipal Parser TypeName
textP
  , Principal -> Value
PrincipalV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"principal" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate TypeName -> Either String Principal
parsePrincipal Parser TypeName
textP
  , ByteString -> Value
BlobV forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
k String
"blob" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
blobP
  ]

variantFieldValP :: Parser (FieldName, Value)
variantFieldValP :: Parser (FieldName, Value)
variantFieldValP = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldName
fieldLabelP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Parser ()
s String
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Value
annValueP) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
NullV)

recordFieldValP :: Parser (Word32 -> (FieldName, Value))
recordFieldValP :: Parser (Word32 -> (FieldName, Value))
recordFieldValP = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    FieldName
l <- Parser FieldName
fieldLabelP
    String -> Parser ()
s String
"="
    Value
v <- Parser Value
annValueP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (FieldName
l,Value
v)
  , do
    Value
v <- Parser Value
annValueP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Word32
next -> (Word32 -> FieldName
hashedField Word32
next, Value
v)
  ]

-- A lexeme
l :: Parser a -> Parser a
l :: forall a. Parser a -> Parser a
l Parser a
x = Parser a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
theVoid

-- The space between a lexeme
theVoid :: Parser ()
theVoid :: Parser ()
theVoid = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
comment)

comment :: Parser ()
comment :: Parser ()
comment = Parser ()
lineComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
multiLineComment

-- a parser for nested multi-line comments. there might be a nicer way
multiLineComment :: Parser ()
multiLineComment :: Parser ()
multiLineComment = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"/*") (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"*/") forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
        Parser ()
multiLineComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/')) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
anySingleBut Char
'*')

lineComment :: Parser ()
lineComment :: Parser ()
lineComment = do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"//")
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"character") (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n')

-- a symbol
s :: String -> Parser ()
s :: String -> Parser ()
s String
str = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. Parser a -> Parser a
l (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
str)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
str

-- a keyword
k :: String -> Parser ()
k :: String -> Parser ()
k String
str = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. Parser a -> Parser a
l (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
str forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
no)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
str)
  where
    no :: Parser ()
no = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Char -> Bool
isAscii Token String
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Token String
c Bool -> Bool -> Bool
|| Token String
c forall a. Eq a => a -> a -> Bool
== Char
'_'))

natP :: Parser Natural
natP :: Parser Natural
natP = forall a. Parser a -> Parser a
l (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"number")

braces :: Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> Parser ()
s String
"{") (String -> Parser ()
s String
"}")
braceSemi :: Parser a -> Parser [a]
braceSemi :: forall a. Parser a -> Parser [a]
braceSemi Parser a
p = forall a. Parser a -> Parser a
braces forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy Parser a
p (String -> Parser ()
s String
";")
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> Parser ()
s String
"(") (String -> Parser ()
s String
")")
parenComma :: Parser a -> Parser [a]
parenComma :: forall a. Parser a -> Parser [a]
parenComma Parser a
p = forall a. Parser a -> Parser a
parens forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy Parser a
p (String -> Parser ()
s String
",")


-- from https://markkarpov.com/tutorial/megaparsec.html#parse-errors
withPredicate :: (a -> Either String b) -> Parser a -> Parser b
withPredicate :: forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate a -> Either String b
f Parser a
p = do
  Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  a
r <- Parser a
p
  case a -> Either String b
f a
r of
    Left String
msg -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (forall a. a -> Set a
Set.singleton (forall e. String -> ErrorFancy e
ErrorFail String
msg)))
    Right b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return b
x


-- | A candid test file
--
-- (no support for type definitions yet)
data CandidTestFile = CandidTestFile
    { CandidTestFile -> [DidDef TypeName]
testDefs :: [ DidDef TypeName ]
    , CandidTestFile -> [CandidTest TypeName]
testTests ::  [ CandidTest TypeName ]
    }

data CandidTest a = CandidTest
    { forall a. CandidTest a -> Int
testLine :: Int
    , forall a. CandidTest a -> TestAssertion
testAssertion :: TestAssertion
    , forall a. CandidTest a -> [Type a]
testType :: [Type a]
    , forall a. CandidTest a -> Maybe TypeName
testDesc :: Maybe T.Text
    }
  deriving (forall a b. a -> CandidTest b -> CandidTest a
forall a b. (a -> b) -> CandidTest a -> CandidTest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CandidTest b -> CandidTest a
$c<$ :: forall a b. a -> CandidTest b -> CandidTest a
fmap :: forall a b. (a -> b) -> CandidTest a -> CandidTest b
$cfmap :: forall a b. (a -> b) -> CandidTest a -> CandidTest b
Functor, forall a. Eq a => a -> CandidTest a -> Bool
forall a. Num a => CandidTest a -> a
forall a. Ord a => CandidTest a -> a
forall m. Monoid m => CandidTest m -> m
forall a. CandidTest a -> Bool
forall a. CandidTest a -> Int
forall a. CandidTest a -> [a]
forall a. (a -> a -> a) -> CandidTest a -> a
forall m a. Monoid m => (a -> m) -> CandidTest a -> m
forall b a. (b -> a -> b) -> b -> CandidTest a -> b
forall a b. (a -> b -> b) -> b -> CandidTest 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 :: forall a. Num a => CandidTest a -> a
$cproduct :: forall a. Num a => CandidTest a -> a
sum :: forall a. Num a => CandidTest a -> a
$csum :: forall a. Num a => CandidTest a -> a
minimum :: forall a. Ord a => CandidTest a -> a
$cminimum :: forall a. Ord a => CandidTest a -> a
maximum :: forall a. Ord a => CandidTest a -> a
$cmaximum :: forall a. Ord a => CandidTest a -> a
elem :: forall a. Eq a => a -> CandidTest a -> Bool
$celem :: forall a. Eq a => a -> CandidTest a -> Bool
length :: forall a. CandidTest a -> Int
$clength :: forall a. CandidTest a -> Int
null :: forall a. CandidTest a -> Bool
$cnull :: forall a. CandidTest a -> Bool
toList :: forall a. CandidTest a -> [a]
$ctoList :: forall a. CandidTest a -> [a]
foldl1 :: forall a. (a -> a -> a) -> CandidTest a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CandidTest a -> a
foldr1 :: forall a. (a -> a -> a) -> CandidTest a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CandidTest a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
fold :: forall m. Monoid m => CandidTest m -> m
$cfold :: forall m. Monoid m => CandidTest m -> m
Foldable, Functor CandidTest
Foldable CandidTest
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 =>
CandidTest (m a) -> m (CandidTest a)
forall (f :: * -> *) a.
Applicative f =>
CandidTest (f a) -> f (CandidTest a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CandidTest a -> m (CandidTest b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CandidTest a -> f (CandidTest b)
sequence :: forall (m :: * -> *) a.
Monad m =>
CandidTest (m a) -> m (CandidTest a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CandidTest (m a) -> m (CandidTest a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CandidTest a -> m (CandidTest b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CandidTest a -> m (CandidTest b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CandidTest (f a) -> f (CandidTest a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CandidTest (f a) -> f (CandidTest a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CandidTest a -> f (CandidTest b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CandidTest a -> f (CandidTest b)
Traversable)

data TestInput
    = FromTextual T.Text
    | FromBinary BS.ByteString

data TestAssertion
    = CanParse TestInput
    | CannotParse TestInput
    | ParseEq Bool TestInput TestInput

-- | Parses a candid spec test file from a string
parseCandidTests :: String -> String -> Either String CandidTestFile
parseCandidTests :: String -> String -> Either String CandidTestFile
parseCandidTests String
source = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a. Parser a -> Parser a
allInput Parser CandidTestFile
testFileP) String
source

testFileP :: Parser CandidTestFile
testFileP :: Parser CandidTestFile
testFileP = [DidDef TypeName] -> [CandidTest TypeName] -> CandidTestFile
CandidTestFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [DidDef TypeName]
defsP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy Parser (CandidTest TypeName)
testP (String -> Parser ()
s String
";")

testP :: Parser (CandidTest TypeName)
testP :: Parser (CandidTest TypeName)
testP = forall a.
Int -> TestAssertion -> [Type a] -> Maybe TypeName -> CandidTest a
CandidTest
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pos -> Int
unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  String -> Parser ()
k String
"assert"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestAssertion
testAssertP
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Type TypeName]
seqP
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TypeName
textP

testAssertP :: Parser TestAssertion
testAssertP :: Parser TestAssertion
testAssertP = do
    TestInput
input1 <- Parser TestInput
testInputP
    forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ TestInput -> TestAssertion
CanParse TestInput
input1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
":"
        , TestInput -> TestAssertion
CannotParse TestInput
input1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
"!:"
        , Bool -> TestInput -> TestInput -> TestAssertion
ParseEq Bool
True TestInput
input1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
"==" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestInput
testInputP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
":"
        , Bool -> TestInput -> TestInput -> TestAssertion
ParseEq Bool
False TestInput
input1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
s String
"!=" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestInput
testInputP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
s String
":"
        ]

testInputP :: Parser TestInput
testInputP :: Parser TestInput
testInputP = TypeName -> TestInput
FromTextual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
textP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> TestInput
FromBinary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser ()
k String
"blob" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
blobP)