{-# OPTIONS_GHC -Wno-orphans #-}

-- | Support for uninhabited type.
--
-- Currently they are not supported my Michelson, so we provide
-- a sort of replacement.
--
-- This module should be removed once the proposal is implemented:
-- https://gitlab.com/tezos/tezos/issues/662
module Lorentz.Empty
  ( Empty
  , absurd_
  ) where

import Fmt (Buildable(..))

import Lorentz.Base
import Lorentz.Doc
import Lorentz.Errors
import Lorentz.Value
import Michelson.Typed.Haskell.Doc

-- | Replacement for uninhabited type.
newtype Empty = Empty ()
  deriving stock Generic
  deriving anyclass IsoValue

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" = ()

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