module Lorentz.EntryPoints.Helpers
( ctorNameToAnn
, ctorNameToEp
, CanHaveEntryPoints
, ShouldHaveEntryPoints (..)
, RequireSumType
) where
import qualified Data.Kind as Kind
import Michelson.Typed.Haskell
import Michelson.Typed.T
import Michelson.Untyped (EpName, FieldAnn, ann, epNameFromParamAnn)
import Util.Text
import Util.Type
import Util.TypeLits
ctorNameToAnn :: forall ctor. (KnownSymbol ctor, HasCallStack) => FieldAnn
ctorNameToAnn :: FieldAnn
ctorNameToAnn = Text -> FieldAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann (Text -> FieldAnn) -> (Text -> Text) -> Text -> FieldAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text
Text -> Text
headToLower (Text -> FieldAnn) -> Text -> FieldAnn
forall a b. (a -> b) -> a -> b
$ (KnownSymbol ctor => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @ctor)
ctorNameToEp :: forall ctor. (KnownSymbol ctor, HasCallStack) => EpName
ctorNameToEp :: EpName
ctorNameToEp =
FieldAnn -> Maybe EpName
epNameFromParamAnn ((KnownSymbol ctor, HasCallStack) => FieldAnn
forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
FieldAnn
ctorNameToAnn @ctor)
Maybe EpName -> EpName -> EpName
forall a. Maybe a -> a -> a
?: Text -> EpName
forall a. HasCallStack => Text -> a
error "Empty constructor-entrypoint name"
newtype ShouldHaveEntryPoints a = ShouldHaveEntryPoints { ShouldHaveEntryPoints a -> a
unHasEntryPoints :: a }
deriving stock (forall x.
ShouldHaveEntryPoints a -> Rep (ShouldHaveEntryPoints a) x)
-> (forall x.
Rep (ShouldHaveEntryPoints a) x -> ShouldHaveEntryPoints a)
-> Generic (ShouldHaveEntryPoints a)
forall x.
Rep (ShouldHaveEntryPoints a) x -> ShouldHaveEntryPoints a
forall x.
ShouldHaveEntryPoints a -> Rep (ShouldHaveEntryPoints a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (ShouldHaveEntryPoints a) x -> ShouldHaveEntryPoints a
forall a x.
ShouldHaveEntryPoints a -> Rep (ShouldHaveEntryPoints a) x
$cto :: forall a x.
Rep (ShouldHaveEntryPoints a) x -> ShouldHaveEntryPoints a
$cfrom :: forall a x.
ShouldHaveEntryPoints a -> Rep (ShouldHaveEntryPoints a) x
Generic
deriving anyclass instance (WellTypedIsoValue r) => IsoValue (ShouldHaveEntryPoints r)
type family CanHaveEntryPoints (p :: Kind.Type) :: Bool where
CanHaveEntryPoints (ShouldHaveEntryPoints _) = 'True
CanHaveEntryPoints p = CanHaveEntryPointsT (ToT p)
type family CanHaveEntryPointsT (t :: T) :: Bool where
CanHaveEntryPointsT ('TOr _ _) = 'True
CanHaveEntryPointsT _ = 'False
type family RequireSumType (a :: Kind.Type) :: Constraint where
RequireSumType a =
If (CanHaveEntryPoints a)
(() :: Constraint)
(TypeError ('Text "Expected Michelson sum type" ':$$:
'Text "In type `" ':<>: 'ShowType a ':<>: 'Text "`"
))