EntryPoints.hs

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 -> "<default>"
    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)