{-# LANGUAGE ExistentialQuantification, StandaloneDeriving #-}

-- |
-- Module      : OAlg.Control.Exception
-- Description : general algebraic exceptions
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- General algebraic exceptions.
module OAlg.Control.Exception
  ( -- * Algebraic Exceptions
    oalgExceptionToException
  , oalgExceptionFromException
  , SomeOAlgException(..)
  , AlgebraicException(..)
  , implementation

    -- * Exports
  , Exception(..), throw
  )
  where

import Control.Exception as E
import Data.Typeable (cast)

--------------------------------------------------------------------------------
-- Algebraic exceptions

-- | The root exception for all algebraic exceptions.
data SomeOAlgException = forall e . Exception e => SomeOAlgException e

instance Show SomeOAlgException where
  show :: SomeOAlgException -> String
show (SomeOAlgException e
e) = forall a. Show a => a -> String
show e
e
  
instance Exception SomeOAlgException

-- | embedding an exception into 'SomeOAlgException'.
oalgExceptionToException :: Exception e => e -> SomeException
oalgExceptionToException :: forall e. Exception e => e -> SomeException
oalgExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeOAlgException
SomeOAlgException

-- | casting an exception to 'SomeOAlgException'.
oalgExceptionFromException :: Exception e => SomeException -> Maybe e
oalgExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
oalgExceptionFromException SomeException
e = do
  SomeOAlgException e
a <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
  forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

-- | general algebraic exception which are sub exceptions of 'SomeOAlgException'.
data AlgebraicException
  = AlgebraicException String
  | Undefined String
  | ImplementationError String
  | NoPredecor
  | InvalidData String
  deriving (Int -> AlgebraicException -> ShowS
[AlgebraicException] -> ShowS
AlgebraicException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlgebraicException] -> ShowS
$cshowList :: [AlgebraicException] -> ShowS
show :: AlgebraicException -> String
$cshow :: AlgebraicException -> String
showsPrec :: Int -> AlgebraicException -> ShowS
$cshowsPrec :: Int -> AlgebraicException -> ShowS
Show)

instance Exception AlgebraicException where
  toException :: AlgebraicException -> SomeException
toException   = forall e. Exception e => e -> SomeException
oalgExceptionToException
  fromException :: SomeException -> Maybe AlgebraicException
fromException = forall e. Exception e => SomeException -> Maybe e
oalgExceptionFromException

--------------------------------------------------------------------------------
-- implementation -

-- | message for implementation errors. Mainly used for non-permissible or unreachable
-- patterns.
implementation :: String
implementation :: String
implementation = String
"implementation"