packages feed

indigo-0.3.0: src/Indigo/Backend/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 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

-- | Generic generator of failing 'IndigoState' from failing Lorentz instructions.
failIndigoState :: inp :-> out -> IndigoState inp out
failIndigoState gcCode = iput $ GenCode {..}
  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.
    gcStack = error $ "StackVars is undefined after a failing instruction"
    gcClear = L.unit # L.failWith

failWith :: KnownValue a => Expr a -> IndigoState s t
failWith exa = compileExpr exa >> failIndigoState L.failWith

failUsing_ :: (IsError x) => x -> IndigoState s t
failUsing_ 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 = withDict (niceConstantEvi @err) $ do
  compileExpr errEx
  failIndigoState $ L.failCustom l

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

failUnexpected_ :: MText -> IndigoState s t
failUnexpected_ msg = failUsing_ $ [mt|Unexpected: |] <> msg