module Morley.Micheline.Expression
( Annotation(..)
, Expression(..)
, MichelinePrimAp(..)
, MichelinePrimitive(..)
, michelsonPrimitive
, annotToText
, annotFromText
) where
import Data.Aeson
(FromJSON, ToJSON, parseJSON, toEncoding, toJSON, withObject, withText, (.!=), (.:), (.:?))
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import qualified Data.Aeson.Encoding.Internal as Aeson
import Data.Aeson.TH (deriveToJSON)
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Sequence as Seq
import qualified Data.Text as T (uncons)
import Fmt (Buildable(..), pretty, (+|), (|+))
import Michelson.Untyped.Annotation
(FieldAnn, FieldTag, KnownAnnTag(..), TypeAnn, TypeTag, VarAnn, VarTag, ann, annPrefix)
import qualified Michelson.Untyped.Annotation as MUA (Annotation)
import Morley.Micheline.Json
import Tezos.Crypto (encodeBase58Check)
import Util.ByteString (HexJSONByteString(..))
newtype MichelinePrimitive = MichelinePrimitive Text
deriving newtype (MichelinePrimitive -> MichelinePrimitive -> Bool
(MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> Eq MichelinePrimitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c/= :: MichelinePrimitive -> MichelinePrimitive -> Bool
== :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c== :: MichelinePrimitive -> MichelinePrimitive -> Bool
Eq, Eq MichelinePrimitive
Eq MichelinePrimitive =>
(MichelinePrimitive -> MichelinePrimitive -> Ordering)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive)
-> (MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive)
-> Ord MichelinePrimitive
MichelinePrimitive -> MichelinePrimitive -> Bool
MichelinePrimitive -> MichelinePrimitive -> Ordering
MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
$cmin :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
max :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
$cmax :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
>= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c>= :: MichelinePrimitive -> MichelinePrimitive -> Bool
> :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c> :: MichelinePrimitive -> MichelinePrimitive -> Bool
<= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c<= :: MichelinePrimitive -> MichelinePrimitive -> Bool
< :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c< :: MichelinePrimitive -> MichelinePrimitive -> Bool
compare :: MichelinePrimitive -> MichelinePrimitive -> Ordering
$ccompare :: MichelinePrimitive -> MichelinePrimitive -> Ordering
$cp1Ord :: Eq MichelinePrimitive
Ord, [MichelinePrimitive] -> Encoding
[MichelinePrimitive] -> Value
MichelinePrimitive -> Encoding
MichelinePrimitive -> Value
(MichelinePrimitive -> Value)
-> (MichelinePrimitive -> Encoding)
-> ([MichelinePrimitive] -> Value)
-> ([MichelinePrimitive] -> Encoding)
-> ToJSON MichelinePrimitive
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MichelinePrimitive] -> Encoding
$ctoEncodingList :: [MichelinePrimitive] -> Encoding
toJSONList :: [MichelinePrimitive] -> Value
$ctoJSONList :: [MichelinePrimitive] -> Value
toEncoding :: MichelinePrimitive -> Encoding
$ctoEncoding :: MichelinePrimitive -> Encoding
toJSON :: MichelinePrimitive -> Value
$ctoJSON :: MichelinePrimitive -> Value
ToJSON, Value -> Parser [MichelinePrimitive]
Value -> Parser MichelinePrimitive
(Value -> Parser MichelinePrimitive)
-> (Value -> Parser [MichelinePrimitive])
-> FromJSON MichelinePrimitive
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MichelinePrimitive]
$cparseJSONList :: Value -> Parser [MichelinePrimitive]
parseJSON :: Value -> Parser MichelinePrimitive
$cparseJSON :: Value -> Parser MichelinePrimitive
FromJSON)
deriving stock (Int -> MichelinePrimitive -> ShowS
[MichelinePrimitive] -> ShowS
MichelinePrimitive -> String
(Int -> MichelinePrimitive -> ShowS)
-> (MichelinePrimitive -> String)
-> ([MichelinePrimitive] -> ShowS)
-> Show MichelinePrimitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MichelinePrimitive] -> ShowS
$cshowList :: [MichelinePrimitive] -> ShowS
show :: MichelinePrimitive -> String
$cshow :: MichelinePrimitive -> String
showsPrec :: Int -> MichelinePrimitive -> ShowS
$cshowsPrec :: Int -> MichelinePrimitive -> ShowS
Show)
michelsonPrimitive :: Seq Text
michelsonPrimitive :: Seq Text
michelsonPrimitive = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList [
"parameter", "storage", "code", "False", "Elt", "Left", "None", "Pair",
"Right", "Some", "True", "Unit", "PACK", "UNPACK", "BLAKE2B", "SHA256",
"SHA512", "ABS", "ADD", "AMOUNT", "AND", "BALANCE", "CAR", "CDR",
"CHECK_SIGNATURE", "COMPARE", "CONCAT", "CONS", "CREATE_ACCOUNT",
"CREATE_CONTRACT", "IMPLICIT_ACCOUNT", "DIP", "DROP", "DUP", "EDIV",
"EMPTY_MAP", "EMPTY_SET", "EQ", "EXEC", "FAILWITH", "GE", "GET", "GT",
"HASH_KEY", "IF", "IF_CONS", "IF_LEFT", "IF_NONE", "INT", "LAMBDA",
"LE", "LEFT", "LOOP", "LSL", "LSR", "LT", "MAP", "MEM", "MUL", "NEG",
"NEQ", "NIL", "NONE", "NOT", "NOW", "OR", "PAIR", "PUSH", "RIGHT",
"SIZE", "SOME", "SOURCE", "SENDER", "SELF", "STEPS_TO_QUOTA", "SUB",
"SWAP", "TRANSFER_TOKENS", "SET_DELEGATE", "UNIT", "UPDATE", "XOR",
"ITER", "LOOP_LEFT", "ADDRESS", "CONTRACT", "ISNAT", "CAST", "RENAME",
"bool", "contract", "int", "key", "key_hash", "lambda", "list", "map",
"big_map", "nat", "option", "or", "pair", "set", "signature", "string",
"bytes", "mutez", "timestamp", "unit", "operation", "address", "SLICE",
"DIG", "DUG", "EMPTY_BIG_MAP", "APPLY", "chain_id", "CHAIN_ID"
]
data Expression
= ExpressionInt Integer
| ExpressionString Text
| ExpressionBytes ByteString
| ExpressionSeq (Seq Expression)
| ExpressionPrim MichelinePrimAp
deriving stock (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)
instance Buildable Expression where
build :: Expression -> Builder
build = \case
ExpressionInt i :: Integer
i -> Integer -> Builder
forall p. Buildable p => p -> Builder
build (Integer -> Builder) -> Integer -> Builder
forall a b. (a -> b) -> a -> b
$ Integer
i
ExpressionString s :: Text
s -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
s
ExpressionBytes b :: ByteString
b ->
Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeBase58Check ByteString
b
ExpressionSeq s :: Seq Expression
s -> "(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| (Element (Seq Expression) -> Builder) -> Seq Expression -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq Element (Seq Expression) -> Builder
forall p. Buildable p => p -> Builder
build Seq Expression
s Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ")"
ExpressionPrim (MichelinePrimAp (MichelinePrimitive text :: Text
text) s :: Seq Expression
s annots :: Seq Annotation
annots) ->
Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ "(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
(Element (Seq Expression) -> Builder) -> Seq Expression -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq Element (Seq Expression) -> Builder
forall p. Buildable p => p -> Builder
build Seq Expression
s Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ") " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
(Element (Seq Annotation) -> Builder) -> Seq Annotation -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq (Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Annotation -> Text) -> Annotation -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText) Seq Annotation
annots
where
buildSeq :: (Element t -> c) -> t -> c
buildSeq buildElem :: Element t -> c
buildElem =
[c] -> c
forall a. Monoid a => [a] -> a
mconcat ([c] -> c) -> (t -> [c]) -> t -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse ", " ([c] -> [c]) -> (t -> [c]) -> t -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element t -> c) -> [Element t] -> [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
Element t -> c
buildElem ([Element t] -> [c]) -> (t -> [Element t]) -> t -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [Element t]
forall t. Container t => t -> [Element t]
toList
data Annotation
= AnnotationType TypeAnn
| AnnotationVariable VarAnn
| AnnotationField FieldAnn
deriving stock (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show)
data MichelinePrimAp = MichelinePrimAp
{ MichelinePrimAp -> MichelinePrimitive
mpaPrim :: MichelinePrimitive
, MichelinePrimAp -> Seq Expression
mpaArgs :: Seq Expression
, MichelinePrimAp -> Seq Annotation
mpaAnnots :: Seq Annotation
} deriving stock (MichelinePrimAp -> MichelinePrimAp -> Bool
(MichelinePrimAp -> MichelinePrimAp -> Bool)
-> (MichelinePrimAp -> MichelinePrimAp -> Bool)
-> Eq MichelinePrimAp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MichelinePrimAp -> MichelinePrimAp -> Bool
$c/= :: MichelinePrimAp -> MichelinePrimAp -> Bool
== :: MichelinePrimAp -> MichelinePrimAp -> Bool
$c== :: MichelinePrimAp -> MichelinePrimAp -> Bool
Eq, Int -> MichelinePrimAp -> ShowS
[MichelinePrimAp] -> ShowS
MichelinePrimAp -> String
(Int -> MichelinePrimAp -> ShowS)
-> (MichelinePrimAp -> String)
-> ([MichelinePrimAp] -> ShowS)
-> Show MichelinePrimAp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MichelinePrimAp] -> ShowS
$cshowList :: [MichelinePrimAp] -> ShowS
show :: MichelinePrimAp -> String
$cshow :: MichelinePrimAp -> String
showsPrec :: Int -> MichelinePrimAp -> ShowS
$cshowsPrec :: Int -> MichelinePrimAp -> ShowS
Show)
instance FromJSON MichelinePrimAp where
parseJSON :: Value -> Parser MichelinePrimAp
parseJSON = String
-> (Object -> Parser MichelinePrimAp)
-> Value
-> Parser MichelinePrimAp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Prim" ((Object -> Parser MichelinePrimAp)
-> Value -> Parser MichelinePrimAp)
-> (Object -> Parser MichelinePrimAp)
-> Value
-> Parser MichelinePrimAp
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp
MichelinePrimAp
(MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp)
-> Parser MichelinePrimitive
-> Parser (Seq Expression -> Seq Annotation -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser MichelinePrimitive
forall a. FromJSON a => Object -> Text -> Parser a
.: "prim"
Parser (Seq Expression -> Seq Annotation -> MichelinePrimAp)
-> Parser (Seq Expression)
-> Parser (Seq Annotation -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Seq Expression))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "args" Parser (Maybe (Seq Expression))
-> Seq Expression -> Parser (Seq Expression)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq Expression
forall a. Monoid a => a
mempty
Parser (Seq Annotation -> MichelinePrimAp)
-> Parser (Seq Annotation) -> Parser MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Seq Annotation))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "annots" Parser (Maybe (Seq Annotation))
-> Seq Annotation -> Parser (Seq Annotation)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq Annotation
forall a. Monoid a => a
mempty
annotFromText :: MonadFail m => Text -> m Annotation
annotFromText :: Text -> m Annotation
annotFromText txt :: Text
txt = case Maybe Annotation
result of
Just a :: Annotation
a -> Annotation -> m Annotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation
a
Nothing -> String -> m Annotation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unknown annotation type"
where
result :: Maybe Annotation
result = (TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation) -> Maybe TypeAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe TypeAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @TypeTag Text
txt)
Maybe Annotation -> Maybe Annotation -> Maybe Annotation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation) -> Maybe VarAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe VarAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @VarTag Text
txt)
Maybe Annotation -> Maybe Annotation -> Maybe Annotation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> Maybe FieldAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe FieldAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @FieldTag Text
txt)
stripPrefix :: forall tag . KnownAnnTag tag => Text -> Maybe (MUA.Annotation tag)
stripPrefix :: Text -> Maybe (Annotation tag)
stripPrefix txt :: Text
txt = do
(n :: Char
n, t :: Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
txt
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
prefix)
Annotation tag -> Maybe (Annotation tag)
forall a. a -> Maybe a
Just (Annotation tag -> Maybe (Annotation tag))
-> Annotation tag -> Maybe (Annotation tag)
forall a b. (a -> b) -> a -> b
$ Text -> Annotation tag
forall k (a :: k). HasCallStack => Text -> Annotation a
ann Text
t
where
prefix :: Text
prefix = KnownAnnTag tag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @tag
annotToText :: Annotation -> Text
annotToText :: Annotation -> Text
annotToText = \case
AnnotationType n :: TypeAnn
n -> TypeAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty TypeAnn
n
AnnotationVariable n :: VarAnn
n -> VarAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty VarAnn
n
AnnotationField n :: FieldAnn
n -> FieldAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty FieldAnn
n
instance FromJSON Annotation where
parseJSON :: Value -> Parser Annotation
parseJSON = String -> (Text -> Parser Annotation) -> Value -> Parser Annotation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Annotation" Text -> Parser Annotation
forall (m :: * -> *). MonadFail m => Text -> m Annotation
annotFromText
instance ToJSON Annotation where
toJSON :: Annotation -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Annotation -> Text) -> Annotation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText
toEncoding :: Annotation -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (Annotation -> Text) -> Annotation -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText
instance FromJSON Expression where
parseJSON :: Value -> Parser Expression
parseJSON v :: Value
v = Seq Expression -> Expression
ExpressionSeq (Seq Expression -> Expression)
-> Parser (Seq Expression) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Seq Expression)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Parser MichelinePrimAp -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MichelinePrimAp
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Expression
ExpressionString (Text -> Expression) -> Parser Text -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ExpressionString" (Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "string") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Expression
ExpressionInt (Integer -> Expression)
-> (StringEncode Integer -> Integer)
-> StringEncode Integer
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringEncode Integer -> Integer
forall a. StringEncode a -> a
unStringEncode (StringEncode Integer -> Expression)
-> Parser (StringEncode Integer) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser (StringEncode Integer))
-> Value
-> Parser (StringEncode Integer)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ExpressionInt" (Object -> Text -> Parser (StringEncode Integer)
forall a. FromJSON a => Object -> Text -> Parser a
.: "int") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Expression
ExpressionBytes (ByteString -> Expression)
-> (HexJSONByteString -> ByteString)
-> HexJSONByteString
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexJSONByteString -> ByteString
unHexJSONByteString (HexJSONByteString -> Expression)
-> Parser HexJSONByteString -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser HexJSONByteString)
-> Value
-> Parser HexJSONByteString
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ExpressionBytes" (Object -> Text -> Parser HexJSONByteString
forall a. FromJSON a => Object -> Text -> Parser a
.: "bytes") Value
v
instance ToJSON Expression where
toJSON :: Expression -> Value
toJSON (ExpressionSeq xs :: Seq Expression
xs) = Seq Expression -> Value
forall a. ToJSON a => a -> Value
toJSON Seq Expression
xs
toJSON (ExpressionPrim xs :: MichelinePrimAp
xs) = MichelinePrimAp -> Value
forall a. ToJSON a => a -> Value
toJSON MichelinePrimAp
xs
toJSON (ExpressionString x :: Text
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "string" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x)
toJSON (ExpressionInt x :: Integer
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "int" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ StringEncode Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (StringEncode Integer -> Value) -> StringEncode Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x)
toJSON (ExpressionBytes x :: ByteString
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "bytes" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ HexJSONByteString -> Value
forall a. ToJSON a => a -> Value
toJSON (HexJSONByteString -> Value) -> HexJSONByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x)
toEncoding :: Expression -> Encoding
toEncoding (ExpressionSeq xs :: Seq Expression
xs) = Seq Expression -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Seq Expression
xs
toEncoding (ExpressionPrim xs :: MichelinePrimAp
xs) = MichelinePrimAp -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding MichelinePrimAp
xs
toEncoding (ExpressionString x :: Text
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "string" (Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
x))
toEncoding (ExpressionInt x :: Integer
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "int" (StringEncode Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (StringEncode Integer -> Encoding)
-> StringEncode Integer -> Encoding
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x))
toEncoding (ExpressionBytes x :: ByteString
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "bytes" (HexJSONByteString -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (HexJSONByteString -> Encoding) -> HexJSONByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x))
deriveToJSON (aesonPrefix snakeCase) ''MichelinePrimAp