{-# OPTIONS_GHC -Wno-deprecations -Wno-redundant-constraints #-}
module Morley.Michelson.Parser
(
Parser
, program
, programExt
, value
, CustomParserException (..)
, ParseErrorBundle
, ParserException (..)
, StringLiteralParserException (..)
, MichelsonSource (..)
, codeSrc
, parseNoEnv
, parseValue
, parseExpandValue
, codeEntry
, ops
, type_
, letInner
, letType
, stringLiteral
, bytesLiteral
, intLiteral
, parsedOp
, printComment
, utypeQ
, uparamTypeQ
, notes
, errorBundlePretty
) where
import Prelude hiding (try)
import Data.Default (Default(..))
import Fmt (pretty, (+|), (|+))
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Text.Megaparsec
(Parsec, choice, customFailure, eitherP, eof, errorBundlePretty, getSourcePos, hidden, lookAhead,
parse, sepEndBy, try)
import Text.Megaparsec.Pos (SourcePos(..), unPos)
import Morley.Michelson.ErrorPos (SrcPos(..), mkPos)
import Morley.Michelson.Macro (Macro(..), ParsedInstr, ParsedOp(..), ParsedValue, expandValue)
import Morley.Michelson.Parser.Annotations (noteF)
import Morley.Michelson.Parser.Common
import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Ext
import Morley.Michelson.Parser.Instr
import Morley.Michelson.Parser.Let
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Macro
import Morley.Michelson.Parser.Type
import Morley.Michelson.Parser.Types
import Morley.Michelson.Parser.Value
import Morley.Michelson.Typed.Extract (withUType)
import Morley.Michelson.Untyped
import Morley.Michelson.Untyped qualified as U
parseNoEnv ::
Default le
=> Parser' le a
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
parseNoEnv :: Parser' le a
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
parseNoEnv Parser' le a
p MichelsonSource
src = Parsec CustomParserException Text a
-> String
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser' le a -> le -> Parsec CustomParserException Text a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Parser' le a
p le
forall a. Default a => a
def Parsec CustomParserException Text a
-> Parsec CustomParserException Text ()
-> Parsec CustomParserException Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec CustomParserException Text ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) (MichelsonSource -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty MichelsonSource
src)
program :: Parsec CustomParserException Text (Contract' ParsedOp)
program :: Parsec CustomParserException Text (Contract' ParsedOp)
program = ReaderT () (Parsec CustomParserException Text) (Contract' ParsedOp)
-> () -> Parsec CustomParserException Text (Contract' ParsedOp)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Default () => Parser () (Contract' ParsedOp)
forall env. Default env => Parser env (Contract' ParsedOp)
programInner @()) ()
forall a. Default a => a
def Parsec CustomParserException Text (Contract' ParsedOp)
-> Parsec CustomParserException Text ()
-> Parsec CustomParserException Text (Contract' ParsedOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec CustomParserException Text ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
programInner
:: forall env. (Default env)
=> Parser env (Contract' ParsedOp)
programInner :: Parser' env (Contract' ParsedOp)
programInner = do
Parser' env ()
forall le. Parser le ()
mSpace
env
env <- env -> Maybe env -> env
forall a. a -> Maybe a -> a
fromMaybe env
forall a. Default a => a
def (Maybe env -> env)
-> ReaderT env (Parsec CustomParserException Text) (Maybe env)
-> ReaderT env (Parsec CustomParserException Text) env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT env (Parsec CustomParserException Text) env
-> ReaderT env (Parsec CustomParserException Text) (Maybe env)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser' env ParsedOp -> Parser env env
forall le. Parser' le ParsedOp -> Parser le le
letBlock Parser' env ParsedOp
forall le. Parser le ParsedOp
parsedOp))
(env -> env)
-> Parser' env (Contract' ParsedOp)
-> Parser' env (Contract' ParsedOp)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (env -> env -> env
forall a b. a -> b -> a
const env
env) Parser' env (Contract' ParsedOp)
forall le. Parser le (Contract' ParsedOp)
contract
programExt :: Parsec CustomParserException Text (Contract' ParsedOp)
programExt :: Parsec CustomParserException Text (Contract' ParsedOp)
programExt = ReaderT
LetEnv (Parsec CustomParserException Text) (Contract' ParsedOp)
-> LetEnv -> Parsec CustomParserException Text (Contract' ParsedOp)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Default LetEnv => Parser LetEnv (Contract' ParsedOp)
forall env. Default env => Parser env (Contract' ParsedOp)
programInner @LetEnv) LetEnv
forall a. Default a => a
def Parsec CustomParserException Text (Contract' ParsedOp)
-> Parsec CustomParserException Text ()
-> Parsec CustomParserException Text (Contract' ParsedOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec CustomParserException Text ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
cbParameter :: Parser le ParameterType
cbParameter :: Parser' le ParameterType
cbParameter = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol1 Tokens Text
"parameter" Parser' le ()
-> Parser' le ParameterType -> Parser' le ParameterType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' le ParameterType
forall le. Parser le ParameterType
cbParameterBare
cbParameterBare :: Parser le ParameterType
cbParameterBare :: Parser' le ParameterType
cbParameterBare = do
Maybe FieldAnn
prefixRootAnn <- ReaderT le (Parsec CustomParserException Text) FieldAnn
-> ReaderT le (Parsec CustomParserException Text) (Maybe FieldAnn)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ReaderT le (Parsec CustomParserException Text) FieldAnn
forall le. Parser le FieldAnn
noteF
(FieldAnn
inTypeRootAnn, Ty
t) <- Parser' le (FieldAnn, Ty)
forall le. Parser le (FieldAnn, Ty)
field
FieldAnn
rootAnn <- case (Maybe FieldAnn
prefixRootAnn, FieldAnn
inTypeRootAnn) of
(Just FieldAnn
a, FieldAnn
b) | FieldAnn
a FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall k (a :: k). Annotation a
noAnn Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& FieldAnn
b FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall k (a :: k). Annotation a
noAnn -> FieldAnn -> ReaderT le (Parsec CustomParserException Text) FieldAnn
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldAnn
forall k (a :: k). Annotation a
noAnn
(Just FieldAnn
a, FieldAnn
b) | FieldAnn
b FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall k (a :: k). Annotation a
noAnn -> FieldAnn -> ReaderT le (Parsec CustomParserException Text) FieldAnn
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldAnn
a
(Maybe FieldAnn
Nothing, FieldAnn
b) -> FieldAnn -> ReaderT le (Parsec CustomParserException Text) FieldAnn
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldAnn
b
(Just FieldAnn
_, FieldAnn
_) -> CustomParserException
-> ReaderT le (Parsec CustomParserException Text) FieldAnn
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomParserException
MultiRootAnnotationException
pure $ Ty -> FieldAnn -> ParameterType
ParameterType Ty
t FieldAnn
rootAnn
cbStorage :: Parser le Ty
cbStorage :: Parser' le Ty
cbStorage = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol1 Tokens Text
"storage" Parser' le () -> Parser' le Ty -> Parser' le Ty
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' le Ty
forall le. Parser le Ty
type_
cbCode :: Parser le [ParsedOp]
cbCode :: Parser' le [ParsedOp]
cbCode = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"code" Parser' le () -> Parser' le [ParsedOp] -> Parser' le [ParsedOp]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' le [ParsedOp]
forall le. Parser le [ParsedOp]
codeEntry
cbView :: Parser le (View' ParsedOp)
cbView :: Parser' le (View' ParsedOp)
cbView = do
Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"view"
ViewName
viewName <- Parser' le ViewName
forall le. Parser le ViewName
viewName_
Ty
viewArgument <- Parser' le Ty
forall le. Parser le Ty
type_
Ty
viewReturn <- Parser' le Ty
forall le. Parser le Ty
type_
[ParsedOp]
viewCode <- Parser' le [ParsedOp]
forall le. Parser le [ParsedOp]
ops
return View :: forall op. ViewName -> Ty -> Ty -> [op] -> View' op
View{[ParsedOp]
Ty
ViewName
viewCode :: [ParsedOp]
viewReturn :: Ty
viewArgument :: Ty
viewName :: ViewName
viewCode :: [ParsedOp]
viewReturn :: Ty
viewArgument :: Ty
viewName :: ViewName
..}
contractBlock :: Parser le (ContractBlock ParsedOp)
contractBlock :: Parser' le (ContractBlock ParsedOp)
contractBlock = [Parser' le (ContractBlock ParsedOp)]
-> Parser' le (ContractBlock ParsedOp)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (ParameterType -> ContractBlock ParsedOp
forall op. ParameterType -> ContractBlock op
CBParam (ParameterType -> ContractBlock ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) ParameterType
-> Parser' le (ContractBlock ParsedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) ParameterType
forall le. Parser le ParameterType
cbParameter)
, (Ty -> ContractBlock ParsedOp
forall op. Ty -> ContractBlock op
CBStorage (Ty -> ContractBlock ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) Ty
-> Parser' le (ContractBlock ParsedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) Ty
forall le. Parser le Ty
cbStorage)
, ([ParsedOp] -> ContractBlock ParsedOp
forall op. [op] -> ContractBlock op
CBCode ([ParsedOp] -> ContractBlock ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> Parser' le (ContractBlock ParsedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
cbCode)
, (View' ParsedOp -> ContractBlock ParsedOp
forall op. View' op -> ContractBlock op
CBView (View' ParsedOp -> ContractBlock ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) (View' ParsedOp)
-> Parser' le (ContractBlock ParsedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) (View' ParsedOp)
forall le. Parser le (View' ParsedOp)
cbView)
]
ensureNotDuplicate :: [ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
ensureNotDuplicate :: [ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
ensureNotDuplicate [ContractBlock ParsedOp]
blocks ContractBlock ParsedOp
result =
let
failDuplicateField :: a -> m a
failDuplicateField a
a = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ Builder
"Duplicate contract field: " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| a
a a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
in
case (ContractBlock ParsedOp
result, [ContractBlock ParsedOp]
blocks) of
(CBParam ParameterType
_, CBParam ParameterType
_ : [ContractBlock ParsedOp]
_) -> ContractBlock ParsedOp -> Parser' le ()
forall (m :: * -> *) a a. (MonadFail m, Buildable a) => a -> m a
failDuplicateField ContractBlock ParsedOp
result
(CBStorage Ty
_, CBStorage Ty
_: [ContractBlock ParsedOp]
_) -> ContractBlock ParsedOp -> Parser' le ()
forall (m :: * -> *) a a. (MonadFail m, Buildable a) => a -> m a
failDuplicateField ContractBlock ParsedOp
result
(CBCode [ParsedOp]
_, CBCode [ParsedOp]
_: [ContractBlock ParsedOp]
_) -> ContractBlock ParsedOp -> Parser' le ()
forall (m :: * -> *) a a. (MonadFail m, Buildable a) => a -> m a
failDuplicateField ContractBlock ParsedOp
result
(CBView View' ParsedOp
_, [ContractBlock ParsedOp]
_) -> () -> Parser' le ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(ContractBlock ParsedOp
_, ContractBlock ParsedOp
_:[ContractBlock ParsedOp]
xs) -> [ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
forall le.
[ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
ensureNotDuplicate [ContractBlock ParsedOp]
xs ContractBlock ParsedOp
result
(ContractBlock ParsedOp
_, []) -> () -> Parser' le ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
contract :: Parser le (Contract' ParsedOp)
contract :: Parser' le (Contract' ParsedOp)
contract = do
Parser' le ()
forall le. Parser le ()
mSpace
[ContractBlock ParsedOp]
result <- Parser le [ContractBlock ParsedOp]
-> Parser le [ContractBlock ParsedOp]
forall le a. Parser le a -> Parser le a
braces Parser' le [ContractBlock ParsedOp]
Parser le [ContractBlock ParsedOp]
contractTuple Parser' le [ContractBlock ParsedOp]
-> Parser' le [ContractBlock ParsedOp]
-> Parser' le [ContractBlock ParsedOp]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le [ContractBlock ParsedOp]
contractTuple
case [ContractBlock ParsedOp] -> Maybe (Contract' ParsedOp)
forall op. [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock [ContractBlock ParsedOp]
result of
Just Contract' ParsedOp
contract' ->
Contract' ParsedOp -> Parser' le (Contract' ParsedOp)
forall (m :: * -> *) a. Monad m => a -> m a
return Contract' ParsedOp
contract'
Maybe (Contract' ParsedOp)
Nothing ->
String -> Parser' le (Contract' ParsedOp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser' le (Contract' ParsedOp))
-> String -> Parser' le (Contract' ParsedOp)
forall a b. (a -> b) -> a -> b
$ String
"Duplicate contract field: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [ContractBlock ParsedOp] -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty [ContractBlock ParsedOp]
result
where
contractTuple :: Parser' le [ContractBlock ParsedOp]
contractTuple = ([ContractBlock ParsedOp] -> [ContractBlock ParsedOp])
-> Parser' le [ContractBlock ParsedOp]
-> Parser' le [ContractBlock ParsedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ContractBlock ParsedOp] -> [ContractBlock ParsedOp]
forall a. [a] -> [a]
reverse (Parser' le [ContractBlock ParsedOp]
-> Parser' le [ContractBlock ParsedOp])
-> (StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
-> Parser' le [ContractBlock ParsedOp])
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
-> Parser' le [ContractBlock ParsedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ContractBlock ParsedOp]
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
-> Parser' le [ContractBlock ParsedOp]
forall (f :: * -> *) s a. Functor f => s -> StateT s f a -> f s
executingStateT [] (StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
-> Parser' le [ContractBlock ParsedOp])
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
-> Parser' le [ContractBlock ParsedOp]
forall a b. (a -> b) -> a -> b
$ do
(StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` Parser' le ()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser' le ()
forall le. Parser le ()
semicolon) (StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()])
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[()]
forall a b. (a -> b) -> a -> b
$ do
ContractBlock ParsedOp
r <- ReaderT
le (Parsec CustomParserException Text) (ContractBlock ParsedOp)
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
(ContractBlock ParsedOp)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT
le (Parsec CustomParserException Text) (ContractBlock ParsedOp)
forall le. Parser le (ContractBlock ParsedOp)
contractBlock
StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[ContractBlock ParsedOp]
forall s (m :: * -> *). MonadState s m => m s
get StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
[ContractBlock ParsedOp]
-> ([ContractBlock ParsedOp]
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
())
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ContractBlock ParsedOp]
prev -> Parser' le ()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser' le ()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
())
-> Parser' le ()
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
forall a b. (a -> b) -> a -> b
$ [ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
forall le.
[ContractBlock ParsedOp] -> ContractBlock ParsedOp -> Parser le ()
ensureNotDuplicate [ContractBlock ParsedOp]
prev ContractBlock ParsedOp
r
([ContractBlock ParsedOp] -> [ContractBlock ParsedOp])
-> StateT
[ContractBlock ParsedOp]
(ReaderT le (Parsec CustomParserException Text))
()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ContractBlock ParsedOp
r ContractBlock ParsedOp
-> [ContractBlock ParsedOp] -> [ContractBlock ParsedOp]
forall a. a -> [a] -> [a]
:)
value :: Parser le ParsedValue
value :: Parser' le ParsedValue
value = Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
value' Parser le ParsedOp
forall le. Parser le ParsedOp
parsedOp
parseValue :: MichelsonSource -> Text -> Either ParserException ParsedValue
parseValue :: MichelsonSource -> Text -> Either ParserException ParsedValue
parseValue = (ParseErrorBundle Text CustomParserException -> ParserException)
-> Either (ParseErrorBundle Text CustomParserException) ParsedValue
-> Either ParserException ParsedValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text CustomParserException -> ParserException
ParserException (Either (ParseErrorBundle Text CustomParserException) ParsedValue
-> Either ParserException ParsedValue)
-> (MichelsonSource
-> Text
-> Either
(ParseErrorBundle Text CustomParserException) ParsedValue)
-> MichelsonSource
-> Text
-> Either ParserException ParsedValue
forall a b c. SuperComposition a b c => a -> b -> c
... (Parser' () ParsedValue
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) ParsedValue
forall le a.
Default le =>
Parser' le a
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
parseNoEnv @()) Parser' () ParsedValue
forall le. Parser le ParsedValue
value
parseExpandValue :: MichelsonSource -> Text -> Either ParserException U.Value
parseExpandValue :: MichelsonSource -> Text -> Either ParserException Value
parseExpandValue = (ParsedValue -> Value)
-> Either ParserException ParsedValue
-> Either ParserException Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedValue -> Value
expandValue (Either ParserException ParsedValue
-> Either ParserException Value)
-> (MichelsonSource -> Text -> Either ParserException ParsedValue)
-> MichelsonSource
-> Text
-> Either ParserException Value
forall a b c. SuperComposition a b c => a -> b -> c
... MichelsonSource -> Text -> Either ParserException ParsedValue
parseValue
prim :: Parser le ParsedInstr
prim :: Parser' le ParsedInstr
prim = Parser' le (Contract' ParsedOp)
-> Parser' le ParsedOp -> Parser le ParsedInstr
forall le.
Parser' le (Contract' ParsedOp)
-> Parser' le ParsedOp -> Parser le ParsedInstr
primInstr Parser' le (Contract' ParsedOp)
forall le. Parser le (Contract' ParsedOp)
contract Parser' le ParsedOp
forall le. Parser le ParsedOp
parsedOp
codeEntry :: Parser le [ParsedOp]
codeEntry :: Parser' le [ParsedOp]
codeEntry = Parser' le [ParsedOp]
forall le. Parser le [ParsedOp]
bracewrappedOps
bracewrappedOps :: Parser le [ParsedOp]
bracewrappedOps :: Parser' le [ParsedOp]
bracewrappedOps = ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"{") ReaderT le (Parsec CustomParserException Text) ()
-> Parser' le [ParsedOp] -> Parser' le [ParsedOp]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' le [ParsedOp]
forall le. Parser le [ParsedOp]
ops
parsedOp :: Parser le ParsedOp
parsedOp :: Parser' le ParsedOp
parsedOp = do
SrcPos
pos <- Parser' le SrcPos
forall le. Parser le SrcPos
getSrcPos
[Parser' le ParsedOp] -> Parser' le ParsedOp
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Parser' LetEnv ParsedOp -> Parser le ParsedOp
forall le a. Parser' LetEnv a -> Parser le a
withLetEnv (Parser' LetEnv ParsedOp -> Parser le ParsedOp)
-> Parser' LetEnv ParsedOp -> Parser le ParsedOp
forall a b. (a -> b) -> a -> b
$ (ParsedInstr -> SrcPos -> ParsedOp)
-> SrcPos -> ParsedInstr -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsedInstr -> SrcPos -> ParsedOp
Prim SrcPos
pos (ParsedInstr -> ParsedOp)
-> ReaderT LetEnv (Parsec CustomParserException Text) ParsedInstr
-> Parser' LetEnv ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExtInstrAbstract ParsedOp -> ParsedInstr
forall op. ExtInstrAbstract op -> InstrAbstract op
EXT (ExtInstrAbstract ParsedOp -> ParsedInstr)
-> ReaderT
LetEnv
(Parsec CustomParserException Text)
(ExtInstrAbstract ParsedOp)
-> ReaderT LetEnv (Parsec CustomParserException Text) ParsedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' LetEnv [ParsedOp]
-> ReaderT
LetEnv
(Parsec CustomParserException Text)
(ExtInstrAbstract ParsedOp)
extInstr Parser' LetEnv [ParsedOp]
forall le. Parser le [ParsedOp]
ops)
, Parser' LetEnv ParsedOp -> Parser le ParsedOp
forall le a. Parser' LetEnv a -> Parser le a
withLetEnv (Parser' LetEnv ParsedOp -> Parser le ParsedOp)
-> Parser' LetEnv ParsedOp -> Parser le ParsedOp
forall a b. (a -> b) -> a -> b
$ Parser' LetEnv ParsedOp
lmacWithPos
, (ParsedInstr -> SrcPos -> ParsedOp)
-> SrcPos -> ParsedInstr -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsedInstr -> SrcPos -> ParsedOp
Prim SrcPos
pos (ParsedInstr -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
prim
, (Macro -> SrcPos -> ParsedOp) -> SrcPos -> Macro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Macro -> SrcPos -> ParsedOp
Mac SrcPos
pos (Macro -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) Macro
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' le ParsedOp -> Parser le Macro
forall le. Parser' le ParsedOp -> Parser le Macro
macro Parser' le ParsedOp
forall le. Parser le ParsedOp
parsedOp
, Parser' le ParsedOp
forall le. Parser le ParsedOp
primOrMac
, ([ParsedOp] -> SrcPos -> ParsedOp)
-> SrcPos -> [ParsedOp] -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ParsedOp] -> SrcPos -> ParsedOp
Seq SrcPos
pos ([ParsedOp] -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
bracewrappedOps
]
where
lmacWithPos :: Parser' LetEnv ParsedOp
lmacWithPos :: Parser' LetEnv ParsedOp
lmacWithPos = do
Parser' LetEnv LetMacro
act <- Map Text LetMacro -> Parser' LetEnv LetMacro
mkLetMac (Map Text LetMacro -> Parser' LetEnv LetMacro)
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Map Text LetMacro)
-> ReaderT
LetEnv
(Parsec CustomParserException Text)
(Parser' LetEnv LetMacro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LetEnv -> Map Text LetMacro)
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Map Text LetMacro)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LetEnv -> Map Text LetMacro
letMacros
SrcPos
srcPos <- Parser' LetEnv SrcPos
forall le. Parser le SrcPos
getSrcPos
(LetMacro -> SrcPos -> ParsedOp) -> SrcPos -> LetMacro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip LetMacro -> SrcPos -> ParsedOp
LMac SrcPos
srcPos (LetMacro -> ParsedOp)
-> Parser' LetEnv LetMacro -> Parser' LetEnv ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' LetEnv LetMacro
act
getSrcPos :: Parser le SrcPos
getSrcPos :: Parser' le SrcPos
getSrcPos = do
SourcePos
sp <- ReaderT le (Parsec CustomParserException Text) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let l :: Int
l = Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
sp
let c :: Int
c = Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
sp
SrcPos -> Parser' le SrcPos
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcPos -> Parser' le SrcPos)
-> (Either Text SrcPos -> SrcPos)
-> Either Text SrcPos
-> Parser' le SrcPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text SrcPos -> SrcPos
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text SrcPos -> Parser' le SrcPos)
-> Either Text SrcPos -> Parser' le SrcPos
forall a b. (a -> b) -> a -> b
$ Pos -> Pos -> SrcPos
SrcPos (Pos -> Pos -> SrcPos)
-> Either Text Pos -> Either Text (Pos -> SrcPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Either Text Pos
mkPos (Int -> Either Text Pos) -> Int -> Either Text Pos
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Either Text (Pos -> SrcPos)
-> Either Text Pos -> Either Text SrcPos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Either Text Pos
mkPos (Int -> Either Text Pos) -> Int -> Either Text Pos
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
primWithPos :: Parser le ParsedInstr -> Parser le ParsedOp
primWithPos :: Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
act = do
SrcPos
srcPos <- Parser' le SrcPos
forall le. Parser le SrcPos
getSrcPos
(ParsedInstr -> SrcPos -> ParsedOp)
-> SrcPos -> ParsedInstr -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsedInstr -> SrcPos -> ParsedOp
Prim SrcPos
srcPos (ParsedInstr -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) ParsedInstr
Parser le ParsedInstr
act
macWithPos :: Parser le Macro -> Parser le ParsedOp
macWithPos :: Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
act = do
SrcPos
srcPos <- Parser' le SrcPos
forall le. Parser le SrcPos
getSrcPos
(Macro -> SrcPos -> ParsedOp) -> SrcPos -> Macro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Macro -> SrcPos -> ParsedOp
Mac SrcPos
srcPos (Macro -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) Macro
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) Macro
Parser le Macro
act
ops :: Parser le [ParsedOp]
ops :: Parser' le [ParsedOp]
ops = Parser' le ParsedOp -> Parser le [ParsedOp]
forall le. Parser' le ParsedOp -> Parser le [ParsedOp]
ops' Parser' le ParsedOp
forall le. Parser le ParsedOp
parsedOp
ifOrIfX :: Parser le ParsedOp
ifOrIfX :: Parser' le ParsedOp
ifOrIfX = do
SrcPos
pos <- Parser' le SrcPos
forall le. Parser le SrcPos
getSrcPos
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol' Text
"IF"
Either ParsedInstr [ParsedOp]
a <- ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT
le
(Parsec CustomParserException Text)
(Either ParsedInstr [ParsedOp])
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
cmpOp ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
ops
case Either ParsedInstr [ParsedOp]
a of
Left ParsedInstr
cmp -> (Macro -> SrcPos -> ParsedOp) -> SrcPos -> Macro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Macro -> SrcPos -> ParsedOp
Mac SrcPos
pos (Macro -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) Macro
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsedInstr -> [ParsedOp] -> [ParsedOp] -> Macro
IFX ParsedInstr
cmp ([ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT
le (Parsec CustomParserException Text) ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
ops ReaderT
le (Parsec CustomParserException Text) ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
ops)
Right [ParsedOp]
op -> (ParsedInstr -> SrcPos -> ParsedOp)
-> SrcPos -> ParsedInstr -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsedInstr -> SrcPos -> ParsedOp
Prim SrcPos
pos (ParsedInstr -> ParsedOp)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> Parser' le ParsedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ParsedOp] -> [ParsedOp] -> ParsedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF [ParsedOp]
op ([ParsedOp] -> ParsedInstr)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
forall le. Parser le [ParsedOp]
ops)
primOrMac :: Parser le ParsedOp
primOrMac :: Parser' le ParsedOp
primOrMac = Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden
(Parser' le ParsedOp -> Parser' le ParsedOp)
-> Parser' le ParsedOp -> Parser' le ParsedOp
forall a b. (a -> b) -> a -> b
$ (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos (Parser le ParsedOp -> Parser le Macro
forall le. Parser le ParsedOp -> Parser le Macro
ifCmpMac Parser le ParsedOp
forall le. Parser le ParsedOp
parsedOp) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le ParsedOp
forall le. Parser le ParsedOp
ifOrIfX)
Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos (Parser le ParsedOp -> Parser le Macro
forall le. Parser le ParsedOp -> Parser le Macro
mapCadrMac Parser le ParsedOp
forall le. Parser le ParsedOp
parsedOp) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos (Parser' le ParsedOp -> Parser le ParsedInstr
forall le. Parser' le ParsedOp -> Parser le ParsedInstr
mapOp Parser' le ParsedOp
forall le. Parser le ParsedOp
parsedOp))
Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
forall le. Parser le ParsedInstr
pairOp) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
forall le. Parser le ParsedInstr
pairNOp) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
forall le. Parser le Macro
pairMac)
Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
forall le. Parser le Macro
duupMac) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
forall le. Parser le ParsedInstr
dupOp)
Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
forall le. Parser le Macro
carnMac) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
forall le. Parser le Macro
cdrnMac) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le ParsedOp -> Parser' le ParsedOp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser le Macro -> Parser le ParsedOp
forall le. Parser le Macro -> Parser le ParsedOp
macWithPos Parser le Macro
forall le. Parser le Macro
cadrMac) Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
forall le. Parser le ParsedInstr
carOp Parser' le ParsedOp -> Parser' le ParsedOp -> Parser' le ParsedOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le ParsedInstr -> Parser le ParsedOp
forall le. Parser le ParsedInstr -> Parser le ParsedOp
primWithPos Parser le ParsedInstr
forall le. Parser le ParsedInstr
cdrOp)
parserToQuasiQuoter :: Parser () (TH.Q TH.Exp) -> TH.QuasiQuoter
parserToQuasiQuoter :: Parser () (Q Exp) -> QuasiQuoter
parserToQuasiQuoter Parser () (Q Exp)
parser = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
{ quoteExp :: String -> Q Exp
TH.quoteExp = \String
s ->
case Parser' () (Q Exp)
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) (Q Exp)
forall le a.
Default le =>
Parser' le a
-> MichelsonSource
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
parseNoEnv (Parser' () ()
forall le. Parser le ()
mSpace Parser' () () -> Parser' () (Q Exp) -> Parser' () (Q Exp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' () (Q Exp)
Parser () (Q Exp)
parser) MichelsonSource
"quasi-quoter" (String -> Text
forall a. ToText a => a -> Text
toText String
s) of
Left ParseErrorBundle Text CustomParserException
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomParserException -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text CustomParserException
err
Right Q Exp
qexp -> Q Exp
qexp
, quotePat :: String -> Q Pat
TH.quotePat = \String
_ -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as pattern"
, quoteType :: String -> Q Type
TH.quoteType = \String
_ -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as type"
, quoteDec :: String -> Q [Dec]
TH.quoteDec = \String
_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as declaration"
}
utypeQ :: TH.QuasiQuoter
utypeQ :: QuasiQuoter
utypeQ = Parser () (Q Exp) -> QuasiQuoter
parserToQuasiQuoter (Ty -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Ty -> Q Exp)
-> ReaderT () (Parsec CustomParserException Text) Ty
-> Parser' () (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT () (Parsec CustomParserException Text) Ty
forall le. Parser le Ty
type_)
uparamTypeQ :: TH.QuasiQuoter
uparamTypeQ :: QuasiQuoter
uparamTypeQ = Parser () (Q Exp) -> QuasiQuoter
parserToQuasiQuoter (ParameterType -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (ParameterType -> Q Exp)
-> ReaderT () (Parsec CustomParserException Text) ParameterType
-> Parser' () (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT () (Parsec CustomParserException Text) ParameterType
forall le. Parser le ParameterType
cbParameterBare)
notes :: TH.QuasiQuoter
notes :: QuasiQuoter
notes =
Parser () (Q Exp) -> QuasiQuoter
parserToQuasiQuoter do
Ty
t <- ReaderT () (Parsec CustomParserException Text) Ty
forall le. Parser le Ty
type_
pure $ Ty -> (forall (t :: T). SingI t => Notes t -> Q Exp) -> Q Exp
forall r. Ty -> (forall (t :: T). SingI t => Notes t -> r) -> r
withUType Ty
t forall t. Lift t => t -> Q Exp
forall (t :: T). SingI t => Notes t -> Q Exp
TH.lift