{-# LANGUAGE Safe #-}

{- |
    Module      :  Control.Exception.SDP
    Copyright   :  (c) Andrey Mulik 2019-2021
    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 when performing the (safe) rebound
  operation with unacceptable target range (example: an attempt to convert
  structure with bounds @(2, 5)@ to structure with bounds @('\\0', '\\255')@ is
  invalid because available size is smaller than required)
  * 'UnexpectedRank' - occurs when trying to convert one representation of an
  index to another, if their dimensions doesn't match (example: trying to
  convert a list @[1, 2, 3]@ of type @[Int]@ to an index of type @(T4 Int)@)
  * 'UndefinedValue' - occurs when referring to a non-existent or undefined
  element; some unsafe structures and operations can lead to the possibility of
  untracked reading of invalid or undefined values
  * 'EmptyRange' - occurs when accessing the contents of an empty structure
  * 'IndexOverflow' - occurs when going beyond the upper boundary of the
  structure (overflow)
  * 'IndexUnderflow' - occurs when going beyond the lower boundary of the
  structure (underflow)
  
  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. 'IndexException'
  constructor order is the recommended order.
-}
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.
  
  Example: @newArray#@ requires a default value to fill the newly created array.
  If the array is guaranteed to be filled with values (for example, in the
  @replicate@ function), then this value will never be needed and, therefore,
  calculated. 'UnreachableException' in this case will be a marker of
  unreachability of this expression.
-}
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