-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Backend failing statements of Indigo.

module Indigo.Backend.Error
  ( failWith
  , failUsing_
  , failCustom
  , failCustom_
  , failUnexpected_
  ) where

import Indigo.Backend.Prelude
import Indigo.Internal.Expr.Compilation
import Indigo.Internal.Expr.Types
import Indigo.Internal.State
import Indigo.Lorentz
import qualified Lorentz.Errors as L
import qualified Lorentz.Instr as L

-- | Generic generator of failing 'IndigoState' from failing Lorentz instructions.
failIndigoState :: inp :-> out -> IndigoState inp out
failIndigoState :: (inp :-> out) -> IndigoState inp out
failIndigoState gcCode :: inp :-> out
gcCode = GenCode inp out -> IndigoState inp out
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> IndigoState inp out
iput (GenCode inp out -> IndigoState inp out)
-> GenCode inp out -> IndigoState inp out
forall a b. (a -> b) -> a -> b
$ $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {..}
  where
    -- note: here we can use errors for the output and MetaData, because they
    -- are lazy field of GenCode and, due to the way # combines the generated
    -- code (ignores everything following a failWith) they won't actually ever
    -- be accessed again. The same goes for the "cleaning" code, except it is
    -- not lazy and needs to typecheck, so we have to use `failWith` again.
    gcStack :: a
gcStack = Text -> a
forall a. HasCallStack => Text -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ "StackVars is undefined after a failing instruction"
    gcClear :: a :-> c
gcClear = a :-> (() & a)
forall (s :: [*]). s :-> (() & s)
L.unit (a :-> (() & a)) -> ((() & a) :-> c) -> a :-> c
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (() & a) :-> c
forall a (s :: [*]) (t :: [*]). KnownValue a => (a & s) :-> t
L.failWith

failWith :: KnownValue a => Expr a -> IndigoState s t
failWith :: Expr a -> IndigoState s t
failWith exa :: Expr a
exa = Expr a -> IndigoState s (a & s)
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr Expr a
exa IndigoState s (a & s) -> IndigoState (a & s) t -> IndigoState s t
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>> ((a & s) :-> t) -> IndigoState (a & s) t
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState (a & s) :-> t
forall a (s :: [*]) (t :: [*]). KnownValue a => (a & s) :-> t
L.failWith

failUsing_ :: (IsError x) => x -> IndigoState s t
failUsing_ :: x -> IndigoState s t
failUsing_ x :: x
x = (s :-> t) -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState (x -> s :-> t
forall e (s :: [*]) (t :: [*]). IsError e => e -> s :-> t
failUsing x
x)

failCustom
  :: forall tag err s t.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     )
  => Label tag -> Expr err -> IndigoState s t
failCustom :: Label tag -> Expr err -> IndigoState s t
failCustom l :: Label tag
l errEx :: Expr err
errEx = ((KnownValue err,
  (SingI (ToT err), FailOnOperationFound (ContainsOp (ToT err)),
   FailOnBigMapFound (ContainsBigMap (ToT err)),
   FailOnContractFound (ContainsContract (ToT err))))
 :- ConstantScope (ToT err))
-> (ConstantScope (ToT err) => IndigoState s t) -> IndigoState s t
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue err,
 (SingI (ToT err), FailOnOperationFound (ContainsOp (ToT err)),
  FailOnBigMapFound (ContainsBigMap (ToT err)),
  FailOnContractFound (ContainsContract (ToT err))))
:- ConstantScope (ToT err)
forall a. NiceConstant a :- ConstantScope (ToT a)
niceConstantEvi @err) ((ConstantScope (ToT err) => IndigoState s t) -> IndigoState s t)
-> (ConstantScope (ToT err) => IndigoState s t) -> IndigoState s t
forall a b. (a -> b) -> a -> b
$ do
  Expr err -> IndigoState s (err & s)
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr Expr err
errEx
  ((err & s) :-> t) -> IndigoState (err & s) t
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState (((err & s) :-> t) -> IndigoState (err & s) t)
-> ((err & s) :-> t) -> IndigoState (err & s) t
forall a b. (a -> b) -> a -> b
$ Label tag -> (err & s) :-> t
forall (tag :: Symbol) err (s :: [*]) (any :: [*]).
(err ~ ErrorArg tag, CustomErrorHasDoc tag, KnownError err) =>
Label tag -> (err : s) :-> any
L.failCustom Label tag
l

failCustom_
  :: forall tag s t notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> IndigoState s t
failCustom_ :: Label tag -> IndigoState s t
failCustom_ = (s :-> t) -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState ((s :-> t) -> IndigoState s t)
-> (Label tag -> s :-> t) -> Label tag -> IndigoState s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label tag -> s :-> t
forall (tag :: Symbol) (s :: [*]) (any :: [*])
       (notVoidErrorMsg :: ErrorMessage).
(RequireNoArgError tag notVoidErrorMsg, CustomErrorHasDoc tag) =>
Label tag -> s :-> any
L.failCustom_

failUnexpected_ :: MText -> IndigoState s t
failUnexpected_ :: MText -> IndigoState s t
failUnexpected_ msg :: MText
msg = MText -> IndigoState s t
forall x (s :: [*]) (t :: [*]). IsError x => x -> IndigoState s t
failUsing_ (MText -> IndigoState s t) -> MText -> IndigoState s t
forall a b. (a -> b) -> a -> b
$ [mt|Unexpected: |] MText -> MText -> MText
forall a. Semigroup a => a -> a -> a
<> MText
msg