{-# LANGUAGE Safe #-}

{- |
    Module      :  Control.Exception.SDP
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
  
  "Control.Exception.SDP" - service module that provide some useful exceptions.
  Note that "SDP.SafePrelude" doesn't export this module.
-}
module Control.Exception.SDP
(
  -- * Exports
  module Control.Exception,
  
  -- * Exceptions
  UnreachableException (..), IndexException (..)
)
where

import Prelude ( Eq (..), Show (..), String, (++) )

import Control.Exception
import Data.Typeable

default ()

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

{- |
  'IndexException' replaces the less informative 'ArrayException' and has more
  neutral names.
  
  * 'UnacceptableExpansion' - occurs if the desired range exceed the actual size
  * 'UnexpectedRank' - occurs when trying to convert a list into a generalized
  index of inappropriate dimension
  * 'UndefinedValue' - occurs if the value is undefined
  * 'EmptyRange' - occurs if range is empty
  * 'IndexOverflow' - occurs if index overflows range
  * 'IndexUnderflow' - occurs if index underflows range
  
  'Exception' constructors are specified in the order of definition, this is the
  recommended check order.
  
  If the error type may depend on the check order, it should be indicated in the
  documentation. For example: overflow is checked first, and then underflow. But
  if an overflow is detected, underflow may not be noticed.
-}
data IndexException = UnacceptableExpansion String
                    | UndefinedValue        String
                    | UnexpectedRank        String
                    | IndexUnderflow        String
                    | IndexOverflow         String
                    | EmptyRange            String
  deriving ( IndexException -> IndexException -> Bool
(IndexException -> IndexException -> Bool)
-> (IndexException -> IndexException -> Bool) -> Eq IndexException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexException -> IndexException -> Bool
$c/= :: IndexException -> IndexException -> Bool
== :: IndexException -> IndexException -> Bool
$c== :: IndexException -> IndexException -> Bool
Eq, Typeable )

instance Show IndexException
  where
    show :: IndexException -> String
show (UnacceptableExpansion String
s) = String
"unacceptable expansion "   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (UndefinedValue        String
s) = String
"undefined element "        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (UnexpectedRank        String
s) = String
"unexpected rank "          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (IndexUnderflow        String
s) = String
"index out of lower bound " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (IndexOverflow         String
s) = String
"index out of upper bound " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    show (EmptyRange            String
s) = String
"empty range "              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

instance Exception IndexException

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

{- |
  A 'UnreachableException' is used as an exception that should never be thrown.
  
  * 'ErrorCall' and 'AssertionFailed' means that the function is partially
  defined or missused (if some arguments shouldn't be passed).
  * 'UnreachableException' means that some expression, by definition, cannot be
  reached (for example, a default value when initializing an array, if each
  value is guaranteed to be overwritten before use).
-}
data UnreachableException = UnreachableException String deriving (UnreachableException -> UnreachableException -> Bool
(UnreachableException -> UnreachableException -> Bool)
-> (UnreachableException -> UnreachableException -> Bool)
-> Eq UnreachableException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnreachableException -> UnreachableException -> Bool
$c/= :: UnreachableException -> UnreachableException -> Bool
== :: UnreachableException -> UnreachableException -> Bool
$c== :: UnreachableException -> UnreachableException -> Bool
Eq, Typeable)

instance Show UnreachableException
  where
    show :: UnreachableException -> String
show (UnreachableException String
s) = String
"unreachable exception " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

instance Exception UnreachableException