module Morley.Michelson.Typed.Entrypoints
( EpAddress (..)
, ParseEpAddressError (..)
, formatEpAddress
, mformatEpAddress
, parseEpAddress
, parseEpAddressRaw
, ParamNotes (..)
, pattern ParamNotes
, starParamNotes
, ArmCoord (..)
, ArmCoords
, ParamEpError (..)
, mkParamNotes
, EpLiftSequence (..)
, EntrypointCallT (..)
, epcPrimitive
, unsafeEpcCallRoot
, SomeEntrypointCallT (..)
, unsafeSepcCallRoot
, sepcPrimitive
, sepcName
, ForbidOr
, MkEntrypointCallRes (..)
, mkEntrypointCall
, tyImplicitAccountParam
, EpName (..)
, pattern DefEpName
, epNameFromParamAnn
, epNameToParamAnn
, epNameFromRefAnn
, epNameToRefAnn
, EpNameFromRefAnnError (..)
) where
import Control.Monad.Except (throwError)
import Data.ByteString qualified as BS
import Data.Constraint (Dict(..))
import Data.List.NonEmpty qualified as NE
import Data.Singletons (withSingI)
import Data.Text qualified as T
import Fmt (Buildable(..), hexF, pretty, (+|), (|+))
import Text.PrettyPrint.Leijen.Text (int, punctuate, squotes, textStrict, (<+>))
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDoc, renderAnyBuildable)
import Morley.Michelson.Text
import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.Sing
import Morley.Michelson.Typed.T
import Morley.Michelson.Untyped.Annotation
import Morley.Michelson.Untyped.Entrypoints
import Morley.Tezos.Address
import Morley.Tezos.Crypto (hashLengthBytes)
import Morley.Util.TH
import Morley.Util.TypeLits
import Morley.Util.Typeable
data EpAddress = EpAddress
{ EpAddress -> Address
eaAddress :: Address
, EpAddress -> EpName
eaEntrypoint :: EpName
} deriving stock (Int -> EpAddress -> ShowS
[EpAddress] -> ShowS
EpAddress -> String
(Int -> EpAddress -> ShowS)
-> (EpAddress -> String)
-> ([EpAddress] -> ShowS)
-> Show EpAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpAddress] -> ShowS
$cshowList :: [EpAddress] -> ShowS
show :: EpAddress -> String
$cshow :: EpAddress -> String
showsPrec :: Int -> EpAddress -> ShowS
$cshowsPrec :: Int -> EpAddress -> ShowS
Show, EpAddress -> EpAddress -> Bool
(EpAddress -> EpAddress -> Bool)
-> (EpAddress -> EpAddress -> Bool) -> Eq EpAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpAddress -> EpAddress -> Bool
$c/= :: EpAddress -> EpAddress -> Bool
== :: EpAddress -> EpAddress -> Bool
$c== :: EpAddress -> EpAddress -> Bool
Eq, Eq EpAddress
Eq EpAddress
-> (EpAddress -> EpAddress -> Ordering)
-> (EpAddress -> EpAddress -> Bool)
-> (EpAddress -> EpAddress -> Bool)
-> (EpAddress -> EpAddress -> Bool)
-> (EpAddress -> EpAddress -> Bool)
-> (EpAddress -> EpAddress -> EpAddress)
-> (EpAddress -> EpAddress -> EpAddress)
-> Ord EpAddress
EpAddress -> EpAddress -> Bool
EpAddress -> EpAddress -> Ordering
EpAddress -> EpAddress -> EpAddress
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 :: EpAddress -> EpAddress -> EpAddress
$cmin :: EpAddress -> EpAddress -> EpAddress
max :: EpAddress -> EpAddress -> EpAddress
$cmax :: EpAddress -> EpAddress -> EpAddress
>= :: EpAddress -> EpAddress -> Bool
$c>= :: EpAddress -> EpAddress -> Bool
> :: EpAddress -> EpAddress -> Bool
$c> :: EpAddress -> EpAddress -> Bool
<= :: EpAddress -> EpAddress -> Bool
$c<= :: EpAddress -> EpAddress -> Bool
< :: EpAddress -> EpAddress -> Bool
$c< :: EpAddress -> EpAddress -> Bool
compare :: EpAddress -> EpAddress -> Ordering
$ccompare :: EpAddress -> EpAddress -> Ordering
Ord, (forall x. EpAddress -> Rep EpAddress x)
-> (forall x. Rep EpAddress x -> EpAddress) -> Generic EpAddress
forall x. Rep EpAddress x -> EpAddress
forall x. EpAddress -> Rep EpAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpAddress x -> EpAddress
$cfrom :: forall x. EpAddress -> Rep EpAddress x
Generic)
instance Buildable EpAddress where
build :: EpAddress -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (EpAddress -> Text) -> EpAddress -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAddress -> Text
formatEpAddress
instance NFData EpAddress
formatEpAddress :: EpAddress -> Text
formatEpAddress :: EpAddress -> Text
formatEpAddress (EpAddress Address
addr EpName
ep)
| EpName -> Bool
isDefEpName EpName
ep = Address -> Text
formatAddress Address
addr
| Bool
otherwise = Address -> Text
formatAddress Address
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EpName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty EpName
ep
mformatEpAddress :: EpAddress -> MText
mformatEpAddress :: EpAddress -> MText
mformatEpAddress EpAddress
ea =
let t :: Text
t = EpAddress -> Text
formatEpAddress EpAddress
ea
in Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Text -> Either Text MText) -> Text -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ Text
t
data ParseEpAddressError
= ParseEpAddressBadAddress ParseAddressError
| ParseEpAddressRawBadAddress ParseAddressRawError
| ParseEpAddressBadEntryopint ByteString UnicodeException
| ParseEpAddressBadRefAnn Text
| ParseEpAddressRefAnnError EpNameFromRefAnnError
| ParseEpAddressInvalidLength Int
deriving stock (Int -> ParseEpAddressError -> ShowS
[ParseEpAddressError] -> ShowS
ParseEpAddressError -> String
(Int -> ParseEpAddressError -> ShowS)
-> (ParseEpAddressError -> String)
-> ([ParseEpAddressError] -> ShowS)
-> Show ParseEpAddressError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseEpAddressError] -> ShowS
$cshowList :: [ParseEpAddressError] -> ShowS
show :: ParseEpAddressError -> String
$cshow :: ParseEpAddressError -> String
showsPrec :: Int -> ParseEpAddressError -> ShowS
$cshowsPrec :: Int -> ParseEpAddressError -> ShowS
Show, ParseEpAddressError -> ParseEpAddressError -> Bool
(ParseEpAddressError -> ParseEpAddressError -> Bool)
-> (ParseEpAddressError -> ParseEpAddressError -> Bool)
-> Eq ParseEpAddressError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseEpAddressError -> ParseEpAddressError -> Bool
$c/= :: ParseEpAddressError -> ParseEpAddressError -> Bool
== :: ParseEpAddressError -> ParseEpAddressError -> Bool
$c== :: ParseEpAddressError -> ParseEpAddressError -> Bool
Eq, (forall x. ParseEpAddressError -> Rep ParseEpAddressError x)
-> (forall x. Rep ParseEpAddressError x -> ParseEpAddressError)
-> Generic ParseEpAddressError
forall x. Rep ParseEpAddressError x -> ParseEpAddressError
forall x. ParseEpAddressError -> Rep ParseEpAddressError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseEpAddressError x -> ParseEpAddressError
$cfrom :: forall x. ParseEpAddressError -> Rep ParseEpAddressError x
Generic)
instance NFData ParseEpAddressError
instance Buildable ParseEpAddressError where
build :: ParseEpAddressError -> Builder
build = ParseEpAddressError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance RenderDoc ParseEpAddressError where
renderDoc :: RenderContext -> ParseEpAddressError -> Doc
renderDoc RenderContext
context = \case
ParseEpAddressBadAddress ParseAddressError
err -> RenderContext -> ParseAddressError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context ParseAddressError
err
ParseEpAddressRawBadAddress ParseAddressRawError
err -> RenderContext -> ParseAddressRawError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context ParseAddressRawError
err
ParseEpAddressBadEntryopint ByteString
addr UnicodeException
exception ->
Doc
"Invalid entrypoint given for raw adddress" Doc -> Doc -> Doc
<+> (Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Builder -> Doc) -> Builder -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
addr)Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
" and failed with" Doc -> Doc -> Doc
<+> (Text -> Doc
textStrict (forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text UnicodeException
exception))
ParseEpAddressBadRefAnn Text
txt -> Doc
"Invalid reference annotation:" Doc -> Doc -> Doc
<+> (Text -> Doc
textStrict Text
txt)
ParseEpAddressRefAnnError EpNameFromRefAnnError
err -> RenderContext -> EpNameFromRefAnnError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context EpNameFromRefAnnError
err
ParseEpAddressInvalidLength Int
len ->
Doc
"Given raw entrypoint address has invalid length:" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
len
parseEpAddress :: Text -> Either ParseEpAddressError EpAddress
parseEpAddress :: Text -> Either ParseEpAddressError EpAddress
parseEpAddress Text
txt =
let (Text
addrTxt, Text
mannotTxt) = Text -> Text -> (Text, Text)
T.breakOn Text
"%" Text
txt
in case Text
mannotTxt of
Text
"" -> do
Address
addr <- (ParseAddressError -> ParseEpAddressError)
-> Either ParseAddressError Address
-> Either ParseEpAddressError Address
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseAddressError -> ParseEpAddressError
ParseEpAddressBadAddress (Either ParseAddressError Address
-> Either ParseEpAddressError Address)
-> Either ParseAddressError Address
-> Either ParseEpAddressError Address
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseAddressError Address
parseAddress Text
addrTxt
return $ Address -> EpName -> EpAddress
EpAddress Address
addr EpName
DefEpName
Text
annotTxt' -> do
Address
addr <- (ParseAddressError -> ParseEpAddressError)
-> Either ParseAddressError Address
-> Either ParseEpAddressError Address
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseAddressError -> ParseEpAddressError
ParseEpAddressBadAddress (Either ParseAddressError Address
-> Either ParseEpAddressError Address)
-> Either ParseAddressError Address
-> Either ParseEpAddressError Address
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseAddressError Address
parseAddress Text
addrTxt
RootAnn
annot <- (Text -> ParseEpAddressError)
-> Either Text RootAnn -> Either ParseEpAddressError RootAnn
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ParseEpAddressError
ParseEpAddressBadRefAnn (Either Text RootAnn -> Either ParseEpAddressError RootAnn)
-> Either Text RootAnn -> Either ParseEpAddressError RootAnn
forall a b. (a -> b) -> a -> b
$ case Text -> Text -> Maybe Text
T.stripPrefix Text
"%" Text
annotTxt' of
Maybe Text
Nothing -> Text -> Either Text RootAnn
forall a. HasCallStack => Text -> a
error Text
"impossible"
Just Text
a -> Text -> Either Text RootAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
a
EpName
epName <- (EpNameFromRefAnnError -> ParseEpAddressError)
-> Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first EpNameFromRefAnnError -> ParseEpAddressError
ParseEpAddressRefAnnError (Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName)
-> Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName
forall a b. (a -> b) -> a -> b
$ RootAnn -> Either EpNameFromRefAnnError EpName
epNameFromRefAnn RootAnn
annot
return $ Address -> EpName -> EpAddress
EpAddress Address
addr EpName
epName
parseEpAddressRaw :: ByteString -> Either ParseEpAddressError EpAddress
parseEpAddressRaw :: ByteString -> Either ParseEpAddressError EpAddress
parseEpAddressRaw ByteString
raw = do
let (ByteString
bytes, ByteString
eps) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
forall n. Integral n => n
hashLengthBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ByteString
raw
Address
eaAddress <- (ParseAddressRawError -> ParseEpAddressError)
-> Either ParseAddressRawError Address
-> Either ParseEpAddressError Address
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseAddressRawError -> ParseEpAddressError
ParseEpAddressRawBadAddress (Either ParseAddressRawError Address
-> Either ParseEpAddressError Address)
-> Either ParseAddressRawError Address
-> Either ParseEpAddressError Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseAddressRawError Address
parseAddressRaw ByteString
bytes
Text
decodedEntrypoint <- (UnicodeException -> ParseEpAddressError)
-> Either UnicodeException Text -> Either ParseEpAddressError Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> UnicodeException -> ParseEpAddressError
ParseEpAddressBadEntryopint ByteString
raw) (Either UnicodeException Text -> Either ParseEpAddressError Text)
-> Either UnicodeException Text -> Either ParseEpAddressError Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
eps
RootAnn
decodedAnnotation <- (Text -> ParseEpAddressError)
-> Either Text RootAnn -> Either ParseEpAddressError RootAnn
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ParseEpAddressError
ParseEpAddressBadRefAnn (Either Text RootAnn -> Either ParseEpAddressError RootAnn)
-> Either Text RootAnn -> Either ParseEpAddressError RootAnn
forall a b. (a -> b) -> a -> b
$ Text -> Either Text RootAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation Text
decodedEntrypoint
EpName
eaEntrypoint <- (EpNameFromRefAnnError -> ParseEpAddressError)
-> Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first EpNameFromRefAnnError -> ParseEpAddressError
ParseEpAddressRefAnnError (Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName)
-> Either EpNameFromRefAnnError EpName
-> Either ParseEpAddressError EpName
forall a b. (a -> b) -> a -> b
$ RootAnn -> Either EpNameFromRefAnnError EpName
epNameFromRefAnn RootAnn
decodedAnnotation
pure $ EpAddress :: Address -> EpName -> EpAddress
EpAddress {EpName
Address
eaEntrypoint :: EpName
eaAddress :: Address
eaEntrypoint :: EpName
eaAddress :: Address
..}
data ParamNotes (t :: T) = UnsafeParamNotes
{ forall (t :: T). ParamNotes t -> Notes t
pnNotes :: Notes t
, forall (t :: T). ParamNotes t -> RootAnn
pnRootAnn :: RootAnn
} deriving stock (Int -> ParamNotes t -> ShowS
[ParamNotes t] -> ShowS
ParamNotes t -> String
(Int -> ParamNotes t -> ShowS)
-> (ParamNotes t -> String)
-> ([ParamNotes t] -> ShowS)
-> Show (ParamNotes t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: T). Int -> ParamNotes t -> ShowS
forall (t :: T). [ParamNotes t] -> ShowS
forall (t :: T). ParamNotes t -> String
showList :: [ParamNotes t] -> ShowS
$cshowList :: forall (t :: T). [ParamNotes t] -> ShowS
show :: ParamNotes t -> String
$cshow :: forall (t :: T). ParamNotes t -> String
showsPrec :: Int -> ParamNotes t -> ShowS
$cshowsPrec :: forall (t :: T). Int -> ParamNotes t -> ShowS
Show, ParamNotes t -> ParamNotes t -> Bool
(ParamNotes t -> ParamNotes t -> Bool)
-> (ParamNotes t -> ParamNotes t -> Bool) -> Eq (ParamNotes t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: T). ParamNotes t -> ParamNotes t -> Bool
/= :: ParamNotes t -> ParamNotes t -> Bool
$c/= :: forall (t :: T). ParamNotes t -> ParamNotes t -> Bool
== :: ParamNotes t -> ParamNotes t -> Bool
$c== :: forall (t :: T). ParamNotes t -> ParamNotes t -> Bool
Eq, (forall x. ParamNotes t -> Rep (ParamNotes t) x)
-> (forall x. Rep (ParamNotes t) x -> ParamNotes t)
-> Generic (ParamNotes t)
forall x. Rep (ParamNotes t) x -> ParamNotes t
forall x. ParamNotes t -> Rep (ParamNotes t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: T) x. Rep (ParamNotes t) x -> ParamNotes t
forall (t :: T) x. ParamNotes t -> Rep (ParamNotes t) x
$cto :: forall (t :: T) x. Rep (ParamNotes t) x -> ParamNotes t
$cfrom :: forall (t :: T) x. ParamNotes t -> Rep (ParamNotes t) x
Generic)
deriving anyclass (ParamNotes t -> ()
(ParamNotes t -> ()) -> NFData (ParamNotes t)
forall a. (a -> ()) -> NFData a
forall (t :: T). ParamNotes t -> ()
rnf :: ParamNotes t -> ()
$crnf :: forall (t :: T). ParamNotes t -> ()
NFData)
pattern ParamNotes :: Notes t -> RootAnn -> ParamNotes t
pattern $mParamNotes :: forall {r} {t :: T}.
ParamNotes t -> (Notes t -> RootAnn -> r) -> (Void# -> r) -> r
ParamNotes t f <- UnsafeParamNotes t f
{-# COMPLETE ParamNotes #-}
starParamNotes :: SingI t => ParamNotes t
starParamNotes :: forall (t :: T). SingI t => ParamNotes t
starParamNotes = Notes t -> RootAnn -> ParamNotes t
forall (t :: T). Notes t -> RootAnn -> ParamNotes t
UnsafeParamNotes Notes t
forall (t :: T). SingI t => Notes t
starNotes RootAnn
forall {k} (a :: k). Annotation a
noAnn
type ArmCoords = [ArmCoord]
data ArmCoord = AcLeft | AcRight
deriving stock (Int -> ArmCoord -> ShowS
ArmCoords -> ShowS
ArmCoord -> String
(Int -> ArmCoord -> ShowS)
-> (ArmCoord -> String) -> (ArmCoords -> ShowS) -> Show ArmCoord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ArmCoords -> ShowS
$cshowList :: ArmCoords -> ShowS
show :: ArmCoord -> String
$cshow :: ArmCoord -> String
showsPrec :: Int -> ArmCoord -> ShowS
$cshowsPrec :: Int -> ArmCoord -> ShowS
Show, ArmCoord -> ArmCoord -> Bool
(ArmCoord -> ArmCoord -> Bool)
-> (ArmCoord -> ArmCoord -> Bool) -> Eq ArmCoord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArmCoord -> ArmCoord -> Bool
$c/= :: ArmCoord -> ArmCoord -> Bool
== :: ArmCoord -> ArmCoord -> Bool
$c== :: ArmCoord -> ArmCoord -> Bool
Eq, (forall x. ArmCoord -> Rep ArmCoord x)
-> (forall x. Rep ArmCoord x -> ArmCoord) -> Generic ArmCoord
forall x. Rep ArmCoord x -> ArmCoord
forall x. ArmCoord -> Rep ArmCoord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArmCoord x -> ArmCoord
$cfrom :: forall x. ArmCoord -> Rep ArmCoord x
Generic)
instance NFData ArmCoord
instance Buildable ArmCoord where
build :: ArmCoord -> Builder
build = ArmCoord -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance RenderDoc ArmCoord where
renderDoc :: RenderContext -> ArmCoord -> Doc
renderDoc RenderContext
_ = \case
ArmCoord
AcLeft -> Doc
"left"
ArmCoord
AcRight -> Doc
"right"
data ParamEpError
= ParamEpDuplicatedNames (NonEmpty EpName)
| ParamEpUncallableArm ArmCoords
deriving stock (Int -> ParamEpError -> ShowS
[ParamEpError] -> ShowS
ParamEpError -> String
(Int -> ParamEpError -> ShowS)
-> (ParamEpError -> String)
-> ([ParamEpError] -> ShowS)
-> Show ParamEpError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamEpError] -> ShowS
$cshowList :: [ParamEpError] -> ShowS
show :: ParamEpError -> String
$cshow :: ParamEpError -> String
showsPrec :: Int -> ParamEpError -> ShowS
$cshowsPrec :: Int -> ParamEpError -> ShowS
Show, ParamEpError -> ParamEpError -> Bool
(ParamEpError -> ParamEpError -> Bool)
-> (ParamEpError -> ParamEpError -> Bool) -> Eq ParamEpError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamEpError -> ParamEpError -> Bool
$c/= :: ParamEpError -> ParamEpError -> Bool
== :: ParamEpError -> ParamEpError -> Bool
$c== :: ParamEpError -> ParamEpError -> Bool
Eq, (forall x. ParamEpError -> Rep ParamEpError x)
-> (forall x. Rep ParamEpError x -> ParamEpError)
-> Generic ParamEpError
forall x. Rep ParamEpError x -> ParamEpError
forall x. ParamEpError -> Rep ParamEpError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParamEpError x -> ParamEpError
$cfrom :: forall x. ParamEpError -> Rep ParamEpError x
Generic)
instance NFData ParamEpError
instance Buildable ParamEpError where
build :: ParamEpError -> Builder
build = ParamEpError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance RenderDoc ParamEpError where
renderDoc :: RenderContext -> ParamEpError -> Doc
renderDoc RenderContext
context = \case
ParamEpDuplicatedNames NonEmpty EpName
names -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Doc
"Duplicated entrypoint names: "
, [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
", " ([Doc] -> [Doc]) -> ([EpName] -> [Doc]) -> [EpName] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpName -> Doc) -> [EpName] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
squotes (Doc -> Doc) -> (EpName -> Doc) -> EpName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpName -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable) ([EpName] -> [Doc]) -> [EpName] -> [Doc]
forall a b. (a -> b) -> a -> b
$ NonEmpty EpName -> [Element (NonEmpty EpName)]
forall t. Container t => t -> [Element t]
toList NonEmpty EpName
names
]
ParamEpUncallableArm ArmCoords
arm -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Doc
"Due to presence of 'default' entrypoint, one of contract \"arms\" \
\cannot be called: \""
, [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
" - " ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ArmCoord -> Doc) -> ArmCoords -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (RenderContext -> ArmCoord -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context) ArmCoords
arm
, Doc
"\""
, if ArmCoords -> Int
forall t. Container t => t -> Int
length ArmCoords
arm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Doc
" (in top-to-bottom order)" else Doc
""
]
verifyParamNotes :: Notes t -> RootAnn -> Either ParamEpError ()
verifyParamNotes :: forall (t :: T). Notes t -> RootAnn -> Either ParamEpError ()
verifyParamNotes Notes t
notes RootAnn
ra = do
let allEps :: [EpName]
allEps = Endo [EpName] -> [EpName] -> [EpName]
forall a. Endo a -> a -> a
appEndo (Notes t -> Endo [EpName]
forall (t :: T). Notes t -> Endo [EpName]
gatherEntrypoints Notes t
notes) []
duplicatedEps :: [EpName]
duplicatedEps
= (NonEmpty EpName -> Maybe EpName) -> [NonEmpty EpName] -> [EpName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([EpName] -> Maybe EpName
forall t. Container t => t -> Maybe (Element t)
safeHead ([EpName] -> Maybe EpName)
-> (NonEmpty EpName -> [EpName]) -> NonEmpty EpName -> Maybe EpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty EpName -> [EpName]
forall a. NonEmpty a -> [a]
tail)
([NonEmpty EpName] -> [EpName])
-> ([EpName] -> [NonEmpty EpName]) -> [EpName] -> [EpName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EpName] -> [NonEmpty EpName]
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group
([EpName] -> [NonEmpty EpName])
-> ([EpName] -> [EpName]) -> [EpName] -> [NonEmpty EpName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EpName] -> [EpName]
forall a. Ord a => [a] -> [a]
sort
([EpName] -> [EpName]) -> [EpName] -> [EpName]
forall a b. (a -> b) -> a -> b
$ [EpName] -> (EpName -> [EpName]) -> Maybe EpName -> [EpName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [EpName]
allEps (EpName -> [EpName] -> [EpName]
forall a. a -> [a] -> [a]
: [EpName]
allEps) (RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
ra)
Maybe (NonEmpty EpName)
-> (NonEmpty EpName -> Either ParamEpError ())
-> Either ParamEpError ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust ([EpName] -> Maybe (NonEmpty EpName)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [EpName]
duplicatedEps) ((NonEmpty EpName -> Either ParamEpError ())
-> Either ParamEpError ())
-> (NonEmpty EpName -> Either ParamEpError ())
-> Either ParamEpError ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty EpName
dups ->
ParamEpError -> Either ParamEpError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParamEpError -> Either ParamEpError ())
-> ParamEpError -> Either ParamEpError ()
forall a b. (a -> b) -> a -> b
$ NonEmpty EpName -> ParamEpError
ParamEpDuplicatedNames NonEmpty EpName
dups
Bool -> Either ParamEpError () -> Either ParamEpError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RootAnn
ra RootAnn -> RootAnn -> Bool
forall a. Eq a => a -> a -> Bool
== RootAnn
forall {k} (a :: k). Annotation a
noAnn) (Either ParamEpError () -> Either ParamEpError ())
-> Either ParamEpError () -> Either ParamEpError ()
forall a b. (a -> b) -> a -> b
$ Either ParamEpError Bool -> Either ParamEpError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
(Either ParamEpError Bool -> Either ParamEpError ())
-> Either ParamEpError Bool -> Either ParamEpError ()
forall a b. (a -> b) -> a -> b
$ (ArmCoords -> ParamEpError)
-> Either ArmCoords Bool -> Either ParamEpError Bool
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ArmCoords -> ParamEpError
ParamEpUncallableArm
(Either ArmCoords Bool -> Either ParamEpError Bool)
-> Either ArmCoords Bool -> Either ParamEpError Bool
forall a b. (a -> b) -> a -> b
$ Notes t -> Either ArmCoords Bool
forall (t :: T). Notes t -> Either ArmCoords Bool
ensureAllCallable Notes t
notes
where
gatherEntrypoints :: Notes t -> Endo [EpName]
gatherEntrypoints :: forall (t :: T). Notes t -> Endo [EpName]
gatherEntrypoints = \case
NTOr TypeAnn
_ RootAnn
fn1 RootAnn
fn2 Notes p
l Notes q
r -> [Endo [EpName]] -> Endo [EpName]
forall a. Monoid a => [a] -> a
mconcat
[ ([EpName] -> [EpName]) -> Endo [EpName]
forall a. (a -> a) -> Endo a
Endo (([EpName] -> [EpName]) -> Endo [EpName])
-> ([EpName] -> [EpName]) -> Endo [EpName]
forall a b. (a -> b) -> a -> b
$ ([EpName] -> [EpName])
-> (EpName -> [EpName] -> [EpName])
-> Maybe EpName
-> [EpName]
-> [EpName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [EpName] -> [EpName]
forall a. a -> a
id (:) (RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fn1)
, ([EpName] -> [EpName]) -> Endo [EpName]
forall a. (a -> a) -> Endo a
Endo (([EpName] -> [EpName]) -> Endo [EpName])
-> ([EpName] -> [EpName]) -> Endo [EpName]
forall a b. (a -> b) -> a -> b
$ ([EpName] -> [EpName])
-> (EpName -> [EpName] -> [EpName])
-> Maybe EpName
-> [EpName]
-> [EpName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [EpName] -> [EpName]
forall a. a -> a
id (:) (RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fn2)
, Notes p -> Endo [EpName]
forall (t :: T). Notes t -> Endo [EpName]
gatherEntrypoints Notes p
l
, Notes q -> Endo [EpName]
forall (t :: T). Notes t -> Endo [EpName]
gatherEntrypoints Notes q
r
]
Notes t
_ -> Endo [EpName]
forall a. Monoid a => a
mempty
ensureAllCallable :: Notes t -> Either ArmCoords Bool
ensureAllCallable :: forall (t :: T). Notes t -> Either ArmCoords Bool
ensureAllCallable = \case
NTOr TypeAnn
_ RootAnn
fnL RootAnn
fnR Notes p
l Notes q
r -> do
let epNameL :: Maybe EpName
epNameL = RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fnL
let epNameR :: Maybe EpName
epNameR = RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fnR
Bool
haveDefLL <- (ArmCoords -> ArmCoords)
-> Either ArmCoords Bool -> Either ArmCoords Bool
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcLeft ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords Bool -> Either ArmCoords Bool)
-> Either ArmCoords Bool -> Either ArmCoords Bool
forall a b. (a -> b) -> a -> b
$ Notes p -> Either ArmCoords Bool
forall (t :: T). Notes t -> Either ArmCoords Bool
ensureAllCallable Notes p
l
Bool
haveDefRR <- (ArmCoords -> ArmCoords)
-> Either ArmCoords Bool -> Either ArmCoords Bool
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcRight ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords Bool -> Either ArmCoords Bool)
-> Either ArmCoords Bool -> Either ArmCoords Bool
forall a b. (a -> b) -> a -> b
$ Notes q -> Either ArmCoords Bool
forall (t :: T). Notes t -> Either ArmCoords Bool
ensureAllCallable Notes q
r
let haveDefL :: Bool
haveDefL = [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or [Bool
haveDefLL, Bool -> (EpName -> Bool) -> Maybe EpName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False EpName -> Bool
isDefEpName Maybe EpName
epNameL]
let haveDefR :: Bool
haveDefR = [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or [Bool
haveDefRR, Bool -> (EpName -> Bool) -> Maybe EpName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False EpName -> Bool
isDefEpName Maybe EpName
epNameR]
Bool -> Either ArmCoords () -> Either ArmCoords ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
haveDefL (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ (ArmCoords -> ArmCoords)
-> Either ArmCoords () -> Either ArmCoords ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcRight ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ Maybe EpName -> Notes q -> Either ArmCoords ()
forall (t :: T). Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed Maybe EpName
epNameR Notes q
r
Bool -> Either ArmCoords () -> Either ArmCoords ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
haveDefR (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ (ArmCoords -> ArmCoords)
-> Either ArmCoords () -> Either ArmCoords ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcLeft ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ Maybe EpName -> Notes p -> Either ArmCoords ()
forall (t :: T). Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed Maybe EpName
epNameL Notes p
l
return $ [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or [Bool
haveDefL, Bool
haveDefR]
Notes t
_ -> Bool -> Either ArmCoords Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkAllEpsNamed :: Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed :: forall (t :: T). Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed Maybe EpName
epNameRoot
| Maybe EpName -> Bool
forall a. Maybe a -> Bool
isJust Maybe EpName
epNameRoot = \Notes t
_ -> Either ArmCoords ()
forall (f :: * -> *). Applicative f => f ()
pass
| Bool
otherwise = \case
NTOr TypeAnn
_ RootAnn
fnL RootAnn
fnR Notes p
l Notes q
r -> do
let epNameL :: Maybe EpName
epNameL = RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fnL
epNameR :: Maybe EpName
epNameR = RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
fnR
(ArmCoords -> ArmCoords)
-> Either ArmCoords () -> Either ArmCoords ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcLeft ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ Maybe EpName -> Notes p -> Either ArmCoords ()
forall (t :: T). Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed Maybe EpName
epNameL Notes p
l
(ArmCoords -> ArmCoords)
-> Either ArmCoords () -> Either ArmCoords ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ArmCoord
AcRight ArmCoord -> ArmCoords -> ArmCoords
forall a. a -> [a] -> [a]
:) (Either ArmCoords () -> Either ArmCoords ())
-> Either ArmCoords () -> Either ArmCoords ()
forall a b. (a -> b) -> a -> b
$ Maybe EpName -> Notes q -> Either ArmCoords ()
forall (t :: T). Maybe EpName -> Notes t -> Either ArmCoords ()
checkAllEpsNamed Maybe EpName
epNameR Notes q
r
Notes t
_ -> ArmCoords -> Either ArmCoords ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError []
mkParamNotes :: Notes t -> RootAnn -> Either ParamEpError (ParamNotes t)
mkParamNotes :: forall (t :: T).
Notes t -> RootAnn -> Either ParamEpError (ParamNotes t)
mkParamNotes Notes t
nt RootAnn
fa = Notes t -> RootAnn -> Either ParamEpError ()
forall (t :: T). Notes t -> RootAnn -> Either ParamEpError ()
verifyParamNotes Notes t
nt RootAnn
fa Either ParamEpError ()
-> ParamNotes t -> Either ParamEpError (ParamNotes t)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Notes t -> RootAnn -> ParamNotes t
forall (t :: T). Notes t -> RootAnn -> ParamNotes t
UnsafeParamNotes Notes t
nt RootAnn
fa
data EpLiftSequence (arg :: T) (param :: T) where
EplArgHere :: EpLiftSequence arg arg
EplWrapLeft
:: (SingI subparam, SingI r)
=> EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr subparam r)
EplWrapRight
:: (SingI l, SingI subparam)
=> EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr l subparam)
deriving stock instance Eq (EpLiftSequence arg param)
deriving stock instance Show (EpLiftSequence arg param)
$(deriveGADTNFData ''EpLiftSequence)
instance Buildable (EpLiftSequence arg param) where
build :: EpLiftSequence arg param -> Builder
build = \case
EpLiftSequence arg param
EplArgHere -> Builder
"×"
EplWrapLeft EpLiftSequence arg subparam
es -> Builder
"Left (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EpLiftSequence arg subparam -> Builder
forall p. Buildable p => p -> Builder
build EpLiftSequence arg subparam
es Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
EplWrapRight EpLiftSequence arg subparam
es -> Builder
"Right (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EpLiftSequence arg subparam -> Builder
forall p. Buildable p => p -> Builder
build EpLiftSequence arg subparam
es Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
data EntrypointCallT (param :: T) (arg :: T) =
ParameterScope arg => EntrypointCall
{ forall (param :: T) (arg :: T). EntrypointCallT param arg -> EpName
epcName :: EpName
, forall (param :: T) (arg :: T).
EntrypointCallT param arg -> Proxy param
epcParamProxy :: Proxy param
, forall (param :: T) (arg :: T).
EntrypointCallT param arg -> EpLiftSequence arg param
epcLiftSequence :: EpLiftSequence arg param
}
deriving stock instance Eq (EntrypointCallT param arg)
deriving stock instance Show (EntrypointCallT param arg)
instance NFData (EntrypointCallT param arg) where
rnf :: EntrypointCallT param arg -> ()
rnf (EntrypointCall EpName
name Proxy param
Proxy EpLiftSequence arg param
s) = (EpName, EpLiftSequence arg param) -> ()
forall a. NFData a => a -> ()
rnf (EpName
name, EpLiftSequence arg param
s)
instance Buildable (EntrypointCallT param arg) where
build :: EntrypointCallT param arg -> Builder
build EntrypointCall{Proxy param
EpName
EpLiftSequence arg param
epcLiftSequence :: EpLiftSequence arg param
epcParamProxy :: Proxy param
epcName :: EpName
epcLiftSequence :: forall (param :: T) (arg :: T).
EntrypointCallT param arg -> EpLiftSequence arg param
epcParamProxy :: forall (param :: T) (arg :: T).
EntrypointCallT param arg -> Proxy param
epcName :: forall (param :: T) (arg :: T). EntrypointCallT param arg -> EpName
..} =
Builder
"Call " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| EpName
epcName EpName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| EpLiftSequence arg param
epcLiftSequence EpLiftSequence arg param -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
unsafeEpcCallRoot :: ParameterScope param => EntrypointCallT param param
unsafeEpcCallRoot :: forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
unsafeEpcCallRoot = EntrypointCall :: forall (param :: T) (arg :: T).
ParameterScope arg =>
EpName
-> Proxy param
-> EpLiftSequence arg param
-> EntrypointCallT param arg
EntrypointCall
{ epcName :: EpName
epcName = EpName
DefEpName
, epcParamProxy :: Proxy param
epcParamProxy = Proxy param
forall {k} (t :: k). Proxy t
Proxy
, epcLiftSequence :: EpLiftSequence param param
epcLiftSequence = EpLiftSequence param param
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
}
epcPrimitive
:: forall p.
(ParameterScope p, ForbidOr p)
=> EntrypointCallT p p
epcPrimitive :: forall (p :: T).
(ParameterScope p, ForbidOr p) =>
EntrypointCallT p p
epcPrimitive = EntrypointCallT p p
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
unsafeEpcCallRoot
where
_requireNoOr :: Dict (ForbidOr p)
_requireNoOr = forall (a :: Constraint). a => Dict a
Dict @(ForbidOr p)
type family ForbidOr (t :: T) :: Constraint where
ForbidOr ('TOr l r) =
TypeError
('Text "Cannot apply to sum type parameter " ':<>: 'ShowType ('TOr l r))
ForbidOr _ = ()
data SomeEntrypointCallT (arg :: T) =
forall param. (ParameterScope param) =>
SomeEpc (EntrypointCallT param arg)
instance Eq (SomeEntrypointCallT arg) where
SomeEpc EntrypointCallT param arg
epc1 == :: SomeEntrypointCallT arg -> SomeEntrypointCallT arg -> Bool
== SomeEpc EntrypointCallT param arg
epc2 = forall a. Maybe a -> Bool
isJust @() (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
param :~: param
Refl <- Proxy param -> Proxy param -> Maybe (param :~: param)
forall (a :: T) (b :: T).
(SingI a, SingI b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
eqP (EntrypointCallT param arg -> Proxy param
forall (param :: T) (arg :: T).
EntrypointCallT param arg -> Proxy param
epcParamProxy EntrypointCallT param arg
epc1) (EntrypointCallT param arg -> Proxy param
forall (param :: T) (arg :: T).
EntrypointCallT param arg -> Proxy param
epcParamProxy EntrypointCallT param arg
epc2)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (EntrypointCallT param arg
epc1 EntrypointCallT param arg -> EntrypointCallT param arg -> Bool
forall a. Eq a => a -> a -> Bool
== EntrypointCallT param arg
EntrypointCallT param arg
epc2)
deriving stock instance Show (SomeEntrypointCallT arg)
instance NFData (SomeEntrypointCallT arg) where
rnf :: SomeEntrypointCallT arg -> ()
rnf (SomeEpc EntrypointCallT param arg
epc) = EntrypointCallT param arg -> ()
forall a. NFData a => a -> ()
rnf EntrypointCallT param arg
epc
instance Buildable (SomeEntrypointCallT arg) where
build :: SomeEntrypointCallT arg -> Builder
build (SomeEpc EntrypointCallT param arg
epc) = EntrypointCallT param arg -> Builder
forall p. Buildable p => p -> Builder
build EntrypointCallT param arg
epc
unsafeSepcCallRoot :: ParameterScope param => SomeEntrypointCallT param
unsafeSepcCallRoot :: forall (param :: T).
ParameterScope param =>
SomeEntrypointCallT param
unsafeSepcCallRoot = EntrypointCallT param param -> SomeEntrypointCallT param
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT param param
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
unsafeEpcCallRoot
sepcPrimitive
:: forall t.
(ParameterScope t, ForbidOr t)
=> SomeEntrypointCallT t
sepcPrimitive :: forall (t :: T).
(ParameterScope t, ForbidOr t) =>
SomeEntrypointCallT t
sepcPrimitive = EntrypointCallT t t -> SomeEntrypointCallT t
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT t t
forall (p :: T).
(ParameterScope p, ForbidOr p) =>
EntrypointCallT p p
epcPrimitive
sepcName :: SomeEntrypointCallT arg -> EpName
sepcName :: forall (arg :: T). SomeEntrypointCallT arg -> EpName
sepcName (SomeEpc EntrypointCallT param arg
epc) = EntrypointCallT param arg -> EpName
forall (param :: T) (arg :: T). EntrypointCallT param arg -> EpName
epcName EntrypointCallT param arg
epc
withEpLiftSequence
:: forall param r.
(ParameterScope param)
=> EpName
-> Notes param
-> (forall arg. (ParameterScope arg) => (Notes arg, EpLiftSequence arg param) -> r)
-> Maybe r
withEpLiftSequence :: forall (param :: T) r.
ParameterScope param =>
EpName
-> Notes param
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r)
-> Maybe r
withEpLiftSequence epName :: EpName
epName@(EpName -> RootAnn
epNameToParamAnn -> RootAnn
epAnn) Notes param
param forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r
cont =
case (forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @param, Notes param
param) of
(STOr Sing n1
lSing Sing n2
rSing, NTOr TypeAnn
_ RootAnn
lFieldAnn RootAnn
rFieldAnn Notes p
lNotes Notes q
rNotes) ->
Sing n1 -> (SingI n1 => Maybe r) -> Maybe r
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n1
lSing ((SingI n1 => Maybe r) -> Maybe r)
-> (SingI n1 => Maybe r) -> Maybe r
forall a b. (a -> b) -> a -> b
$
Sing n2 -> (SingI n2 => Maybe r) -> Maybe r
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n2
rSing ((SingI n2 => Maybe r) -> Maybe r)
-> (SingI n2 => Maybe r) -> Maybe r
forall a b. (a -> b) -> a -> b
$
case (Sing n1 -> OpPresence n1
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing n1
lSing, Sing n1 -> NestedBigMapsPresence n1
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing n1
lSing) of
(OpPresence n1
OpAbsent, NestedBigMapsPresence n1
NestedBigMapsAbsent) -> [Maybe r] -> Maybe r
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
[ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RootAnn
lFieldAnn RootAnn -> RootAnn -> Bool
forall a. Eq a => a -> a -> Bool
== RootAnn
epAnn) Maybe () -> r -> Maybe r
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Notes p, EpLiftSequence p param) -> r
forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r
cont (Notes p
lNotes, EpLiftSequence p p -> EpLiftSequence p ('TOr p n2)
forall (arg :: T) (subparam :: T) (arg :: T).
(SingI arg, SingI subparam) =>
EpLiftSequence arg arg -> EpLiftSequence arg ('TOr arg subparam)
EplWrapLeft EpLiftSequence p p
forall (arg :: T). EpLiftSequence arg arg
EplArgHere)
, Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RootAnn
rFieldAnn RootAnn -> RootAnn -> Bool
forall a. Eq a => a -> a -> Bool
== RootAnn
epAnn) Maybe () -> r -> Maybe r
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Notes q, EpLiftSequence q param) -> r
forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r
cont (Notes q
rNotes, EpLiftSequence q q -> EpLiftSequence q ('TOr n1 q)
forall (arg :: T) (subparam :: T) (arg :: T).
(SingI arg, SingI subparam) =>
EpLiftSequence arg subparam
-> EpLiftSequence arg ('TOr arg subparam)
EplWrapRight EpLiftSequence q q
forall (arg :: T). EpLiftSequence arg arg
EplArgHere)
, EpName
-> Notes p
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg p) -> r)
-> Maybe r
forall (param :: T) r.
ParameterScope param =>
EpName
-> Notes param
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r)
-> Maybe r
withEpLiftSequence EpName
epName Notes p
lNotes ((Notes arg, EpLiftSequence arg param) -> r
forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r
cont ((Notes arg, EpLiftSequence arg param) -> r)
-> ((Notes arg, EpLiftSequence arg p)
-> (Notes arg, EpLiftSequence arg param))
-> (Notes arg, EpLiftSequence arg p)
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @((,) _) EpLiftSequence arg p -> EpLiftSequence arg ('TOr p n2)
forall (arg :: T) (subparam :: T) (arg :: T).
(SingI arg, SingI subparam) =>
EpLiftSequence arg arg -> EpLiftSequence arg ('TOr arg subparam)
EplWrapLeft)
, EpName
-> Notes q
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg q) -> r)
-> Maybe r
forall (param :: T) r.
ParameterScope param =>
EpName
-> Notes param
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r)
-> Maybe r
withEpLiftSequence EpName
epName Notes q
rNotes ((Notes arg, EpLiftSequence arg param) -> r
forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r
cont ((Notes arg, EpLiftSequence arg param) -> r)
-> ((Notes arg, EpLiftSequence arg q)
-> (Notes arg, EpLiftSequence arg param))
-> (Notes arg, EpLiftSequence arg q)
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @((,) _) EpLiftSequence arg q -> EpLiftSequence arg ('TOr n1 q)
forall (arg :: T) (subparam :: T) (arg :: T).
(SingI arg, SingI subparam) =>
EpLiftSequence arg subparam
-> EpLiftSequence arg ('TOr arg subparam)
EplWrapRight)
]
(SingT param, Notes param)
_ -> Maybe r
forall a. Maybe a
Nothing
data MkEntrypointCallRes param where
MkEntrypointCallRes
:: ParameterScope arg
=> Notes arg
-> EntrypointCallT param arg
-> MkEntrypointCallRes param
mkEntrypointCall
:: (ParameterScope param)
=> EpName
-> ParamNotes param
-> Maybe (MkEntrypointCallRes param)
mkEntrypointCall :: forall (param :: T).
ParameterScope param =>
EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param)
mkEntrypointCall EpName
epName (ParamNotes Notes param
paramNotes RootAnn
root) =
[Maybe (MkEntrypointCallRes param)]
-> Maybe (MkEntrypointCallRes param)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
[ do
EpName
epName' <- RootAnn -> Maybe EpName
epNameFromParamAnn RootAnn
root
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (EpName
epName EpName -> EpName -> Bool
forall a. Eq a => a -> a -> Bool
== EpName
epName')
return $ Notes param
-> EntrypointCallT param param -> MkEntrypointCallRes param
forall (arg :: T) (param :: T).
ParameterScope arg =>
Notes arg -> EntrypointCallT param arg -> MkEntrypointCallRes param
MkEntrypointCallRes
Notes param
paramNotes
EntrypointCall :: forall (param :: T) (arg :: T).
ParameterScope arg =>
EpName
-> Proxy param
-> EpLiftSequence arg param
-> EntrypointCallT param arg
EntrypointCall
{ epcName :: EpName
epcName = EpName
epName
, epcParamProxy :: Proxy param
epcParamProxy = Proxy param
forall {k} (t :: k). Proxy t
Proxy
, epcLiftSequence :: EpLiftSequence param param
epcLiftSequence = EpLiftSequence param param
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
}
, EpName
-> Notes param
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> MkEntrypointCallRes param)
-> Maybe (MkEntrypointCallRes param)
forall (param :: T) r.
ParameterScope param =>
EpName
-> Notes param
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> r)
-> Maybe r
withEpLiftSequence EpName
epName Notes param
paramNotes ((forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> MkEntrypointCallRes param)
-> Maybe (MkEntrypointCallRes param))
-> (forall (arg :: T).
ParameterScope arg =>
(Notes arg, EpLiftSequence arg param) -> MkEntrypointCallRes param)
-> Maybe (MkEntrypointCallRes param)
forall a b. (a -> b) -> a -> b
$ \(Notes arg
argInfo, EpLiftSequence arg param
liftSeq) ->
Notes arg -> EntrypointCallT param arg -> MkEntrypointCallRes param
forall (arg :: T) (param :: T).
ParameterScope arg =>
Notes arg -> EntrypointCallT param arg -> MkEntrypointCallRes param
MkEntrypointCallRes Notes arg
argInfo (EntrypointCallT param arg -> MkEntrypointCallRes param)
-> EntrypointCallT param arg -> MkEntrypointCallRes param
forall a b. (a -> b) -> a -> b
$ EntrypointCall :: forall (param :: T) (arg :: T).
ParameterScope arg =>
EpName
-> Proxy param
-> EpLiftSequence arg param
-> EntrypointCallT param arg
EntrypointCall
{ epcName :: EpName
epcName = EpName
epName
, epcParamProxy :: Proxy param
epcParamProxy = Proxy param
forall {k} (t :: k). Proxy t
Proxy
, epcLiftSequence :: EpLiftSequence arg param
epcLiftSequence = EpLiftSequence arg param
liftSeq
}
, Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (EpName -> Bool
isDefEpName EpName
epName) Maybe ()
-> MkEntrypointCallRes param -> Maybe (MkEntrypointCallRes param)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>
Notes param
-> EntrypointCallT param param -> MkEntrypointCallRes param
forall (arg :: T) (param :: T).
ParameterScope arg =>
Notes arg -> EntrypointCallT param arg -> MkEntrypointCallRes param
MkEntrypointCallRes Notes param
paramNotes EntrypointCall :: forall (param :: T) (arg :: T).
ParameterScope arg =>
EpName
-> Proxy param
-> EpLiftSequence arg param
-> EntrypointCallT param arg
EntrypointCall
{ epcName :: EpName
epcName = EpName
epName
, epcParamProxy :: Proxy param
epcParamProxy = Proxy param
forall {k} (t :: k). Proxy t
Proxy
, epcLiftSequence :: EpLiftSequence param param
epcLiftSequence = EpLiftSequence param param
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
}
]
tyImplicitAccountParam :: ParamNotes 'TUnit
tyImplicitAccountParam :: ParamNotes 'TUnit
tyImplicitAccountParam = Notes 'TUnit -> RootAnn -> ParamNotes 'TUnit
forall (t :: T). Notes t -> RootAnn -> ParamNotes t
UnsafeParamNotes Notes 'TUnit
forall (t :: T). SingI t => Notes t
starNotes RootAnn
forall {k} (a :: k). Annotation a
noAnn