Error.hs

-- 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 gcCode = iput $ GenCode {..}
  where
    gcStack = FailureStack
    gcClear = L.unit # L.failWith

failWith :: KnownValue a => Expr a -> IndigoState s t
failWith exa = stmtHookState ("failWith (" <> pretty exa <> ")") $
  exprHookState (pretty exa) (compileExpr exa) >>
  failIndigoState L.failWith

failUsing_ :: (IsError x, Buildable x) => x -> IndigoState s t
failUsing_ x = stmtHookState ("failUsing_ (" <> pretty x <> ")") $ failIndigoState (failUsing x)

failCustom
  :: forall tag err s t.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     )
  => Label tag -> Expr err -> IndigoState s t
failCustom l errEx = stmtHookState ("failCustom (" <> pretty errEx <> ")") $
  withDict (niceConstantEvi @err) $ do
    exprHookState (pretty errEx) (compileExpr errEx)
    failIndigoState $ L.failCustom l

failCustom_
  :: forall tag s t notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> IndigoState s t
failCustom_ = stmtHookState "failCustom_" . failIndigoState . L.failCustom_

failUnexpected_ :: MText -> IndigoState s t
failUnexpected_ msg =
  stmtHookState ("failUnexpected_ (" <> pretty msg <> ")") . failUsing_ $ [mt|Unexpected: |] <> msg