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
newtype EpName = EpNameUnsafe { unEpName :: Text }
deriving (Show, Eq, Ord)
pattern DefEpName :: EpName
pattern DefEpName = EpNameUnsafe ""
instance Buildable EpName where
build = \case
DefEpName -> "<default>"
EpNameUnsafe name -> build name
instance Default EpName where
def = EpNameUnsafe ""
epNameFromParamAnn :: FieldAnn -> Maybe EpName
epNameFromParamAnn an@(Annotation a)
| an == noAnn = Nothing
| a == "default" = Just (EpNameUnsafe "")
| otherwise = Just $ EpNameUnsafe a
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 |+ "`"
epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName
epNameFromRefAnn an@(Annotation a)
| a == "default" = Left $ InEpNameBadAnnotation an
| otherwise = Right $ EpNameUnsafe a
epNameToRefAnn :: EpName -> FieldAnn
epNameToRefAnn (EpNameUnsafe name) = ann name
instance Arbitrary FieldAnn => Arbitrary EpName where
arbitrary = arbitrary `suchThatMap` (rightToMaybe . epNameFromRefAnn)