| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Morley.Michelson.Parser
Synopsis
- type Parser a r = HasLetEnv a => Parser' a r
- program :: Parsec CustomParserException Text (Contract' ParsedOp)
- programExt :: Parsec CustomParserException Text (Contract' ParsedOp)
- value :: Parser le ParsedValue
- data CustomParserException
- data ParseErrorBundle s e
- data ParserException = ParserException (ParseErrorBundle Text CustomParserException)
- data StringLiteralParserException
- data MichelsonSource where
- MSFile FilePath
- MSName Text
- MSCode SrcLoc
- MSUnspecified
- pattern MSStdin :: MichelsonSource
- pattern MSCli :: MichelsonSource
- codeSrc :: HasCallStack => MichelsonSource
- parseNoEnv :: Default le => Parser' le a -> MichelsonSource -> Text -> Either (ParseErrorBundle Text CustomParserException) a
- parseValue :: MichelsonSource -> Text -> Either ParserException ParsedValue
- parseExpandValue :: MichelsonSource -> Text -> Either ParserException Value
- codeEntry :: Parser le [ParsedOp]
- ops :: Parser le [ParsedOp]
- type_ :: Parser le Ty
- letInner :: Parser' LetEnv ParsedOp -> Parser' LetEnv LetEnv
- letType :: Parser' LetEnv LetType
- stringLiteral :: forall le. Parser le ParsedValue
- bytesLiteral :: Parser le (Value' op)
- intLiteral :: Parser le (Value' op)
- parsedOp :: Parser le ParsedOp
- printComment :: Parser' LetEnv PrintComment
- utypeQ :: QuasiQuoter
- uparamTypeQ :: QuasiQuoter
- notes :: QuasiQuoter
- errorBundlePretty :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String
Main parser type
Parsers
programExt :: Parsec CustomParserException Text (Contract' ParsedOp) Source #
Michelson contract with let definitions
value :: Parser le ParsedValue Source #
Errors
data CustomParserException Source #
Constructors
| StringLiteralException StringLiteralParserException | |
| ViewNameException BadViewNameError | |
| OddNumberBytesException | |
| WrongTagArgs Natural Positive | Deprecated: Exceptions specific to deprecated Morley language extensions |
| WrongAccessArgs Natural Positive | Deprecated: Exceptions specific to deprecated Morley language extensions |
| WrongSetArgs Natural Positive | Deprecated: Exceptions specific to deprecated Morley language extensions |
| ExcessFieldAnnotation | |
| MultiRootAnnotationException | |
| DeprecatedException |
Instances
data ParseErrorBundle s e #
A non-empty collection of ParseErrors equipped with PosState that
allows to pretty-print the errors efficiently and correctly.
Since: megaparsec-7.0.0
Instances
data ParserException Source #
Constructors
| ParserException (ParseErrorBundle Text CustomParserException) |
Instances
| Eq ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods (==) :: ParserException -> ParserException -> Bool # (/=) :: ParserException -> ParserException -> Bool # | |
| Show ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods showsPrec :: Int -> ParserException -> ShowS # show :: ParserException -> String # showList :: [ParserException] -> ShowS # | |
| Exception ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods toException :: ParserException -> SomeException # | |
| Buildable ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods build :: ParserException -> Builder # | |
data StringLiteralParserException Source #
Constructors
| InvalidEscapeSequence Char | |
| InvalidChar Char |
Instances
Additional helpers
data MichelsonSource Source #
Where a contract or value in Michelson comes from.
Constructors
| MSFile FilePath | From given file. |
| MSName Text | Only source name is known. |
| MSCode SrcLoc | Defined in Haskell code. |
| MSUnspecified | Some unknown source. |
Bundled Patterns
| pattern MSStdin :: MichelsonSource | Designates |
| pattern MSCli :: MichelsonSource | Designates command line input source. |
Instances
| Eq MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods (==) :: MichelsonSource -> MichelsonSource -> Bool # (/=) :: MichelsonSource -> MichelsonSource -> Bool # | |
| Show MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods showsPrec :: Int -> MichelsonSource -> ShowS # show :: MichelsonSource -> String # showList :: [MichelsonSource] -> ShowS # | |
| IsString MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods fromString :: String -> MichelsonSource # | |
| Buildable MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods build :: MichelsonSource -> Builder # | |
codeSrc :: HasCallStack => MichelsonSource Source #
MichelsonSource that points to the current position.
parseNoEnv :: Default le => Parser' le a -> MichelsonSource -> Text -> Either (ParseErrorBundle Text CustomParserException) a Source #
Parse with empty environment
parseValue :: MichelsonSource -> Text -> Either ParserException ParsedValue Source #
Parse untyped value from text which comes from something that is not a file (which is often the case). So we assume it does not need any parsing environment.
>>>parseValue MSUnspecified "{PUSH int aaa}" & either (putStrLn . displayException) (const $ pure ())1:11: | 1 | {PUSH int aaa} | ^^^^ unexpected "aaa}" expecting value
parseExpandValue :: MichelsonSource -> Text -> Either ParserException Value Source #
Like parseValue, but also expands macros.
For tests
codeEntry :: Parser le [ParsedOp] Source #
Parses code block after "code" keyword of a contract.
This function is part of the module API, its semantics should not change.
type_ :: Parser le Ty Source #
This parses arbitrary type expressions.
Note that this includes parenthesized ones for efficiency, see t_operator.
That is to say, int, (int), ((int)), etc will match with this parser and produce TInt.
letInner :: Parser' LetEnv ParsedOp -> Parser' LetEnv LetEnv Source #
Incrementally build the let environment
stringLiteral :: forall le. Parser le ParsedValue Source #
bytesLiteral :: Parser le (Value' op) Source #
intLiteral :: Parser le (Value' op) Source #
parsedOp :: Parser le ParsedOp Source #
>>>parseNoEnv @() parsedOp "" "{a}" & either (putStrLn . displayException . ParserException) (const $ pure ())1:2: | 1 | {a} | ^ unexpected 'a' expecting '{', '}', macro, or primitive instruction>>>:m + Morley.Michelson.Parser.Types>>>parseNoEnv @LetEnv parsedOp "" "{a}" & either (putStrLn . displayException . ParserException) (const $ pure ())... 1:2: | 1 | {a} | ^ unexpected 'a' expecting '{', '}', macro, morley instruction, or primitive instruction
Quoters
utypeQ :: QuasiQuoter Source #
Creates Ty by its Morley representation.
>>>[utypeQ| or (int :a) (nat :b) |]Ty (TOr (UnsafeAnnotation @FieldTag "") (UnsafeAnnotation @FieldTag "") (Ty TInt (UnsafeAnnotation @TypeTag "a")) (Ty TNat (UnsafeAnnotation @TypeTag "b"))) (UnsafeAnnotation @TypeTag "")
>>>[utypeQ|a|]... | 1 | a | ^ unexpected 'a' expecting type ...
uparamTypeQ :: QuasiQuoter Source #
Creates ParameterType by its Morley representation.
notes :: QuasiQuoter Source #
Parses and typechecks a Notes.
>>>[notes|int :ty|]NTInt (UnsafeAnnotation @TypeTag "ty")
Re-exports
Arguments
| :: (VisualStream s, TraversableStream s, ShowErrorComponent e) | |
| => ParseErrorBundle s e | Parse error bundle to display |
| -> String | Textual rendition of the bundle |
Pretty-print a ParseErrorBundle. All ParseErrors in the bundle will
be pretty-printed in order together with the corresponding offending
lines by doing a single efficient pass over the input stream. The
rendered String always ends with a newline.
Since: megaparsec-7.0.0