Annotations.hs

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

module Michelson.Parser.Annotations
  ( note
  , 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 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 = lexeme $ string (annPrefix @tag) >> (specialNote <|> note' <|> emptyNote)
  where
    -- TODO [#48] these are special annotations and should not always be accepted
    specialVNote = unsafeMkAnnotation <$> asum (map string specialVarAnns)
    specialFNote = unsafeMkAnnotation <$> string specialFieldAnn
    specialNote = specialVNote <|> specialFNote
    emptyNote = pure noAnn
    note' = do
      a <- satisfy isValidAnnStart
      b <- takeWhileP Nothing isValidAnnBodyChar
      return . unsafeMkAnnotation $ T.cons a b

noteV :: Parser VarAnn
noteV = note

noteDef :: KnownAnnTag tag => Parser (Annotation tag)
noteDef = parseDef note

noteF :: Parser FieldAnn
noteF = note

noteV2Def :: Parser (VarAnn, VarAnn)
noteV2Def = permute2Def note note

notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn)
notesTVF = permute3Def note note note

notesTVF2Def :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2Def = permute3Def note note (permute2Def note note)

-- | Parse 0/1/2 var anns and 0/1/2 field anns.
-- It doesn't matter which come first, so long as annotations of the same type appear together.
--
-- E.g.:
--
-- * "" is valid
-- * "%a" is valid
-- * "%a @c" is valid
-- * "%a %b @c @d" is valid
-- * "@c @d %a %b" is valid
-- * "@c %a %b @d" is not valid, because the two var anns are not "grouped" together.
-- * "%a @c @d %b" is not valid, because the two fields anns are not "grouped" together.
notesVVFF :: Parser ((VarAnn, VarAnn), (FieldAnn, FieldAnn))
notesVVFF = permute2Def (liftA2 (,) note noteDef) (liftA2 (,) note noteDef)

notesVF :: Parser (VarAnn, FieldAnn)
notesVF = permute2Def note note

notesTV :: Parser (TypeAnn, VarAnn)
notesTV = permute2Def note note

notesTF :: Parser (TypeAnn, FieldAnn)
notesTF = permute2Def note note

fieldType :: Default a
          => Parser a
          -> Parser (a, TypeAnn)
fieldType fp = runPermutation $
  (,) <$> toPermutationWithDefault  def     fp
      <*> toPermutationWithDefault noAnn note