Error.hs

-- 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 code = iput $ GenCode errOut errMd code 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 = " is undefined after a failing instruction"
    errOut = error $ "Output" <> msg
    errMd = error $ "MetaData" <> msg
    failCl = L.unit # L.failWith

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

failUsing_ :: (IsError x) => x -> IndigoState s t r
failUsing_ x = failIndigoState (failUsing x)

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

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

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

assert
  :: forall s x. IsError x
  => x -> Expr Bool -> IndigoState s s ()
assert err e = if_ (toExpr e) (return ()) (failUsing_ err :: IndigoState s s ())

assertSome
  :: forall x s err. (IsError err, KnownValue x)
  => err -> Expr (Maybe x) -> IndigoState s s ()
assertSome err ex =
  ifSome ex
    (\_ -> failUsing_ err :: IndigoState (x & s) s ())
    (return ())

assertNone
  :: forall x s err. (IsError err, KnownValue x)
  => err -> Expr (Maybe x) -> IndigoState s s ()
assertNone err ex =
  ifSome ex
    (\_ -> return ())
    (failUsing_ 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 ex =
  ifRight ex
    (\_ -> failUsing_ err :: IndigoState (x & s) s ())
    (\_ -> return ())

assertLeft
  :: forall x y s err. (IsError err, KnownValue x, KnownValue y)
  => err -> Expr (Either y x) -> IndigoState s s ()
assertLeft err ex =
  ifRight ex
    (\_ -> return ())
    (\_ -> failUsing_ 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 tag errEx e = if_ (toExpr e) (return ()) (failCustom tag errEx :: IndigoState s s ())

assertCustom_
  :: forall tag s notVoidErrorMsg.
     ( RequireNoArgError tag notVoidErrorMsg
     , CustomErrorHasDoc tag
     )
  => Label tag -> Expr Bool -> IndigoState s s ()
assertCustom_ tag e = if_ (toExpr e) (return ()) (failCustom_ tag :: IndigoState s s ())