-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

module Michelson.Untyped.Value
  ( Value' (..)
  , Elt (..)
  -- Internal types to avoid orphan instances
  , InternalByteString(..)
  , unInternalByteString
  ) where

import Data.Aeson (FromJSON(..), ToJSON(..), withText)
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Fmt (Buildable(build))
import Text.Hex (decodeHex, encodeHex)
import Text.PrettyPrint.Leijen.Text
  (Doc, braces, dquotes, enclose, semi, space, text, textStrict, (<+>))

import Michelson.Printer.Util
  (RenderDoc(..), addParens, buildRenderDoc, doesntNeedParens, needsParens, renderOps)
import Michelson.Text
import 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 or a set.
  -- We can't distinguish lists and sets during parsing.
  | ValueMap     (NonEmpty $ Elt op)
  | ValueLambda  (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, a -> Value' b -> Value' a
(a -> b) -> Value' a -> Value' b
(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
<$ :: a -> Value' b -> Value' a
$c<$ :: forall a b. a -> Value' b -> Value' a
fmap :: (a -> b) -> Value' a -> Value' b
$cfmap :: forall a b. (a -> b) -> Value' a -> Value' b
Functor, Typeable (Value' op)
DataType
Constr
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 d. Data d => c (t d)) -> Maybe (c (Value' op))
(forall b. Data b => b -> b) -> Value' op -> Value' op
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value' op -> c (Value' op)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
$cValueLambda :: Constr
$cValueMap :: Constr
$cValueSeq :: Constr
$cValueNil :: Constr
$cValueNone :: Constr
$cValueSome :: Constr
$cValueRight :: Constr
$cValueLeft :: Constr
$cValuePair :: Constr
$cValueFalse :: Constr
$cValueTrue :: Constr
$cValueUnit :: Constr
$cValueBytes :: Constr
$cValueString :: Constr
$cValueInt :: Constr
$tValue' :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Value' op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Value' op -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall op. Data op => Typeable (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, a -> Elt b -> Elt a
(a -> b) -> Elt a -> Elt b
(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
<$ :: a -> Elt b -> Elt a
$c<$ :: forall a b. a -> Elt b -> Elt a
fmap :: (a -> b) -> Elt a -> Elt b
$cfmap :: forall a b. (a -> b) -> Elt a -> Elt b
Functor, Typeable (Elt op)
DataType
Constr
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 d. Data d => c (t d)) -> Maybe (c (Elt op))
(forall b. Data b => b -> b) -> Elt op -> Elt op
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Elt op -> c (Elt op)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
$cElt :: Constr
$tElt :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Elt op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Elt op -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall op. Data op => Typeable (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
DataType
Constr
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalByteString
-> c InternalByteString
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cInternalByteString :: Constr
$tInternalByteString :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> InternalByteString -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InternalByteString -> u
gmapQ :: (forall d. Data d => d -> u) -> InternalByteString -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InternalByteString -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 bs :: ByteString
bs) = ByteString
bs

instance RenderDoc op => RenderDoc (Value' op) where
  renderDoc :: RenderContext -> Value' op -> Doc
renderDoc pn :: RenderContext
pn =
    \case
      ValueNil       -> "{ }"
      ValueInt x :: 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. (Show a, IsString b) => a -> b
show (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Integer
x
      ValueString x :: 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 xs :: InternalByteString
xs  -> "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)
      ValueUnit      -> "Unit"
      ValueTrue      -> "True"
      ValueFalse     -> "False"
      ValuePair l :: Value' op
l r :: Value' op
r  -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                        "Pair" Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
l Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
r
      ValueLeft l :: Value' op
l    -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                        "Left" Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
l
      ValueRight r :: Value' op
r   -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                        "Right" Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
r
      ValueSome x :: Value' op
x    -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                        "Some"  Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
x
      ValueNone      -> "None"
      ValueSeq xs :: 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 xs :: 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 xs :: NonEmpty op
xs -> Bool -> NonEmpty op -> Doc
forall op. RenderDoc op => Bool -> NonEmpty op -> Doc
renderOps Bool
True NonEmpty op
xs

renderElt :: RenderDoc op => Elt op -> Doc
renderElt :: Elt op -> Doc
renderElt (Elt k :: Value' op
k v :: Value' op
v) =
   "Elt" Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
k Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v

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

renderValuesList :: (e -> Doc) -> NonEmpty e -> Doc
renderValuesList :: (e -> Doc) -> NonEmpty e -> Doc
renderValuesList renderElem :: e -> Doc
renderElem (NonEmpty e -> [Element (NonEmpty e)]
forall t. Container t => t -> [Element t]
toList -> [Element (NonEmpty e)]
es) =
  Doc -> Doc
braces (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> Doc
enclose Doc
space Doc
space (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (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 "Hex-encoded bytestring" ((Text -> Parser InternalByteString)
 -> Value -> Parser InternalByteString)
-> (Text -> Parser InternalByteString)
-> Value
-> Parser InternalByteString
forall a b. (a -> b) -> a -> b
$ \t :: Text
t ->
      case Text -> Maybe ByteString
decodeHex Text
t of
        Nothing -> String -> Parser InternalByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid hex encoding"
        Just res :: ByteString
res -> InternalByteString -> Parser InternalByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> InternalByteString
InternalByteString ByteString
res)

deriveJSON morleyAesonOptions ''Value'
deriveJSON morleyAesonOptions ''Elt