-- SPDX-FileCopyrightText: 2020 Tocqueville Group
-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA
-- SPDX-License-Identifier: LicenseRef-MIT-obsidian-systems

-- | Module that define encoding and decoding function from Expression type
-- to binary format.
module Morley.Micheline.Binary
  ( decodeExpression
  , eitherDecodeExpression
  , encodeExpression
  , encodeExpression'
  ) where

import Data.Binary.Builder qualified as Bi
import Data.Binary.Get qualified as Bi
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Unsafe qualified (fromIntegral)

import Morley.Micheline.Binary.Internal
import Morley.Micheline.Expression
import Morley.Util.Binary (UnpackError(..), ensureEnd, launchGet)

-------------------------------------------------
-- Encode
-------------------------------------------------

-- | Encode 'Expression' to 'ByteString'.
encodeExpression :: Expression -> LByteString
encodeExpression :: Exp RegularExp -> LByteString
encodeExpression = Builder -> LByteString
Bi.toLazyByteString (Builder -> LByteString)
-> (Exp RegularExp -> Builder) -> Exp RegularExp -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp RegularExp -> Builder
buildExpr

-- | Same as 'encodeExpression', for strict bytestring.
encodeExpression' :: Expression -> BS.ByteString
encodeExpression' :: Exp RegularExp -> ByteString
encodeExpression' = LByteString -> ByteString
LBS.toStrict (LByteString -> ByteString)
-> (Exp RegularExp -> LByteString) -> Exp RegularExp -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp RegularExp -> LByteString
encodeExpression

buildExpr :: Expression -> Bi.Builder
buildExpr :: Exp RegularExp -> Builder
buildExpr = \case
  ExpSeq () [Exp RegularExp]
xs -> Word8 -> Builder
buildWord8 Word8
2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Exp RegularExp] -> Builder)
-> DynamicSize [Exp RegularExp] -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic [Exp RegularExp] -> Builder
buildList ([Exp RegularExp] -> DynamicSize [Exp RegularExp]
forall a. a -> DynamicSize a
DynamicSize [Exp RegularExp]
xs)
  ExpPrim () (MichelinePrimAp MichelinePrimitive
prim [Exp RegularExp]
args [Annotation]
annots) -> case ([Exp RegularExp]
args, [Annotation]
annots) of
    ([], []) -> Word8 -> Builder
buildWord8 Word8
3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim
    ([], [Annotation]
_) -> Word8 -> Builder
buildWord8 Word8
4 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
    ([Exp RegularExp
arg1], []) -> Word8 -> Builder
buildWord8 Word8
5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg1
    ([Exp RegularExp
arg1], [Annotation]
_) -> Word8 -> Builder
buildWord8 Word8
6 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
    ([Exp RegularExp
arg1, Exp RegularExp
arg2], []) -> Word8 -> Builder
buildWord8 Word8
7 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg2
    ([Exp RegularExp
arg1, Exp RegularExp
arg2], [Annotation]
_) -> Word8 -> Builder
buildWord8 Word8
8 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp RegularExp -> Builder
buildExpr Exp RegularExp
arg2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
    ([Exp RegularExp], [Annotation])
_ -> Word8 -> Builder
buildWord8 Word8
9 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MichelinePrimitive -> Builder
buildPrim MichelinePrimitive
prim Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Exp RegularExp] -> Builder)
-> DynamicSize [Exp RegularExp] -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic [Exp RegularExp] -> Builder
buildList ([Exp RegularExp] -> DynamicSize [Exp RegularExp]
forall a. a -> DynamicSize a
DynamicSize [Exp RegularExp]
args) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
  ExpString () Text
x -> Word8 -> Builder
buildWord8 Word8
1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> DynamicSize Text -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic Text -> Builder
buildText (Text -> DynamicSize Text
forall a. a -> DynamicSize a
DynamicSize Text
x)
  ExpInt () Integer
x -> Word8 -> Builder
buildWord8 Word8
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
buildInteger Integer
x
  ExpBytes () ByteString
x -> Word8 -> Builder
buildWord8 Word8
10 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder) -> DynamicSize ByteString -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic ByteString -> Builder
buildByteString (ByteString -> DynamicSize ByteString
forall a. a -> DynamicSize a
DynamicSize ByteString
x)

buildList :: [Expression] -> Bi.Builder
buildList :: [Exp RegularExp] -> Builder
buildList = (Element [Exp RegularExp] -> Builder)
-> [Exp RegularExp] -> Builder
forall m.
Monoid m =>
(Element [Exp RegularExp] -> m) -> [Exp RegularExp] -> m
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element [Exp RegularExp] -> Builder
Exp RegularExp -> Builder
buildExpr

buildPrim :: MichelinePrimitive -> Bi.Builder
buildPrim :: MichelinePrimitive -> Builder
buildPrim = Word8 -> Builder
buildWord8 (Word8 -> Builder)
-> (MichelinePrimitive -> Word8) -> MichelinePrimitive -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word8 (Int -> Word8)
-> (MichelinePrimitive -> Int) -> MichelinePrimitive -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MichelinePrimitive -> Int
forall a. Enum a => a -> Int
fromEnum

buildAnnotationList :: [Annotation] -> Bi.Builder
buildAnnotationList :: [Annotation] -> Builder
buildAnnotationList [Annotation]
listAnn = (Text -> Builder) -> DynamicSize Text -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic Text -> Builder
buildText (Text -> DynamicSize Text
forall a. a -> DynamicSize a
DynamicSize (Text -> DynamicSize Text) -> Text -> DynamicSize Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unwords ([Text] -> Text)
-> ([Annotation] -> [Text]) -> [Annotation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation -> Text) -> [Annotation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Annotation -> Text
annotToText ([Annotation] -> Text) -> [Annotation] -> Text
forall a b. (a -> b) -> a -> b
$ [Annotation]
listAnn)

-------------------------------------------------
-- Decode
-------------------------------------------------

-- | Decode 'Expression' from 'ByteString'.
eitherDecodeExpression :: BS.ByteString -> Either UnpackError Expression
eitherDecodeExpression :: ByteString -> Either UnpackError (Exp RegularExp)
eitherDecodeExpression ByteString
x = Get (Exp RegularExp)
-> LByteString -> Either UnpackError (Exp RegularExp)
forall a. Get a -> LByteString -> Either UnpackError a
launchGet (Get (Exp RegularExp)
getExpr Get (Exp RegularExp) -> Get () -> Get (Exp RegularExp)
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
ensureEnd) (LByteString -> Either UnpackError (Exp RegularExp))
-> LByteString -> Either UnpackError (Exp RegularExp)
forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
LBS.fromStrict ByteString
x

-- | Partial version of 'eitherDecodeExpression'.
decodeExpression :: HasCallStack => BS.ByteString -> Expression
decodeExpression :: HasCallStack => ByteString -> Exp RegularExp
decodeExpression = (UnpackError -> Exp RegularExp)
-> (Exp RegularExp -> Exp RegularExp)
-> Either UnpackError (Exp RegularExp)
-> Exp RegularExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Exp RegularExp
forall a. HasCallStack => Text -> a
error (Text -> Exp RegularExp)
-> (UnpackError -> Text) -> UnpackError -> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpackError -> Text
unUnpackError) Exp RegularExp -> Exp RegularExp
forall a. a -> a
id (Either UnpackError (Exp RegularExp) -> Exp RegularExp)
-> (ByteString -> Either UnpackError (Exp RegularExp))
-> ByteString
-> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnpackError (Exp RegularExp)
eitherDecodeExpression

getExpr :: Bi.Get Expression
getExpr :: Get (Exp RegularExp)
getExpr = Get Word8
Bi.getWord8 Get Word8
-> (Word8 -> Get (Exp RegularExp)) -> Get (Exp RegularExp)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0 -> XExpInt RegularExp -> Integer -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt () (Integer -> Exp RegularExp) -> Get Integer -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger
  Word8
1 -> XExpString RegularExp -> Text -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString () (Text -> Exp RegularExp)
-> (DynamicSize Text -> Text) -> DynamicSize Text -> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize Text -> Text
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize Text -> Exp RegularExp)
-> Get (DynamicSize Text) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Text -> Get (DynamicSize Text)
forall a. Get a -> Get (DynamicSize a)
getDynamic Get Text
getText)
  Word8
2 -> XExpSeq RegularExp -> [Exp RegularExp] -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq () ([Exp RegularExp] -> Exp RegularExp)
-> (DynamicSize [Exp RegularExp] -> [Exp RegularExp])
-> DynamicSize [Exp RegularExp]
-> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize [Exp RegularExp] -> [Exp RegularExp]
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize [Exp RegularExp] -> Exp RegularExp)
-> Get (DynamicSize [Exp RegularExp]) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get [Exp RegularExp] -> Get (DynamicSize [Exp RegularExp])
forall a. Get a -> Get (DynamicSize a)
getDynamic Get [Exp RegularExp]
getList)
  Word8
3 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> (MichelinePrimitive -> MichelinePrimAp RegularExp)
-> MichelinePrimitive
-> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\MichelinePrimitive
pn -> MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp MichelinePrimitive
pn [] []) (MichelinePrimitive -> Exp RegularExp)
-> Get MichelinePrimitive -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim
  Word8
4 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((MichelinePrimitive
 -> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> [Exp RegularExp]
-> MichelinePrimitive
-> [Annotation]
-> MichelinePrimAp RegularExp
forall a b c. (a -> b -> c) -> b -> a -> c
flip MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp [] (MichelinePrimitive -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get ([Annotation] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Annotation] -> MichelinePrimAp RegularExp)
-> Get [Annotation] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
5 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp (MichelinePrimitive
 -> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get
     ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get
  ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get [Exp RegularExp]
-> Get ([Annotation] -> MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (OneItem [Exp RegularExp] -> [Exp RegularExp]
Exp RegularExp -> [Exp RegularExp]
forall x. One x => OneItem x -> x
one (Exp RegularExp -> [Exp RegularExp])
-> Get (Exp RegularExp) -> Get [Exp RegularExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Exp RegularExp)
getExpr) Get ([Annotation] -> MichelinePrimAp RegularExp)
-> Get [Annotation] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Annotation] -> Get [Annotation]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  Word8
6 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp (MichelinePrimitive
 -> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get
     ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get
  ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get [Exp RegularExp]
-> Get ([Annotation] -> MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (OneItem [Exp RegularExp] -> [Exp RegularExp]
Exp RegularExp -> [Exp RegularExp]
forall x. One x => OneItem x -> x
one (Exp RegularExp -> [Exp RegularExp])
-> Get (Exp RegularExp) -> Get [Exp RegularExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Exp RegularExp)
getExpr) Get ([Annotation] -> MichelinePrimAp RegularExp)
-> Get [Annotation] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
7 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\MichelinePrimitive
n [Exp RegularExp]
a -> MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp MichelinePrimitive
n [Exp RegularExp]
a []) (MichelinePrimitive
 -> [Exp RegularExp] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get ([Exp RegularExp] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Exp RegularExp] -> MichelinePrimAp RegularExp)
-> Get [Exp RegularExp] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get (Exp RegularExp) -> Get [Exp RegularExp]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Get (Exp RegularExp)
getExpr)
  Word8
8 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp (MichelinePrimitive
 -> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get
     ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get
  ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get [Exp RegularExp]
-> Get ([Annotation] -> MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get (Exp RegularExp) -> Get [Exp RegularExp]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Get (Exp RegularExp)
getExpr Get ([Annotation] -> MichelinePrimAp RegularExp)
-> Get [Annotation] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
9 -> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Exp RegularExp)
-> Get (MichelinePrimAp RegularExp) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp (MichelinePrimitive
 -> [Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get MichelinePrimitive
-> Get
     ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get
  ([Exp RegularExp] -> [Annotation] -> MichelinePrimAp RegularExp)
-> Get [Exp RegularExp]
-> Get ([Annotation] -> MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DynamicSize [Exp RegularExp] -> [Exp RegularExp]
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize [Exp RegularExp] -> [Exp RegularExp])
-> Get (DynamicSize [Exp RegularExp]) -> Get [Exp RegularExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get [Exp RegularExp] -> Get (DynamicSize [Exp RegularExp])
forall a. Get a -> Get (DynamicSize a)
getDynamic Get [Exp RegularExp]
getList)) Get ([Annotation] -> MichelinePrimAp RegularExp)
-> Get [Annotation] -> Get (MichelinePrimAp RegularExp)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
10 -> XExpBytes RegularExp -> ByteString -> Exp RegularExp
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes () (ByteString -> Exp RegularExp)
-> (DynamicSize ByteString -> ByteString)
-> DynamicSize ByteString
-> Exp RegularExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize ByteString -> ByteString
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize ByteString -> Exp RegularExp)
-> Get (DynamicSize ByteString) -> Get (Exp RegularExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get ByteString -> Get (DynamicSize ByteString)
forall a. Get a -> Get (DynamicSize a)
getDynamic Get ByteString
getByteString)
  Word8
_ -> String -> Get (Exp RegularExp)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid Micheline expression tag"

getList :: Bi.Get [Expression]
getList :: Get [Exp RegularExp]
getList = Get (Exp RegularExp) -> Get [Exp RegularExp]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get (Exp RegularExp)
getExpr

getPrim :: Bi.Get MichelinePrimitive
getPrim :: Get MichelinePrimitive
getPrim = Get MichelinePrimitive
-> (MichelinePrimitive -> Get MichelinePrimitive)
-> Maybe MichelinePrimitive
-> Get MichelinePrimitive
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get MichelinePrimitive
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown Michelson/Micheline opcode") MichelinePrimitive -> Get MichelinePrimitive
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MichelinePrimitive -> Get MichelinePrimitive)
-> (Word8 -> Maybe MichelinePrimitive)
-> Word8
-> Get MichelinePrimitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe MichelinePrimitive
forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumSafe (Int -> Maybe MichelinePrimitive)
-> (Word8 -> Int) -> Word8 -> Maybe MichelinePrimitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral
  (Word8 -> Get MichelinePrimitive)
-> Get Word8 -> Get MichelinePrimitive
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
Bi.getWord8

getAnnotationList :: Bi.Get [Annotation]
getAnnotationList :: Get [Annotation]
getAnnotationList = (Text -> Get Annotation) -> [Text] -> Get [Annotation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Get Annotation
forall (m :: * -> *). MonadFail m => Text -> m Annotation
annotFromText ([Text] -> Get [Annotation])
-> (DynamicSize Text -> [Text])
-> DynamicSize Text
-> Get [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
words (Text -> [Text])
-> (DynamicSize Text -> Text) -> DynamicSize Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize Text -> Text
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize Text -> Get [Annotation])
-> Get (DynamicSize Text) -> Get [Annotation]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Get Text -> Get (DynamicSize Text)
forall a. Get a -> Get (DynamicSize a)
getDynamic Get Text
getText)