{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Massiv.Core.Exception
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
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)

-- | Orphan instance in "massiv"
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."

-- | An error that gets thrown when an unitialized element of a boxed array gets accessed. Can only
-- happen when array was constructed with `unsafeNew`.
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"


-- | 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 :: 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 #-}