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

noteV :: Parser VarAnn
noteV = note

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

noteF :: Parser FieldAnn
noteF = note

noteF2 :: Parser (FieldAnn, FieldAnn)
noteF2 = do a <- note; b <- note; return (a, b)

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

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

notesTVF2 :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn))
notesTVF2 = permute3Def note note noteF2

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

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