module Morley.Micheline.Class
( ToExpression (..)
, FromExpression (..)
) where
import Data.Sequence (fromList, (|>))
import Data.Singletons (pattern FromSing, Sing, SingI, withSingI)
import Michelson.Interpret.Pack (encodeValue', packCode', packNotedT', packT')
import Michelson.Interpret.Unpack (unpackInstr', unpackValue')
import Michelson.Typed
(Contract(..), HasNoOp, Instr(..), Notes(..), T(..), Value, pnNotes, pnRootAnn)
import Michelson.Typed.Scope (UnpackedValScope)
import Michelson.Untyped.Annotation (RootAnn, convAnn)
import Michelson.Untyped.Instr (ExpandedOp)
import Morley.Micheline.Binary (decodeExpression, encodeExpression)
import Morley.Micheline.Expression (Annotation (..), Expression(..), MichelinePrimAp(..), MichelinePrimitive(..))
class ToExpression a where
toExpression :: a -> Expression
instance ToExpression (Instr inp out) where
toExpression :: Instr inp out -> Expression
toExpression = HasCallStack => ByteString -> Expression
ByteString -> Expression
decodeExpression (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)) =
HasCallStack => ByteString -> Expression
ByteString -> Expression
decodeExpression (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 = HasCallStack => ByteString -> Expression
ByteString -> Expression
decodeExpression (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 = HasCallStack => ByteString -> Expression
ByteString -> Expression
decodeExpression (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 (Contract cp st) where
toExpression :: Contract cp st -> Expression
toExpression Contract{..} = Seq Expression -> Expression
ExpressionSeq (Seq Expression -> Expression) -> Seq Expression -> Expression
forall a b. (a -> b) -> a -> b
$ [Expression] -> Seq Expression
forall a. [a] -> Seq a
fromList
[ MichelinePrimAp -> Expression
ExpressionPrim (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
cParamNotes) (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
cParamNotes
])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
, MichelinePrimAp -> Expression
ExpressionPrim (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
cStoreNotes])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
, MichelinePrimAp -> Expression
ExpressionPrim (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
cCode])
([Annotation] -> Seq Annotation
forall a. [a] -> Seq a
fromList [])
]
where
addRootAnnToExpression :: RootAnn -> Expression -> Expression
addRootAnnToExpression :: RootAnn -> Expression -> Expression
addRootAnnToExpression rootAnn :: RootAnn
rootAnn = \case
ExpressionPrim p :: MichelinePrimAp
p -> MichelinePrimAp -> Expression
ExpressionPrim
MichelinePrimAp
p{ mpaAnnots :: Seq Annotation
mpaAnnots = MichelinePrimAp -> Seq Annotation
mpaAnnots MichelinePrimAp
p Seq Annotation -> Annotation -> Seq Annotation
forall a. Seq a -> a -> Seq a
|>
(FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> FieldAnn -> Annotation
forall a b. (a -> b) -> a -> b
$ RootAnn -> FieldAnn
forall k1 k2 (tag1 :: k1) (tag2 :: k2).
Annotation tag1 -> Annotation tag2
convAnn 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
encodeExpression
instance 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
encodeExpression