Empty.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Support for uninhabited type.
--
-- Note: this module exists solely for historical reasons since the time when
-- 'Never' was not yet supported by the Michelson.
--
-- TODO [#549]: remove this module.
module Lorentz.Empty
  ( Empty
  , absurd_
  ) where

import Fmt (Buildable(..))

import Lorentz.Annotation (HasAnnotation)
import Lorentz.Base
import Lorentz.Doc
import Lorentz.Errors
import Lorentz.Value
import Morley.AsRPC (HasRPCRepr(..))
import Morley.Michelson.Typed.Haskell.Doc

-- | Replacement for uninhabited type.
{-# DEPRECATED Empty "Use Never type instead" #-}
newtype Empty = Empty ()
  deriving stock Generic
  deriving anyclass (IsoValue, HasAnnotation)

instance HasRPCRepr Empty where
  type AsRPC Empty = Empty

instance TypeHasDoc Empty where
  typeDocMdDescription =
    "Type which should never be constructed.\n\n\
    \If appears as part of entrypoint argument, this means that the entrypoint \
    \should never be called."

-- | Someone constructed 'Empty' type.
type instance ErrorArg "emptySupplied" = UnitErrorArg

instance Buildable (CustomError "emptySupplied") where
  build (CustomError _ (_, ())) =
    "'Empty' value was passed to the contract."

instance CustomErrorHasDoc "emptySupplied" where
  customErrClass = ErrClassBadArgument
  customErrDocMdCause =
    "Value of type " <> typeDocMdReference (Proxy @Empty) (WithinParens False)
    <> " has been supplied."

-- | Witness of that this code is unreachable.
absurd_ :: Empty : s :-> s'
absurd_ =
  failCustom_ #emptySupplied #
  doc (DDescription "Should never be called")