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

-- | Untyped Michelson values (i. e. type of a value is not statically known).

module Morley.Michelson.Untyped.Value
  ( Value' (..)
  , Elt (..)
  -- Internal types to avoid orphan instances
  , InternalByteString(..)
  , unInternalByteString
  , linearizeRightCombValuePair
  , renderValuesList
  , renderSome
  , renderNone
  , renderLeft
  , renderRight
  , renderPair
  , renderElt'
  ) where

import Prelude hiding (group)

import Data.Aeson (FromJSON(..), ToJSON(..), withText)
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.List.NonEmpty ((<|))
import Fmt (Buildable(build))
import Text.Hex (decodeHex, encodeHex)
import Text.PrettyPrint.Leijen.Text
  (Doc, align, dquotes, encloseSep, group, hang, lbrace, rbrace, semi, sep, softline, space, text,
  textStrict, (<+>))
import Text.PrettyPrint.Leijen.Text qualified as PP

import Morley.Michelson.Printer.Util
  (RenderContext, RenderDoc(..), addParensMultiline, buildRenderDoc, doesntNeedParens, needsParens,
  renderOps)
import Morley.Michelson.Text
import Morley.Util.Aeson

data Value' op =
    ValueInt     Integer
  | ValueString  MText
  | ValueBytes   InternalByteString
  | ValueUnit
  | ValueTrue
  | ValueFalse
  | ValuePair    (Value' op) (Value' op)
  | ValueLeft    (Value' op)
  | ValueRight   (Value' op)
  | ValueSome    (Value' op)
  | ValueNone
  | ValueNil
  | ValueSeq     (NonEmpty $ Value' op)
  -- ^ A sequence of elements: can be a list, a set or a pair.
  -- We can't distinguish lists and sets during parsing.
  | ValueMap     (NonEmpty $ Elt op)
  | ValueLambda  (NonEmpty op)
  | ValueLamRec  (NonEmpty op)
  deriving stock (Value' op -> Value' op -> Bool
(Value' op -> Value' op -> Bool)
-> (Value' op -> Value' op -> Bool) -> Eq (Value' op)
forall op. Eq op => Value' op -> Value' op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value' op -> Value' op -> Bool
$c/= :: forall op. Eq op => Value' op -> Value' op -> Bool
== :: Value' op -> Value' op -> Bool
$c== :: forall op. Eq op => Value' op -> Value' op -> Bool
Eq, Int -> Value' op -> ShowS
[Value' op] -> ShowS
Value' op -> String
(Int -> Value' op -> ShowS)
-> (Value' op -> String)
-> ([Value' op] -> ShowS)
-> Show (Value' op)
forall op. Show op => Int -> Value' op -> ShowS
forall op. Show op => [Value' op] -> ShowS
forall op. Show op => Value' op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value' op] -> ShowS
$cshowList :: forall op. Show op => [Value' op] -> ShowS
show :: Value' op -> String
$cshow :: forall op. Show op => Value' op -> String
showsPrec :: Int -> Value' op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> Value' op -> ShowS
Show, (forall a b. (a -> b) -> Value' a -> Value' b)
-> (forall a b. a -> Value' b -> Value' a) -> Functor Value'
forall a b. a -> Value' b -> Value' a
forall a b. (a -> b) -> Value' a -> Value' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Value' b -> Value' a
$c<$ :: forall a b. a -> Value' b -> Value' a
fmap :: forall a b. (a -> b) -> Value' a -> Value' b
$cfmap :: forall a b. (a -> b) -> Value' a -> Value' b
Functor, Typeable (Value' op)
Typeable (Value' op)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Value' op -> c (Value' op))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Value' op))
-> (Value' op -> Constr)
-> (Value' op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Value' op)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Value' op)))
-> ((forall b. Data b => b -> b) -> Value' op -> Value' op)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Value' op -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Value' op -> r)
-> (forall u. (forall d. Data d => d -> u) -> Value' op -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Value' op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Value' op -> m (Value' op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value' op -> m (Value' op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value' op -> m (Value' op))
-> Data (Value' op)
Value' op -> DataType
Value' op -> Constr
(forall b. Data b => b -> b) -> Value' op -> Value' op
forall {op}. Data op => Typeable (Value' op)
forall op. Data op => Value' op -> DataType
forall op. Data op => Value' op -> Constr
forall op.
Data op =>
(forall b. Data b => b -> b) -> Value' op -> Value' op
forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Value' op -> u
forall op u.
Data op =>
(forall d. Data d => d -> u) -> Value' op -> [u]
forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Value' op)
forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value' op -> c (Value' op)
forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Value' op))
forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Value' op))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Value' op -> u
forall u. (forall d. Data d => d -> u) -> Value' op -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Value' op)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value' op -> c (Value' op)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Value' op))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Value' op))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
$cgmapMp :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Value' op -> m (Value' op)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value' op -> u
$cgmapQi :: forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Value' op -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Value' op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Value' op -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
$cgmapQl :: forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Value' op -> r
gmapT :: (forall b. Data b => b -> b) -> Value' op -> Value' op
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b) -> Value' op -> Value' op
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Value' op))
$cdataCast2 :: forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Value' op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Value' op))
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Value' op))
dataTypeOf :: Value' op -> DataType
$cdataTypeOf :: forall op. Data op => Value' op -> DataType
toConstr :: Value' op -> Constr
$ctoConstr :: forall op. Data op => Value' op -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Value' op)
$cgunfold :: forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Value' op)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value' op -> c (Value' op)
$cgfoldl :: forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value' op -> c (Value' op)
Data, (forall x. Value' op -> Rep (Value' op) x)
-> (forall x. Rep (Value' op) x -> Value' op)
-> Generic (Value' op)
forall x. Rep (Value' op) x -> Value' op
forall x. Value' op -> Rep (Value' op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (Value' op) x -> Value' op
forall op x. Value' op -> Rep (Value' op) x
$cto :: forall op x. Rep (Value' op) x -> Value' op
$cfrom :: forall op x. Value' op -> Rep (Value' op) x
Generic)

instance NFData op => NFData (Value' op)

data Elt op = Elt (Value' op) (Value' op)
  deriving stock (Elt op -> Elt op -> Bool
(Elt op -> Elt op -> Bool)
-> (Elt op -> Elt op -> Bool) -> Eq (Elt op)
forall op. Eq op => Elt op -> Elt op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elt op -> Elt op -> Bool
$c/= :: forall op. Eq op => Elt op -> Elt op -> Bool
== :: Elt op -> Elt op -> Bool
$c== :: forall op. Eq op => Elt op -> Elt op -> Bool
Eq, Int -> Elt op -> ShowS
[Elt op] -> ShowS
Elt op -> String
(Int -> Elt op -> ShowS)
-> (Elt op -> String) -> ([Elt op] -> ShowS) -> Show (Elt op)
forall op. Show op => Int -> Elt op -> ShowS
forall op. Show op => [Elt op] -> ShowS
forall op. Show op => Elt op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elt op] -> ShowS
$cshowList :: forall op. Show op => [Elt op] -> ShowS
show :: Elt op -> String
$cshow :: forall op. Show op => Elt op -> String
showsPrec :: Int -> Elt op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> Elt op -> ShowS
Show, (forall a b. (a -> b) -> Elt a -> Elt b)
-> (forall a b. a -> Elt b -> Elt a) -> Functor Elt
forall a b. a -> Elt b -> Elt a
forall a b. (a -> b) -> Elt a -> Elt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Elt b -> Elt a
$c<$ :: forall a b. a -> Elt b -> Elt a
fmap :: forall a b. (a -> b) -> Elt a -> Elt b
$cfmap :: forall a b. (a -> b) -> Elt a -> Elt b
Functor, Typeable (Elt op)
Typeable (Elt op)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Elt op -> c (Elt op))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Elt op))
-> (Elt op -> Constr)
-> (Elt op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Elt op)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Elt op)))
-> ((forall b. Data b => b -> b) -> Elt op -> Elt op)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Elt op -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Elt op -> r)
-> (forall u. (forall d. Data d => d -> u) -> Elt op -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Elt op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Elt op -> m (Elt op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Elt op -> m (Elt op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Elt op -> m (Elt op))
-> Data (Elt op)
Elt op -> DataType
Elt op -> Constr
(forall b. Data b => b -> b) -> Elt op -> Elt op
forall {op}. Data op => Typeable (Elt op)
forall op. Data op => Elt op -> DataType
forall op. Data op => Elt op -> Constr
forall op.
Data op =>
(forall b. Data b => b -> b) -> Elt op -> Elt op
forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Elt op -> u
forall op u.
Data op =>
(forall d. Data d => d -> u) -> Elt op -> [u]
forall op r r'.
Data op =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
forall op r r'.
Data op =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Elt op)
forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Elt op -> c (Elt op)
forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Elt op))
forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Elt op))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Elt op -> u
forall u. (forall d. Data d => d -> u) -> Elt op -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Elt op)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Elt op -> c (Elt op)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Elt op))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Elt op))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
$cgmapMp :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Elt op -> m (Elt op)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Elt op -> u
$cgmapQi :: forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Elt op -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Elt op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Elt op -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
$cgmapQl :: forall op r r'.
Data op =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Elt op -> r
gmapT :: (forall b. Data b => b -> b) -> Elt op -> Elt op
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b) -> Elt op -> Elt op
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Elt op))
$cdataCast2 :: forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Elt op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Elt op))
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Elt op))
dataTypeOf :: Elt op -> DataType
$cdataTypeOf :: forall op. Data op => Elt op -> DataType
toConstr :: Elt op -> Constr
$ctoConstr :: forall op. Data op => Elt op -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Elt op)
$cgunfold :: forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Elt op)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Elt op -> c (Elt op)
$cgfoldl :: forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Elt op -> c (Elt op)
Data, (forall x. Elt op -> Rep (Elt op) x)
-> (forall x. Rep (Elt op) x -> Elt op) -> Generic (Elt op)
forall x. Rep (Elt op) x -> Elt op
forall x. Elt op -> Rep (Elt op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (Elt op) x -> Elt op
forall op x. Elt op -> Rep (Elt op) x
$cto :: forall op x. Rep (Elt op) x -> Elt op
$cfrom :: forall op x. Elt op -> Rep (Elt op) x
Generic)

instance NFData op => NFData (Elt op)

-- | ByteString does not have an instance for ToJSON and FromJSON, to
-- avoid orphan type class instances, make a new type wrapper around it.
newtype InternalByteString = InternalByteString ByteString
  deriving stock (Typeable InternalByteString
Typeable InternalByteString
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InternalByteString
    -> c InternalByteString)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InternalByteString)
-> (InternalByteString -> Constr)
-> (InternalByteString -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InternalByteString))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InternalByteString))
-> ((forall b. Data b => b -> b)
    -> InternalByteString -> InternalByteString)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InternalByteString -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InternalByteString -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InternalByteString -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InternalByteString -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InternalByteString -> m InternalByteString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InternalByteString -> m InternalByteString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InternalByteString -> m InternalByteString)
-> Data InternalByteString
InternalByteString -> DataType
InternalByteString -> Constr
(forall b. Data b => b -> b)
-> InternalByteString -> InternalByteString
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InternalByteString -> u
forall u. (forall d. Data d => d -> u) -> InternalByteString -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalByteString
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalByteString
-> c InternalByteString
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InternalByteString)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalByteString)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InternalByteString -> m InternalByteString
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InternalByteString -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InternalByteString -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InternalByteString -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InternalByteString -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalByteString -> r
gmapT :: (forall b. Data b => b -> b)
-> InternalByteString -> InternalByteString
$cgmapT :: (forall b. Data b => b -> b)
-> InternalByteString -> InternalByteString
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalByteString)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalByteString)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InternalByteString)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InternalByteString)
dataTypeOf :: InternalByteString -> DataType
$cdataTypeOf :: InternalByteString -> DataType
toConstr :: InternalByteString -> Constr
$ctoConstr :: InternalByteString -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalByteString
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalByteString
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalByteString
-> c InternalByteString
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalByteString
-> c InternalByteString
Data, InternalByteString -> InternalByteString -> Bool
(InternalByteString -> InternalByteString -> Bool)
-> (InternalByteString -> InternalByteString -> Bool)
-> Eq InternalByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalByteString -> InternalByteString -> Bool
$c/= :: InternalByteString -> InternalByteString -> Bool
== :: InternalByteString -> InternalByteString -> Bool
$c== :: InternalByteString -> InternalByteString -> Bool
Eq, Int -> InternalByteString -> ShowS
[InternalByteString] -> ShowS
InternalByteString -> String
(Int -> InternalByteString -> ShowS)
-> (InternalByteString -> String)
-> ([InternalByteString] -> ShowS)
-> Show InternalByteString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalByteString] -> ShowS
$cshowList :: [InternalByteString] -> ShowS
show :: InternalByteString -> String
$cshow :: InternalByteString -> String
showsPrec :: Int -> InternalByteString -> ShowS
$cshowsPrec :: Int -> InternalByteString -> ShowS
Show, (forall x. InternalByteString -> Rep InternalByteString x)
-> (forall x. Rep InternalByteString x -> InternalByteString)
-> Generic InternalByteString
forall x. Rep InternalByteString x -> InternalByteString
forall x. InternalByteString -> Rep InternalByteString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalByteString x -> InternalByteString
$cfrom :: forall x. InternalByteString -> Rep InternalByteString x
Generic)

instance NFData InternalByteString

unInternalByteString :: InternalByteString -> ByteString
unInternalByteString :: InternalByteString -> ByteString
unInternalByteString (InternalByteString ByteString
bs) = ByteString
bs

instance RenderDoc op => RenderDoc (Value' op) where
  renderDoc :: RenderContext -> Value' op -> Doc
renderDoc RenderContext
pn =
    \case
      Value' op
ValueNil       -> Doc
"{ }"
      ValueInt Integer
x     -> Text -> Doc
text (Text -> Doc) -> (Integer -> Text) -> Integer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Integer
x
      ValueString MText
x  -> Doc -> Doc
dquotes (Text -> Doc
textStrict (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ MText -> Text
writeMText MText
x)
      ValueBytes InternalByteString
xs  -> Doc
"0x" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc
textStrict (Text -> Doc)
-> (InternalByteString -> Text) -> InternalByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (InternalByteString -> ByteString) -> InternalByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalByteString -> ByteString
unInternalByteString (InternalByteString -> Doc) -> InternalByteString -> Doc
forall a b. (a -> b) -> a -> b
$ InternalByteString
xs)
      Value' op
ValueUnit      -> Doc
"Unit"
      Value' op
ValueTrue      -> Doc
"True"
      Value' op
ValueFalse     -> Doc
"False"
      p :: Value' op
p@(ValuePair Value' op
_ (ValuePair Value' op
_ Value' op
_))  ->
        let encodedValues :: NonEmpty (Value' op)
encodedValues = Value' op -> NonEmpty (Value' op)
forall op. Value' op -> NonEmpty (Value' op)
linearizeRightCombValuePair Value' op
p
        in (Value' op -> Doc) -> NonEmpty (Value' op) -> Doc
forall e. (e -> Doc) -> NonEmpty e -> Doc
renderValuesList (RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens) NonEmpty (Value' op)
encodedValues
      ValuePair Value' op
l Value' op
r  -> RenderContext
-> (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderPair  RenderContext
pn ((RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
l) ((RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
r)
      ValueLeft Value' op
l    -> RenderContext -> (RenderContext -> Doc) -> Doc
renderLeft  RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ (RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
l
      ValueRight Value' op
r   -> RenderContext -> (RenderContext -> Doc) -> Doc
renderRight RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ (RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
r
      ValueSome Value' op
x    -> RenderContext -> (RenderContext -> Doc) -> Doc
renderSome  RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ (RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
x
      Value' op
ValueNone      -> Doc
renderNone
      ValueSeq NonEmpty (Value' op)
xs    -> (Value' op -> Doc) -> NonEmpty (Value' op) -> Doc
forall e. (e -> Doc) -> NonEmpty e -> Doc
renderValuesList (RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens) NonEmpty (Value' op)
xs
      ValueMap NonEmpty $ Elt op
xs    -> (Elt op -> Doc) -> (NonEmpty $ Elt op) -> Doc
forall e. (e -> Doc) -> NonEmpty e -> Doc
renderValuesList Elt op -> Doc
forall op. RenderDoc op => Elt op -> Doc
renderElt NonEmpty $ Elt op
xs
      ValueLambda NonEmpty op
xs -> Bool -> NonEmpty op -> Doc
forall op. RenderDoc op => Bool -> NonEmpty op -> Doc
renderOps Bool
False NonEmpty op
xs
      ValueLamRec NonEmpty op
xs -> Doc
"Lambda_rec" Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (Bool -> NonEmpty op -> Doc
forall op. RenderDoc op => Bool -> NonEmpty op -> Doc
renderOps Bool
False NonEmpty op
xs)

-- | Helper function to render @None@ @Value@
renderNone :: Doc
renderNone :: Doc
renderNone = Doc
"None"

-- | Helper functions to render @Value@s
renderSome, renderLeft, renderRight :: RenderContext -> (RenderContext -> Doc) -> Doc
renderSome :: RenderContext -> (RenderContext -> Doc) -> Doc
renderSome  RenderContext
pn RenderContext -> Doc
render = RenderContext -> Doc -> Doc
renderContainer RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Some" Doc -> Doc -> Doc
PP.<$> RenderContext -> Doc
render RenderContext
needsParens
renderLeft :: RenderContext -> (RenderContext -> Doc) -> Doc
renderLeft  RenderContext
pn RenderContext -> Doc
render = RenderContext -> Doc -> Doc
renderContainer RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Left" Doc -> Doc -> Doc
PP.<$> RenderContext -> Doc
render RenderContext
needsParens
renderRight :: RenderContext -> (RenderContext -> Doc) -> Doc
renderRight RenderContext
pn RenderContext -> Doc
render = RenderContext -> Doc -> Doc
renderContainer RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Right" Doc -> Doc -> Doc
PP.<$> RenderContext -> Doc
render RenderContext
needsParens

-- | Helper function to format container values such as @Some@ and @Right@.
renderContainer :: RenderContext -> Doc -> Doc
renderContainer :: RenderContext -> Doc -> Doc
renderContainer RenderContext
pn Doc
doc = RenderContext -> Doc -> Doc
addParensMultiline RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
doc

-- | Helper function to render @Pair@ @Value@
renderPair :: RenderContext -> (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderPair :: RenderContext
-> (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderPair RenderContext
pn RenderContext -> Doc
l RenderContext -> Doc
r = RenderContext -> Doc -> Doc
addParensMultiline RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
  [Doc] -> Doc
sep [Doc
"Pair", RenderContext -> Doc
l RenderContext
needsParens, RenderContext -> Doc
r RenderContext
needsParens]

-- | Helper function to render @Elt@
renderElt' :: (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderElt' :: (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderElt' RenderContext -> Doc
l RenderContext -> Doc
r = Doc
"Elt" Doc -> Doc -> Doc
<+> RenderContext -> Doc
l RenderContext
needsParens Doc -> Doc -> Doc
<+> RenderContext -> Doc
r RenderContext
needsParens

-- | Converts @Pair a (Pair b c)@ to @[a, b, c]@.
linearizeRightCombValuePair :: (Value' op) -> NonEmpty (Value' op)
linearizeRightCombValuePair :: forall op. Value' op -> NonEmpty (Value' op)
linearizeRightCombValuePair (ValuePair Value' op
l Value' op
r) = Value' op
l Value' op -> NonEmpty (Value' op) -> NonEmpty (Value' op)
forall a. a -> NonEmpty a -> NonEmpty a
<| Value' op -> NonEmpty (Value' op)
forall op. Value' op -> NonEmpty (Value' op)
linearizeRightCombValuePair Value' op
r
linearizeRightCombValuePair Value' op
v = Value' op
v Value' op -> [Value' op] -> NonEmpty (Value' op)
forall a. a -> [a] -> NonEmpty a
:| []

renderElt :: RenderDoc op => Elt op -> Doc
renderElt :: forall op. RenderDoc op => Elt op -> Doc
renderElt (Elt Value' op
k Value' op
v) = (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
renderElt' ((RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
k) ((RenderContext -> Value' op -> Doc)
-> Value' op -> RenderContext -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc Value' op
v)

instance RenderDoc op => RenderDoc (Elt op) where
  renderDoc :: RenderContext -> Elt op -> Doc
renderDoc RenderContext
_ = Elt op -> Doc
forall op. RenderDoc op => Elt op -> Doc
renderElt

-- | A helper function that renders a 'NonEmpty' list of items in Michelson-readable format,
-- given a rendering function for a single item.
renderValuesList :: (e -> Doc) -> NonEmpty e -> Doc
renderValuesList :: forall e. (e -> Doc) -> NonEmpty e -> Doc
renderValuesList e -> Doc
renderElem (NonEmpty e -> [Element (NonEmpty e)]
forall t. Container t => t -> [Element t]
toList -> [Element (NonEmpty e)]
es) =
  Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep (Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) (Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace) (Doc
semi Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
    e -> Doc
renderElem (e -> Doc) -> [e] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e]
[Element (NonEmpty e)]
es

instance (RenderDoc op) => Buildable (Value' op) where
  build :: Value' op -> Builder
build = Value' op -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

instance (RenderDoc op) => Buildable (Elt op) where
  build :: Elt op -> Builder
build = Elt op -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

----------------------------------------------------------------------------
-- JSON serialization
----------------------------------------------------------------------------

-- it is not possible to derives these automatically because
-- ByteString does not have a ToJSON or FromJSON instance

instance ToJSON InternalByteString where
  toJSON :: InternalByteString -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (InternalByteString -> Text) -> InternalByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (InternalByteString -> ByteString) -> InternalByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalByteString -> ByteString
unInternalByteString

instance FromJSON InternalByteString where
  parseJSON :: Value -> Parser InternalByteString
parseJSON =
    String
-> (Text -> Parser InternalByteString)
-> Value
-> Parser InternalByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Hex-encoded bytestring" ((Text -> Parser InternalByteString)
 -> Value -> Parser InternalByteString)
-> (Text -> Parser InternalByteString)
-> Value
-> Parser InternalByteString
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Maybe ByteString
decodeHex Text
t of
        Maybe ByteString
Nothing -> String -> Parser InternalByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid hex encoding"
        Just ByteString
res -> InternalByteString -> Parser InternalByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> InternalByteString
InternalByteString ByteString
res)

$(mconcat
  [ deriveJSON morleyAesonOptions ''Value'
  , deriveJSON morleyAesonOptions ''Elt
  ])