{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Massiv.Core.Exception (
throwImpossible,
throwEither,
Uninitialized (..),
guardNumberOfElements,
Exception (..),
SomeException,
HasCallStack,
) where
import Control.Exception
import Control.Monad
import Control.Monad.Catch
import Data.Massiv.Core.Index.Internal
import GHC.Exception
import GHC.Stack
#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
throwImpossible :: HasCallStack => Exception e => e -> a
throwImpossible :: forall e a. (HasCallStack, Exception e) => e -> a
throwImpossible e
exc = forall a e. Exception e => e -> a
throw (String -> CallStack -> SomeException
errorCallWithCallStackException String
msg HasCallStack
?callStack)
where
msg :: String
msg =
String
"<massiv> ImpossibleException ("
forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> String
displayException e
exc
forall a. [a] -> [a] -> [a]
++ String
"): Either one of the unsafe functions was used or it is a bug in the library. "
forall a. [a] -> [a] -> [a]
++ String
"In latter case please report this error."
{-# NOINLINE throwImpossible #-}
throwEither :: HasCallStack => Either SomeException a -> a
throwEither :: forall a. HasCallStack => Either SomeException a -> a
throwEither =
\case
Left SomeException
exc -> forall a e. Exception e => e -> a
throw (String -> CallStack -> SomeException
errorCallWithCallStackException (forall e. Exception e => e -> String
displayException SomeException
exc) HasCallStack
?callStack)
Right a
res -> a
res
{-# INLINE throwEither #-}
data Uninitialized = Uninitialized deriving (Int -> Uninitialized -> ShowS
[Uninitialized] -> ShowS
Uninitialized -> String
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 :: forall (m :: * -> *) ix ix'.
(MonadThrow m, Index ix, Index ix') =>
Sz ix -> Sz ix' -> m ()
guardNumberOfElements Sz ix
sz Sz ix'
sz' =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall ix. Index ix => Sz ix -> Int
totalElem Sz ix
sz forall a. Eq a => a -> a -> Bool
== forall ix. Index ix => Sz ix -> Int
totalElem Sz ix'
sz') forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ forall ix ix'.
(Index ix, Index ix') =>
Sz ix -> Sz ix' -> SizeException
SizeElementsMismatchException Sz ix
sz Sz ix'
sz'
{-# INLINE guardNumberOfElements #-}