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
  :: IsExpr ex a
  => ex -> IndigoState s t r
failWith exa = compileToExpr exa >> failIndigoState L.failWith

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

failCustom
  :: forall tag err ex s t r.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     , IsExpr ex err
     )
  => Label tag -> ex -> IndigoState s t r
failCustom l errEx = withDict (niceConstantEvi @err) $ do
  compileToExpr 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 ex.
  ( IsError x
  , IsExpr ex Bool
  )
  => x -> ex -> IndigoState s s ()
assert err e = if_ (toExpr e) (return ()) (failUsing_ err :: IndigoState s s ())

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

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

assertRight
  :: forall x y s err ex.
  ( IsError err
  , KnownValue x
  , KnownValue y
  , ex :~> Either y x
  )
  => err -> ex -> IndigoState s s ()
assertRight err ex =
  ifRight ex
    (\_ -> failUsing_ err :: IndigoState (x & s) s ())
    (\_ -> return ())

assertLeft
  :: forall x y s err ex.
  ( IsError err
  , KnownValue x
  , KnownValue y
  , ex :~> Either y x
  )
  => err -> ex -> IndigoState s s ()
assertLeft err ex =
  ifRight ex
    (\_ -> return ())
    (\_ -> failUsing_ err :: IndigoState (y & s) s ())

assertCustom
  :: forall tag err errEx ex s.
     ( err ~ ErrorArg tag
     , CustomErrorHasDoc tag
     , NiceConstant err
     , IsExpr errEx err
     , IsExpr ex Bool
     )
  => Label tag -> errEx -> ex -> IndigoState s s ()
assertCustom tag errEx e = if_ (toExpr e) (return ()) (failCustom tag errEx :: IndigoState s s ())

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