-- 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
  , 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

-- | Generic generator of failing 'IndigoState' from failing Lorentz instructions.
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