{-# LANGUAGE DerivingStrategies #-}
module Lorentz.Errors
( IsError
, LorentzUserError
, unLorentzUserError
, UserFailInstr
, userFailWith
) where
import Data.Singletons (SingI)
import Data.Vinyl.Derived (Label)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Lorentz.ADT
import Lorentz.Base
import Lorentz.Coercions
import Lorentz.Constraints
import Lorentz.Instr
import Lorentz.Value
import Michelson.Text
import Michelson.Typed.Haskell
type IsError err =
( IsoValue err
, KnownValue err
, NoOperation err
, NoBigMap err
)
newtype ErrorTag = ErrorTag MText
deriving newtype (Show, Eq, Ord, IsString, IsoValue)
type LorentzUserError e = (ErrorTag, e)
unLorentzUserError :: LorentzUserError e -> e
unLorentzUserError = snd
type UserFailInstr e name s s'
= (InstrWrapC e name, KnownSymbol name)
=> Label name -> AppendCtorField (GetCtorField e name) s :-> s'
userFailWith
:: forall err name s s'.
(Typeable (ToT err), SingI (ToT err))
=> UserFailInstr err name s s'
userFailWith label =
wrap_ @err @_ @s label # push (mkMTextUnsafe . toText $ symbolVal (Proxy @name)) # pair #
coerce_ @_ @(LorentzUserError err) #
failWith