-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Module, carrying logic of @PACK@ instruction.
--
-- This is nearly symmetric to adjacent Unpack.hs module.
module Morley.Michelson.Interpret.Pack
  ( packValue
  , packValue'
  , packValuePrefix
  , toBinary
  , toBinary'
  ) where

import Prelude hiding (EQ, GT, LT)

import Morley.Micheline.Binary (encodeExpression, encodeExpression')
import Morley.Micheline.Class (ToExpression(..))
import Morley.Michelson.Typed

-- | Generic serializer.
toBinary :: ToExpression a => a -> LByteString
toBinary :: forall a. ToExpression a => a -> LByteString
toBinary = Expression -> LByteString
encodeExpression (Expression -> LByteString)
-> (a -> Expression) -> a -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expression
forall a. ToExpression a => a -> Expression
toExpression

-- | Same as 'toBinary', for strict bytestring.
toBinary' :: ToExpression a => a -> ByteString
toBinary' :: forall a. ToExpression a => a -> ByteString
toBinary' = Expression -> ByteString
encodeExpression' (Expression -> ByteString) -> (a -> Expression) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expression
forall a. ToExpression a => a -> Expression
toExpression

-- | Serialize a value given to @PACK@ instruction.
packValue :: PackedValScope t => Value t -> LByteString
packValue :: forall (t :: T). PackedValScope t => Value t -> LByteString
packValue Value t
x =
  let uval :: Value
uval = Value t -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValueHashable Value t
x
  in LByteString
forall s. IsString s => s
packValuePrefix LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> (Expression -> LByteString
encodeExpression (Expression -> LByteString) -> Expression -> LByteString
forall a b. (a -> b) -> a -> b
$ Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
uval)

-- | Same as 'packValue', for strict bytestring.
packValue' :: PackedValScope t => Value t -> ByteString
packValue' :: forall (t :: T). PackedValScope t => Value t -> ByteString
packValue' Value t
x =
  let uval :: Value
uval = Value t -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValueHashable Value t
x
  in ByteString
forall s. IsString s => s
packValuePrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Expression -> ByteString
encodeExpression' (Expression -> ByteString) -> Expression -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
uval)

-- | Prefix prepended to the binary representation of a value.
packValuePrefix :: IsString s => s
packValuePrefix :: forall s. IsString s => s
packValuePrefix = s
"\x05"