-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Parsing of Michelson types.

module Morley.Michelson.Parser.Type
  ( type_
  , field
  ) where

import Prelude hiding (note, some, try)

import Data.Default (Default, def)
import qualified Data.Map as Map
import Fmt (pretty)
import Text.Megaparsec (choice, customFailure, label, sepBy)

import Morley.Michelson.Let (LetType(..))
import Morley.Michelson.Parser.Annotations
import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Helpers
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types (Parser, letTypes)
import Morley.Michelson.Untyped
import Morley.Util.Generic

-- | This parses arbitrary type expressions.
--
-- Note that this includes parenthesized ones for efficiency, see 't_operator'.
-- That is to say, @int@, @(int)@, @((int))@, etc will match with this parser and produce @TInt@.
type_ :: Parser Ty
type_ :: Parser Ty
type_ = (FieldAnn, Ty) -> Ty
forall a b. (a, b) -> b
snd ((FieldAnn, Ty) -> Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> Parser Ty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
typeInner (FieldAnn -> Parser FieldAnn
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldAnn
forall k (a :: k). Annotation a
noAnn)

field :: Parser (FieldAnn, Ty)
field :: ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field = Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
typeInner Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

-- | 't_operator' parses tuples @(a, b, c)@, variants @(a | b | c)@, and also type expressions in
-- parentheses @(a)@ and unit @()@. This is done this way for performance considerations.
--
-- Consequently, 't_unit' doesn't bother with parsing @()@.
t_operator :: Parser FieldAnn -> Parser (FieldAnn, Ty)
t_operator :: Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
t_operator Parser FieldAnn
fp = do
  Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)]))
whole <- Parser (Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)])))
-> Parser (Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)])))
forall a. Parser a -> Parser a
parens do
    ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)]))
-> Parser (Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)])))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
      (FieldAnn, Ty)
ty   <- ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field
      Maybe (Bool, [(FieldAnn, Ty)])
rest <- ReaderT
  LetEnv (Parsec CustomParserException Text) (Bool, [(FieldAnn, Ty)])
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (Maybe (Bool, [(FieldAnn, Ty)]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        Bool
isOr <- (Text -> Parser ()
symbol' Text
"|" Parser ()
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ReaderT LetEnv (Parsec CustomParserException Text) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
            ReaderT LetEnv (Parsec CustomParserException Text) Bool
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser ()
symbol' Text
"," Parser ()
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
-> ReaderT LetEnv (Parsec CustomParserException Text) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ReaderT LetEnv (Parsec CustomParserException Text) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        [(FieldAnn, Ty)]
others <- ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> Parser ()
-> ReaderT
     LetEnv (Parsec CustomParserException Text) [(FieldAnn, Ty)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser ()
symbol' if Bool
isOr then Text
"|" else Text
","
        return (Bool
isOr, [(FieldAnn, Ty)]
others)
      return ((FieldAnn, Ty)
ty, Maybe (Bool, [(FieldAnn, Ty)])
rest)

  (FieldAnn
f, TypeAnn
t) <- Parser FieldAnn -> Parser (FieldAnn, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser FieldAnn
fp
  case Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)]))
whole of
    Just ((FieldAnn, Ty)
ty, Just (Bool
isOr, [(FieldAnn, Ty)]
tys)) -> do
      let (FieldAnn
f', Ty T
ty' TypeAnn
_) = (Natural -> (FieldAnn, Ty) -> (FieldAnn, Ty) -> (FieldAnn, Ty))
-> NonEmpty (FieldAnn, Ty) -> (FieldAnn, Ty)
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree (Bool
-> Natural -> (FieldAnn, Ty) -> (FieldAnn, Ty) -> (FieldAnn, Ty)
forall k p (a :: k).
Bool -> p -> (FieldAnn, Ty) -> (FieldAnn, Ty) -> (Annotation a, Ty)
mergeTwo Bool
isOr) ((FieldAnn, Ty)
ty (FieldAnn, Ty) -> [(FieldAnn, Ty)] -> NonEmpty (FieldAnn, Ty)
forall a. a -> [a] -> NonEmpty a
:| [(FieldAnn, Ty)]
tys)
      FieldAnn
f'' <- FieldAnn -> FieldAnn -> Parser FieldAnn
forall a (m :: * -> *) s.
(Default a, MonadParsec CustomParserException s m, Eq a) =>
a -> a -> m a
mergeAnnots FieldAnn
f FieldAnn
f'
      return (FieldAnn
f'', T -> TypeAnn -> Ty
Ty T
ty' TypeAnn
t)
    Just ((FieldAnn, Ty)
res, Maybe (Bool, [(FieldAnn, Ty)])
_) -> do
      (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldAnn, Ty)
res
    Maybe ((FieldAnn, Ty), Maybe (Bool, [(FieldAnn, Ty)]))
Nothing -> do
      (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldAnn
f, T -> TypeAnn -> Ty
Ty T
TUnit TypeAnn
t)
  where
    mergeTwo :: Bool -> p -> (FieldAnn, Ty) -> (FieldAnn, Ty) -> (Annotation a, Ty)
mergeTwo Bool
isOr p
_ (FieldAnn
l, Ty
a) (FieldAnn
r, Ty
b) =
      (Annotation a
forall k (a :: k). Annotation a
noAnn, T -> TypeAnn -> Ty
Ty ((if Bool
isOr then FieldAnn -> FieldAnn -> Ty -> Ty -> T
TOr FieldAnn
l FieldAnn
r else FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair FieldAnn
l FieldAnn
r VarAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn) Ty
a Ty
b) TypeAnn
forall k (a :: k). Annotation a
noAnn)

    mergeAnnots :: a -> a -> m a
mergeAnnots a
l a
r
      | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Default a => a
def  = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
      | a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Default a => a
def  = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
l
      | Bool
otherwise = CustomParserException -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomParserException
ExcessFieldAnnotation

typeInner
  :: Parser FieldAnn -> Parser (FieldAnn, Ty)
typeInner :: Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
typeInner Parser FieldAnn
fp = String
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"type" (ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty))
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a b. (a -> b) -> a -> b
$ ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Parser a -> Parser a
lexeme (ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty))
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a b. (a -> b) -> a -> b
$ [ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)]
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ReaderT
    LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)]
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty))
-> [ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)]
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a b. (a -> b) -> a -> b
$ (\Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
x -> Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
x Parser FieldAnn
fp) ((Parser FieldAnn
  -> ReaderT
       LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty))
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty))
-> [Parser FieldAnn
    -> ReaderT
         LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)]
-> [ReaderT
      LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  [ Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
t_operator
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_int, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_nat, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_string, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_bytes, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_mutez, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_bool
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_keyhash, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_timestamp, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_address
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_key, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_unit, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_never, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_signature, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_chain_id
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_bls12381fr, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_bls12381g1, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_bls12381g2
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_option, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_list, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_set
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_operation, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_contract, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_ticket, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_pair, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_or
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_lambda, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_map, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_big_map, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_view
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_void, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_letType
  , Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_chestKey, Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
forall a. Default a => Parser a -> Parser (a, Ty)
t_chest
  ]

----------------------------------------------------------------------------
-- Non-comparable types
----------------------------------------------------------------------------

mkType :: T -> (a, TypeAnn) -> (a, Ty)
mkType :: T -> (a, TypeAnn) -> (a, Ty)
mkType T
t (a
a, TypeAnn
ta) = (a
a, T -> TypeAnn -> Ty
Ty T
t TypeAnn
ta)


t_int :: (Default a) => Parser a -> Parser (a, Ty)
t_int :: Parser a -> Parser (a, Ty)
t_int Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Int" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TInt) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_nat :: (Default a) => Parser a -> Parser (a, Ty)
t_nat :: Parser a -> Parser (a, Ty)
t_nat Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Nat" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TNat) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_string :: (Default a) => Parser a -> Parser (a, Ty)
t_string :: Parser a -> Parser (a, Ty)
t_string Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"String" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TString) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_bytes :: (Default a) => Parser a -> Parser (a, Ty)
t_bytes :: Parser a -> Parser (a, Ty)
t_bytes Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Bytes" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TBytes) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_mutez :: (Default a) => Parser a -> Parser (a, Ty)
t_mutez :: Parser a -> Parser (a, Ty)
t_mutez Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Mutez" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TMutez) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_bool :: (Default a) => Parser a -> Parser (a, Ty)
t_bool :: Parser a -> Parser (a, Ty)
t_bool Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Bool" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TBool) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_keyhash :: (Default a) => Parser a -> Parser (a, Ty)
t_keyhash :: Parser a -> Parser (a, Ty)
t_keyhash Parser a
fp = ((Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"KeyHash" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TKeyHash)) Parser ((a, TypeAnn) -> (a, Ty))
-> Parser ((a, TypeAnn) -> (a, Ty))
-> Parser ((a, TypeAnn) -> (a, Ty))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"key_hash" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TKeyHash))) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_timestamp :: (Default a) => Parser a -> Parser (a, Ty)
t_timestamp :: Parser a -> Parser (a, Ty)
t_timestamp Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Timestamp" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TTimestamp) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_address :: (Default a) => Parser a -> Parser (a, Ty)
t_address :: Parser a -> Parser (a, Ty)
t_address Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Address" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TAddress) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_key :: (Default a) => Parser a -> Parser (a, Ty)
t_key :: Parser a -> Parser (a, Ty)
t_key Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Key" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TKey) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_signature :: (Default a) => Parser a -> Parser (a, Ty)
t_signature :: Parser a -> Parser (a, Ty)
t_signature Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Signature" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TSignature) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_bls12381fr :: (Default a) => Parser a -> Parser (a, Ty)
t_bls12381fr :: Parser a -> Parser (a, Ty)
t_bls12381fr Parser a
fp = do
  Text -> Parser ()
symbol' Text
"bls12_381_fr" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"Bls12381Fr"
  T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TBls12381Fr ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_bls12381g1 :: (Default a) => Parser a -> Parser (a, Ty)
t_bls12381g1 :: Parser a -> Parser (a, Ty)
t_bls12381g1 Parser a
fp = do
  Text -> Parser ()
symbol' Text
"bls12_381_g1" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"Bls12381G1"
  T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TBls12381G1 ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_bls12381g2 :: (Default a) => Parser a -> Parser (a, Ty)
t_bls12381g2 :: Parser a -> Parser (a, Ty)
t_bls12381g2 Parser a
fp = do
  Text -> Parser ()
symbol' Text
"bls12_381_g2" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"Bls12381G2"
  T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TBls12381G2 ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_chestKey :: (Default a) => Parser a -> Parser (a, Ty)
t_chestKey :: Parser a -> Parser (a, Ty)
t_chestKey Parser a
fp = do
  Text -> Parser ()
symbol' Text
"ChestKey" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"chest_key"
  T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TChestKey ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_chest :: (Default a) => Parser a -> Parser (a, Ty)
t_chest :: Parser a -> Parser (a, Ty)
t_chest Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Chest" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TChest) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_chain_id :: (Default a) => Parser a -> Parser (a, Ty)
t_chain_id :: Parser a -> Parser (a, Ty)
t_chain_id Parser a
fp = do
  Text -> Parser ()
symbol' Text
"ChainId" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"chain_id"
  T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TChainId ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_operation :: (Default a) => Parser a -> Parser (a, Ty)
t_operation :: Parser a -> Parser (a, Ty)
t_operation Parser a
fp = Tokens Text
-> ((a, TypeAnn) -> (a, Ty)) -> Parser ((a, TypeAnn) -> (a, Ty))
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"Operation" (T -> (a, TypeAnn) -> (a, Ty)
forall a. T -> (a, TypeAnn) -> (a, Ty)
mkType T
TOperation) Parser ((a, TypeAnn) -> (a, Ty))
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
-> Parser (a, Ty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
-> ReaderT LetEnv (Parsec CustomParserException Text) (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp

t_contract :: (Default a) => Parser a -> Parser (a, Ty)
t_contract :: Parser a -> Parser (a, Ty)
t_contract Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Contract"
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  Ty
a <- Parser Ty
type_
  return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TContract Ty
a) TypeAnn
t)

t_ticket :: (Default a) => Parser a -> Parser (a, Ty)
t_ticket :: Parser a -> Parser (a, Ty)
t_ticket Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Ticket"
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  Ty
a <- Parser Ty
type_
  return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TTicket Ty
a) TypeAnn
t)

-- | Parses a @unit@ type. Unit type admits two variants of syntax, @unit@ and @()@. This parser
-- handles only the former, the latter is handled in 't_operator'
t_unit :: (Default a) => Parser a -> Parser (a, Ty)
t_unit :: Parser a -> Parser (a, Ty)
t_unit Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Unit"
  (a
f,TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  return (a
f, T -> TypeAnn -> Ty
Ty T
TUnit TypeAnn
t)

t_never :: (Default a) => Parser a -> Parser (a, Ty)
t_never :: Parser a -> Parser (a, Ty)
t_never Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Never" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol' Text
"⊥"
  (a
f,TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  return (a
f, T -> TypeAnn -> Ty
Ty T
TNever TypeAnn
t)

t_pair :: (Default a) => Parser a -> Parser (a, Ty)
t_pair :: Parser a -> Parser (a, Ty)
t_pair Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Pair"
  (a
fieldAnn, TypeAnn
typeAnn) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  [(FieldAnn, Ty)]
fields <- ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) [(FieldAnn, Ty)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field
  T
tPair <- [(FieldAnn, Ty)] -> Parser T
go [(FieldAnn, Ty)]
fields
  pure $ (a
fieldAnn, T -> TypeAnn -> Ty
Ty T
tPair TypeAnn
typeAnn)
  where
    go :: [(FieldAnn, Ty)] -> Parser T
    go :: [(FieldAnn, Ty)] -> Parser T
go = \case
      [] -> String -> Parser T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The 'pair' type expects at least 2 type arguments, but 0 were given."
      [(FieldAnn
_, Ty
t)] -> String -> Parser T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser T) -> String -> Parser T
forall a b. (a -> b) -> a -> b
$ String
"The 'pair' type expects at least 2 type arguments, but only 1 was given: '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Ty -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Ty
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'."
      [(FieldAnn
fieldAnnL, Ty
typeL), (FieldAnn
fieldAnnR, Ty
typeR)] ->
        T -> Parser T
forall (f :: * -> *) a. Applicative f => a -> f a
pure (T -> Parser T) -> T -> Parser T
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair FieldAnn
fieldAnnL FieldAnn
fieldAnnR VarAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn Ty
typeL Ty
typeR
      (FieldAnn
fieldAnnL, Ty
typeL) : [(FieldAnn, Ty)]
fields -> do
        T
rightCombedT <- [(FieldAnn, Ty)] -> Parser T
go [(FieldAnn, Ty)]
fields
        pure $ FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair FieldAnn
fieldAnnL FieldAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn Ty
typeL (T -> TypeAnn -> Ty
Ty T
rightCombedT TypeAnn
forall k (a :: k). Annotation a
noAnn)

t_or :: (Default a) => Parser a -> Parser (a, Ty)
t_or :: Parser a -> Parser (a, Ty)
t_or Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Or"
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  (FieldAnn
l, Ty
a) <- ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field
  (FieldAnn
r, Ty
b) <- ReaderT LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
field
  return (a
f, T -> TypeAnn -> Ty
Ty (FieldAnn -> FieldAnn -> Ty -> Ty -> T
TOr FieldAnn
l FieldAnn
r Ty
a Ty
b) TypeAnn
t)

t_option :: (Default a) => Parser a -> Parser (a, Ty)
t_option :: Parser a -> Parser (a, Ty)
t_option Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Option"
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  Ty
a <- (FieldAnn, Ty) -> Ty
forall a b. (a, b) -> b
snd ((FieldAnn, Ty) -> Ty)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
-> Parser Ty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldAnn
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (FieldAnn, Ty)
typeInner (FieldAnn -> Parser FieldAnn
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldAnn
forall k (a :: k). Annotation a
noAnn)
  return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TOption Ty
a) TypeAnn
t)

t_lambda :: (Default a) => Parser a -> Parser (a, Ty)
t_lambda :: Parser a -> Parser (a, Ty)
t_lambda Parser a
fp = Parser (a, Ty)
core Parser (a, Ty) -> Parser (a, Ty) -> Parser (a, Ty)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a, Ty)
slashLambda
  where
    core :: Parser (a, Ty)
core = do
      Text -> Parser ()
symbol' Text
"Lambda"
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      Ty
a <- Parser Ty
type_
      Ty
b <- Parser Ty
type_
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
TLambda Ty
a Ty
b) TypeAnn
t)
    slashLambda :: Parser (a, Ty)
slashLambda = do
      Tokens Text -> Parser ()
symbol Tokens Text
"\\"
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      Ty
a <- Parser Ty
type_
      Tokens Text -> Parser ()
symbol Tokens Text
"->"
      Ty
b <- Parser Ty
type_
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
TLambda Ty
a Ty
b) TypeAnn
t)

-- Container types
t_list :: (Default a) => Parser a -> Parser (a, Ty)
t_list :: Parser a -> Parser (a, Ty)
t_list Parser a
fp = Parser (a, Ty)
core Parser (a, Ty) -> Parser (a, Ty) -> Parser (a, Ty)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a, Ty)
bracketList
  where
    core :: Parser (a, Ty)
core = do
      Text -> Parser ()
symbol' Text
"List"
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      Ty
a <- Parser Ty
type_
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TList Ty
a) TypeAnn
t)
    bracketList :: Parser (a, Ty)
bracketList = do
      Ty
a <- Parser Ty -> Parser Ty
forall a. Parser a -> Parser a
brackets Parser Ty
type_
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TList Ty
a) TypeAnn
t)

t_set :: (Default a) => Parser a -> Parser (a, Ty)
t_set :: Parser a -> Parser (a, Ty)
t_set Parser a
fp = Parser (a, Ty)
core Parser (a, Ty) -> Parser (a, Ty) -> Parser (a, Ty)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a, Ty)
braceSet
  where
    core :: Parser (a, Ty)
core = do
      Text -> Parser ()
symbol' Text
"Set"
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      Ty
a <- Parser Ty
type_
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TSet Ty
a) TypeAnn
t)
    braceSet :: Parser (a, Ty)
braceSet = do
      Ty
a <- Parser Ty -> Parser Ty
forall a. Parser a -> Parser a
braces Parser Ty
type_
      (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
      return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> T
TSet Ty
a) TypeAnn
t)

t_map_like
  :: Default a
  => Parser a -> Parser (Ty, Ty, a, TypeAnn)
t_map_like :: Parser a -> Parser (Ty, Ty, a, TypeAnn)
t_map_like Parser a
fp = do
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  Ty
a <- Parser Ty
type_
  Ty
b <- Parser Ty
type_
  return (Ty
a, Ty
b, a
f, TypeAnn
t)

t_map :: (Default a) => Parser a -> Parser (a, Ty)
t_map :: Parser a -> Parser (a, Ty)
t_map Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Map"
  (Ty
a, Ty
b, a
f, TypeAnn
t) <- Parser a -> Parser (Ty, Ty, a, TypeAnn)
forall a. Default a => Parser a -> Parser (Ty, Ty, a, TypeAnn)
t_map_like Parser a
fp
  return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
TMap Ty
a Ty
b) TypeAnn
t)

t_big_map :: (Default a) => Parser a -> Parser (a, Ty)
t_big_map :: Parser a -> Parser (a, Ty)
t_big_map Parser a
fp = do
  Text -> Parser ()
symbol' Text
"BigMap" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Parser ()
symbol Tokens Text
"big_map"
  (Ty
a, Ty
b, a
f, TypeAnn
t) <- Parser a -> Parser (Ty, Ty, a, TypeAnn)
forall a. Default a => Parser a -> Parser (Ty, Ty, a, TypeAnn)
t_map_like Parser a
fp
  return (a
f, T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
TBigMap Ty
a Ty
b) TypeAnn
t)

----------------------------------------------------------------------------
-- Non-standard types (Morley extensions)
----------------------------------------------------------------------------

t_view :: Default a => Parser a -> Parser (a, Ty)
t_view :: Parser a -> Parser (a, Ty)
t_view Parser a
fp = do
  Text -> Parser ()
symbol' Text
"View"
  Ty
a <- Parser Ty
type_
  Ty
r <- Parser Ty
type_
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  let c' :: Ty
c' = T -> TypeAnn -> Ty
Ty (Ty -> T
TContract Ty
r) TypeAnn
forall k (a :: k). Annotation a
noAnn
  return (a
f, T -> TypeAnn -> Ty
Ty (FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn Ty
a Ty
c') TypeAnn
t)

t_void :: Default a => Parser a -> Parser (a, Ty)
t_void :: Parser a -> Parser (a, Ty)
t_void Parser a
fp = do
  Text -> Parser ()
symbol' Text
"Void"
  Ty
a <- Parser Ty
type_
  Ty
b <- Parser Ty
type_
  (a
f, TypeAnn
t) <- Parser a -> Parser (a, TypeAnn)
forall a. Default a => Parser a -> Parser (a, TypeAnn)
fieldType Parser a
fp
  let c :: Ty
c = T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
TLambda Ty
b Ty
b) TypeAnn
forall k (a :: k). Annotation a
noAnn
  return (a
f, T -> TypeAnn -> Ty
Ty (FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn Ty
a Ty
c) TypeAnn
t)

t_letType :: Default fp => Parser fp -> Parser (fp, Ty)
t_letType :: Parser fp -> Parser (fp, Ty)
t_letType Parser fp
fp = do
  Map Text LetType
lts <- (LetEnv -> Map Text LetType)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Map Text LetType)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LetEnv -> Map Text LetType
letTypes
  Ty
lt <- LetType -> Ty
ltSig (LetType -> Ty)
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
-> Parser Ty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text LetType
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
mkLetType Map Text LetType
lts)
  fp
f <- Parser fp -> Parser fp
forall a. Default a => Parser a -> Parser a
parseDef Parser fp
fp
  return (fp
f, Ty
lt)

mkLetType :: Map Text LetType -> Parser LetType
mkLetType :: Map Text LetType
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
mkLetType Map Text LetType
lts = [ReaderT LetEnv (Parsec CustomParserException Text) LetType]
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ReaderT LetEnv (Parsec CustomParserException Text) LetType]
 -> ReaderT LetEnv (Parsec CustomParserException Text) LetType)
-> [ReaderT LetEnv (Parsec CustomParserException Text) LetType]
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
forall a b. (a -> b) -> a -> b
$ (LetType -> Text)
-> LetType
-> ReaderT LetEnv (Parsec CustomParserException Text) LetType
forall a. (a -> Text) -> a -> Parser a
mkParser LetType -> Text
ltName (LetType
 -> ReaderT LetEnv (Parsec CustomParserException Text) LetType)
-> [LetType]
-> [ReaderT LetEnv (Parsec CustomParserException Text) LetType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text LetType -> [LetType]
forall k a. Map k a -> [a]
Map.elems Map Text LetType
lts)