{-# LANGUAGE DeriveLift #-}
module Morley.Micheline.Expression
( Exp
( ..
, ExpPrim'
)
, expressionInt
, expressionString
, expressionBytes
, expressionSeq
, expressionPrim
, expressionPrim'
, RegularExp
, Expression
, MichelinePrimAp(..)
, MichelinePrimitive(..)
, michelsonPrimitive
, ExpExtensionDescriptorKind
, ExpExtensionDescriptor (..)
, ExpExtrasConstrained
, ExpAllExtrasConstrainted
, ExpExtras (..)
, mkUniformExpExtras
, hoistExpExtras
, Annotation (..)
, annotToText
, annotFromText
, isAnnotationField
, isAnnotationType
, isAnnotationVariable
, isNoAnn
, mkAnns
, toAnnSet
, mkAnnsFromAny
, _ExpInt
, _ExpString
, _ExpBytes
, _ExpSeq
, _ExpPrim
, _ExpressionInt
, _ExpressionString
, _ExpressionBytes
, _ExpressionSeq
, _ExpressionPrim
, _AnnotationField
, _AnnotationVariable
, _AnnotationType
, mpaPrimL
, mpaArgsL
, mpaAnnotsL
) where
import Control.Lens (Iso', Plated, Prism', iso, prism')
import Control.Lens.TH (makeLensesWith, makePrisms)
import Data.Aeson
(FromJSON, ToJSON, object, parseJSON, toEncoding, toJSON, withObject, withText, (.!=), (.:),
(.:?), (.=))
import Data.Aeson.Encoding.Internal qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types qualified as Aeson
import Data.Data (Data)
import Data.Sequence qualified as Seq
import Data.Text qualified as T (uncons)
import Fmt (Buildable(..), pretty, (+|), (|+))
import Language.Haskell.TH.Syntax (Lift)
import Morley.Micheline.Json (StringEncode(StringEncode, unStringEncode))
import Morley.Michelson.Untyped qualified 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(..))
import Morley.Util.Lens (postfixLFields)
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
Ord, String -> MichelinePrimitive
(String -> MichelinePrimitive) -> IsString MichelinePrimitive
forall a. (String -> a) -> IsString a
fromString :: String -> MichelinePrimitive
$cfromString :: String -> MichelinePrimitive
IsString, [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
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> MichelinePrimitive -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MichelinePrimitive -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MichelinePrimitive -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MichelinePrimitive -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, (forall (m :: * -> *). Quote m => MichelinePrimitive -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
MichelinePrimitive -> Code m MichelinePrimitive)
-> Lift MichelinePrimitive
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MichelinePrimitive -> m Exp
forall (m :: * -> *).
Quote m =>
MichelinePrimitive -> Code m MichelinePrimitive
liftTyped :: forall (m :: * -> *).
Quote m =>
MichelinePrimitive -> Code m MichelinePrimitive
$cliftTyped :: forall (m :: * -> *).
Quote m =>
MichelinePrimitive -> Code m MichelinePrimitive
lift :: forall (m :: * -> *). Quote m => MichelinePrimitive -> m Exp
$clift :: forall (m :: * -> *). Quote m => MichelinePrimitive -> m Exp
Lift)
michelsonPrimitive :: Seq Text
michelsonPrimitive :: Seq Text
michelsonPrimitive = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList [
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_deprecated", Text
"SAPLING_EMPTY_STATE", Text
"SAPLING_VERIFY_UPDATE", Text
"ticket",
Text
"TICKET_DEPRECATED", Text
"READ_TICKET", Text
"SPLIT_TICKET", Text
"JOIN_TICKETS", Text
"GET_AND_UPDATE", Text
"chest", Text
"chest_key", Text
"OPEN_CHEST",
Text
"VIEW", Text
"view", Text
"constant", Text
"SUB_MUTEZ", Text
"tx_rollup_l2_address", Text
"MIN_BLOCK_TIME", Text
"sapling_transaction", Text
"EMIT",
Text
"Lambda_rec", Text
"LAMBDA_REC", Text
"TICKET", Text
"BYTES", Text
"NAT"
]
data Exp x
= ExpInt (XExpInt x) Integer
| ExpString (XExpString x) Text
| ExpBytes (XExpBytes x) ByteString
| ExpSeq (XExpSeq x) [Exp x]
| ExpPrim (XExpPrim x) (MichelinePrimAp x)
| ExpX (XExp x)
pattern ExpPrim' :: XExpPrim x -> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
pattern $bExpPrim' :: forall (x :: ExpExtensionDescriptorKind).
XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
$mExpPrim' :: forall {r} {x :: ExpExtensionDescriptorKind}.
Exp x
-> (XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> r)
-> (Void# -> r)
-> r
ExpPrim' x primAp exprs anns = ExpPrim x (MichelinePrimAp primAp exprs anns)
deriving stock instance ExpAllExtrasConstrainted Eq x => Eq (Exp x)
deriving stock instance ExpAllExtrasConstrainted Show x => Show (Exp x)
deriving stock instance (ExpAllExtrasConstrainted Data x, Typeable x) => Data (Exp x)
deriving stock instance ExpAllExtrasConstrainted Lift x => Lift (Exp x)
type ExpExtensionDescriptorKind = ExpExtensionTag -> Type
data ExpExtensionTag
class ExpExtensionDescriptor (x :: ExpExtensionDescriptorKind) where
type XExpInt x :: Type
type XExpInt _ = ()
type XExpString x :: Type
type XExpString _ = ()
type XExpBytes x :: Type
type XExpBytes _ = ()
type XExpSeq x :: Type
type XExpSeq _ = ()
type XExpPrim x :: Type
type XExpPrim _ = ()
type XExp x :: Type
type XExp _ = Void
type c x =
Each '[c]
[XExpInt x, XExpString x, XExpBytes x, XExpSeq x, XExpPrim x]
type c x = (ExpExtrasConstrained c x, c (XExp x))
data f x =
{ forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpInt x)
eeInt :: f (XExpInt x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpString x)
eeString :: f (XExpString x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpBytes x)
eeBytes :: f (XExpBytes x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpSeq x)
eeSeq :: f (XExpSeq x)
, forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpPrim x)
eePrim :: f (XExpPrim x)
}
mkUniformExpExtras
:: ( extra ~ XExpInt x
, extra ~ XExpString x
, extra ~ XExpBytes x
, extra ~ XExpSeq x
, extra ~ XExpPrim x
)
=> f extra -> ExpExtras f x
f extra
x = f (XExpInt x)
-> f (XExpString x)
-> f (XExpBytes x)
-> f (XExpSeq x)
-> f (XExpPrim x)
-> ExpExtras f x
forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
f (XExpInt x)
-> f (XExpString x)
-> f (XExpBytes x)
-> f (XExpSeq x)
-> f (XExpPrim x)
-> ExpExtras f x
ExpExtras f extra
f (XExpInt x)
x f extra
f (XExpString x)
x f extra
f (XExpBytes x)
x f extra
f (XExpSeq x)
x f extra
f (XExpPrim x)
x
hoistExpExtras
:: (forall extra. f1 extra -> f2 extra)
-> ExpExtras f1 x -> ExpExtras f2 x
forall extra. f1 extra -> f2 extra
f ExpExtras{f1 (XExpInt x)
f1 (XExpString x)
f1 (XExpBytes x)
f1 (XExpSeq x)
f1 (XExpPrim x)
eePrim :: f1 (XExpPrim x)
eeSeq :: f1 (XExpSeq x)
eeBytes :: f1 (XExpBytes x)
eeString :: f1 (XExpString x)
eeInt :: f1 (XExpInt x)
eePrim :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpPrim x)
eeSeq :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpSeq x)
eeBytes :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpBytes x)
eeString :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpString x)
eeInt :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
ExpExtras f x -> f (XExpInt x)
..} = ExpExtras :: forall (f :: * -> *) (x :: ExpExtensionDescriptorKind).
f (XExpInt x)
-> f (XExpString x)
-> f (XExpBytes x)
-> f (XExpSeq x)
-> f (XExpPrim x)
-> ExpExtras f x
ExpExtras
{ eeInt :: f2 (XExpInt x)
eeInt = f1 (XExpInt x) -> f2 (XExpInt x)
forall extra. f1 extra -> f2 extra
f f1 (XExpInt x)
eeInt
, eeString :: f2 (XExpString x)
eeString = f1 (XExpString x) -> f2 (XExpString x)
forall extra. f1 extra -> f2 extra
f f1 (XExpString x)
eeString
, eeBytes :: f2 (XExpBytes x)
eeBytes = f1 (XExpBytes x) -> f2 (XExpBytes x)
forall extra. f1 extra -> f2 extra
f f1 (XExpBytes x)
eeBytes
, eeSeq :: f2 (XExpSeq x)
eeSeq = f1 (XExpSeq x) -> f2 (XExpSeq x)
forall extra. f1 extra -> f2 extra
f f1 (XExpSeq x)
eeSeq
, eePrim :: f2 (XExpPrim x)
eePrim = f1 (XExpPrim x) -> f2 (XExpPrim x)
forall extra. f1 extra -> f2 extra
f f1 (XExpPrim x)
eePrim
}
data RegularExp :: ExpExtensionDescriptorKind
instance ExpExtensionDescriptor RegularExp
type Expression = Exp RegularExp
expressionInt :: Integer -> Expression
expressionInt :: Integer -> Expression
expressionInt Integer
a = XExpInt RegularExp -> Integer -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt () Integer
a
expressionString :: Text -> Expression
expressionString :: Text -> Expression
expressionString Text
a = XExpString RegularExp -> Text -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString () Text
a
expressionBytes :: ByteString -> Expression
expressionBytes :: ByteString -> Expression
expressionBytes ByteString
a = XExpBytes RegularExp -> ByteString -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes () ByteString
a
expressionSeq :: [Expression] -> Expression
expressionSeq :: [Expression] -> Expression
expressionSeq [Expression]
a = XExpSeq RegularExp -> [Expression] -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq () [Expression]
a
expressionPrim :: MichelinePrimAp RegularExp -> Expression
expressionPrim :: MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp RegularExp
a = XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () MichelinePrimAp RegularExp
a
expressionPrim' :: Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' :: Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
primName [Expression]
args [Annotation]
anns =
XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp RegularExp
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp (Text -> MichelinePrimitive
MichelinePrimitive Text
primName) [Expression]
args [Annotation]
anns)
instance ( Typeable x
, ExpAllExtrasConstrainted Data x
, ExpAllExtrasConstrainted Typeable x)
=> Plated (Exp x)
instance Buildable Expression where
build :: Expression -> Builder
build = \case
ExpInt () Integer
i -> Integer -> Builder
forall p. Buildable p => p -> Builder
build Integer
i
ExpString () Text
s -> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
s
ExpBytes () 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
ExpSeq () [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
")"
ExpPrim () (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
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Annotation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Annotation -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, (forall (m :: * -> *). Quote m => Annotation -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
Annotation -> Code m Annotation)
-> Lift Annotation
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Annotation -> m Exp
forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
liftTyped :: forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
$cliftTyped :: forall (m :: * -> *). Quote m => Annotation -> Code m Annotation
lift :: forall (m :: * -> *). Quote m => Annotation -> m Exp
$clift :: forall (m :: * -> *). Quote m => Annotation -> m Exp
Lift)
data MichelinePrimAp x = MichelinePrimAp
{ forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> MichelinePrimitive
mpaPrim :: MichelinePrimitive
, forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Exp x]
mpaArgs :: [Exp x]
, forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaAnnots :: [Annotation]
}
deriving stock instance Eq (Exp x) => Eq (MichelinePrimAp x)
deriving stock instance Show (Exp x) => Show (MichelinePrimAp x)
deriving stock instance (Data (Exp x), Typeable x) => Data (MichelinePrimAp x)
deriving stock instance Lift (Exp x) => Lift (MichelinePrimAp x)
instance FromJSON (Exp x) => FromJSON (MichelinePrimAp x) where
parseJSON :: Value -> Parser (MichelinePrimAp x)
parseJSON = String
-> (Object -> Parser (MichelinePrimAp x))
-> Value
-> Parser (MichelinePrimAp x)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Prim" ((Object -> Parser (MichelinePrimAp x))
-> Value -> Parser (MichelinePrimAp x))
-> (Object -> Parser (MichelinePrimAp x))
-> Value
-> Parser (MichelinePrimAp x)
forall a b. (a -> b) -> a -> b
$ \Object
v -> MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp
(MichelinePrimitive
-> [Exp x] -> [Annotation] -> MichelinePrimAp x)
-> Parser MichelinePrimitive
-> Parser ([Exp x] -> [Annotation] -> MichelinePrimAp x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MichelinePrimitive
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prim"
Parser ([Exp x] -> [Annotation] -> MichelinePrimAp x)
-> Parser [Exp x] -> Parser ([Annotation] -> MichelinePrimAp x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Exp x])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args" Parser (Maybe [Exp x]) -> [Exp x] -> Parser [Exp x]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
Parser ([Annotation] -> MichelinePrimAp x)
-> Parser [Annotation] -> Parser (MichelinePrimAp x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Annotation])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annots" Parser (Maybe [Annotation]) -> [Annotation] -> Parser [Annotation]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
instance ToJSON (Exp x) => ToJSON (MichelinePrimAp x) where
toJSON :: MichelinePrimAp x -> Value
toJSON MichelinePrimAp {[Annotation]
[Exp x]
MichelinePrimitive
mpaAnnots :: [Annotation]
mpaArgs :: [Exp x]
mpaPrim :: MichelinePrimitive
mpaAnnots :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaArgs :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Exp x]
mpaPrim :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> 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 (Key
"prim" Key -> MichelinePrimitive -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MichelinePrimitive
mpaPrim)
, if [Exp x] -> Bool
forall t. Container t => t -> Bool
null [Exp x]
mpaArgs then Maybe Pair
forall a. Maybe a
Nothing else Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"args" Key -> [Exp x] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Exp x]
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 (Key
"annots" Key -> [Annotation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Annotation]
mpaAnnots)
]
annotFromText :: forall m. MonadFail m => Text -> m Annotation
annotFromText :: forall (m :: * -> *). MonadFail m => 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
== 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
== 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
== 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 :: forall a. 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)
mkAnnsFromAny :: [U.AnyAnn] -> [Annotation]
mkAnnsFromAny :: [AnyAnn] -> [Annotation]
mkAnnsFromAny [AnyAnn]
xs = [AnyAnn]
xs [AnyAnn] -> (AnyAnn -> Annotation) -> [Annotation]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
U.AnyAnnType TypeAnn
x -> TypeAnn -> Annotation
AnnotationType TypeAnn
x
U.AnyAnnField FieldAnn
x -> FieldAnn -> Annotation
AnnotationField FieldAnn
x
U.AnyAnnVar VarAnn
x -> VarAnn -> Annotation
AnnotationVariable VarAnn
x
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 TypeAnn
a -> TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet TypeAnn
a
AnnotationField FieldAnn
a -> FieldAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
U.singleAnnSet FieldAnn
a
AnnotationVariable VarAnn
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 = XExpSeq RegularExp -> [Expression] -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq () ([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
<|> XExpPrim RegularExp -> MichelinePrimAp RegularExp -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim () (MichelinePrimAp RegularExp -> Expression)
-> Parser (MichelinePrimAp RegularExp) -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (MichelinePrimAp RegularExp)
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
<|> XExpString RegularExp -> Text -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString () (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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"string") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpInt RegularExp -> Integer -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt () (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 -> Key -> Parser (StringEncode Integer)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"int") Value
v
Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XExpBytes RegularExp -> ByteString -> Expression
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes () (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 -> Key -> Parser HexJSONByteString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bytes") Value
v
instance ToJSON Expression where
toJSON :: Expression -> Value
toJSON (ExpSeq () [Expression]
xs) = [Expression] -> Value
forall a. ToJSON a => a -> Value
toJSON [Expression]
xs
toJSON (ExpPrim () MichelinePrimAp RegularExp
xs) = MichelinePrimAp RegularExp -> Value
forall a. ToJSON a => a -> Value
toJSON MichelinePrimAp RegularExp
xs
toJSON (ExpString () Text
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"string" (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x)
toJSON (ExpInt () Integer
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"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 (ExpBytes () ByteString
x) = Object -> Value
Aeson.Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
"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 (ExpSeq () [Expression]
xs) = [Expression] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Expression]
xs
toEncoding (ExpPrim () MichelinePrimAp RegularExp
xs) = MichelinePrimAp RegularExp -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding MichelinePrimAp RegularExp
xs
toEncoding (ExpString () Text
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"string" (Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Text
x))
toEncoding (ExpInt () Integer
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"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 (ExpBytes () ByteString
x) = Series -> Encoding
Aeson.pairs (Key -> Encoding -> Series
Aeson.pair Key
"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))
_ExpInt :: Prism' (Exp d) (XExpInt d, Integer)
_ExpInt :: forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpInt d, Integer)
_ExpInt = ((XExpInt d, Integer) -> Exp d)
-> (Exp d -> Maybe (XExpInt d, Integer))
-> Prism (Exp d) (Exp d) (XExpInt d, Integer) (XExpInt d, Integer)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((XExpInt d -> Integer -> Exp d) -> (XExpInt d, Integer) -> Exp d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XExpInt d -> Integer -> Exp d
forall (x :: ExpExtensionDescriptorKind).
XExpInt x -> Integer -> Exp x
ExpInt) \case
ExpInt XExpInt d
x Integer
a -> (XExpInt d, Integer) -> Maybe (XExpInt d, Integer)
forall a. a -> Maybe a
Just (XExpInt d
x, Integer
a)
Exp d
_ -> Maybe (XExpInt d, Integer)
forall a. Maybe a
Nothing
_ExpString :: Prism' (Exp d) (XExpString d, Text)
_ExpString :: forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpString d, Text)
_ExpString = ((XExpString d, Text) -> Exp d)
-> (Exp d -> Maybe (XExpString d, Text))
-> Prism (Exp d) (Exp d) (XExpString d, Text) (XExpString d, Text)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((XExpString d -> Text -> Exp d) -> (XExpString d, Text) -> Exp d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XExpString d -> Text -> Exp d
forall (x :: ExpExtensionDescriptorKind).
XExpString x -> Text -> Exp x
ExpString) \case
ExpString XExpString d
x Text
a -> (XExpString d, Text) -> Maybe (XExpString d, Text)
forall a. a -> Maybe a
Just (XExpString d
x, Text
a)
Exp d
_ -> Maybe (XExpString d, Text)
forall a. Maybe a
Nothing
_ExpBytes :: Prism' (Exp d) (XExpBytes d, ByteString)
_ExpBytes :: forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpBytes d, ByteString)
_ExpBytes = ((XExpBytes d, ByteString) -> Exp d)
-> (Exp d -> Maybe (XExpBytes d, ByteString))
-> Prism
(Exp d) (Exp d) (XExpBytes d, ByteString) (XExpBytes d, ByteString)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((XExpBytes d -> ByteString -> Exp d)
-> (XExpBytes d, ByteString) -> Exp d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XExpBytes d -> ByteString -> Exp d
forall (x :: ExpExtensionDescriptorKind).
XExpBytes x -> ByteString -> Exp x
ExpBytes) \case
ExpBytes XExpBytes d
x ByteString
a -> (XExpBytes d, ByteString) -> Maybe (XExpBytes d, ByteString)
forall a. a -> Maybe a
Just (XExpBytes d
x, ByteString
a)
Exp d
_ -> Maybe (XExpBytes d, ByteString)
forall a. Maybe a
Nothing
_ExpSeq :: Prism' (Exp d) (XExpSeq d, [Exp d])
_ExpSeq :: forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpSeq d, [Exp d])
_ExpSeq = ((XExpSeq d, [Exp d]) -> Exp d)
-> (Exp d -> Maybe (XExpSeq d, [Exp d]))
-> Prism (Exp d) (Exp d) (XExpSeq d, [Exp d]) (XExpSeq d, [Exp d])
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((XExpSeq d -> [Exp d] -> Exp d) -> (XExpSeq d, [Exp d]) -> Exp d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XExpSeq d -> [Exp d] -> Exp d
forall (x :: ExpExtensionDescriptorKind).
XExpSeq x -> [Exp x] -> Exp x
ExpSeq) \case
ExpSeq XExpSeq d
x [Exp d]
a -> (XExpSeq d, [Exp d]) -> Maybe (XExpSeq d, [Exp d])
forall a. a -> Maybe a
Just (XExpSeq d
x, [Exp d]
a)
Exp d
_ -> Maybe (XExpSeq d, [Exp d])
forall a. Maybe a
Nothing
_ExpPrim :: Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim :: forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim = ((XExpPrim d, MichelinePrimAp d) -> Exp d)
-> (Exp d -> Maybe (XExpPrim d, MichelinePrimAp d))
-> Prism
(Exp d)
(Exp d)
(XExpPrim d, MichelinePrimAp d)
(XExpPrim d, MichelinePrimAp d)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((XExpPrim d -> MichelinePrimAp d -> Exp d)
-> (XExpPrim d, MichelinePrimAp d) -> Exp d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XExpPrim d -> MichelinePrimAp d -> Exp d
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x -> MichelinePrimAp x -> Exp x
ExpPrim) \case
ExpPrim XExpPrim d
x MichelinePrimAp d
a -> (XExpPrim d, MichelinePrimAp d)
-> Maybe (XExpPrim d, MichelinePrimAp d)
forall a. a -> Maybe a
Just (XExpPrim d
x, MichelinePrimAp d
a)
Exp d
_ -> Maybe (XExpPrim d, MichelinePrimAp d)
forall a. Maybe a
Nothing
neglecting :: Iso' ((), a) a
neglecting :: forall a. Iso' ((), a) a
neglecting = (((), a) -> a) -> (a -> ((), a)) -> Iso ((), a) ((), a) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((), a) -> a
forall a b. (a, b) -> b
snd a -> ((), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
_ExpressionInt :: Prism' Expression Integer
_ExpressionInt :: Prism' Expression Integer
_ExpressionInt = p ((), Integer) (f ((), Integer)) -> p Expression (f Expression)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpInt d, Integer)
_ExpInt (p ((), Integer) (f ((), Integer)) -> p Expression (f Expression))
-> (p Integer (f Integer) -> p ((), Integer) (f ((), Integer)))
-> p Integer (f Integer)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Integer (f Integer) -> p ((), Integer) (f ((), Integer))
forall a. Iso' ((), a) a
neglecting
_ExpressionString :: Prism' Expression Text
_ExpressionString :: Prism' Expression Text
_ExpressionString = p ((), Text) (f ((), Text)) -> p Expression (f Expression)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpString d, Text)
_ExpString (p ((), Text) (f ((), Text)) -> p Expression (f Expression))
-> (p Text (f Text) -> p ((), Text) (f ((), Text)))
-> p Text (f Text)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p ((), Text) (f ((), Text))
forall a. Iso' ((), a) a
neglecting
_ExpressionBytes :: Prism' Expression ByteString
_ExpressionBytes :: Prism' Expression ByteString
_ExpressionBytes = p ((), ByteString) (f ((), ByteString))
-> p Expression (f Expression)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpBytes d, ByteString)
_ExpBytes (p ((), ByteString) (f ((), ByteString))
-> p Expression (f Expression))
-> (p ByteString (f ByteString)
-> p ((), ByteString) (f ((), ByteString)))
-> p ByteString (f ByteString)
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ByteString (f ByteString)
-> p ((), ByteString) (f ((), ByteString))
forall a. Iso' ((), a) a
neglecting
_ExpressionSeq :: Prism' Expression [Expression]
_ExpressionSeq :: Prism' Expression [Expression]
_ExpressionSeq = p ((), [Expression]) (f ((), [Expression]))
-> p Expression (f Expression)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpSeq d, [Exp d])
_ExpSeq (p ((), [Expression]) (f ((), [Expression]))
-> p Expression (f Expression))
-> (p [Expression] (f [Expression])
-> p ((), [Expression]) (f ((), [Expression])))
-> p [Expression] (f [Expression])
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p [Expression] (f [Expression])
-> p ((), [Expression]) (f ((), [Expression]))
forall a. Iso' ((), a) a
neglecting
_ExpressionPrim :: Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim :: Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim = p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
-> p Expression (f Expression)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
-> p Expression (f Expression))
-> (p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp)))
-> p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p Expression (f Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (MichelinePrimAp RegularExp) (f (MichelinePrimAp RegularExp))
-> p ((), MichelinePrimAp RegularExp)
(f ((), MichelinePrimAp RegularExp))
forall a. Iso' ((), a) a
neglecting
makePrisms ''Annotation
makeLensesWith postfixLFields ''MichelinePrimAp