module Morley.Michelson.Parser.Annotations
( note
, anyNote
, noteF
, noteV
, noteDef
, noteV2Def
, notesTVF
, notesTVF2Def
, notesVVFF
, notesTV
, notesTF
, notesVF
, fieldType
, permute2Def
, permute3Def
) where
import Prelude hiding (note)
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import Data.Text qualified as T
import Text.Megaparsec (satisfy, takeWhileP)
import Text.Megaparsec.Char (string)
import Morley.Michelson.Parser.Helpers (parseDef)
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types (Parser)
import Morley.Michelson.Untyped.Annotation
import Morley.Util.Default
note :: forall tag. KnownAnnTag tag => Parser (Annotation tag)
note :: forall tag. KnownAnnTag tag => Parser (Annotation tag)
note = Parser (Annotation tag) -> Parser (Annotation tag)
forall a. Parser a -> Parser a
lexeme (Parser (Annotation tag) -> Parser (Annotation tag))
-> Parser (Annotation tag) -> Parser (Annotation tag)
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (forall tag. KnownAnnTag tag => Text
annPrefix @tag) ParsecT CustomParserException Text Identity Text
-> Parser (Annotation tag) -> Parser (Annotation tag)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parser (Annotation tag)
specialNote Parser (Annotation tag)
-> Parser (Annotation tag) -> Parser (Annotation tag)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Annotation tag)
forall {k} {a :: k}.
ParsecT CustomParserException Text Identity (Annotation a)
note' Parser (Annotation tag)
-> Parser (Annotation tag) -> Parser (Annotation tag)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Annotation tag)
forall {k} {a :: k}.
ParsecT CustomParserException Text Identity (Annotation a)
emptyNote)
where
specialVNote :: ParsecT CustomParserException Text Identity (Annotation a)
specialVNote = Either Text (Annotation a) -> Annotation a
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text (Annotation a) -> Annotation a)
-> (Text -> Either Text (Annotation a)) -> Text -> Annotation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Annotation a)
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> Annotation a)
-> ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity (Annotation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT CustomParserException Text Identity Text]
-> ParsecT CustomParserException Text Identity Text
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum ((Text -> ParsecT CustomParserException Text Identity Text)
-> [Text] -> [ParsecT CustomParserException Text Identity Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ParsecT CustomParserException Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
specialVarAnns)
specialFNote :: ParsecT CustomParserException Text Identity (Annotation a)
specialFNote = Either Text (Annotation a) -> Annotation a
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text (Annotation a) -> Annotation a)
-> (Text -> Either Text (Annotation a)) -> Text -> Annotation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Annotation a)
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> Annotation a)
-> ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity (Annotation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
specialFieldAnn
specialNote :: Parser (Annotation tag)
specialNote = Parser (Annotation tag)
forall {k} {a :: k}.
ParsecT CustomParserException Text Identity (Annotation a)
specialVNote Parser (Annotation tag)
-> Parser (Annotation tag) -> Parser (Annotation tag)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Annotation tag)
forall {k} {a :: k}.
ParsecT CustomParserException Text Identity (Annotation a)
specialFNote
emptyNote :: ParsecT CustomParserException Text Identity (Annotation a)
emptyNote = Annotation a
-> ParsecT CustomParserException Text Identity (Annotation a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation a
forall {k} (a :: k). Annotation a
noAnn
note' :: ParsecT CustomParserException Text Identity (Annotation a)
note' = do
Char
a <- (Token Text -> Bool)
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isValidAnnStart
Text
b <- Maybe String
-> (Token Text -> Bool)
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isValidAnnBodyChar
Annotation a
-> ParsecT CustomParserException Text Identity (Annotation a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation a
-> ParsecT CustomParserException Text Identity (Annotation a))
-> (Text -> Annotation a)
-> Text
-> ParsecT CustomParserException Text Identity (Annotation a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text (Annotation a) -> Annotation a
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text (Annotation a) -> Annotation a)
-> (Text -> Either Text (Annotation a)) -> Text -> Annotation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Annotation a)
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text
-> ParsecT CustomParserException Text Identity (Annotation a))
-> Text
-> ParsecT CustomParserException Text Identity (Annotation a)
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
a Text
b
anyNote :: Parser AnyAnn
anyNote :: Parser AnyAnn
anyNote =
Annotation TypeTag -> AnyAnn
AnyAnnType (Annotation TypeTag -> AnyAnn)
-> ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> Parser AnyAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tag. KnownAnnTag tag => Parser (Annotation tag)
note @TypeTag
Parser AnyAnn -> Parser AnyAnn -> Parser AnyAnn
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Annotation FieldTag -> AnyAnn
AnyAnnField (Annotation FieldTag -> AnyAnn)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> Parser AnyAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tag. KnownAnnTag tag => Parser (Annotation tag)
note @FieldTag
Parser AnyAnn -> Parser AnyAnn -> Parser AnyAnn
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Annotation VarTag -> AnyAnn
AnyAnnVar (Annotation VarTag -> AnyAnn)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser AnyAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tag. KnownAnnTag tag => Parser (Annotation tag)
note @VarTag
noteV :: Parser VarAnn
noteV :: ParsecT CustomParserException Text Identity (Annotation VarTag)
noteV = ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
noteDef :: KnownAnnTag tag => Parser (Annotation tag)
noteDef :: forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef = Parser (Annotation tag) -> Parser (Annotation tag)
forall a. Default a => Parser a -> Parser a
parseDef Parser (Annotation tag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
noteF :: Parser FieldAnn
noteF :: ParsecT CustomParserException Text Identity (Annotation FieldTag)
noteF = ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
noteV2Def :: Parser (VarAnn, VarAnn)
noteV2Def :: Parser (Annotation VarTag, Annotation VarTag)
noteV2Def = ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser (Annotation VarTag, Annotation VarTag)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn)
notesTVF :: Parser (Annotation TypeTag, Annotation VarTag, Annotation FieldTag)
notesTVF = ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> Parser
(Annotation TypeTag, Annotation VarTag, Annotation FieldTag)
forall a b c (f :: * -> *).
(Default a, Default b, Default c, Monad f, Alternative f) =>
f a -> f b -> f c -> f (a, b, c)
permute3Def ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
notesTVF2Def :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2Def :: Parser
(Annotation TypeTag, Annotation VarTag,
(Annotation FieldTag, Annotation FieldTag))
notesTVF2Def = ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT
CustomParserException
Text
Identity
(Annotation FieldTag, Annotation FieldTag)
-> Parser
(Annotation TypeTag, Annotation VarTag,
(Annotation FieldTag, Annotation FieldTag))
forall a b c (f :: * -> *).
(Default a, Default b, Default c, Monad f, Alternative f) =>
f a -> f b -> f c -> f (a, b, c)
permute3Def ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note (ParsecT CustomParserException Text Identity (Annotation FieldTag)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> ParsecT
CustomParserException
Text
Identity
(Annotation FieldTag, Annotation FieldTag)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note)
notesVVFF :: Parser ((VarAnn, VarAnn), (FieldAnn, FieldAnn))
notesVVFF :: Parser
((Annotation VarTag, Annotation VarTag),
(Annotation FieldTag, Annotation FieldTag))
notesVVFF = Parser (Annotation VarTag, Annotation VarTag)
-> ParsecT
CustomParserException
Text
Identity
(Annotation FieldTag, Annotation FieldTag)
-> Parser
((Annotation VarTag, Annotation VarTag),
(Annotation FieldTag, Annotation FieldTag))
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ((Annotation VarTag
-> Annotation VarTag -> (Annotation VarTag, Annotation VarTag))
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser (Annotation VarTag, Annotation VarTag)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef) ((Annotation FieldTag
-> Annotation FieldTag
-> (Annotation FieldTag, Annotation FieldTag))
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> ParsecT
CustomParserException
Text
Identity
(Annotation FieldTag, Annotation FieldTag)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef)
notesVF :: Parser (VarAnn, FieldAnn)
notesVF :: Parser (Annotation VarTag, Annotation FieldTag)
notesVF = ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> Parser (Annotation VarTag, Annotation FieldTag)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
notesTV :: Parser (TypeAnn, VarAnn)
notesTV :: Parser (Annotation TypeTag, Annotation VarTag)
notesTV = ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser (Annotation TypeTag, Annotation VarTag)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
notesTF :: Parser (TypeAnn, FieldAnn)
notesTF :: Parser (Annotation TypeTag, Annotation FieldTag)
notesTF = ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> ParsecT
CustomParserException Text Identity (Annotation FieldTag)
-> Parser (Annotation TypeTag, Annotation FieldTag)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note
fieldType :: Default a
=> Parser a
-> Parser (a, TypeAnn)
fieldType :: forall a. Default a => Parser a -> Parser (a, Annotation TypeTag)
fieldType Parser a
fp = Permutation
(ParsecT CustomParserException Text Identity)
(a, Annotation TypeTag)
-> ParsecT
CustomParserException Text Identity (a, Annotation TypeTag)
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CustomParserException Text Identity)
(a, Annotation TypeTag)
-> ParsecT
CustomParserException Text Identity (a, Annotation TypeTag))
-> Permutation
(ParsecT CustomParserException Text Identity)
(a, Annotation TypeTag)
-> ParsecT
CustomParserException Text Identity (a, Annotation TypeTag)
forall a b. (a -> b) -> a -> b
$
(,) (a -> Annotation TypeTag -> (a, Annotation TypeTag))
-> Permutation (ParsecT CustomParserException Text Identity) a
-> Permutation
(ParsecT CustomParserException Text Identity)
(Annotation TypeTag -> (a, Annotation TypeTag))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Parser a
-> Permutation (ParsecT CustomParserException Text Identity) a
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault a
forall a. Default a => a
def Parser a
fp
Permutation
(ParsecT CustomParserException Text Identity)
(Annotation TypeTag -> (a, Annotation TypeTag))
-> Permutation
(ParsecT CustomParserException Text Identity) (Annotation TypeTag)
-> Permutation
(ParsecT CustomParserException Text Identity)
(a, Annotation TypeTag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotation TypeTag
-> ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> Permutation
(ParsecT CustomParserException Text Identity) (Annotation TypeTag)
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Annotation TypeTag
forall {k} (a :: k). Annotation a
noAnn ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note