module Lorentz.EntryPoints.Helpers
( ctorNameToAnn
, CanHaveEntryPoints
, ShouldHaveEntryPoints (..)
, RequireSumType
) where
import qualified Data.Kind as Kind
import Michelson.Typed.Haskell
import Michelson.Typed.T
import Michelson.Untyped (FieldAnn, ann)
import Util.Text
import Util.Type
import Util.TypeLits
ctorNameToAnn :: forall ctor. (KnownSymbol ctor, HasCallStack) => FieldAnn
ctorNameToAnn = ann . headToLower $ (symbolValT' @ctor)
newtype ShouldHaveEntryPoints a = ShouldHaveEntryPoints { unHasEntryPoints :: a }
deriving stock Generic
deriving anyclass IsoValue
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"))