-- 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 Data.Sequence qualified as Seq
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 :: Expression -> LByteString
encodeExpression = Builder -> LByteString
Bi.toLazyByteString (Builder -> LByteString)
-> (Expression -> Builder) -> Expression -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Builder
buildExpr

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

buildExpr :: Expression -> Bi.Builder
buildExpr :: Expression -> Builder
buildExpr = \case
  ExpressionSeq [Expression]
xs -> Word8 -> Builder
buildWord8 Word8
2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Expression] -> Builder) -> DynamicSize [Expression] -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic [Expression] -> Builder
buildList ([Expression] -> DynamicSize [Expression]
forall a. a -> DynamicSize a
DynamicSize [Expression]
xs)
  ExpressionPrim (MichelinePrimAp MichelinePrimitive
prim [Expression]
args [Annotation]
annots) -> case ([Expression]
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
    ([Expression
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
<> Expression -> Builder
buildExpr Expression
arg1
    ([Expression
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
<> Expression -> Builder
buildExpr Expression
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
    ([Expression
arg1, Expression
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
<> Expression -> Builder
buildExpr Expression
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expression -> Builder
buildExpr Expression
arg2
    ([Expression
arg1, Expression
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
<> Expression -> Builder
buildExpr Expression
arg1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expression -> Builder
buildExpr Expression
arg2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
    ([Expression], [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
<> ([Expression] -> Builder) -> DynamicSize [Expression] -> Builder
forall a. (a -> Builder) -> DynamicSize a -> Builder
buildDynamic [Expression] -> Builder
buildList ([Expression] -> DynamicSize [Expression]
forall a. a -> DynamicSize a
DynamicSize [Expression]
args) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> Builder
buildAnnotationList [Annotation]
annots
  ExpressionString 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)
  ExpressionInt Integer
x -> Word8 -> Builder
buildWord8 Word8
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
buildInteger Integer
x
  ExpressionBytes 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 :: [Expression] -> Builder
buildList = (Element [Expression] -> Builder) -> [Expression] -> Builder
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element [Expression] -> Builder
Expression -> Builder
buildExpr

buildPrim :: MichelinePrimitive -> Bi.Builder
buildPrim :: MichelinePrimitive -> Builder
buildPrim (MichelinePrimitive Text
p) = case Text -> Seq Text -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL Text
p Seq Text
michelsonPrimitive of
  Maybe Int
Nothing -> Text -> Builder
forall a. HasCallStack => Text -> a
error (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
"unknown Michelson/Micheline primitive: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
  Just Int
ix -> Word8 -> Builder
buildWord8 (Int -> Word8
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word8 Int
ix)

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 (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 Expression
eitherDecodeExpression ByteString
x = Get Expression -> LByteString -> Either UnpackError Expression
forall a. Get a -> LByteString -> Either UnpackError a
launchGet (Get Expression
getExpr Get Expression -> Get () -> Get Expression
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
ensureEnd) (LByteString -> Either UnpackError Expression)
-> LByteString -> Either UnpackError Expression
forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
LBS.fromStrict ByteString
x

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

getExpr :: Bi.Get Expression
getExpr :: Get Expression
getExpr = Get Word8
Bi.getWord8 Get Word8 -> (Word8 -> Get Expression) -> Get Expression
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0 -> Integer -> Expression
ExpressionInt (Integer -> Expression) -> Get Integer -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger
  Word8
1 -> Text -> Expression
ExpressionString (Text -> Expression)
-> (DynamicSize Text -> Text) -> DynamicSize Text -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize Text -> Text
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize Text -> Expression)
-> Get (DynamicSize Text) -> Get Expression
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 -> [Expression] -> Expression
ExpressionSeq ([Expression] -> Expression)
-> (DynamicSize [Expression] -> [Expression])
-> DynamicSize [Expression]
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize [Expression] -> [Expression]
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize [Expression] -> Expression)
-> Get (DynamicSize [Expression]) -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get [Expression] -> Get (DynamicSize [Expression])
forall a. Get a -> Get (DynamicSize a)
getDynamic Get [Expression]
getList)
  Word8
3 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> (MichelinePrimitive -> MichelinePrimAp)
-> MichelinePrimitive
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\MichelinePrimitive
pn -> MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp MichelinePrimitive
pn [] []) (MichelinePrimitive -> Expression)
-> Get MichelinePrimitive -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim
  Word8
4 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> [Expression]
-> MichelinePrimitive
-> [Annotation]
-> MichelinePrimAp
forall a b c. (a -> b -> c) -> b -> a -> c
flip MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp [] (MichelinePrimitive -> [Annotation] -> MichelinePrimAp)
-> Get MichelinePrimitive -> Get ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Annotation] -> MichelinePrimAp)
-> Get [Annotation] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
5 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> Get MichelinePrimitive
-> Get ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Expression] -> [Annotation] -> MichelinePrimAp)
-> Get [Expression] -> Get ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expression -> [Expression]
forall x. One x => OneItem x -> x
one (Expression -> [Expression]) -> Get Expression -> Get [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Expression
getExpr) Get ([Annotation] -> MichelinePrimAp)
-> Get [Annotation] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Annotation] -> Get [Annotation]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  Word8
6 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> Get MichelinePrimitive
-> Get ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Expression] -> [Annotation] -> MichelinePrimAp)
-> Get [Expression] -> Get ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expression -> [Expression]
forall x. One x => OneItem x -> x
one (Expression -> [Expression]) -> Get Expression -> Get [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Expression
getExpr) Get ([Annotation] -> MichelinePrimAp)
-> Get [Annotation] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
7 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\MichelinePrimitive
n [Expression]
a -> MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp MichelinePrimitive
n [Expression]
a []) (MichelinePrimitive -> [Expression] -> MichelinePrimAp)
-> Get MichelinePrimitive -> Get ([Expression] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Expression] -> MichelinePrimAp)
-> Get [Expression] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Expression -> Get [Expression]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Get Expression
getExpr)
  Word8
8 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> Get MichelinePrimitive
-> Get ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Expression] -> [Annotation] -> MichelinePrimAp)
-> Get [Expression] -> Get ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Expression -> Get [Expression]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Get Expression
getExpr Get ([Annotation] -> MichelinePrimAp)
-> Get [Annotation] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
9 -> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Get MichelinePrimAp -> Get Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> Get MichelinePrimitive
-> Get ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MichelinePrimitive
getPrim Get ([Expression] -> [Annotation] -> MichelinePrimAp)
-> Get [Expression] -> Get ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DynamicSize [Expression] -> [Expression]
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize [Expression] -> [Expression])
-> Get (DynamicSize [Expression]) -> Get [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get [Expression] -> Get (DynamicSize [Expression])
forall a. Get a -> Get (DynamicSize a)
getDynamic Get [Expression]
getList)) Get ([Annotation] -> MichelinePrimAp)
-> Get [Annotation] -> Get MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Annotation]
getAnnotationList)
  Word8
10 -> ByteString -> Expression
ExpressionBytes (ByteString -> Expression)
-> (DynamicSize ByteString -> ByteString)
-> DynamicSize ByteString
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicSize ByteString -> ByteString
forall a. DynamicSize a -> a
unDynamicSize (DynamicSize ByteString -> Expression)
-> Get (DynamicSize ByteString) -> Get Expression
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 Expression
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid Micheline expression tag"

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

getPrim :: Bi.Get MichelinePrimitive
getPrim :: Get MichelinePrimitive
getPrim =
  Get Word8
Bi.getWord8 Get Word8
-> (Word8 -> Get MichelinePrimitive) -> Get MichelinePrimitive
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
ix -> case Int -> Seq Text -> Maybe Text
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Word8 -> Int
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral Word8
ix) Seq Text
michelsonPrimitive of
    Maybe Text
Nothing -> String -> Get MichelinePrimitive
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown Michelson/Micheline opcode"
    Just Text
str -> MichelinePrimitive -> Get MichelinePrimitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MichelinePrimitive -> Get MichelinePrimitive)
-> MichelinePrimitive -> Get MichelinePrimitive
forall a b. (a -> b) -> a -> b
$ Text -> MichelinePrimitive
MichelinePrimitive Text
str

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)
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)