{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module: Capnp.Rpc.Errors
-- Description: helpers for working with capnproto exceptions.
--
-- In addition to the values exposed in the API, this module also
-- defines an instance of Haskell's 'E.Exception' type class, for
-- Cap'n Proto's 'Exception'.
module Capnp.Rpc.Errors
  ( -- * Converting arbitrary exceptions to capnproto exceptions
    wrapException,

    -- * Helpers for constructing exceptions
    eMethodUnimplemented,
    eUnimplemented,
    eDisconnected,
    eFailed,
    throwFailed,
  )
where

import Capnp.Gen.Capnp.Rpc
import qualified Control.Exception.Safe as E
import Data.Default (Default (def))
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import Data.Text (Text)

-- | Construct an exception with a type field of failed and the
-- given text as its reason.
eFailed :: Text -> Parsed Exception
eFailed :: Text -> Parsed Exception
eFailed Text
reason =
  forall a. Default a => a
def
    { $sel:type_:Exception :: Parsed Exception'Type
type_ = Exception'Type
Exception'Type'failed,
      $sel:reason:Exception :: Parsed Text
reason = Text
reason
    }

-- | An exception with type = disconnected
eDisconnected :: Parsed Exception
eDisconnected :: Parsed Exception
eDisconnected =
  forall a. Default a => a
def
    { $sel:type_:Exception :: Parsed Exception'Type
type_ = Exception'Type
Exception'Type'disconnected,
      $sel:reason:Exception :: Parsed Text
reason = Text
"Disconnected"
    }

-- | An exception indicating an unimplemented method.
eMethodUnimplemented :: Parsed Exception
eMethodUnimplemented :: Parsed Exception
eMethodUnimplemented =
  Text -> Parsed Exception
eUnimplemented Text
"Method unimplemented"

-- | An @unimplemented@ exception with a custom reason message.
eUnimplemented :: Text -> Parsed Exception
eUnimplemented :: Text -> Parsed Exception
eUnimplemented Text
reason =
  forall a. Default a => a
def
    { $sel:type_:Exception :: Parsed Exception'Type
type_ = Exception'Type
Exception'Type'unimplemented,
      $sel:reason:Exception :: Parsed Text
reason = Text
reason
    }

instance E.Exception (Parsed Exception)

-- | @'wrapException' debugMode e@ converts an arbitrary haskell exception
-- @e@ into an rpc exception, which can be communicated to a remote vat.
-- If @debugMode@ is true, the returned exception's reason field will include
-- the text of @show e@.
wrapException :: Bool -> E.SomeException -> Parsed Exception
wrapException :: Bool -> SomeException -> Parsed Exception
wrapException Bool
debugMode SomeException
e =
  forall a. a -> Maybe a -> a
fromMaybe
    forall a. Default a => a
def
      { $sel:type_:Exception :: Parsed Exception'Type
type_ = Exception'Type
Exception'Type'failed,
        $sel:reason:Exception :: Parsed Text
reason =
          if Bool
debugMode
            then Text
"Unhandled exception: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show SomeException
e)
            else Text
"Unhandled exception"
      }
    (forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e)

-- | Throw an exception with a type field of 'Exception'Type'failed' and
-- the argument as a reason.
throwFailed :: E.MonadThrow m => Text -> m a
throwFailed :: forall (m :: * -> *) a. MonadThrow m => Text -> m a
throwFailed = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parsed Exception
eFailed