-- 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 Fmt (Buildable, pretty)

import Indigo.Backend.Prelude
import Indigo.Internal.Expr.Compilation
import Indigo.Internal.Expr.Types
import Indigo.Internal.State
import Indigo.Internal.Var
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
    gcStack :: StackVars stk
gcStack = StackVars stk
forall (stk :: [*]). StackVars stk
FailureStack
    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 = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("failWith (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr a
exa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (IndigoState s t -> IndigoState s t)
-> IndigoState s t -> IndigoState s t
forall a b. (a -> b) -> a -> b
$
  Text -> IndigoState s (a : s) -> IndigoState s (a : s)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState (Expr a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty 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, Buildable x) => x -> IndigoState s t
failUsing_ :: x -> IndigoState s t
failUsing_ x :: x
x = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("failUsing_ (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> x -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty x
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (IndigoState s t -> IndigoState s t)
-> IndigoState s t -> IndigoState s t
forall a b. (a -> b) -> a -> b
$ (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 = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("failCustom (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr err -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr err
errEx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (IndigoState s t -> IndigoState s t)
-> IndigoState s t -> IndigoState s t
forall a b. (a -> b) -> a -> b
$
  ((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
    Text -> IndigoState s (err : s) -> IndigoState s (err : s)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState (Expr err -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr err
errEx) (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_ = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState "failCustom_" (IndigoState s t -> IndigoState s t)
-> (Label tag -> IndigoState s t) -> Label tag -> IndigoState s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 =
  Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("failUnexpected_ (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MText -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty MText
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (IndigoState s t -> IndigoState s t)
-> (MText -> IndigoState s t) -> MText -> IndigoState s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MText -> IndigoState s t
forall x (s :: [*]) (t :: [*]).
(IsError x, Buildable 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