Errors.hs

{-# LANGUAGE TypeFamilyDependencies #-}

-- We want to make sure 'failUsingArg' is used with sane argument.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Lorentz.Errors
  ( -- * Haskell to 'Value' conversion
    IsError (..)
  , isoErrorToVal
  , isoErrorFromVal
  , ErrorHasDoc (..)
  , typeDocMdDescriptionReferToError

  , UnspecifiedError (..)

    -- * General instructions
  , failUsing
  , failUnexpected

    -- * Custom errors
  , ErrorArg
  , CustomError (..)
  , failCustom
  , RequireNoArgError
  , failCustom_

    -- * Documentation
  , ErrorClass (..)
  , CustomErrorHasDoc (..)
  , DError (..)
  , DThrows (..)

    -- * Old interface (DEPRECATED)
  , customErrorToVal
  , customErrorFromVal
  , failUsingArg
  , FailUsingArg
  , CustomErrorNoIsoValue
  , deriveCustomError

  , errorsDocumentation
  ) where

import qualified Data.Char as C
import Data.Constraint (Dict(..))
import qualified Data.Kind as Kind
import qualified Data.List as L
import Data.Singletons (SingI(..), demote)
import Data.Type.Equality (type (==))
import Data.Typeable (cast)
import Data.Vinyl.Derived (Label)
import Fmt (Buildable, build, fmt, pretty, (+|), (+||), (|+), (||+))
import GHC.TypeLits (ErrorMessage(..), KnownSymbol, Symbol, TypeError, symbolVal)
import qualified Language.Haskell.TH as TH
import qualified Text.Show

import Lorentz.Base
import Lorentz.Doc
import Lorentz.Instr hiding (cast)
import Lorentz.Value
import Michelson.Text
import Michelson.Typed.Haskell
import Michelson.Typed.Instr
import Michelson.Typed.Scope
import Michelson.Typed.Sing
import Michelson.Typed.T
import Michelson.Typed.Value
import Util.Markdown
import Util.Type
import Util.Typeable
import Util.TypeLits

----------------------------------------------------------------------------
-- IsError
----------------------------------------------------------------------------

type ErrorScope t =
  -- We can require a weaker constraint (e.g. no 'HasNoOp'), but
  -- for now it's the simplest way to make 'failUsing' work
  ( Typeable t
  , ConstantScope t
  )

type KnownError a = ErrorScope (ToT a)

-- | Haskell type representing error.
class (Typeable e, ErrorHasDoc e) => IsError e where

  -- | Converts a Haskell error into @Value@ representation.
  errorToVal :: e -> (forall t. ErrorScope t => Value t -> r) -> r

  -- | Converts a @Value@ into Haskell error.
  errorFromVal :: (Typeable t, SingI t) => Value t -> Either Text e

-- | Implementation of 'errorToVal' via 'IsoValue'.
isoErrorToVal
  :: (KnownError e, IsoValue e)
  => e -> (forall t. ErrorScope t => Value t -> r) -> r
isoErrorToVal e cont = cont $ toVal e

-- | Implementation of 'errorFromVal' via 'IsoValue'.
isoErrorFromVal
  :: (Typeable t, Typeable (ToT e), IsoValue e)
  => Value t -> Either Text e
isoErrorFromVal e = fromVal <$> gcastE e

class ErrorHasDoc e where
  -- | Name of error as it appears in the corresponding section title.
  errorDocName :: Text

  -- | What should happen for this error to be raised.
  errorDocMdCause :: Markdown

  -- | Brief version of 'errorDocMdCause'.
  --
  -- This will appear along with the error when mentioned in entrypoint description.
  -- By default, the first sentence of the full description is used.
  errorDocMdCauseInEntrypoint :: Markdown
  errorDocMdCauseInEntrypoint = pickFirstSentence $ errorDocMdCause @e

  -- | How this error is represented in Haskell.
  errorDocHaskellRep :: Markdown

  -- | Error class.
  errorDocClass :: ErrorClass
  errorDocClass = ErrClassUnknown

  -- | Which definitions documentation for this error mentions.
  errorDocDependencies :: [SomeDocDefinitionItem]

-- | Helper for managing descriptions.
pickFirstSentence :: Markdown -> Markdown
pickFirstSentence = build . toText . go . fmt
  where
    go :: String -> String
    go = \case
      '.' : c : _ | C.isSpace c -> "."
      c : s -> c : go s
      "" -> ""

-- Instances
----------------------------------------------------------------------------

-- | Use this for internal errors only.
--
-- "Normal" error scenarios should use the mechanism of custom errors, see below.
instance IsError MText where
  errorToVal = isoErrorToVal
  errorFromVal = isoErrorFromVal

instance ErrorHasDoc MText where
  errorDocName = "InternalError"
  errorDocMdCause =
    "Internal error occured."
  errorDocHaskellRep =
    "Textual error message, see " <>
    typeDocMdReference (Proxy @MText) (WithinParens False) <> "."
  errorDocClass = ErrClassContractInternal
  errorDocDependencies = [SomeDocDefinitionItem (DType $ Proxy @MText)]

instance TypeError ('Text "Use representative error messages") => IsError () where
  errorToVal _ _ = error "impossible"
  errorFromVal = error "impossible"

instance TypeError ('Text "Use representative error messages") => ErrorHasDoc () where
  errorDocName = error "impossible"
  errorDocMdCause = error "impossible"
  errorDocHaskellRep = error "impossible"
  errorDocDependencies = error "impossible"

-- | Use this type as replacement for @()@ when you __really__ want to leave
-- error cause unspecified.
data UnspecifiedError = UnspecifiedError
  deriving stock Generic
  deriving anyclass IsoValue

instance IsError UnspecifiedError where
  errorToVal = isoErrorToVal
  errorFromVal = isoErrorFromVal

instance ErrorHasDoc UnspecifiedError where
  errorDocName = "Unspecified error"
  errorDocMdCause = "Some error occured."
  errorDocHaskellRep = typeDocMdReference (Proxy @()) (WithinParens False) <> "."
  errorDocDependencies = typeDocDependencies' (Proxy @())

----------------------------------------------------------------------------
-- General instructions
----------------------------------------------------------------------------

-- | Fail with the given Haskell value.
failUsing
  :: forall e s t.
     (IsError e)
  => e -> s :-> t
failUsing err =
  errorToVal err $ \eval ->
    doc (DThrows (Proxy @e)) #
    (FI $ PUSH eval `Seq` FAILWITH)

-- | Fail, providing a reference to the place in the code where
-- this function is called.
--
-- Like 'error' in Haskell code, this instruction is for internal errors only.
failUnexpected :: MText -> s :-> t
failUnexpected msg = failUsing $ [mt|Internal: |] <> msg

----------------------------------------------------------------------------
-- Custom errors
----------------------------------------------------------------------------

{- | Declares a custom error, defining @error name - error argument@ relation.

If your error is supposed to carry no argument, then provide @()@.

Note that this relation is defined globally rather than on per-contract basis,
so define errors accordingly. If your error has argument specific to your
contract, call it such that error name reflects its belonging to this contract.
-}

{- About global registry of errors:

Pros: this allows defining pieces of code which can be reused among the contracts.

Cons: possible name collisions. Example of worst case: two libraries define
different errors for the same tag, attempt to use both of these libraries would
cause compile-time error. But such infrastructure will barely take place in
practice.
-}
{- For future work:

* Assosiating unique numeric error codes to tags, and put codes into
the contract instead of tags. This allows getting rid of overhead related to
often long tag literals.

* Allow using arbitrary type instead of tag (and 'KnownSymbol' constraint will
be replaced with a more generic one).
Some users may prefer using datatypes as tags rather than type-level strings as tags
because
  * there will be no orphan instances then
  * no problem with name collisions
  * compiler will prompt a hint in case of typo in tag name
  * in some cases autocomplete handles declarations in code better than strings
(and cons here is that each such tag will need to be declared first).

-}
type family ErrorArg (tag :: Symbol) :: Kind.Type

-- | Material custom error.
--
-- Use this in pattern matches against error (e.g. in tests).
data CustomError (tag :: Symbol) = CustomError
  { ceTag :: Label tag
  , ceArg :: ErrorArg tag
  }

deriving stock instance Eq (ErrorArg tag) => Eq (CustomError tag)
deriving stock instance Show (ErrorArg tag) => Show (CustomError tag)

-- | How 'CustomError' is actually represented in Michelson.
type CustomErrorRep tag = (MText, ErrorArg tag)

-- | This instance cannot be implemented, use 'IsError' instance instead.
instance TypeError ('Text "CustomError has no IsoValue instance") =>
         IsoValue (CustomError tag) where
  type ToT (CustomError tag) = TypeError ('Text "CustomError has no IsoValue instance")
  toVal = error "impossible"
  fromVal = error "impossible"

instance (CustomErrorHasDoc tag, KnownError (ErrorArg tag), IsoValue (ErrorArg tag)) =>
         IsError (CustomError tag) where
  errorToVal (CustomError l arg) cont =
    cont $ toVal @(CustomErrorRep tag) (errorTagToMText l, arg)
  errorFromVal (v :: Value t) =
    let expectedTag = errorTagToMText (fromLabel @tag)
    in case cast v of
        Just v' ->
          let (tag, arg) = fromVal @(CustomErrorRep tag) v'
          in if tag == expectedTag
             then Right $ CustomError fromLabel arg
             else Left $ "Bad tag, expected " +| expectedTag |+ ", got " +| tag |+ ""
        Nothing -> Left $ "Wrong type for custom error: " <> pretty (demote @t)

instance (CustomErrorHasDoc tag, SingI (ToT (ErrorArg tag))) =>
         ErrorHasDoc (CustomError tag) where
  errorDocName = errorTagToText @tag
  errorDocDependencies = [SomeDocDefinitionItem $ DType $ Proxy @(ErrorArg tag)]
  errorDocMdCause = customErrDocMdCause @tag
  errorDocMdCauseInEntrypoint = customErrDocMdCauseInEntrypoint @tag
  errorDocClass = customErrClass @tag
  errorDocHaskellRep =
    let hasArg = demote @(ToT (ErrorArg tag)) /= TUnit
        name = build $ errorTagToText @tag
    in mconcat $ catMaybes
      [ Just $
          ( if hasArg
            then mdTicked ("(\"" <> name <> "\", " <> "<error argument>" <> ")")
            else mdTicked ("(\"" <> name <> "\", ())")
          ) <> "."
      , guard hasArg $>
          ("\n\nProvided error argument will be of type "
          <> typeDocMdReference (Proxy @(ErrorArg tag)) (WithinParens False)
          <> (maybe "" (\txt -> " and stand for " <> txt) (customErrArgumentSemantics @tag))
          <> "."
          )
      ]

-- | Demote error tag to term level.
errorTagToMText :: KnownSymbol tag => Label tag -> MText
errorTagToMText l =
  -- Now tags come not from constructor names, but from labels,
  -- we have to lead the first letter to upper case to preserve
  -- compatibility with FA1.2 interface.
  mtextHeadToUpper $
    labelToMText l

errorTagToText :: forall tag. KnownSymbol tag => Text
errorTagToText = toText $ errorTagToMText (fromLabel @tag)

-- | Fail with given custom error.
failCustom
  :: forall tag err s any.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , KnownError err
     )
  => Label tag -> err : s :-> any
failCustom l =
  doc (DThrows (Proxy @(CustomError tag))) #
  push (errorTagToMText l) # pair @MText @err #
  FI (FAILWITH @(ToT (CustomErrorRep tag)))

type RequireNoArgError tag msg =
  ( TypeErrorUnless (ErrorArg tag == ()) msg
  , msg ~
    ('Text "Expected no-arg error, but given error requires argument of type "
      ':<>: 'ShowType (ErrorArg tag)
    )
  )

-- | Specialization of 'failCustom' for no-arg errors.
failCustom_
  :: forall tag s any notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> s :-> any
failCustom_ l =
  inTypeErrorUnless @(ErrorArg tag == ()) @notVoidErrorMsg $
  reifyTypeEquality @(ErrorArg tag) @() $
    unit # failCustom l

-- Special treatment of no-arg errors
----------------------------------------------------------------------------

instance Eq (ErrorArg tag) => Eq (() -> CustomError tag) where
  e1 == e2 = e1 () == e2 ()
instance Show (ErrorArg tag) => Show (() -> CustomError tag) where
  show e = show (e ())

-- | If 'CustomError' constructor is not provided its argument, we assume
-- that this is no-arg error and interpret the passed value as complete.
instance ( Typeable arg
         , IsError (CustomError tag)
         , TypeErrorUnless (arg == ()) notVoidError
         , arg ~ ErrorArg tag
         , notVoidError ~
            ('Text "This error requires argument of type "
              ':<>: 'ShowType (ErrorArg tag)
            )
         ) =>
         IsError (arg -> CustomError tag) where
  errorToVal mkCustomError cont =
    inTypeErrorUnless @(arg == ()) @notVoidError $
    reifyTypeEquality @arg @() $
      errorToVal (mkCustomError ()) cont
  errorFromVal v =
    inTypeErrorUnless @(arg == ()) @notVoidError $
    reifyTypeEquality @arg @() $
      errorFromVal v <&> \(CustomError l ()) -> CustomError l

instance ErrorHasDoc (CustomError tag) => ErrorHasDoc (arg -> CustomError tag) where
  errorDocName = errorDocName @(CustomError tag)
  errorDocMdCauseInEntrypoint = errorDocMdCauseInEntrypoint @(CustomError tag)
  errorDocMdCause = errorDocMdCause @(CustomError tag)
  errorDocHaskellRep = errorDocHaskellRep @(CustomError tag)
  errorDocDependencies = errorDocDependencies @(CustomError tag)

----------------------------------------------------------------------------
-- Errors documentation injection into contracts
----------------------------------------------------------------------------

-- | Error class on how the error should be handled by the client.
data ErrorClass
  = ErrClassActionException
    -- ^ Normal expected error.
    -- Examples: "insufficient balance", "wallet does not exist".
  | ErrClassBadArgument
    -- ^ Invalid argument passed to entrypoint.
    -- Examples: your entrypoint accepts an enum represented as @nat@, and
    -- unknown value is provided.
    -- This includes more complex cases which involve multiple entrypoints.
    -- E.g. API provides iterator interface, middleware should care about using it
    -- hiding complex details and exposing a simpler API to user; then an attempt to
    -- request non-existing element would also correspond to an error from this class.
  | ErrClassContractInternal
    -- ^ Unexpected error. Most likely it means that there is a bug in
    -- the contract or the contract has been deployed incorrectly.
  | ErrClassUnknown
    -- ^ It's possible to leave error class unspecified.

instance Buildable ErrorClass where
  build = \case
    ErrClassActionException -> "Action exception"
    ErrClassBadArgument -> "Bad argument"
    ErrClassContractInternal -> "Internal"
    ErrClassUnknown -> "-"

isInternalErrorClass :: ErrorClass -> Bool
isInternalErrorClass = \case
  ErrClassActionException -> False
  ErrClassBadArgument -> False
  ErrClassContractInternal -> True
  ErrClassUnknown -> False

class (KnownSymbol tag, TypeHasDoc (ErrorArg tag), IsError (CustomError tag)) =>
      CustomErrorHasDoc tag where
  -- | What should happen for this error to be raised.
  customErrDocMdCause :: Markdown

  -- | Brief version of 'customErrDocMdCause'.
  -- This will appear along with the error when mentioned in entrypoint description.
  --
  -- By default, the first sentence of the full description is used.
  customErrDocMdCauseInEntrypoint :: Markdown
  customErrDocMdCauseInEntrypoint = pickFirstSentence $ customErrDocMdCause @tag

  -- | Error class.
  --
  -- By default this returns "unknown error" class; though you should provide
  -- explicit implementation in order to avoid a warning.
  customErrClass :: ErrorClass
  customErrClass = ErrClassUnknown

  -- | Clarification of error argument meaning.
  --
  -- Provide when it's not obvious, e.g. argument is not named with ':!'.
  --
  -- NOTE: This should /not/ be an entire sentence, rather just the semantic
  -- backbone.
  --
  -- Bad:
  -- * @Error argument stands for the previous value of approval.@
  --
  -- Good:
  -- * @the previous value of approval@
  -- * @pair, first argument of which is one thing, and the second is another@
  customErrArgumentSemantics :: Maybe Markdown
  customErrArgumentSemantics = Nothing
  {-# MINIMAL customErrDocMdCause, customErrClass #-}

-- | Mentions that contract uses given error.
data DError where
  DError :: IsError e => Proxy e -> DError

instance Eq DError where
  DError e1 == DError e2 = e1 `eqParam1` e2
instance Ord DError where
  DError e1 `compare` DError e2 = e1 `compareExt` e2

instance DocItem DError where
  type DocItemPosition DError = 5010
  type DocItemPlacement DError = 'DocItemInDefinitions
  docItemSectionName = Just "Errors"
  docItemSectionDescription = Just errorsDocumentation
  docItemRef (DError (_ :: Proxy e)) = DocItemRef $
    DocItemId ("errors-" <> errorDocName @e)
  docItemToMarkdown lvl (DError (_ :: Proxy e)) =
    mconcat
    [ mdSeparator
    , mdHeader lvl (mdTicked . build $ errorDocName @e)
    , mdSubsection "Class" (build $ errorDocClass @e)
    , "\n\n"
    , mdSubsection "Fires if" $ errorDocMdCause @e
    , "\n\n"
    , mdSubsection "Representation" $ errorDocHaskellRep @e
    ]
  docItemDependencies (DError (_ :: Proxy e)) = errorDocDependencies @e

errorDocMdReference :: forall e. IsError e => Markdown
errorDocMdReference =
  let DocItemRef (DocItemId anchor) = docItemRef $ DError (Proxy @e)
  in mdLocalRef (mdTicked . build $ errorDocName @e) anchor

-- | Documentation for custom errors.

-- | Mentions that entrypoint throws given error.
data DThrows where
  DThrows :: IsError e => Proxy e -> DThrows

instance Eq DThrows where
  DThrows e1 == DThrows e2 = eqParam1 e1 e2

instance DocItem DThrows where
  type DocItemPosition DThrows = 5011
  docItemSectionName = Just "Possible errors"
  docItemSectionNameStyle = DocSectionNameSmall
  docItemDependencies (DThrows ds) =
    [SomeDocDefinitionItem (DError ds)]
  docItemToMarkdown _ (DThrows (_ :: Proxy e)) =
    "* " <> errorDocMdReference @e <> " — " <> errorDocMdCauseInEntrypoint @e
  docItemsOrder =
    let errType (DThrows (_ :: Proxy e)) = errorDocClass @e
    in L.nub . filter (Prelude.not . isInternalErrorClass . errType)

-- | Implementation of 'typeDocMdDescription' (of 'TypeHasDoc' typeclass)
-- for Haskell types which sole purpose is to be error.
typeDocMdDescriptionReferToError :: forall e. IsError e => Markdown
typeDocMdDescriptionReferToError =
  "This type is primarily used as error, see " <>
  docDefinitionRef "description in section with errors" (DError (Proxy @e))

-- | This is to be included on top of @Errors@ section of the generated
-- documentation.
errorsDocumentation :: Markdown
errorsDocumentation = [md|
  Our contract implies the possibility of error scenarios, this section enlists
  all values which the contract can produce via calling `FAILWITH` instruction
  on them. In case of error, no changes to contract state will be applied.

  Each entrypoint also contains a list of errors which can be raised during its
  execution; only for no-throw entrypoints this list will be omitted.
  Errors in these lists are placed in the order in which the corresponding
  properties are checked unless the opposite is specified. I.e., if for a
  given entrypoint call two different errors may take place, the one which
  appears in the list first will be thrown.

  Most of the errors are represented according to the same
  `(error name, error argument)` pattern. See the list of errors below
  for details.

  We distinquish several error classes:
  + #{mdBold $ build ErrClassActionException}: given action cannot be performed with
    regard to the current contract state.

    Examples: "insufficient balance", "wallet does not exist".

    If you are implementing a middleware, such errors should be propagated to
    the client.

  + #{mdBold $ build ErrClassBadArgument}: invalid argument supplied to the entrypoint.

    Examples: entrypoint accepts a natural number from `0-3` range, and you
    supply `5`.

    If you are implementing a middleware, you should care about not letting
    such errors happen.

  + #{mdBold $ build ErrClassContractInternal}: contract-internal error.

    In ideal case, such errors should not take place, but still, make sure
    that you are ready to handle them. They can signal either invalid contract
    deployment or a bug in contract implementation.

    If an internal error is thrown, please report it to the author of this contract.
  |]

----------------------------------------------------------------------------
-- Old interface (DEPRECATED)
----------------------------------------------------------------------------

{- This API implements an approach when errors are declared via datatype
with constructors corresponding to error scenarios.
-}

-- | Implementation of 'errorToVal' for custom errors.
customErrorToVal
  :: (LooseSumC e, HasCallStack)
  => e
  -> (forall t. ErrorScope t => Value t -> r)
  -> r
customErrorToVal e cont =
  case toTaggedVal e of
    (tag, SomeValue (datVal :: Value t)) ->
      -- Tags come from constructors names, so we can assume
      -- the event of weird chars occurrence to be quite improbable
      let tag' = mkMTextUnsafe tag
      in case (opAbsense (sing @t), bigMapAbsense (sing @t), contractTypeAbsense (sing @t)) of
        (Just Dict, Just Dict, Just Dict) -> cont $ VPair (VC (CvString tag'), datVal)

        -- We could check this at type-level, but this would require
        -- specializing 'Michelson.Typed.LooseSum' to errors.
        -- We can do so, or assume that no one will ever try to put 'Operation'
        -- to error datatypes:
        (Nothing, _, _) -> error "Operation in constructor data"
        (_, Nothing, _) -> error "BigMap in constructor data"
        (_, _, Nothing) -> error "Contract in constructor data"
{-# DEPRECATED customErrorToVal "Datatype error declarations has been deprecated" #-}

-- | Implementation of 'errorFromVal' for custom errors.
--
-- This function is deprecated.
customErrorFromVal
  :: forall t e.
      (SingI t, LooseSumC e)
  => Value t -> Either Text e
customErrorFromVal v = case (v, sing @t) of
  (VPair (VC (CvString tag), datVal), STPair _ _) ->
    case fromTaggedVal (toText tag, SomeValue datVal) of
      ComposeOk e ->
        Right e
      ComposeCtorNotFound ->
        Left $ "Unknown error constructor " +| tag |+ ""
      ComposeFieldTypeMismatch got expected ->
        Left $ "Error data type mismatch, expected " +|| expected ||+
                                            ", got " +|| got ||+ ""
  _ -> Left $ "Expected a (tag, dat) pair representing error"
{-# DEPRECATED customErrorFromVal "Datatype error declarations has been deprecated" #-}

-- | Prompt an error message saying that 'IsoValue' is not applicable for this type.
type family CustomErrorNoIsoValue a where
  CustomErrorNoIsoValue a = TypeError
    ('Text "No IsoValue instance for " ':<>: 'ShowType a ':$$:
     'Text "It has custom error representation")

-- | Derive 'IsError' instance for given type.
--
-- This will also forbid deriving 'IsoValue' instance for that type to avoid
-- having multiple different Michelson representations.
deriveCustomError :: TH.Name -> TH.Q [TH.Dec]
deriveCustomError name =
  [d|
    instance IsError $ty where
      errorToVal = customErrorToVal
      errorFromVal = customErrorFromVal

    instance CustomErrorNoIsoValue $ty => IsoValue $ty where
      type ToT $ty = CustomErrorNoIsoValue $ty
      toVal = error "impossible"
      fromVal = error "impossible"

    instance ErrorHasDoc $ty where
      errorDocName = "Some error"
      errorDocMdCause = "An error occurred."
      errorDocHaskellRep = "-"
      errorDocClass = ErrClassUnknown
      errorDocDependencies = []
  |]
  where
    ty = pure (TH.ConT name)
{-# DEPRECATED deriveCustomError "Datatype error declarations has been deprecated" #-}

-- | Signature of 'userFailWith'.
type FailUsingArg e name fieldTy s s'
  = ( KnownSymbol name, IsError e
    , IsoValue fieldTy
    , CtorHasOnlyField name e fieldTy, Each [Typeable, SingI] '[ToT fieldTy]
    , HasCallStack
    )
  => Label name -> fieldTy : s :-> s'

-- | Fail with given error, picking argument for error from the top
-- of the stack.
--
-- If your error constructor does not carry an argument, use 'failUsing'
-- function instead.
-- Consider the following practice: once error datatype for your contract
-- is defined, create a specialization of this function to the error type.
--
-- This function is deprecated.
failUsingArg
  :: forall err name fieldTy s s'.
     FailUsingArg err name fieldTy s s'
failUsingArg _ =
  push (mkMTextUnsafe ctor) #
  pair #
  failWith
  where
    ctor = case symbolVal (Proxy @name) of
      'c' : other -> toText other
      other -> error $ "Bad label provided: " +| other |+ ""
{-# DEPRECATED failUsingArg "Datatype error declarations has been deprecated" #-}