{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Language.Spectacle.Syntax.Error
  Copyright    :   ( c ) Arista Networks , 2022 - 2023
  License      :   Apache License 2.0 , see LICENSE
--
-- Stability   :  stable
  Portability :   non - portable ( GHC extensions )
--
-- The 'Error' effect for throwing exceptions which can be caught.
--
-- @since 1.0.0
module Language.Spectacle.Syntax.Error
  ( Error (ThrowE),
    Effect (CatchE),
    throwE,
    catchE,
    runError,
  )
where

import Data.Functor.Loom (hoist, runLoom, (~>~))
import Language.Spectacle.Lang
  ( Effect,
    Lang (Op, Pure, Scoped),
    Member,
    decomposeOp,
    decomposeS,
    scope,
    send,
  )
import Language.Spectacle.Syntax.Error.Internal (Effect (CatchE), Error (ThrowE))

-- -------------------------------------------------------------------------------------------------

  | Throw an error of type  , escaping the current continuation up to the nearest enclosing
-- 'catchE'.
--
-- @since 1.0.0
throwE :: Member (Error e) effs => e -> Lang ctx effs a
throwE e = send (ThrowE e)

  | Catch an error of type  continuting from the provided function if an error was thrown .
--
-- @since 1.0.0
catchE :: Member (Error e) effs => Lang ctx effs a -> (e -> Lang ctx effs a) -> Lang ctx effs a
catchE m f = scope (CatchE m f)

-- | Discharge an 'Error' effect into either an error or the result of a successful computation.
--
-- @since 1.0.0
runError :: Lang ctx (Error e ': effs) a -> Lang ctx effs (Either e a)
runError = \case
  Pure x -> pure (Right x)
  Op op k -> case decomposeOp op of
    Left other -> Op other (runError . k)
    Right (ThrowE exc) -> pure (Left exc)
  Scoped scoped loom -> case decomposeS scoped of
    Left other -> Scoped other loom'
    Right (CatchE m catch) -> do
      x <- runLoom loom' m
      either (runLoom loom' . catch) (pure . pure) x
    where
      loom' = loom ~>~ hoist runError

# OPTIONS_HADDOCK show-extensions #
 |
 Module      :  Language.Spectacle.Syntax.Error

 Stability   :  stable

 The 'Error' effect for throwing exceptions which can be caught.

 @since 1.0.0
 -------------------------------------------------------------------------------------------------
 'catchE'.

 @since 1.0.0

 @since 1.0.0
 | Discharge an 'Error' effect into either an error or the result of a successful computation.

 @since 1.0.0

  Copyright    :   ( c ) Arista Networks , 2022 - 2023
  License      :   Apache License 2.0 , see LICENSE
  Portability :   non - portable ( GHC extensions )
module Language.Spectacle.Syntax.Error
  ( Error (ThrowE),
    Effect (CatchE),
    throwE,
    catchE,
    runError,
  )
where

import Data.Functor.Loom (hoist, runLoom, (~>~))
import Language.Spectacle.Lang
  ( Effect,
    Lang (Op, Pure, Scoped),
    Member,
    decomposeOp,
    decomposeS,
    scope,
    send,
  )
import Language.Spectacle.Syntax.Error.Internal (Effect (CatchE), Error (ThrowE))


  | Throw an error of type  , escaping the current continuation up to the nearest enclosing
throwE :: Member (Error e) effs => e -> Lang ctx effs a
throwE e = send (ThrowE e)

  | Catch an error of type  continuting from the provided function if an error was thrown .
catchE :: Member (Error e) effs => Lang ctx effs a -> (e -> Lang ctx effs a) -> Lang ctx effs a
catchE m f = scope (CatchE m f)

runError :: Lang ctx (Error e ': effs) a -> Lang ctx effs (Either e a)
runError = \case
  Pure x -> pure (Right x)
  Op op k -> case decomposeOp op of
    Left other -> Op other (runError . k)
    Right (ThrowE exc) -> pure (Left exc)
  Scoped scoped loom -> case decomposeS scoped of
    Left other -> Scoped other loom'
    Right (CatchE m catch) -> do
      x <- runLoom loom' m
      either (runLoom loom' . catch) (pure . pure) x
    where
      loom' = loom ~>~ hoist runError
