{-# 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 Data.Default (Default(def))
import Data.Maybe   (fromMaybe)
import Data.String  (fromString)
import Data.Text    (Text)

import qualified Control.Exception.Safe as E

import Capnp.Gen.Capnp.Rpc.Pure (Exception(..), Exception'Type(..))

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

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

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

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

instance E.Exception 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 -> Exception
wrapException :: Bool -> SomeException -> Exception
wrapException Bool
debugMode SomeException
e = Exception -> Maybe Exception -> Exception
forall a. a -> Maybe a -> a
fromMaybe
    Exception
forall a. Default a => a
def { $sel:type_:Exception :: Exception'Type
type_ = Exception'Type
Exception'Type'failed
        , $sel:reason:Exception :: Text
reason =
            if Bool
debugMode then
                Text
"Unhandled exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
            else
                Text
"Unhandled exception"
        }
    (SomeException -> Maybe 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 :: Text -> m a
throwFailed = Exception -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throwM (Exception -> m a) -> (Text -> Exception) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exception
eFailed