| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Morley.Michelson.Parser
Synopsis
- type Parser = Parsec CustomParserException Text
- program :: Parsec CustomParserException Text (Contract' ParsedOp)
- value :: Parser 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 :: Parser a -> MichelsonSource -> Text -> Either (ParseErrorBundle Text CustomParserException) a
- parseValue :: MichelsonSource -> Text -> Either ParserException ParsedValue
- parseExpandValue :: MichelsonSource -> Text -> Either ParserException Value
- parseType :: MichelsonSource -> Text -> Either ParserException Ty
- rawOpsSequence :: Parser a -> Parser [ParsedOp]
- codeEntry :: Parser ParsedOp
- ops :: Parser (ParsedSeq ParsedOp)
- type_ :: Parser Ty
- stringLiteral :: Parser ParsedValue
- bytesLiteral :: Parser (Value' f op)
- intLiteral :: Parser (Value' f op)
- parsedOp :: Parser ParsedOp
- cbParameterBare :: Parser ParameterType
- utypeQ :: QuasiQuoter
- uparamTypeQ :: QuasiQuoter
- notes :: QuasiQuoter
- errorBundlePretty :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String
Main parser type
Parsers
Errors
data CustomParserException Source #
Constructors
| StringLiteralException StringLiteralParserException | |
| ViewNameException BadViewNameError | |
| OddNumberBytesException | |
| ExcessFieldAnnotation |
Instances
data ParseErrorBundle s e #
A non-empty collection of ParseErrors equipped with PosState that
allows us to pretty-print the errors efficiently and correctly.
Since: megaparsec-7.0.0
Instances
data ParserException Source #
Constructors
| ParserException (ParseErrorBundle Text CustomParserException) |
Instances
| Exception ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods toException :: ParserException -> SomeException # | |
| Show ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods showsPrec :: Int -> ParserException -> ShowS # show :: ParserException -> String # showList :: [ParserException] -> ShowS # | |
| Eq ParserException Source # | |
Defined in Morley.Michelson.Parser.Error Methods (==) :: ParserException -> ParserException -> Bool # (/=) :: ParserException -> ParserException -> Bool # | |
| Buildable ParserException Source # | |
Defined in Morley.Michelson.Parser.Error | |
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
| IsString MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods fromString :: String -> MichelsonSource # | |
| Show MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods showsPrec :: Int -> MichelsonSource -> ShowS # show :: MichelsonSource -> String # showList :: [MichelsonSource] -> ShowS # | |
| Eq MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types Methods (==) :: MichelsonSource -> MichelsonSource -> Bool # (/=) :: MichelsonSource -> MichelsonSource -> Bool # | |
| Buildable MichelsonSource Source # | |
Defined in Morley.Michelson.Parser.Types | |
codeSrc :: HasCallStack => MichelsonSource Source #
MichelsonSource that points to the current position.
parseNoEnv :: Parser 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.
parseType :: MichelsonSource -> Text -> Either ParserException Ty Source #
rawOpsSequence :: Parser a -> Parser [ParsedOp] Source #
Michelson sequence of instructions, separated with a semicolon. Last
semicolon is optional, semicolon after } is optional.
The first argument is the sequence terminator, that is to say, usually }. This
might look mysterious, until one considers the alternatives. For example:
>>>let fmt = either (putStrLn . displayException . ParserException) (const $ pure ())>>>parseNoEnv (braces (sepEndBy parsedOp semicolon)) "" "{ DIIIP CMPEQ }" & fmt... 1 | { DIIIP CMPEQ } | ^ unexpected 'D' expecting '}' ...>>>parseNoEnv (symbol "{" *> rawOpsSequence (symbol "}")) "" "{ DIIIP CMPEQ }" & fmt... 1 | { DIIIP CMPEQ } | ^ unexpected 'C' ...
This happens because braces . sepEndBy backtracks a bit too far.
Note that braces . sepEndBy doesn't match Michelson syntax exactly, it's used
as an example only.
For tests
codeEntry :: Parser ParsedOp Source #
Parses code block after "code" keyword of a contract, or code in a view block.
This parses arbitrary type expressions.
Note that this includes parenthesized ones.
That is to say, int, (int), ((int)), etc will match with this parser and produce TInt.
bytesLiteral :: Parser (Value' f op) Source #
intLiteral :: Parser (Value' f op) Source #
parsedOp :: Parser ParsedOp Source #
>>>let fmt = either (putStrLn . displayException . ParserException) (const $ pure ())>>>parseNoEnv parsedOp "" "{a}" & fmt1:2: | 1 | {a} | ^^ unexpected "a}" expecting '{', '}', macro, or primitive instruction
>>>parseNoEnv parsedOp "" "{ UNIT; DIIIP CMPEQ }" & fmt1:15: | 1 | { UNIT; DIIIP CMPEQ } | ^ unexpected 'C'
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 pass over the input stream. The rendered String
always ends with a newline.
Since: megaparsec-7.0.0