module Michelson.Parser.Annotations
( noteV
, noteF
, noteFDef
, noteTDef
, noteVDef
, notesTVF
, notesTVF2
, notesTV
, notesVF
, fieldType
, permute2Def
, permute3Def
) where
import Prelude hiding (note)
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import Data.Char (isAlpha, isAlphaNum, isAscii)
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 as U
import Util.Default
note :: T.Text -> Parser T.Text
note c = lexeme $ string c >> (note' <|> emptyNote)
where
emptyNote = pure ""
note' = do
a <- string "@"
<|> string "%%"
<|> string "%"
<|> T.singleton <$> satisfy (\ x -> isAlpha x && isAscii x)
let validChar x =
isAscii x && (isAlphaNum x || x == '\\' || x == '.' || x == '_')
b <- takeWhileP Nothing validChar
return $ T.append a b
noteT :: Parser U.TypeAnn
noteT = U.ann <$> note ":"
noteV :: Parser U.VarAnn
noteV = U.ann <$> note "@"
noteF :: Parser U.FieldAnn
noteF = U.ann <$> note "%"
noteFDef :: Parser U.FieldAnn
noteFDef = parseDef noteF
noteF2 :: Parser (U.FieldAnn, U.FieldAnn)
noteF2 = do a <- noteF; b <- noteF; return (a, b)
noteTDef :: Parser U.TypeAnn
noteTDef = parseDef noteT
noteVDef :: Parser U.VarAnn
noteVDef = parseDef noteV
notesTVF :: Parser (U.TypeAnn, U.VarAnn, U.FieldAnn)
notesTVF = permute3Def noteT noteV noteF
notesTVF2 :: Parser (U.TypeAnn, U.VarAnn, (U.FieldAnn, U.FieldAnn))
notesTVF2 = permute3Def noteT noteV noteF2
notesTV :: Parser (U.TypeAnn, U.VarAnn)
notesTV = permute2Def noteT noteV
notesVF :: Parser (U.VarAnn, U.FieldAnn)
notesVF = permute2Def noteV noteF
fieldType :: Default a
=> Parser a
-> Parser (a, U.TypeAnn)
fieldType fp = runPermutation $
(,) <$> toPermutationWithDefault def fp
<*> toPermutationWithDefault U.noAnn noteT