{-# 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 = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) DidFile
-> Either String DidFile
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) DidFile
 -> Either String DidFile)
-> (String -> Either (ParseErrorBundle String Void) DidFile)
-> String
-> Either String DidFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String DidFile
-> String
-> String
-> Either (ParseErrorBundle String Void) DidFile
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String DidFile -> Parsec Void String DidFile
forall a. Parser a -> Parser a
allInput Parsec Void String DidFile
fileP) String
"Candid service"

parseDidType :: String -> Either String (Type TypeName)
parseDidType :: String -> Either String (Type TypeName)
parseDidType = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) (Type TypeName)
-> Either String (Type TypeName)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) (Type TypeName)
 -> Either String (Type TypeName))
-> (String
    -> Either (ParseErrorBundle String Void) (Type TypeName))
-> String
-> Either String (Type TypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String (Type TypeName)
-> String
-> String
-> Either (ParseErrorBundle String Void) (Type TypeName)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String (Type TypeName)
-> Parsec Void String (Type TypeName)
forall a. Parser a -> Parser a
allInput Parsec Void String (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 = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) Value
-> Either String Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) Value
 -> Either String Value)
-> (String -> Either (ParseErrorBundle String Void) Value)
-> String
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String Value
-> String -> String -> Either (ParseErrorBundle String Void) Value
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String Value -> Parsec Void String Value
forall a. Parser a -> Parser a
allInput Parsec Void String 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 = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) [Value]
-> Either String [Value]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) [Value]
 -> Either String [Value])
-> (String -> Either (ParseErrorBundle String Void) [Value])
-> String
-> Either String [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String [Value]
-> String
-> String
-> Either (ParseErrorBundle String Void) [Value]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String [Value] -> Parsec Void String [Value]
forall a. Parser a -> Parser a
allInput Parsec Void String [Value]
valuesP) String
"Candid values (argument sequence)"

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

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

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

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

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

importP :: Parser [DidDef TypeName]
importP :: ParsecT Void String Identity [DidDef TypeName]
importP = ([Any] -> Either String [DidDef TypeName])
-> Parser [Any] -> ParsecT Void String Identity [DidDef TypeName]
forall a b. (a -> Either String b) -> Parser a -> Parser b
withPredicate (Either String [DidDef TypeName]
-> [Any] -> Either String [DidDef TypeName]
forall a b. a -> b -> a
const (String -> Either String [DidDef TypeName]
forall a b. a -> Either a b
Left String
"imports not yet supported")) (Parser [Any] -> ParsecT Void String Identity [DidDef TypeName])
-> Parser [Any] -> ParsecT Void String Identity [DidDef TypeName]
forall a b. (a -> b) -> a -> b
$
    [] [Any] -> ParsecT Void String Identity () -> Parser [Any]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Void String Identity ()
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 :: ParsecT Void String Identity (DidService TypeName)
actorP = String -> ParsecT Void String Identity ()
k String
"service" ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe TypeName)
-> ParsecT Void String Identity (Maybe TypeName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity TypeName
-> ParsecT Void String Identity (Maybe TypeName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity TypeName
idP ParsecT Void String Identity (Maybe TypeName)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Void String Identity ()
s String
":" ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Type TypeName]
seqP Parser [Type TypeName]
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Void String Identity ()
sString
"->") ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (DidService TypeName)
-> ParsecT Void String Identity (DidService TypeName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity (DidService TypeName)
actorTypeP -- TODO could be a type id

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

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

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

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

textP :: Parser T.Text
textP :: ParsecT Void String Identity TypeName
textP = String -> TypeName
T.pack (String -> TypeName)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
l (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity Char
stringElem)) ParsecT Void String Identity TypeName
-> String -> ParsecT Void String Identity TypeName
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 ([ByteString] -> ByteString)
-> ParsecT Void String Identity [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity [ByteString]
-> ParsecT Void String Identity [ByteString]
forall a. Parser a -> Parser a
l (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity [ByteString]
-> ParsecT Void String Identity [ByteString]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (Parser ByteString -> ParsecT Void String Identity [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ByteString
blobElem)) Parser ByteString -> String -> Parser ByteString
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blob"

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

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

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

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

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

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

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

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

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

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

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

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

resolveShorthand :: [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand :: [Word32 -> (FieldName, a)] -> [(FieldName, a)]
resolveShorthand = Word32 -> [Word32 -> (FieldName, a)] -> [(FieldName, a)]
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' (FieldName, b) -> [(FieldName, b)] -> [(FieldName, b)]
forall a. a -> [a] -> [a]
: Word32 -> [Word32 -> (FieldName, b)] -> [(FieldName, b)]
go (Word32 -> Word32
forall a. Enum a => a -> a
succ (FieldName -> Word32
fieldHash ((FieldName, b) -> FieldName
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 = [Parser (Word32 -> (FieldName, Type TypeName))]
-> Parser (Word32 -> (FieldName, Type TypeName))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Parser (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (Word32 -> (FieldName, Type TypeName))
 -> Parser (Word32 -> (FieldName, Type TypeName)))
-> Parser (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall a b. (a -> b) -> a -> b
$ do
    FieldName
l <- Parser FieldName
fieldLabelP
    String -> ParsecT Void String Identity ()
s String
":"
    Type TypeName
t <- Parsec Void String (Type TypeName)
dataTypeP
    (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word32 -> (FieldName, Type TypeName))
 -> Parser (Word32 -> (FieldName, Type TypeName)))
-> (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall a b. (a -> b) -> a -> b
$ (FieldName, Type TypeName) -> Word32 -> (FieldName, Type TypeName)
forall a b. a -> b -> a
const (FieldName
l,Type TypeName
t)
  , do
    Type TypeName
t <- Parsec Void String (Type TypeName)
dataTypeP
    (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word32 -> (FieldName, Type TypeName))
 -> Parser (Word32 -> (FieldName, Type TypeName)))
-> (Word32 -> (FieldName, Type TypeName))
-> Parser (Word32 -> (FieldName, Type TypeName))
forall a b. (a -> b) -> a -> b
$ \Word32
next -> (Word32 -> FieldName
hashedField Word32
next, Type TypeName
t)
  ]

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

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

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

smartAnnV :: Value -> Type TypeName -> Parser Value
smartAnnV :: Value -> Type TypeName -> Parsec Void String Value
smartAnnV (NumV Scientific
n) Type TypeName
Nat8T = Word8 -> Value
Nat8V (Word8 -> Value)
-> ParsecT Void String Identity Word8 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Word8
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat16T = Word16 -> Value
Nat16V (Word16 -> Value)
-> ParsecT Void String Identity Word16 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Word16
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat32T = Word32 -> Value
Nat32V (Word32 -> Value)
-> ParsecT Void String Identity Word32 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Word32
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Nat64T = Word64 -> Value
Nat64V (Word64 -> Value)
-> ParsecT Void String Identity Word64 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Word64
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int8T = Int8 -> Value
Int8V (Int8 -> Value)
-> ParsecT Void String Identity Int8 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Int8
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int16T = Int16 -> Value
Int16V (Int16 -> Value)
-> ParsecT Void String Identity Int16 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Int16
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int32T = Int32 -> Value
Int32V (Int32 -> Value)
-> ParsecT Void String Identity Int32 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Int32
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Int64T = Int64 -> Value
Int64V (Int64 -> Value)
-> ParsecT Void String Identity Int64 -> Parsec Void String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> ParsecT Void String Identity Int64
forall a. (Integral a, Bounded a) => Scientific -> Parser a
toBounded Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Float32T = Value -> Parsec Void String Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parsec Void String Value)
-> Value -> Parsec Void String Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
Float32V (Float -> Value) -> Float -> Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
smartAnnV (NumV Scientific
n) Type TypeName
Float64T = Value -> Parsec Void String Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parsec Void String Value)
-> Value -> Parsec Void String Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Float64V (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
smartAnnV Value
v Type TypeName
ReservedT = Value -> Parsec Void String Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parsec Void String Value)
-> Value -> Parsec Void String Value
forall a b. (a -> b) -> a -> b
$ Value -> Type Void -> Value
AnnV Value
v Type Void
forall a. Type a
ReservedT
smartAnnV Value
_ Type TypeName
_ = String -> Parsec Void String Value
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 :: Scientific -> Parser a
toBounded Scientific
v = Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall a. ParsecT Void String Identity a
err a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Parser a) -> Maybe a -> Parser a
forall a b. (a -> b) -> a -> b
$ Scientific -> Maybe a
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
v
  where err :: ParsecT Void String Identity a
err = String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void String Identity a)
-> String -> ParsecT Void String Identity a
forall a b. (a -> b) -> a -> b
$ String
"Number literal out of bounds: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
v

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

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

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

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

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

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

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

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

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

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

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

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

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


-- from https://markkarpov.com/tutorial/megaparsec.html#parse-errors
withPredicate :: (a -> Either String b) -> Parser a -> Parser b
withPredicate :: (a -> Either String b) -> Parser a -> Parser b
withPredicate a -> Either String b
f Parser a
p = do
  Int
o <- ParsecT Void String Identity Int
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 -> ParseError String Void -> Parser b
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (Int -> Set (ErrorFancy Void) -> ParseError String Void
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
msg)))
    Right b
x -> b -> Parser b
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
    { CandidTest a -> Int
testLine :: Int
    , CandidTest a -> TestAssertion
testAssertion :: TestAssertion
    , CandidTest a -> [Type a]
testType :: [Type a]
    , CandidTest a -> Maybe TypeName
testDesc :: Maybe T.Text
    }
  deriving (a -> CandidTest b -> CandidTest a
(a -> b) -> CandidTest a -> CandidTest b
(forall a b. (a -> b) -> CandidTest a -> CandidTest b)
-> (forall a b. a -> CandidTest b -> CandidTest a)
-> Functor CandidTest
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
<$ :: a -> CandidTest b -> CandidTest a
$c<$ :: forall a b. a -> CandidTest b -> CandidTest a
fmap :: (a -> b) -> CandidTest a -> CandidTest b
$cfmap :: forall a b. (a -> b) -> CandidTest a -> CandidTest b
Functor, CandidTest a -> Bool
(a -> m) -> CandidTest a -> m
(a -> b -> b) -> b -> CandidTest a -> b
(forall m. Monoid m => CandidTest m -> m)
-> (forall m a. Monoid m => (a -> m) -> CandidTest a -> m)
-> (forall m a. Monoid m => (a -> m) -> CandidTest a -> m)
-> (forall a b. (a -> b -> b) -> b -> CandidTest a -> b)
-> (forall a b. (a -> b -> b) -> b -> CandidTest a -> b)
-> (forall b a. (b -> a -> b) -> b -> CandidTest a -> b)
-> (forall b a. (b -> a -> b) -> b -> CandidTest a -> b)
-> (forall a. (a -> a -> a) -> CandidTest a -> a)
-> (forall a. (a -> a -> a) -> CandidTest a -> a)
-> (forall a. CandidTest a -> [a])
-> (forall a. CandidTest a -> Bool)
-> (forall a. CandidTest a -> Int)
-> (forall a. Eq a => a -> CandidTest a -> Bool)
-> (forall a. Ord a => CandidTest a -> a)
-> (forall a. Ord a => CandidTest a -> a)
-> (forall a. Num a => CandidTest a -> a)
-> (forall a. Num a => CandidTest a -> a)
-> Foldable CandidTest
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 :: CandidTest a -> a
$cproduct :: forall a. Num a => CandidTest a -> a
sum :: CandidTest a -> a
$csum :: forall a. Num a => CandidTest a -> a
minimum :: CandidTest a -> a
$cminimum :: forall a. Ord a => CandidTest a -> a
maximum :: CandidTest a -> a
$cmaximum :: forall a. Ord a => CandidTest a -> a
elem :: a -> CandidTest a -> Bool
$celem :: forall a. Eq a => a -> CandidTest a -> Bool
length :: CandidTest a -> Int
$clength :: forall a. CandidTest a -> Int
null :: CandidTest a -> Bool
$cnull :: forall a. CandidTest a -> Bool
toList :: CandidTest a -> [a]
$ctoList :: forall a. CandidTest a -> [a]
foldl1 :: (a -> a -> a) -> CandidTest a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CandidTest a -> a
foldr1 :: (a -> a -> a) -> CandidTest a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CandidTest a -> a
foldl' :: (b -> a -> b) -> b -> CandidTest a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
foldl :: (b -> a -> b) -> b -> CandidTest a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CandidTest a -> b
foldr' :: (a -> b -> b) -> b -> CandidTest a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
foldr :: (a -> b -> b) -> b -> CandidTest a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CandidTest a -> b
foldMap' :: (a -> m) -> CandidTest a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
foldMap :: (a -> m) -> CandidTest a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CandidTest a -> m
fold :: CandidTest m -> m
$cfold :: forall m. Monoid m => CandidTest m -> m
Foldable, Functor CandidTest
Foldable CandidTest
Functor CandidTest
-> Foldable CandidTest
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CandidTest a -> f (CandidTest b))
-> (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 (m :: * -> *) a.
    Monad m =>
    CandidTest (m a) -> m (CandidTest a))
-> Traversable CandidTest
(a -> f b) -> CandidTest a -> f (CandidTest 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 =>
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 :: CandidTest (m a) -> m (CandidTest a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CandidTest (m a) -> m (CandidTest a)
mapM :: (a -> m b) -> CandidTest a -> m (CandidTest b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CandidTest a -> m (CandidTest b)
sequenceA :: CandidTest (f a) -> f (CandidTest a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CandidTest (f a) -> f (CandidTest a)
traverse :: (a -> f b) -> CandidTest a -> f (CandidTest b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CandidTest a -> f (CandidTest b)
$cp2Traversable :: Foldable CandidTest
$cp1Traversable :: Functor CandidTest
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 = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) CandidTestFile
-> Either String CandidTestFile
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) CandidTestFile
 -> Either String CandidTestFile)
-> (String -> Either (ParseErrorBundle String Void) CandidTestFile)
-> String
-> Either String CandidTestFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String CandidTestFile
-> String
-> String
-> Either (ParseErrorBundle String Void) CandidTestFile
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String CandidTestFile
-> Parsec Void String CandidTestFile
forall a. Parser a -> Parser a
allInput Parsec Void String CandidTestFile
testFileP) String
source

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

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

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

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