-- SPDX-FileCopyrightText: 2020 Tocqueville Group
-- SPDX-FileCopyrightText: 2018 obsidian.systems
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ
-- SPDX-License-Identifier: LicenseRef-MIT-obsidian-systems

-- | Module that defines Expression type, its related types
-- and its JSON instance.
module Morley.Micheline.Expression
  ( Expression(.., PrimExpr)
  , MichelinePrimAp(..)
  , MichelinePrimitive(..)
  , michelsonPrimitive

  , Annotation (..)
  , annotToText
  , annotFromText
  , isAnnotationField
  , isAnnotationType
  , isAnnotationVariable
  , isNoAnn
  , mkAnns
  , toAnnSet

  -- * Prisms
  , _ExpressionPrim
  , _AnnotationField
  , _AnnotationVariable
  , _AnnotationType

  -- * Lenses
  , mpaAnnotsL
  ) where

import Control.Lens (Plated)
import Control.Lens.TH

import Data.Aeson
  (FromJSON, ToJSON, object, parseJSON, toEncoding, toJSON, withObject, withText, (.!=), (.:),
  (.:?), (.=))
import qualified Data.Aeson.Encoding.Internal as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Data (Data)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Sequence as Seq
import qualified Data.Text as T (uncons)
import Fmt (Buildable(..), pretty, (+|), (|+))

import Morley.Micheline.Json (StringEncode(StringEncode, unStringEncode))
import qualified Morley.Michelson.Untyped as U
import Morley.Michelson.Untyped.Annotation
  (AnnotationSet(..), FieldAnn, FieldTag, KnownAnnTag(..), TypeAnn, TypeTag, VarAnn, VarTag,
  annPrefix, fullAnnSet, minimizeAnnSet, mkAnnotation)
import Morley.Tezos.Crypto (encodeBase58Check)
import Morley.Util.ByteString (HexJSONByteString(..))

newtype MichelinePrimitive = MichelinePrimitive Text
  deriving newtype (MichelinePrimitive -> MichelinePrimitive -> Bool
(MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> Eq MichelinePrimitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c/= :: MichelinePrimitive -> MichelinePrimitive -> Bool
== :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c== :: MichelinePrimitive -> MichelinePrimitive -> Bool
Eq, Eq MichelinePrimitive
Eq MichelinePrimitive
-> (MichelinePrimitive -> MichelinePrimitive -> Ordering)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> Bool)
-> (MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive)
-> (MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive)
-> Ord MichelinePrimitive
MichelinePrimitive -> MichelinePrimitive -> Bool
MichelinePrimitive -> MichelinePrimitive -> Ordering
MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
$cmin :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
max :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
$cmax :: MichelinePrimitive -> MichelinePrimitive -> MichelinePrimitive
>= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c>= :: MichelinePrimitive -> MichelinePrimitive -> Bool
> :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c> :: MichelinePrimitive -> MichelinePrimitive -> Bool
<= :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c<= :: MichelinePrimitive -> MichelinePrimitive -> Bool
< :: MichelinePrimitive -> MichelinePrimitive -> Bool
$c< :: MichelinePrimitive -> MichelinePrimitive -> Bool
compare :: MichelinePrimitive -> MichelinePrimitive -> Ordering
$ccompare :: MichelinePrimitive -> MichelinePrimitive -> Ordering
$cp1Ord :: Eq MichelinePrimitive
Ord, [MichelinePrimitive] -> Encoding
[MichelinePrimitive] -> Value
MichelinePrimitive -> Encoding
MichelinePrimitive -> Value
(MichelinePrimitive -> Value)
-> (MichelinePrimitive -> Encoding)
-> ([MichelinePrimitive] -> Value)
-> ([MichelinePrimitive] -> Encoding)
-> ToJSON MichelinePrimitive
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MichelinePrimitive] -> Encoding
$ctoEncodingList :: [MichelinePrimitive] -> Encoding
toJSONList :: [MichelinePrimitive] -> Value
$ctoJSONList :: [MichelinePrimitive] -> Value
toEncoding :: MichelinePrimitive -> Encoding
$ctoEncoding :: MichelinePrimitive -> Encoding
toJSON :: MichelinePrimitive -> Value
$ctoJSON :: MichelinePrimitive -> Value
ToJSON, Value -> Parser [MichelinePrimitive]
Value -> Parser MichelinePrimitive
(Value -> Parser MichelinePrimitive)
-> (Value -> Parser [MichelinePrimitive])
-> FromJSON MichelinePrimitive
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MichelinePrimitive]
$cparseJSONList :: Value -> Parser [MichelinePrimitive]
parseJSON :: Value -> Parser MichelinePrimitive
$cparseJSON :: Value -> Parser MichelinePrimitive
FromJSON)
  deriving stock (Int -> MichelinePrimitive -> ShowS
[MichelinePrimitive] -> ShowS
MichelinePrimitive -> String
(Int -> MichelinePrimitive -> ShowS)
-> (MichelinePrimitive -> String)
-> ([MichelinePrimitive] -> ShowS)
-> Show MichelinePrimitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MichelinePrimitive] -> ShowS
$cshowList :: [MichelinePrimitive] -> ShowS
show :: MichelinePrimitive -> String
$cshow :: MichelinePrimitive -> String
showsPrec :: Int -> MichelinePrimitive -> ShowS
$cshowsPrec :: Int -> MichelinePrimitive -> ShowS
Show, Typeable MichelinePrimitive
DataType
Constr
Typeable MichelinePrimitive
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> MichelinePrimitive
    -> c MichelinePrimitive)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MichelinePrimitive)
-> (MichelinePrimitive -> Constr)
-> (MichelinePrimitive -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MichelinePrimitive))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MichelinePrimitive))
-> ((forall b. Data b => b -> b)
    -> MichelinePrimitive -> MichelinePrimitive)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MichelinePrimitive -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MichelinePrimitive -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimitive -> m MichelinePrimitive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimitive -> m MichelinePrimitive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimitive -> m MichelinePrimitive)
-> Data MichelinePrimitive
MichelinePrimitive -> DataType
MichelinePrimitive -> Constr
(forall b. Data b => b -> b)
-> MichelinePrimitive -> MichelinePrimitive
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MichelinePrimitive
-> c MichelinePrimitive
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimitive
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) -> MichelinePrimitive -> u
forall u. (forall d. Data d => d -> u) -> MichelinePrimitive -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimitive
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MichelinePrimitive
-> c MichelinePrimitive
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MichelinePrimitive)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimitive)
$cMichelinePrimitive :: Constr
$tMichelinePrimitive :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
gmapMp :: (forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
gmapM :: (forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MichelinePrimitive -> m MichelinePrimitive
gmapQi :: Int -> (forall d. Data d => d -> u) -> MichelinePrimitive -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MichelinePrimitive -> u
gmapQ :: (forall d. Data d => d -> u) -> MichelinePrimitive -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MichelinePrimitive -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimitive -> r
gmapT :: (forall b. Data b => b -> b)
-> MichelinePrimitive -> MichelinePrimitive
$cgmapT :: (forall b. Data b => b -> b)
-> MichelinePrimitive -> MichelinePrimitive
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimitive)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimitive)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MichelinePrimitive)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MichelinePrimitive)
dataTypeOf :: MichelinePrimitive -> DataType
$cdataTypeOf :: MichelinePrimitive -> DataType
toConstr :: MichelinePrimitive -> Constr
$ctoConstr :: MichelinePrimitive -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimitive
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimitive
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MichelinePrimitive
-> c MichelinePrimitive
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MichelinePrimitive
-> c MichelinePrimitive
$cp1Data :: Typeable MichelinePrimitive
Data)

michelsonPrimitive :: Seq Text
michelsonPrimitive :: Seq Text
michelsonPrimitive = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList [
  -- NOTE: The order of this list *matters*!
  --
  -- The position of each item in the list determines which binary code it gets packed to.
  -- E.g.
  --   * "parameter" is at index 0 on the list, so it gets packed to `0x0300`
  --   * "storage" is at index 1, so it gets packed to `0x0301`
  --
  -- You can ask `tezos-client` which code corresponds to a given instruction/type/constructor.
  --
  -- > tezos-client convert data 'storage' from michelson to binary
  -- > 0x0301
  --
  -- Whenever new instructions/types/constructors are added to the protocol,
  -- we can regenerate this list using this script:
  --
  -- > ./scripts/get-micheline-exprs.sh
  --
  Text
"parameter", Text
"storage", Text
"code", Text
"False", Text
"Elt", Text
"Left", Text
"None", Text
"Pair",
  Text
"Right", Text
"Some", Text
"True", Text
"Unit", Text
"PACK", Text
"UNPACK", Text
"BLAKE2B", Text
"SHA256",
  Text
"SHA512", Text
"ABS", Text
"ADD", Text
"AMOUNT", Text
"AND", Text
"BALANCE", Text
"CAR", Text
"CDR",
  Text
"CHECK_SIGNATURE", Text
"COMPARE", Text
"CONCAT", Text
"CONS", Text
"CREATE_ACCOUNT", Text
"CREATE_CONTRACT", Text
"IMPLICIT_ACCOUNT", Text
"DIP",
  Text
"DROP", Text
"DUP", Text
"EDIV", Text
"EMPTY_MAP", Text
"EMPTY_SET", Text
"EQ", Text
"EXEC", Text
"FAILWITH",
  Text
"GE", Text
"GET", Text
"GT", Text
"HASH_KEY", Text
"IF", Text
"IF_CONS", Text
"IF_LEFT", Text
"IF_NONE",
  Text
"INT", Text
"LAMBDA", Text
"LE", Text
"LEFT", Text
"LOOP", Text
"LSL", Text
"LSR", Text
"LT",
  Text
"MAP", Text
"MEM", Text
"MUL", Text
"NEG", Text
"NEQ", Text
"NIL", Text
"NONE", Text
"NOT",
  Text
"NOW", Text
"OR", Text
"PAIR", Text
"PUSH", Text
"RIGHT", Text
"SIZE", Text
"SOME", Text
"SOURCE",
  Text
"SENDER", Text
"SELF", Text
"STEPS_TO_QUOTA", Text
"SUB", Text
"SWAP", Text
"TRANSFER_TOKENS", Text
"SET_DELEGATE", Text
"UNIT",
  Text
"UPDATE", Text
"XOR", Text
"ITER", Text
"LOOP_LEFT", Text
"ADDRESS", Text
"CONTRACT", Text
"ISNAT", Text
"CAST",
  Text
"RENAME", Text
"bool", Text
"contract", Text
"int", Text
"key", Text
"key_hash", Text
"lambda", Text
"list",
  Text
"map", Text
"big_map", Text
"nat", Text
"option", Text
"or", Text
"pair", Text
"set", Text
"signature",
  Text
"string", Text
"bytes", Text
"mutez", Text
"timestamp", Text
"unit", Text
"operation", Text
"address", Text
"SLICE",
  Text
"DIG", Text
"DUG", Text
"EMPTY_BIG_MAP", Text
"APPLY", Text
"chain_id", Text
"CHAIN_ID", Text
"LEVEL", Text
"SELF_ADDRESS",
  Text
"never", Text
"NEVER", Text
"UNPAIR", Text
"VOTING_POWER", Text
"TOTAL_VOTING_POWER", Text
"KECCAK", Text
"SHA3", Text
"PAIRING_CHECK",
  Text
"bls12_381_g1", Text
"bls12_381_g2", Text
"bls12_381_fr", Text
"sapling_state", Text
"sapling_transaction", Text
"SAPLING_EMPTY_STATE", Text
"SAPLING_VERIFY_UPDATE", Text
"ticket",
  Text
"TICKET", Text
"READ_TICKET", Text
"SPLIT_TICKET", Text
"JOIN_TICKETS", Text
"GET_AND_UPDATE"
  ]

-- | Type for Micheline Expression
data Expression
  = ExpressionInt Integer
    -- ^ Micheline represents both nats and ints using the same decimal format.
    -- The Haskell Integer type spans all possible values that the final
    -- (Michelson) type could end up being, and then some, so we use
    -- (StringEncode Integer) to represent all integral values here for easy
    -- JSON encoding compatibility.
  | ExpressionString Text
  | ExpressionBytes ByteString
  | ExpressionSeq [Expression]
  | ExpressionPrim MichelinePrimAp
  deriving stock (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show, Typeable Expression
DataType
Constr
Typeable Expression
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Expression -> c Expression)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Expression)
-> (Expression -> Constr)
-> (Expression -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Expression))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Expression))
-> ((forall b. Data b => b -> b) -> Expression -> Expression)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Expression -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Expression -> r)
-> (forall u. (forall d. Data d => d -> u) -> Expression -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Expression -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> Data Expression
Expression -> DataType
Expression -> Constr
(forall b. Data b => b -> b) -> Expression -> Expression
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
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) -> Expression -> u
forall u. (forall d. Data d => d -> u) -> Expression -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expression)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
$cExpressionPrim :: Constr
$cExpressionSeq :: Constr
$cExpressionBytes :: Constr
$cExpressionString :: Constr
$cExpressionInt :: Constr
$tExpression :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Expression -> m Expression
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapMp :: (forall d. Data d => d -> m d) -> Expression -> m Expression
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapM :: (forall d. Data d => d -> m d) -> Expression -> m Expression
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapQi :: Int -> (forall d. Data d => d -> u) -> Expression -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expression -> u
gmapQ :: (forall d. Data d => d -> u) -> Expression -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Expression -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
gmapT :: (forall b. Data b => b -> b) -> Expression -> Expression
$cgmapT :: (forall b. Data b => b -> b) -> Expression -> Expression
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Expression)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expression)
dataTypeOf :: Expression -> DataType
$cdataTypeOf :: Expression -> DataType
toConstr :: Expression -> Constr
$ctoConstr :: Expression -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
$cp1Data :: Typeable Expression
Data)

pattern PrimExpr :: Text -> [Expression] -> [Annotation] -> Expression
pattern $bPrimExpr :: Text -> [Expression] -> [Annotation] -> Expression
$mPrimExpr :: forall r.
Expression
-> (Text -> [Expression] -> [Annotation] -> r) -> (Void# -> r) -> r
PrimExpr primName args anns =
  ExpressionPrim (MichelinePrimAp (MichelinePrimitive primName) args anns)

instance Plated Expression

instance Buildable Expression where
  build :: Expression -> Builder
build = \case
    ExpressionInt Integer
i -> Integer -> Builder
forall p. Buildable p => p -> Builder
build (Integer -> Builder) -> Integer -> Builder
forall a b. (a -> b) -> a -> b
$ Integer
i
    ExpressionString Text
s -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
s
    ExpressionBytes ByteString
b ->
      Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeBase58Check ByteString
b
    ExpressionSeq [Expression]
s -> Builder
"(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| (Expression -> Builder) -> [Expression] -> Builder
forall c a. (Monoid c, IsString c) => (a -> c) -> [a] -> c
buildList Expression -> Builder
forall p. Buildable p => p -> Builder
build [Expression]
s Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")"
    ExpressionPrim (MichelinePrimAp (MichelinePrimitive Text
text) [Expression]
s [Annotation]
annots) ->
      Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      (Expression -> Builder) -> [Expression] -> Builder
forall c a. (Monoid c, IsString c) => (a -> c) -> [a] -> c
buildList Expression -> Builder
forall p. Buildable p => p -> Builder
build [Expression]
s Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
") " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      (Annotation -> Builder) -> [Annotation] -> Builder
forall c a. (Monoid c, IsString c) => (a -> c) -> [a] -> c
buildList (Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Annotation -> Text) -> Annotation -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText) [Annotation]
annots
    where
      buildList :: (a -> c) -> [a] -> c
buildList a -> c
buildElem = [c] -> c
forall a. Monoid a => [a] -> a
mconcat ([c] -> c) -> ([a] -> [c]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse c
", " ([c] -> [c]) -> ([a] -> [c]) -> [a] -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> c) -> [a] -> [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> c
buildElem

data Annotation
  = AnnotationType TypeAnn
  | AnnotationVariable VarAnn
  | AnnotationField FieldAnn
  deriving stock (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, Typeable Annotation
DataType
Constr
Typeable Annotation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Annotation -> c Annotation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Annotation)
-> (Annotation -> Constr)
-> (Annotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Annotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Annotation))
-> ((forall b. Data b => b -> b) -> Annotation -> Annotation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Annotation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Annotation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Annotation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Annotation -> m Annotation)
-> Data Annotation
Annotation -> DataType
Annotation -> Constr
(forall b. Data b => b -> b) -> Annotation -> Annotation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
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) -> Annotation -> u
forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cAnnotationField :: Constr
$cAnnotationVariable :: Constr
$cAnnotationType :: Constr
$tAnnotation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapMp :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapM :: (forall d. Data d => d -> m d) -> Annotation -> m Annotation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Annotation -> m Annotation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Annotation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
gmapQ :: (forall d. Data d => d -> u) -> Annotation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Annotation -> r
gmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
$cgmapT :: (forall b. Data b => b -> b) -> Annotation -> Annotation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Annotation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Annotation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Annotation)
dataTypeOf :: Annotation -> DataType
$cdataTypeOf :: Annotation -> DataType
toConstr :: Annotation -> Constr
$ctoConstr :: Annotation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Annotation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Annotation -> c Annotation
$cp1Data :: Typeable Annotation
Data)

data MichelinePrimAp = MichelinePrimAp
  { MichelinePrimAp -> MichelinePrimitive
mpaPrim :: MichelinePrimitive
  , MichelinePrimAp -> [Expression]
mpaArgs :: [Expression]
  , MichelinePrimAp -> [Annotation]
mpaAnnots :: [Annotation]
  } deriving stock (MichelinePrimAp -> MichelinePrimAp -> Bool
(MichelinePrimAp -> MichelinePrimAp -> Bool)
-> (MichelinePrimAp -> MichelinePrimAp -> Bool)
-> Eq MichelinePrimAp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MichelinePrimAp -> MichelinePrimAp -> Bool
$c/= :: MichelinePrimAp -> MichelinePrimAp -> Bool
== :: MichelinePrimAp -> MichelinePrimAp -> Bool
$c== :: MichelinePrimAp -> MichelinePrimAp -> Bool
Eq, Int -> MichelinePrimAp -> ShowS
[MichelinePrimAp] -> ShowS
MichelinePrimAp -> String
(Int -> MichelinePrimAp -> ShowS)
-> (MichelinePrimAp -> String)
-> ([MichelinePrimAp] -> ShowS)
-> Show MichelinePrimAp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MichelinePrimAp] -> ShowS
$cshowList :: [MichelinePrimAp] -> ShowS
show :: MichelinePrimAp -> String
$cshow :: MichelinePrimAp -> String
showsPrec :: Int -> MichelinePrimAp -> ShowS
$cshowsPrec :: Int -> MichelinePrimAp -> ShowS
Show, Typeable MichelinePrimAp
DataType
Constr
Typeable MichelinePrimAp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MichelinePrimAp -> c MichelinePrimAp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MichelinePrimAp)
-> (MichelinePrimAp -> Constr)
-> (MichelinePrimAp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MichelinePrimAp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MichelinePrimAp))
-> ((forall b. Data b => b -> b)
    -> MichelinePrimAp -> MichelinePrimAp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MichelinePrimAp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MichelinePrimAp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimAp -> m MichelinePrimAp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimAp -> m MichelinePrimAp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MichelinePrimAp -> m MichelinePrimAp)
-> Data MichelinePrimAp
MichelinePrimAp -> DataType
MichelinePrimAp -> Constr
(forall b. Data b => b -> b) -> MichelinePrimAp -> MichelinePrimAp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MichelinePrimAp -> c MichelinePrimAp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimAp
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) -> MichelinePrimAp -> u
forall u. (forall d. Data d => d -> u) -> MichelinePrimAp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimAp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MichelinePrimAp -> c MichelinePrimAp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MichelinePrimAp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimAp)
$cMichelinePrimAp :: Constr
$tMichelinePrimAp :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
gmapMp :: (forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
gmapM :: (forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MichelinePrimAp -> m MichelinePrimAp
gmapQi :: Int -> (forall d. Data d => d -> u) -> MichelinePrimAp -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MichelinePrimAp -> u
gmapQ :: (forall d. Data d => d -> u) -> MichelinePrimAp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MichelinePrimAp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MichelinePrimAp -> r
gmapT :: (forall b. Data b => b -> b) -> MichelinePrimAp -> MichelinePrimAp
$cgmapT :: (forall b. Data b => b -> b) -> MichelinePrimAp -> MichelinePrimAp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimAp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MichelinePrimAp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MichelinePrimAp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MichelinePrimAp)
dataTypeOf :: MichelinePrimAp -> DataType
$cdataTypeOf :: MichelinePrimAp -> DataType
toConstr :: MichelinePrimAp -> Constr
$ctoConstr :: MichelinePrimAp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimAp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MichelinePrimAp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MichelinePrimAp -> c MichelinePrimAp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MichelinePrimAp -> c MichelinePrimAp
$cp1Data :: Typeable MichelinePrimAp
Data)

instance FromJSON MichelinePrimAp where
  parseJSON :: Value -> Parser MichelinePrimAp
parseJSON = String
-> (Object -> Parser MichelinePrimAp)
-> Value
-> Parser MichelinePrimAp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Prim" ((Object -> Parser MichelinePrimAp)
 -> Value -> Parser MichelinePrimAp)
-> (Object -> Parser MichelinePrimAp)
-> Value
-> Parser MichelinePrimAp
forall a b. (a -> b) -> a -> b
$ \Object
v -> MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp
    (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> Parser MichelinePrimitive
-> Parser ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser MichelinePrimitive
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"prim"
    Parser ([Expression] -> [Annotation] -> MichelinePrimAp)
-> Parser [Expression] -> Parser ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Expression])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"args" Parser (Maybe [Expression]) -> [Expression] -> Parser [Expression]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser ([Annotation] -> MichelinePrimAp)
-> Parser [Annotation] -> Parser MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Annotation])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"annots" Parser (Maybe [Annotation]) -> [Annotation] -> Parser [Annotation]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

instance ToJSON MichelinePrimAp where
  toJSON :: MichelinePrimAp -> Value
toJSON MichelinePrimAp {[Annotation]
[Expression]
MichelinePrimitive
mpaAnnots :: [Annotation]
mpaArgs :: [Expression]
mpaPrim :: MichelinePrimitive
mpaAnnots :: MichelinePrimAp -> [Annotation]
mpaArgs :: MichelinePrimAp -> [Expression]
mpaPrim :: MichelinePrimAp -> MichelinePrimitive
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
    [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
"prim" Text -> MichelinePrimitive -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MichelinePrimitive
mpaPrim)
    , if [Expression] -> Bool
forall t. Container t => t -> Bool
null [Expression]
mpaArgs then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
"args" Text -> [Expression] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Expression]
mpaArgs)
    , if [Annotation] -> Bool
forall t. Container t => t -> Bool
null [Annotation]
mpaAnnots then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
"annots" Text -> [Annotation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Annotation]
mpaAnnots)
    ]

annotFromText :: forall m. MonadFail m => Text -> m Annotation
annotFromText :: Text -> m Annotation
annotFromText Text
txt = do
  (Char
n, Text
t) <-
    m (Char, Text)
-> ((Char, Text) -> m (Char, Text))
-> Maybe (Char, Text)
-> m (Char, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (Char, Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Char, Text)) -> String -> m (Char, Text)
forall a b. (a -> b) -> a -> b
$ String
"Annotation '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' is missing an annotation prefix.") (Char, Text) -> m (Char, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Char, Text) -> m (Char, Text))
-> Maybe (Char, Text) -> m (Char, Text)
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe (Char, Text)
T.uncons Text
txt
  if | String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== KnownAnnTag TypeTag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @TypeTag  -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation)
-> Either Text TypeAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text TypeAnn
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
     | String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== KnownAnnTag VarTag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @VarTag   -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation)
-> Either Text VarAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text VarAnn
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
     | String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== KnownAnnTag FieldTag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @FieldTag -> Either Text Annotation -> m Annotation
forall a. Either Text a -> m a
handleErr (Either Text Annotation -> m Annotation)
-> Either Text Annotation -> m Annotation
forall a b. (a -> b) -> a -> b
$ FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation)
-> Either Text FieldAnn -> Either Text Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text FieldAnn
forall k (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
t
     | Bool
otherwise                         -> String -> m Annotation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Annotation) -> String -> m Annotation
forall a b. (a -> b) -> a -> b
$ String
"Unknown annotation type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt

  where
    handleErr :: Either Text a -> m a
    handleErr :: Either Text a -> m a
handleErr = \case
      Left Text
err -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse annotation '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
txt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
err
      Right a
a -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

annotToText :: Annotation -> Text
annotToText :: Annotation -> Text
annotToText = \case
  AnnotationType TypeAnn
n -> TypeAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty TypeAnn
n
  AnnotationVariable VarAnn
n -> VarAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty VarAnn
n
  AnnotationField FieldAnn
n -> FieldAnn -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty FieldAnn
n

mkAnns :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas =
  let minAnnSet :: AnnotationSet
minAnnSet = AnnotationSet -> AnnotationSet
minimizeAnnSet (AnnotationSet -> AnnotationSet) -> AnnotationSet -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas
  in (TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation) -> [TypeAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [TypeAnn]
asTypes AnnotationSet
minAnnSet) [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<>
     (FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> [FieldAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [FieldAnn]
asFields AnnotationSet
minAnnSet) [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<>
     (VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation) -> [VarAnn] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotationSet -> [VarAnn]
asVars AnnotationSet
minAnnSet)

isAnnotationField :: Annotation -> Bool
isAnnotationField :: Annotation -> Bool
isAnnotationField = \case
  AnnotationField FieldAnn
_ -> Bool
True
  Annotation
_                 -> Bool
False

isAnnotationVariable :: Annotation -> Bool
isAnnotationVariable :: Annotation -> Bool
isAnnotationVariable = \case
  AnnotationVariable VarAnn
_ -> Bool
True
  Annotation
_                    -> Bool
False

isAnnotationType :: Annotation -> Bool
isAnnotationType :: Annotation -> Bool
isAnnotationType = \case
  AnnotationType TypeAnn
_ -> Bool
True
  Annotation
_                -> Bool
False

isNoAnn :: Annotation -> Bool
isNoAnn :: Annotation -> Bool
isNoAnn = \case
  AnnotationVariable (U.Annotation Text
"") -> Bool
True
  AnnotationField (U.Annotation Text
"")    -> Bool
True
  AnnotationType (U.Annotation Text
"")     -> Bool
True
  Annotation
_                                    -> Bool
False

toAnnSet :: [Annotation] -> AnnotationSet
toAnnSet :: [Annotation] -> AnnotationSet
toAnnSet = (Element [Annotation] -> AnnotationSet)
-> [Annotation] -> AnnotationSet
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap ((Element [Annotation] -> AnnotationSet)
 -> [Annotation] -> AnnotationSet)
-> (Element [Annotation] -> AnnotationSet)
-> [Annotation]
-> AnnotationSet
forall a b. (a -> b) -> a -> b
$ \case
  AnnotationType a     -> TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet TypeAnn
a
  AnnotationField a    -> FieldAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet FieldAnn
a
  AnnotationVariable a -> VarAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet VarAnn
a

instance FromJSON Annotation where
  parseJSON :: Value -> Parser Annotation
parseJSON = String -> (Text -> Parser Annotation) -> Value -> Parser Annotation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Annotation" Text -> Parser Annotation
forall (m :: * -> *). MonadFail m => Text -> m Annotation
annotFromText

instance ToJSON Annotation where
  toJSON :: Annotation -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Annotation -> Text) -> Annotation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText
  toEncoding :: Annotation -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (Annotation -> Text) -> Annotation -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Text
annotToText

instance FromJSON Expression where
  parseJSON :: Value -> Parser Expression
parseJSON Value
v = [Expression] -> Expression
ExpressionSeq ([Expression] -> Expression)
-> Parser [Expression] -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Expression]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> Parser MichelinePrimAp -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MichelinePrimAp
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Expression
ExpressionString (Text -> Expression) -> Parser Text -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionString" (Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"string") Value
v
            Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Expression
ExpressionInt (Integer -> Expression)
-> (StringEncode Integer -> Integer)
-> StringEncode Integer
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringEncode Integer -> Integer
forall a. StringEncode a -> a
unStringEncode (StringEncode Integer -> Expression)
-> Parser (StringEncode Integer) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser (StringEncode Integer))
-> Value
-> Parser (StringEncode Integer)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionInt" (Object -> Text -> Parser (StringEncode Integer)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"int") Value
v
            Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Expression
ExpressionBytes (ByteString -> Expression)
-> (HexJSONByteString -> ByteString)
-> HexJSONByteString
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexJSONByteString -> ByteString
unHexJSONByteString (HexJSONByteString -> Expression)
-> Parser HexJSONByteString -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser HexJSONByteString)
-> Value
-> Parser HexJSONByteString
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExpressionBytes" (Object -> Text -> Parser HexJSONByteString
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"bytes") Value
v

instance ToJSON Expression where
  toJSON :: Expression -> Value
toJSON (ExpressionSeq [Expression]
xs) = [Expression] -> Value
forall a. ToJSON a => a -> Value
toJSON [Expression]
xs
  toJSON (ExpressionPrim MichelinePrimAp
xs) = MichelinePrimAp -> Value
forall a. ToJSON a => a -> Value
toJSON MichelinePrimAp
xs
  toJSON (ExpressionString Text
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"string" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x)
  toJSON (ExpressionInt Integer
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"int" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ StringEncode Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (StringEncode Integer -> Value) -> StringEncode Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x)
  toJSON (ExpressionBytes ByteString
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"bytes" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ HexJSONByteString -> Value
forall a. ToJSON a => a -> Value
toJSON (HexJSONByteString -> Value) -> HexJSONByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x)

  toEncoding :: Expression -> Encoding
toEncoding (ExpressionSeq [Expression]
xs) = [Expression] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Expression]
xs
  toEncoding (ExpressionPrim MichelinePrimAp
xs) = MichelinePrimAp -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding MichelinePrimAp
xs
  toEncoding (ExpressionString Text
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair Text
"string" (Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
x))
  toEncoding (ExpressionInt Integer
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair Text
"int" (StringEncode Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (StringEncode Integer -> Encoding)
-> StringEncode Integer -> Encoding
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncode Integer
forall a. a -> StringEncode a
StringEncode Integer
x))
  toEncoding (ExpressionBytes ByteString
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair Text
"bytes" (HexJSONByteString -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (HexJSONByteString -> Encoding) -> HexJSONByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> HexJSONByteString
HexJSONByteString ByteString
x))

makePrisms ''Expression
makePrisms ''Annotation
makeLensesFor [("mpaAnnots", "mpaAnnotsL")] ''MichelinePrimAp