module Michelson.Untyped.EntryPoints ( EpName (..) , pattern DefEpName , epNameFromParamAnn , epNameToParamAnn , epNameFromRefAnn , epNameToRefAnn , EpNameFromRefAnnError (..) ) where import Data.Default (Default(..)) import Fmt (Buildable(..), (+|), (|+)) import Test.QuickCheck (Arbitrary(..), suchThatMap) import Michelson.Untyped.Annotation -- | Entrypoint name. -- -- Empty if this entrypoint is default one. -- Cannot be equal to "default", the reference implementation forbids that. -- Also, set of allowed characters should be the same as in annotations. newtype EpName = EpNameUnsafe { unEpName :: Text } deriving (Show, Eq, Ord) pattern DefEpName :: EpName pattern DefEpName = EpNameUnsafe "" instance Buildable EpName where build = \case DefEpName -> "" EpNameUnsafe name -> build name instance Default EpName where def = EpNameUnsafe "" -- | Make up 'EpName' from annotation in parameter type declaration. -- -- Returns 'Nothing' if no entrypoint is assigned here. epNameFromParamAnn :: FieldAnn -> Maybe EpName epNameFromParamAnn an@(Annotation a) | an == noAnn = Nothing | a == "default" = Just (EpNameUnsafe "") | otherwise = Just $ EpNameUnsafe a -- | Turn entrypoint name into annotation for contract parameter declaration. epNameToParamAnn :: EpName -> FieldAnn epNameToParamAnn (EpNameUnsafe name) | name == "" = ann "default" | otherwise = ann name data EpNameFromRefAnnError = InEpNameBadAnnotation FieldAnn deriving stock (Show, Eq) instance Buildable EpNameFromRefAnnError where build = \case InEpNameBadAnnotation (Annotation an) -> "Invalid entrypoint reference `" +| an |+ "`" -- | Make up 'EpName' from annotation which is reference to an entrypoint -- (e.g. annotation in @CONTRACT@ instruction). -- -- Fails if annotation is invalid. epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName epNameFromRefAnn an@(Annotation a) | a == "default" = Left $ InEpNameBadAnnotation an | otherwise = Right $ EpNameUnsafe a -- | Turn entrypoint name into annotation used as reference to entrypoint. epNameToRefAnn :: EpName -> FieldAnn epNameToRefAnn (EpNameUnsafe name) = ann name instance Arbitrary FieldAnn => Arbitrary EpName where arbitrary = arbitrary `suchThatMap` (rightToMaybe . epNameFromRefAnn)