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

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

-- | Error related statements of Indigo language.

module Indigo.Backend.Error
  ( failWith
  , failUsing_
  , failCustom
  , failCustom_
  , failUnexpected_
  , assert
  , assertSome
  , assertNone
  , assertRight
  , assertLeft
  , assertCustom
  , assertCustom_
  ) where

import Indigo.Backend.Conditional
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

failIndigoState :: inp :-> out -> IndigoState inp out r
failIndigoState :: (inp :-> out) -> IndigoState inp out r
failIndigoState code :: inp :-> out
code = GenCode inp out r -> IndigoState inp out r
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> IndigoState inp out a
iput (GenCode inp out r -> IndigoState inp out r)
-> GenCode inp out r -> IndigoState inp out r
forall a b. (a -> b) -> a -> b
$ r
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out r
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode r
errOut MetaData out
errMd inp :-> out
code out :-> inp
forall (a :: [*]) (c :: [*]). a :-> c
failCl
  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.
    msg :: Text
msg = " is undefined after a failing instruction"
    errOut :: r
errOut = Text -> r
forall a. HasCallStack => Text -> a
error (Text -> r) -> Text -> r
forall a b. (a -> b) -> a -> b
$ "Output" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    errMd :: MetaData out
errMd = Text -> MetaData out
forall a. HasCallStack => Text -> a
error (Text -> MetaData out) -> Text -> MetaData out
forall a b. (a -> b) -> a -> b
$ "MetaData" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    failCl :: a :-> c
failCl = 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 r
failWith :: Expr a -> IndigoState s t r
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 r -> IndigoState s t r
forall (inp :: [*]) (out :: [*]) a (out1 :: [*]) b.
IndigoState inp out a
-> IndigoState out out1 b -> IndigoState inp out1 b
>> ((a & s) :-> t) -> IndigoState (a & s) t r
forall (inp :: [*]) (out :: [*]) r.
(inp :-> out) -> IndigoState inp out r
failIndigoState (a & s) :-> t
forall a (s :: [*]) (t :: [*]). KnownValue a => (a & s) :-> t
L.failWith

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

failCustom
  :: forall tag err s t r.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     )
  => Label tag -> Expr err -> IndigoState s t r
failCustom :: Label tag -> Expr err -> IndigoState s t r
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 r)
-> IndigoState s t r
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 r)
 -> IndigoState s t r)
-> (ConstantScope (ToT err) => IndigoState s t r)
-> IndigoState s t r
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 r
forall (inp :: [*]) (out :: [*]) r.
(inp :-> out) -> IndigoState inp out r
failIndigoState (((err & s) :-> t) -> IndigoState (err & s) t r)
-> ((err & s) :-> t) -> IndigoState (err & s) t r
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 r notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> IndigoState s t r
failCustom_ :: Label tag -> IndigoState s t r
failCustom_ = (s :-> t) -> IndigoState s t r
forall (inp :: [*]) (out :: [*]) r.
(inp :-> out) -> IndigoState inp out r
failIndigoState ((s :-> t) -> IndigoState s t r)
-> (Label tag -> s :-> t) -> Label tag -> IndigoState s t r
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 r
failUnexpected_ :: MText -> IndigoState s t r
failUnexpected_ msg :: MText
msg = MText -> IndigoState s t r
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ (MText -> IndigoState s t r) -> MText -> IndigoState s t r
forall a b. (a -> b) -> a -> b
$ [mt|Unexpected: |] MText -> MText -> MText
forall a. Semigroup a => a -> a -> a
<> MText
msg

assert
  :: forall s x. IsError x
  => x -> Expr Bool -> IndigoState s s ()
assert :: x -> Expr Bool -> IndigoState s s ()
assert err :: x
err e :: Expr Bool
e = Expr Bool
-> IndigoState s s ()
-> IndigoState s s ()
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) a b.
IfConstraint a b =>
Expr Bool
-> IndigoState inp xs a
-> IndigoState inp ys b
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
if_ (Expr Bool -> Expr (ExprType (Expr Bool))
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr Expr Bool
e) (() -> IndigoState s s ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ()) (x -> IndigoState s s ()
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ x
err :: IndigoState s s ())

assertSome
  :: forall x s err. (IsError err, KnownValue x)
  => err -> Expr (Maybe x) -> IndigoState s s ()
assertSome :: err -> Expr (Maybe x) -> IndigoState s s ()
assertSome err :: err
err ex :: Expr (Maybe x)
ex =
  Expr (Maybe x)
-> (Var x -> IndigoState (x & s) s ())
-> IndigoState s s ()
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) x a b.
(IfConstraint a b, KnownValue x) =>
Expr (Maybe x)
-> (Var x -> IndigoState (x & inp) xs a)
-> IndigoState inp ys b
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
ifSome Expr (Maybe x)
ex
    (\_ -> err -> IndigoState (x & s) s ()
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ err
err :: IndigoState (x & s) s ())
    (() -> IndigoState s s ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ())

assertNone
  :: forall x s err. (IsError err, KnownValue x)
  => err -> Expr (Maybe x) -> IndigoState s s ()
assertNone :: err -> Expr (Maybe x) -> IndigoState s s ()
assertNone err :: err
err ex :: Expr (Maybe x)
ex =
  Expr (Maybe x)
-> (Var x -> IndigoState (x & s) (x & s) ())
-> IndigoState s s ()
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) x a b.
(IfConstraint a b, KnownValue x) =>
Expr (Maybe x)
-> (Var x -> IndigoState (x & inp) xs a)
-> IndigoState inp ys b
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
ifSome Expr (Maybe x)
ex
    (\_ -> () -> IndigoState (x & s) (x & s) ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ())
    (err -> IndigoState s s ()
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ err
err :: IndigoState s s ())

assertRight
  :: forall x y s err. (IsError err, KnownValue x, KnownValue y)
  => err -> Expr (Either y x) -> IndigoState s s ()
assertRight :: err -> Expr (Either y x) -> IndigoState s s ()
assertRight err :: err
err ex :: Expr (Either y x)
ex =
  Expr (Either y x)
-> (Var x -> IndigoState (x & s) s ())
-> (Var y -> IndigoState (y & s) (y & s) ())
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) x y a b.
(IfConstraint a b, KnownValue x, KnownValue y) =>
Expr (Either y x)
-> (Var x -> IndigoState (x & inp) xs a)
-> (Var y -> IndigoState (y & inp) ys b)
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
ifRight Expr (Either y x)
ex
    (\_ -> err -> IndigoState (x & s) s ()
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ err
err :: IndigoState (x & s) s ())
    (\_ -> () -> IndigoState (y & s) (y & s) ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ())

assertLeft
  :: forall x y s err. (IsError err, KnownValue x, KnownValue y)
  => err -> Expr (Either y x) -> IndigoState s s ()
assertLeft :: err -> Expr (Either y x) -> IndigoState s s ()
assertLeft err :: err
err ex :: Expr (Either y x)
ex =
  Expr (Either y x)
-> (Var x -> IndigoState (x & s) (x & s) ())
-> (Var y -> IndigoState (y & s) s ())
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) x y a b.
(IfConstraint a b, KnownValue x, KnownValue y) =>
Expr (Either y x)
-> (Var x -> IndigoState (x & inp) xs a)
-> (Var y -> IndigoState (y & inp) ys b)
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
ifRight Expr (Either y x)
ex
    (\_ -> () -> IndigoState (x & s) (x & s) ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ())
    (\_ -> err -> IndigoState (y & s) s ()
forall x (s :: [*]) (t :: [*]) r.
IsError x =>
x -> IndigoState s t r
failUsing_ err
err :: IndigoState (y & s) s ())

assertCustom
  :: forall tag err s.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     )
  => Label tag -> Expr err -> Expr Bool -> IndigoState s s ()
assertCustom :: Label tag -> Expr err -> Expr Bool -> IndigoState s s ()
assertCustom tag :: Label tag
tag errEx :: Expr err
errEx e :: Expr Bool
e = Expr Bool
-> IndigoState s s ()
-> IndigoState s s ()
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) a b.
IfConstraint a b =>
Expr Bool
-> IndigoState inp xs a
-> IndigoState inp ys b
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
if_ (Expr Bool -> Expr (ExprType (Expr Bool))
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr Expr Bool
e) (() -> IndigoState s s ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ()) (Label tag -> Expr err -> IndigoState s s ()
forall (tag :: Symbol) err (s :: [*]) (t :: [*]) r.
(err ~ ErrorArg tag, CustomErrorHasDoc tag, NiceConstant err) =>
Label tag -> Expr err -> IndigoState s t r
failCustom Label tag
tag Expr err
errEx :: IndigoState s s ())

assertCustom_
  :: forall tag s notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> Expr Bool -> IndigoState s s ()
assertCustom_ :: Label tag -> Expr Bool -> IndigoState s s ()
assertCustom_ tag :: Label tag
tag e :: Expr Bool
e = Expr Bool
-> IndigoState s s ()
-> IndigoState s s ()
-> IndigoState s (RetOutStack () ++ s) (RetVars ())
forall (inp :: [*]) (xs :: [*]) (ys :: [*]) a b.
IfConstraint a b =>
Expr Bool
-> IndigoState inp xs a
-> IndigoState inp ys b
-> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
if_ (Expr Bool -> Expr (ExprType (Expr Bool))
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr Expr Bool
e) (() -> IndigoState s s ()
forall a (inp :: [*]). a -> IndigoState inp inp a
return ()) (Label tag -> IndigoState s s ()
forall (tag :: Symbol) (s :: [*]) (t :: [*]) r
       (notVoidErrorMsg :: ErrorMessage).
(RequireNoArgError tag notVoidErrorMsg, CustomErrorHasDoc tag) =>
Label tag -> IndigoState s t r
failCustom_ Label tag
tag :: IndigoState s s ())