{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Massiv.Core.Exception
( ImpossibleException(..)
, throwImpossible
, throwEither
, Uninitialized(..)
, guardNumberOfElements
, Exception(..)
, SomeException
) where
import Control.Exception
import Control.Monad
import Control.Monad.Catch
import Data.Massiv.Core.Index.Internal
#if !MIN_VERSION_exceptions(0, 10, 3)
import Control.Monad.ST (ST)
import Control.Monad.ST.Unsafe (unsafeIOToST)
instance MonadThrow (ST s) where
throwM = unsafeIOToST . throwIO
#endif
newtype ImpossibleException =
ImpossibleException SomeException
deriving (Int -> ImpossibleException -> ShowS
[ImpossibleException] -> ShowS
ImpossibleException -> String
(Int -> ImpossibleException -> ShowS)
-> (ImpossibleException -> String)
-> ([ImpossibleException] -> ShowS)
-> Show ImpossibleException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImpossibleException] -> ShowS
$cshowList :: [ImpossibleException] -> ShowS
show :: ImpossibleException -> String
$cshow :: ImpossibleException -> String
showsPrec :: Int -> ImpossibleException -> ShowS
$cshowsPrec :: Int -> ImpossibleException -> ShowS
Show)
throwImpossible :: Exception e => e -> a
throwImpossible :: e -> a
throwImpossible = ImpossibleException -> a
forall a e. Exception e => e -> a
throw (ImpossibleException -> a) -> (e -> ImpossibleException) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ImpossibleException
ImpossibleException (SomeException -> ImpossibleException)
-> (e -> SomeException) -> e -> ImpossibleException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException
{-# NOINLINE throwImpossible #-}
throwEither :: Either SomeException a -> a
throwEither :: Either SomeException a -> a
throwEither =
\case
Left SomeException
exc -> SomeException -> a
forall a e. Exception e => e -> a
throw SomeException
exc
Right a
res -> a
res
{-# INLINE throwEither #-}
instance Exception ImpossibleException where
displayException :: ImpossibleException -> String
displayException (ImpossibleException SomeException
exc) =
String
"<massiv> ImpossibleException (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
exc String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"): Either one of the unsafe functions was used or it is a bug in the library. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"In latter case please report this error."
data Uninitialized = Uninitialized deriving Int -> Uninitialized -> ShowS
[Uninitialized] -> ShowS
Uninitialized -> String
(Int -> Uninitialized -> ShowS)
-> (Uninitialized -> String)
-> ([Uninitialized] -> ShowS)
-> Show Uninitialized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uninitialized] -> ShowS
$cshowList :: [Uninitialized] -> ShowS
show :: Uninitialized -> String
$cshow :: Uninitialized -> String
showsPrec :: Int -> Uninitialized -> ShowS
$cshowsPrec :: Int -> Uninitialized -> ShowS
Show
instance Exception Uninitialized where
displayException :: Uninitialized -> String
displayException Uninitialized
Uninitialized = String
"Array element is uninitialized"
guardNumberOfElements :: (MonadThrow m, Index ix, Index ix') => Sz ix -> Sz ix' -> m ()
guardNumberOfElements :: Sz ix -> Sz ix' -> m ()
guardNumberOfElements Sz ix
sz Sz ix'
sz' =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Sz ix -> Int
forall ix. Index ix => Sz ix -> Int
totalElem Sz ix
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix' -> Int
forall ix. Index ix => Sz ix -> Int
totalElem Sz ix'
sz') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SizeException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SizeException -> m ()) -> SizeException -> m ()
forall a b. (a -> b) -> a -> b
$ Sz ix -> Sz ix' -> SizeException
forall ix ix'.
(Index ix, Index ix') =>
Sz ix -> Sz ix' -> SizeException
SizeElementsMismatchException Sz ix
sz Sz ix'
sz'
{-# INLINE guardNumberOfElements #-}