module Morley.Michelson.Interpret.Unpack
( UnpackError (..)
, unpackInstr'
, unpackUValue'
, unpackValue'
) where
import Prelude hiding (EQ, Ordering(..), get)
import Data.ByteString qualified as BS
import Data.Constraint (Dict(..))
import Fmt (pretty)
import Morley.Micheline.Binary (eitherDecodeExpression)
import Morley.Micheline.Class (FromExpression, fromExpression)
import Morley.Michelson.Typed (UnpackedValScope)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Untyped
import Morley.Michelson.Untyped qualified as U
import Morley.Util.Binary
unpackValue'
:: forall t. (UnpackedValScope t)
=> ByteString -> Either UnpackError (T.Value t)
unpackValue' :: forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
unpackValue' = forall t. FromExpression t => ByteString -> Either UnpackError t
unpackImpl @(T.Value t)
where
_reallyNeedThisConstraint :: Dict (UnpackedValScope t)
_reallyNeedThisConstraint = forall (a :: Constraint). a => Dict a
Dict @(UnpackedValScope t)
unpackInstr' :: ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' :: ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' = forall t. FromExpression t => ByteString -> Either UnpackError t
unpackImpl @([ExpandedOp])
unpackUValue' :: ByteString -> Either UnpackError U.Value
unpackUValue' :: ByteString -> Either UnpackError Value
unpackUValue' = forall t. FromExpression t => ByteString -> Either UnpackError t
unpackImpl @U.Value
unpackImpl :: forall t. (FromExpression t)
=> ByteString
-> Either UnpackError t
unpackImpl :: forall t. FromExpression t => ByteString -> Either UnpackError t
unpackImpl ByteString
bs = do
(Word8
tag, ByteString
bs') <- UnpackError
-> Maybe (Word8, ByteString)
-> Either UnpackError (Word8, ByteString)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> UnpackError
UnpackError Text
"Empty bytes") (ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs)
Bool -> Either UnpackError () -> Either UnpackError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x05) (Either UnpackError () -> Either UnpackError ())
-> (Text -> Either UnpackError ()) -> Text -> Either UnpackError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpackError -> Either UnpackError ()
forall a b. a -> Either a b
Left (UnpackError -> Either UnpackError ())
-> (Text -> UnpackError) -> Text -> Either UnpackError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UnpackError
UnpackError (Text -> Either UnpackError ()) -> Text -> Either UnpackError ()
forall a b. (a -> b) -> a -> b
$
Text
"Unexpected tag: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Word8 -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word8
tag) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'. '0x05' tag expected."
Expression
expr <- ByteString -> Either UnpackError Expression
eitherDecodeExpression ByteString
bs'
(FromExpressionError -> UnpackError)
-> Either FromExpressionError t -> Either UnpackError t
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> UnpackError
UnpackError (Text -> UnpackError)
-> (FromExpressionError -> Text)
-> FromExpressionError
-> UnpackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromExpressionError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Either FromExpressionError t -> Either UnpackError t)
-> Either FromExpressionError t -> Either UnpackError t
forall a b. (a -> b) -> a -> b
$ forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @t Expression
expr