{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      : Data.Massiv.Core.Exception
-- Copyright   : (c) Alexey Kuleshevich 2019-2022
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
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)

-- | Orphan instance in "massiv"
instance MonadThrow (ST s) where
  throwM = unsafeIOToST . throwIO
#endif

-- | Throw an impossible error.
--
-- @since 0.5.6
throwImpossible :: HasCallStack => Exception e => e -> a
throwImpossible :: forall e a. (HasCallStack, Exception e) => e -> a
throwImpossible e
exc = SomeException -> a
forall a e. Exception e => e -> a
throw (String -> CallStack -> SomeException
errorCallWithCallStackException String
msg HasCallStack
CallStack
?callStack)
  where
    msg :: String
msg =
      String
"<massiv> ImpossibleException ("
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall e. Exception e => e -> String
displayException e
exc
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): Either one of the unsafe functions was used or it is a bug in the library. "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"In latter case please report this error."
{-# NOINLINE throwImpossible #-}

-- | Throw an error on `Left` or produce the result on `Right`. Exception type is lost, so
-- do not expect to be able to catch it as such. Stick to `IO` if you need exception control
-- flow.
--
-- @since 0.5.6
throwEither :: HasCallStack => Either SomeException a -> a
throwEither :: forall a. HasCallStack => Either SomeException a -> a
throwEither =
  \case
    Left SomeException
exc -> SomeException -> a
forall a e. Exception e => e -> a
throw (String -> CallStack -> SomeException
errorCallWithCallStackException (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
exc) HasCallStack
CallStack
?callStack)
    Right a
res -> a
res
{-# INLINE throwEither #-}

-- | An error that gets thrown when an unitialized element of a boxed array gets accessed. Can only
-- happen when array was constructed with `Data.Massiv.Array.Unsafe.unsafeNew`.
data Uninitialized = Uninitialized deriving (Int -> Uninitialized -> String -> String
[Uninitialized] -> String -> String
Uninitialized -> String
(Int -> Uninitialized -> String -> String)
-> (Uninitialized -> String)
-> ([Uninitialized] -> String -> String)
-> Show Uninitialized
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Uninitialized -> String -> String
showsPrec :: Int -> Uninitialized -> String -> String
$cshow :: Uninitialized -> String
show :: Uninitialized -> String
$cshowList :: [Uninitialized] -> String -> String
showList :: [Uninitialized] -> String -> String
Show)

instance Exception Uninitialized where
  displayException :: Uninitialized -> String
displayException Uninitialized
Uninitialized = String
"Array element is uninitialized"

-- | Throw `SizeElementsMismatchException` whenever number of elements in both sizes do
-- not match.
--
-- @since 0.3.5
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' =
  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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 #-}