module Morley.Micheline
( ToExpression (..)
, FromExpression (..)
) where
import Data.Sequence (fromList, (|>))
import Data.Singletons (pattern FromSing, Sing, SingI, withSingI)
import Tezos.Common.Binary (decode, encode)
import Tezos.V005.Micheline
(Annotation(..), Expression(..), MichelinePrimAp(..), MichelinePrimitive(..))
import Michelson.Interpret.Pack (encodeValue', packCode', packNotedT', packT')
import Michelson.Interpret.Unpack (unpackInstr', unpackValue')
import Michelson.Typed
(FullContract(..), HasNoOp, Instr(..), Notes(..), T(..), Value, pnNotes, pnRootAnn)
import Michelson.Typed.Scope (UnpackedValScope)
import Michelson.Untyped.Annotation (Annotation(..), RootAnn)
import Michelson.Untyped.Instr (ExpandedOp)
class ToExpression a where
toExpression :: a -> Expression
instance ToExpression (Instr inp out) where
toExpression :: Instr inp out -> Expression
toExpression = ByteString -> Expression
forall a. TezosBinary a => ByteString -> a
decode (ByteString -> Expression)
-> (Instr inp out -> ByteString) -> Instr inp out -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr inp out -> ByteString
forall (inp :: [T]) (out :: [T]). Instr inp out -> ByteString
packCode'
instance ToExpression T where
toExpression :: T -> Expression
toExpression (FromSing (ts :: Sing t)) =
ByteString -> Expression
forall a. TezosBinary a => ByteString -> a
decode (ByteString -> Expression) -> ByteString -> Expression
forall a b. (a -> b) -> a -> b
$ Sing a -> (SingI a => ByteString) -> ByteString
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing a
ts ((SingI a => ByteString) -> ByteString)
-> (SingI a => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (SingI a => ByteString
forall (t :: T). SingI t => ByteString
packT' @t)
instance SingI t => ToExpression (Notes t) where
toExpression :: Notes t -> Expression
toExpression = ByteString -> Expression
forall a. TezosBinary a => ByteString -> a
decode (ByteString -> Expression)
-> (Notes t -> ByteString) -> Notes t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notes t -> ByteString
forall (t :: T). SingI t => Notes t -> ByteString
packNotedT'
instance (SingI t, HasNoOp t) => ToExpression (Value t) where
toExpression :: Value t -> Expression
toExpression = ByteString -> Expression
forall a. TezosBinary a => ByteString -> a
decode (ByteString -> Expression)
-> (Value t -> ByteString) -> Value t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> ByteString
forall (t :: T). (SingI t, HasNoOp t) => Value t -> ByteString
encodeValue'
instance ToExpression (FullContract cp st) where
toExpression :: FullContract cp st -> Expression
toExpression FullContract{..} = Seq Expression -> Expression
Expression_Seq (Seq Expression -> Expression) -> Seq Expression -> Expression
forall a b. (a -> b) -> a -> b
$ [Expression] -> Seq Expression
forall a. [a] -> Seq a
fromList
[ MichelinePrimAp -> Expression
Expression_Prim (MichelinePrimAp -> Expression) -> MichelinePrimAp -> Expression
forall a b. (a -> b) -> a -> b
$
MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp
MichelinePrimAp (Text -> MichelinePrimitive
MichelinePrimitive "parameter")
([Expression] -> Seq Expression
forall a. [a] -> Seq a
fromList [ RootAnn -> Expression -> Expression
addRootAnnToExpression (ParamNotes cp -> RootAnn
forall (t :: T). ParamNotes t -> RootAnn
pnRootAnn ParamNotes cp
fcParamNotes) (Expression -> Expression) -> Expression -> Expression
forall a b. (a -> b) -> a -> b
$
Notes cp -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Notes cp -> Expression) -> Notes cp -> Expression
forall a b. (a -> b) -> a -> b
$ ParamNotes cp -> Notes cp
forall (t :: T). ParamNotes t -> Notes t
pnNotes ParamNotes cp
fcParamNotes
])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
, MichelinePrimAp -> Expression
Expression_Prim (MichelinePrimAp -> Expression) -> MichelinePrimAp -> Expression
forall a b. (a -> b) -> a -> b
$
MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp
MichelinePrimAp (Text -> MichelinePrimitive
MichelinePrimitive "storage")
([Expression] -> Seq Expression
forall a. [a] -> Seq a
fromList [Notes st -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Notes st -> Expression) -> Notes st -> Expression
forall a b. (a -> b) -> a -> b
$ Notes st
fcStoreNotes])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
, MichelinePrimAp -> Expression
Expression_Prim (MichelinePrimAp -> Expression) -> MichelinePrimAp -> Expression
forall a b. (a -> b) -> a -> b
$
MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp
MichelinePrimAp (Text -> MichelinePrimitive
MichelinePrimitive "code")
([Expression] -> Seq Expression
forall a. [a] -> Seq a
fromList [ContractCode cp st -> Expression
forall a. ToExpression a => a -> Expression
toExpression ContractCode cp st
fcCode])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
]
where
addRootAnnToExpression :: RootAnn -> Expression -> Expression
addRootAnnToExpression :: RootAnn -> Expression -> Expression
addRootAnnToExpression rootAnn :: RootAnn
rootAnn = \case
Expression_Prim p :: MichelinePrimAp
p -> MichelinePrimAp -> Expression
Expression_Prim
MichelinePrimAp
p{ _michelinePrimAps_annots :: Seq Annotation
_michelinePrimAps_annots = MichelinePrimAp -> Seq Annotation
_michelinePrimAps_annots MichelinePrimAp
p Seq Annotation -> Annotation -> Seq Annotation
forall a. Seq a -> a -> Seq a
|>
(Text -> Annotation
Annotation_Field (Text -> Annotation) -> Text -> Annotation
forall a b. (a -> b) -> a -> b
$ RootAnn -> Text
forall k (tag :: k). Annotation tag -> Text
unAnnotation (RootAnn -> Text) -> RootAnn -> Text
forall a b. (a -> b) -> a -> b
$ RootAnn
rootAnn)
}
x :: Expression
x -> Expression
x
class FromExpression a where
fromExpression :: Expression -> Maybe a
instance UnpackedValScope t => FromExpression (Value t) where
fromExpression :: Expression -> Maybe (Value t)
fromExpression = Either UnpackError (Value t) -> Maybe (Value t)
forall l r. Either l r -> Maybe r
rightToMaybe (Either UnpackError (Value t) -> Maybe (Value t))
-> (Expression -> Either UnpackError (Value t))
-> Expression
-> Maybe (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnpackError (Value t)
forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
unpackValue' (ByteString -> Either UnpackError (Value t))
-> (Expression -> ByteString)
-> Expression
-> Either UnpackError (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("\05" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Expression -> ByteString) -> Expression -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> ByteString
forall a. TezosBinary a => a -> ByteString
encode
instance UnpackedValScope t => FromExpression [ExpandedOp] where
fromExpression :: Expression -> Maybe [ExpandedOp]
fromExpression = Either UnpackError [ExpandedOp] -> Maybe [ExpandedOp]
forall l r. Either l r -> Maybe r
rightToMaybe (Either UnpackError [ExpandedOp] -> Maybe [ExpandedOp])
-> (Expression -> Either UnpackError [ExpandedOp])
-> Expression
-> Maybe [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' (ByteString -> Either UnpackError [ExpandedOp])
-> (Expression -> ByteString)
-> Expression
-> Either UnpackError [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> ByteString
forall a. TezosBinary a => a -> ByteString
encode