-- 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
  ( Annotation(..)
  , Expression(..)
  , MichelinePrimAp(..)
  , MichelinePrimitive(..)
  , michelsonPrimitive
  , annotToText
  , annotFromText
  ) where

import Control.Lens (Plated)
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 Michelson.Untyped.Annotation
  (FieldAnn, FieldTag, KnownAnnTag(..), TypeAnn, TypeTag, VarAnn, VarTag, ann, annPrefix)
import qualified Michelson.Untyped.Annotation as MUA (Annotation)
import Morley.Micheline.Json (StringEncode(StringEncode, unStringEncode))
import Tezos.Crypto (encodeBase58Check)
import 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 [
  "parameter", "storage", "code", "False", "Elt", "Left", "None", "Pair",
  "Right", "Some", "True", "Unit", "PACK", "UNPACK", "BLAKE2B", "SHA256",
  "SHA512", "ABS", "ADD", "AMOUNT", "AND", "BALANCE", "CAR", "CDR",
  "CHECK_SIGNATURE", "COMPARE", "CONCAT", "CONS", "CREATE_ACCOUNT",
  "CREATE_CONTRACT", "IMPLICIT_ACCOUNT", "DIP", "DROP", "DUP", "EDIV",
  "EMPTY_MAP", "EMPTY_SET", "EQ", "EXEC", "FAILWITH", "GE", "GET", "GT",
  "HASH_KEY", "IF", "IF_CONS", "IF_LEFT", "IF_NONE", "INT", "LAMBDA",
  "LE", "LEFT", "LOOP", "LSL", "LSR", "LT", "MAP", "MEM", "MUL", "NEG",
  "NEQ", "NIL", "NONE", "NOT", "NOW", "OR", "PAIR", "PUSH", "RIGHT",
  "SIZE", "SOME", "SOURCE", "SENDER", "SELF", "STEPS_TO_QUOTA", "SUB",
  "SWAP", "TRANSFER_TOKENS", "SET_DELEGATE", "UNIT", "UPDATE", "XOR",
  "ITER", "LOOP_LEFT", "ADDRESS", "CONTRACT", "ISNAT", "CAST", "RENAME",
  "bool", "contract", "int", "key", "key_hash", "lambda", "list", "map",
  "big_map", "nat", "option", "or", "pair", "set", "signature", "string",
  "bytes", "mutez", "timestamp", "unit", "operation", "address", "SLICE",
  "DIG", "DUG", "EMPTY_BIG_MAP", "APPLY", "chain_id", "CHAIN_ID", "SHA3",
  "KECCAK", "LEVEL"
  ]

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

instance Plated Expression

instance Buildable Expression where
  build :: Expression -> Builder
build = \case
    ExpressionInt i :: 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 s :: Text
s -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
s
    ExpressionBytes b :: 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 s :: Seq Expression
s -> "(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| (Element (Seq Expression) -> Builder) -> Seq Expression -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq Element (Seq Expression) -> Builder
forall p. Buildable p => p -> Builder
build Seq Expression
s Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ")"
    ExpressionPrim (MichelinePrimAp (MichelinePrimitive text :: Text
text) s :: Seq Expression
s annots :: Seq Annotation
annots) ->
      Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ "(" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      (Element (Seq Expression) -> Builder) -> Seq Expression -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq Element (Seq Expression) -> Builder
forall p. Buildable p => p -> Builder
build Seq Expression
s Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ") " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      (Element (Seq Annotation) -> Builder) -> Seq Annotation -> Builder
forall c t.
(Monoid c, IsString c, Container t) =>
(Element t -> c) -> t -> c
buildSeq (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) Seq Annotation
annots
    where
      buildSeq :: (Element t -> c) -> t -> c
buildSeq buildElem :: Element t -> c
buildElem =
        [c] -> c
forall a. Monoid a => [a] -> a
mconcat ([c] -> c) -> (t -> [c]) -> t -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse ", " ([c] -> [c]) -> (t -> [c]) -> t -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element t -> c) -> [Element t] -> [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
        Element t -> c
buildElem ([Element t] -> [c]) -> (t -> [Element t]) -> t -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [Element t]
forall t. Container t => t -> [Element t]
toList

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 -> Seq Expression
mpaArgs :: Seq Expression
  , MichelinePrimAp -> Seq Annotation
mpaAnnots :: Seq 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 "Prim" ((Object -> Parser MichelinePrimAp)
 -> Value -> Parser MichelinePrimAp)
-> (Object -> Parser MichelinePrimAp)
-> Value
-> Parser MichelinePrimAp
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> MichelinePrimitive
-> Seq Expression -> Seq Annotation -> MichelinePrimAp
MichelinePrimAp
    (MichelinePrimitive
 -> Seq Expression -> Seq Annotation -> MichelinePrimAp)
-> Parser MichelinePrimitive
-> Parser (Seq Expression -> Seq 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
.: "prim"
    Parser (Seq Expression -> Seq Annotation -> MichelinePrimAp)
-> Parser (Seq Expression)
-> Parser (Seq Annotation -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Seq Expression))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "args" Parser (Maybe (Seq Expression))
-> Seq Expression -> Parser (Seq Expression)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq Expression
forall a. Monoid a => a
mempty
    Parser (Seq Annotation -> MichelinePrimAp)
-> Parser (Seq Annotation) -> Parser MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Seq Annotation))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "annots" Parser (Maybe (Seq Annotation))
-> Seq Annotation -> Parser (Seq Annotation)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq Annotation
forall a. Monoid a => a
mempty

instance ToJSON MichelinePrimAp where
  toJSON :: MichelinePrimAp -> Value
toJSON MichelinePrimAp {..} = [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 ("prim" Text -> MichelinePrimitive -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MichelinePrimitive
mpaPrim)
    , if Seq Expression
mpaArgs Seq Expression -> Seq Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Expression
forall a. Monoid a => a
mempty then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just ("args" Text -> Seq Expression -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq Expression
mpaArgs)
    , if Seq Annotation
mpaAnnots Seq Annotation -> Seq Annotation -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Annotation
forall a. Monoid a => a
mempty then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just ("annots" Text -> Seq Annotation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq Annotation
mpaAnnots)
    ]

annotFromText :: MonadFail m => Text -> m Annotation
annotFromText :: Text -> m Annotation
annotFromText txt :: Text
txt = case Maybe Annotation
result of
    Just a :: Annotation
a -> Annotation -> m Annotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation
a
    Nothing -> String -> m Annotation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unknown annotation type"
  where
    result :: Maybe Annotation
result = (TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation) -> Maybe TypeAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe TypeAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @TypeTag Text
txt)
         Maybe Annotation -> Maybe Annotation -> Maybe Annotation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation) -> Maybe VarAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe VarAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @VarTag Text
txt)
         Maybe Annotation -> Maybe Annotation -> Maybe Annotation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> Maybe FieldAnn -> Maybe Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe FieldAnn
forall tag. KnownAnnTag tag => Text -> Maybe (Annotation tag)
stripPrefix @FieldTag Text
txt)

stripPrefix :: forall tag . KnownAnnTag tag => Text -> Maybe (MUA.Annotation tag)
stripPrefix :: Text -> Maybe (Annotation tag)
stripPrefix txt :: Text
txt = do
  (n :: Char
n, t :: Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
txt
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Text
forall a. ToText a => a -> Text
toText [Char
n] Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
prefix)
  Annotation tag -> Maybe (Annotation tag)
forall a. a -> Maybe a
Just (Annotation tag -> Maybe (Annotation tag))
-> Annotation tag -> Maybe (Annotation tag)
forall a b. (a -> b) -> a -> b
$ Text -> Annotation tag
forall k (a :: k). HasCallStack => Text -> Annotation a
ann Text
t
  where
    prefix :: Text
prefix = KnownAnnTag tag => Text
forall tag. KnownAnnTag tag => Text
annPrefix @tag

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

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 "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 v :: Value
v = Seq Expression -> Expression
ExpressionSeq (Seq Expression -> Expression)
-> Parser (Seq Expression) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Seq 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 "ExpressionString" (Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 "ExpressionInt" (Object -> Text -> Parser (StringEncode Integer)
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 "ExpressionBytes" (Object -> Text -> Parser HexJSONByteString
forall a. FromJSON a => Object -> Text -> Parser a
.: "bytes") Value
v

instance ToJSON Expression where
  toJSON :: Expression -> Value
toJSON (ExpressionSeq xs :: Seq Expression
xs) = Seq Expression -> Value
forall a. ToJSON a => a -> Value
toJSON Seq Expression
xs
  toJSON (ExpressionPrim xs :: MichelinePrimAp
xs) = MichelinePrimAp -> Value
forall a. ToJSON a => a -> Value
toJSON MichelinePrimAp
xs
  toJSON (ExpressionString x :: Text
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "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 x :: Integer
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "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 x :: ByteString
x) = Object -> Value
Aeson.Object (Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton "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 xs :: Seq Expression
xs) = Seq Expression -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Seq Expression
xs
  toEncoding (ExpressionPrim xs :: MichelinePrimAp
xs) = MichelinePrimAp -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding MichelinePrimAp
xs
  toEncoding (ExpressionString x :: Text
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "string" (Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
x))
  toEncoding (ExpressionInt x :: Integer
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "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 x :: ByteString
x) = Series -> Encoding
Aeson.pairs (Text -> Encoding -> Series
Aeson.pair "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))