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

module Michelson.Parser.Annotations
  ( note
  , noteF
  , noteV
  , noteDef
  , noteV2Def
  , notesTVF
  , notesTVF2
  , notesTVF2Def
  , notesTV
  , notesTF
  , notesVF
  , fieldType
  , permute2Def
  , permute3Def
  ) where

import Prelude hiding (note)

import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import qualified Data.Text as T
import Text.Megaparsec (satisfy, takeWhileP)
import Text.Megaparsec.Char (string)

import Michelson.Parser.Helpers (parseDef)
import Michelson.Parser.Lexer
import Michelson.Parser.Types (Parser)
import Michelson.Untyped.Annotation
import Util.Default

-- | General T/V/F Annotation parser, including Special Annotations
note :: forall tag. KnownAnnTag tag => Parser (Annotation tag)
note :: 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
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (KnownAnnTag tag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @tag) ReaderT LetEnv (Parsec CustomParserException Text) 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).
ReaderT LetEnv (Parsec CustomParserException Text) (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).
ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
emptyNote)
  where
    -- TODO [#48] these are special annotations and should not always be accepted
    specialVNote :: ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
specialVNote = Text -> Annotation a
forall k (a :: k). HasCallStack => Text -> Annotation a
ann (Text -> Annotation a)
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ReaderT LetEnv (Parsec CustomParserException Text) Text]
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum ((Text -> ReaderT LetEnv (Parsec CustomParserException Text) Text)
-> [Text]
-> [ReaderT LetEnv (Parsec CustomParserException Text) Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ReaderT LetEnv (Parsec CustomParserException Text) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
specialVarAnns)
    specialFNote :: ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
specialFNote = Text -> Annotation a
forall k (a :: k). HasCallStack => Text -> Annotation a
ann (Text -> Annotation a)
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (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).
ReaderT LetEnv (Parsec CustomParserException Text) (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).
ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
specialFNote
    emptyNote :: ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
emptyNote = Annotation a
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation a
forall k (a :: k). Annotation a
noAnn
    note' :: ReaderT LetEnv (Parsec CustomParserException Text) (Annotation a)
note' = do
      Char
a <- (Token Text -> Bool)
-> ReaderT LetEnv (Parsec CustomParserException Text) (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)
-> ReaderT LetEnv (Parsec CustomParserException Text) (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
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation a
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (Annotation a))
-> (Text -> Annotation a)
-> Text
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Annotation a
forall k (a :: k). HasCallStack => Text -> Annotation a
ann (Text
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (Annotation a))
-> Text
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Annotation a)
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
a Text
b

noteV :: Parser VarAnn
noteV :: Parser VarAnn
noteV = Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

noteDef :: KnownAnnTag tag => Parser (Annotation tag)
noteDef :: 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 :: Parser FieldAnn
noteF = Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

noteF2 :: Parser (FieldAnn, FieldAnn)
noteF2 :: Parser (FieldAnn, FieldAnn)
noteF2 = do FieldAnn
a <- Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note; FieldAnn
b <- Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note; return (FieldAnn
a, FieldAnn
b)

noteV2Def :: Parser (VarAnn, VarAnn)
noteV2Def :: Parser (VarAnn, VarAnn)
noteV2Def = Parser VarAnn -> Parser VarAnn -> Parser (VarAnn, VarAnn)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn)
notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn)
notesTVF = ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Parser VarAnn
-> Parser FieldAnn
-> Parser (TypeAnn, VarAnn, FieldAnn)
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 ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

notesTVF2 :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2 :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2 = ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Parser VarAnn
-> Parser (FieldAnn, FieldAnn)
-> Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
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 ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser (FieldAnn, FieldAnn)
noteF2

notesTVF2Def :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2Def :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2Def = ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Parser VarAnn
-> Parser (FieldAnn, FieldAnn)
-> Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
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 ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note (Parser FieldAnn -> Parser FieldAnn -> Parser (FieldAnn, FieldAnn)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note)

notesVF :: Parser (VarAnn, FieldAnn)
notesVF :: Parser (VarAnn, FieldAnn)
notesVF = Parser VarAnn -> Parser FieldAnn -> Parser (VarAnn, FieldAnn)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

notesTV :: Parser (TypeAnn, VarAnn)
notesTV :: Parser (TypeAnn, VarAnn)
notesTV = ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Parser VarAnn -> Parser (TypeAnn, VarAnn)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser VarAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

notesTF :: Parser (TypeAnn, FieldAnn)
notesTF :: Parser (TypeAnn, FieldAnn)
notesTF = ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Parser FieldAnn -> Parser (TypeAnn, FieldAnn)
forall a b (f :: * -> *).
(Default a, Default b, Monad f, Alternative f) =>
f a -> f b -> f (a, b)
permute2Def ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note Parser FieldAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note

fieldType :: Default a
          => Parser a
          -> Parser (a, TypeAnn)
fieldType :: Parser a -> Parser (a, TypeAnn)
fieldType fp :: Parser a
fp = Permutation
  (ReaderT LetEnv (Parsec CustomParserException Text)) (a, TypeAnn)
-> Parser (a, TypeAnn)
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation (Permutation
   (ReaderT LetEnv (Parsec CustomParserException Text)) (a, TypeAnn)
 -> Parser (a, TypeAnn))
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) (a, TypeAnn)
-> Parser (a, TypeAnn)
forall a b. (a -> b) -> a -> b
$
  (,) (a -> TypeAnn -> (a, TypeAnn))
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) a
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text))
     (TypeAnn -> (a, TypeAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Parser a
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) a
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault  a
forall a. Default a => a
def     Parser a
fp
      Permutation
  (ReaderT LetEnv (Parsec CustomParserException Text))
  (TypeAnn -> (a, TypeAnn))
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) TypeAnn
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) (a, TypeAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeAnn
-> ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
-> Permutation
     (ReaderT LetEnv (Parsec CustomParserException Text)) TypeAnn
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault TypeAnn
forall k (a :: k). Annotation a
noAnn ReaderT LetEnv (Parsec CustomParserException Text) TypeAnn
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note