module Michelson.Parser.Annotations
( note
, 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
note :: forall tag. KnownAnnTag tag => Parser (Annotation tag)
note = lexeme $ string (annPrefix @tag) >> (specialNote <|> note' <|> emptyNote)
where
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
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