{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Indigo.Backend.Error
( failWith
, never
, failUsing_
, failCustom
, failCustom_
, failCustomNoArg
, failUnexpected_
) where
import Fmt (Buildable, pretty)
import Indigo.Backend.Expr.Compilation
import Indigo.Backend.Prelude
import Indigo.Common.Expr
import Indigo.Common.State
import Indigo.Common.Var
import Indigo.Lorentz
import Lorentz.Errors qualified as L
import Lorentz.Instr qualified as L
failIndigoState :: inp :-> out -> IndigoState inp out
failIndigoState :: forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState 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
$ GenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {inp :-> out
out :-> inp
StackVars out
forall {stk :: [*]}. StackVars stk
forall {a :: [*]} {c :: [*]}. a :-> c
gcClear :: out :-> inp
gcCode :: inp :-> out
gcStack :: StackVars out
gcClear :: forall {a :: [*]} {c :: [*]}. a :-> c
gcStack :: forall {stk :: [*]}. StackVars stk
gcCode :: inp :-> out
..}
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 :: [*]). NiceConstant a => (a : s) :-> t
L.failWith
failWith :: NiceConstant a => Expr a -> IndigoState s t
failWith :: forall a (s :: [*]) (t :: [*]).
NiceConstant a =>
Expr a -> IndigoState s t
failWith Expr a
exa = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"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
<> Text
")") (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 :: [*]). NiceConstant a => (a : s) :-> t
L.failWith
never :: Expr Never -> IndigoState s t
never :: forall (s :: [*]) (t :: [*]). Expr Never -> IndigoState s t
never Expr Never
exa = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"never (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Never -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr Never
exa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (IndigoState s t -> IndigoState s t)
-> IndigoState s t -> IndigoState s t
forall a b. (a -> b) -> a -> b
$
Text -> IndigoState s (Never : s) -> IndigoState s (Never : s)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState (Expr Never -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr Never
exa) (Expr Never -> IndigoState s (Never : s)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr Never
exa) IndigoState s (Never : s)
-> IndigoState (Never : s) t -> IndigoState s t
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>>
((Never : s) :-> t) -> IndigoState (Never : s) t
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> IndigoState inp out
failIndigoState (Never : s) :-> t
forall (s :: [*]) (s' :: [*]). (Never : s) :-> s'
L.never
failUsing_ :: (IsError x, Buildable x) => x -> IndigoState s t
failUsing_ :: forall x (s :: [*]) (t :: [*]).
(IsError x, Buildable x) =>
x -> IndigoState s t
failUsing_ x
x = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"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
<> Text
")") (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, IsError e) =>
e -> s :-> t
failUsing x
x)
failCustom
:: forall tag err s t.
( MustHaveErrorArg tag (MText, err)
, CustomErrorHasDoc tag
, NiceConstant err
)
=> Label tag -> Expr err -> IndigoState s t
failCustom :: forall (tag :: Symbol) err (s :: [*]) (t :: [*]).
(MustHaveErrorArg tag (MText, err), CustomErrorHasDoc tag,
NiceConstant err) =>
Label tag -> Expr err -> IndigoState s t
failCustom Label tag
l Expr err
errEx = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"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
<> Text
")") 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 :: [*]).
(MustHaveErrorArg tag (MText, err), CustomErrorHasDoc tag,
KnownError err) =>
Label tag -> (err : s) :-> any
L.failCustom Label tag
l
failCustom_
:: forall tag s t.
( MustHaveErrorArg tag (MText, ())
, CustomErrorHasDoc tag
)
=> Label tag -> IndigoState s t
failCustom_ :: forall (tag :: Symbol) (s :: [*]) (t :: [*]).
(MustHaveErrorArg tag (MText, ()), CustomErrorHasDoc tag) =>
Label tag -> IndigoState s t
failCustom_ = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState Text
"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 :: [*]).
(MustHaveErrorArg tag (MText, ()), CustomErrorHasDoc tag) =>
Label tag -> s :-> any
L.failCustom_
failCustomNoArg
:: forall tag s t.
( MustHaveErrorArg tag MText
, CustomErrorHasDoc tag
)
=> Label tag -> IndigoState s t
failCustomNoArg :: forall (tag :: Symbol) (s :: [*]) (t :: [*]).
(MustHaveErrorArg tag MText, CustomErrorHasDoc tag) =>
Label tag -> IndigoState s t
failCustomNoArg = Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState Text
"failCustomNoArg" (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 :: [*]).
(MustHaveErrorArg tag MText, CustomErrorHasDoc tag) =>
Label tag -> s :-> any
L.failCustomNoArg
failUnexpected_ :: MText -> IndigoState s t
failUnexpected_ :: forall (s :: [*]) (t :: [*]). MText -> IndigoState s t
failUnexpected_ MText
msg =
Text -> IndigoState s t -> IndigoState s t
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"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
<> Text
")") (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