{-# LANGUAGE DeriveDataTypeable #-}

-- | Exceptions and utilities
module Pdf.Core.Exception
(
  Corrupted(..),
  Unexpected(..),
  sure,
  message
)
where

import Data.Typeable
import Control.Exception hiding (throw)

-- | File is corrupted
--
-- Contains general message and a list of details
data Corrupted = Corrupted String [String]
  deriving (Int -> Corrupted -> ShowS
[Corrupted] -> ShowS
Corrupted -> String
(Int -> Corrupted -> ShowS)
-> (Corrupted -> String)
-> ([Corrupted] -> ShowS)
-> Show Corrupted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Corrupted] -> ShowS
$cshowList :: [Corrupted] -> ShowS
show :: Corrupted -> String
$cshow :: Corrupted -> String
showsPrec :: Int -> Corrupted -> ShowS
$cshowsPrec :: Int -> Corrupted -> ShowS
Show, Typeable)

instance Exception Corrupted where

-- | Something unexpected occurs, probably API missuse
data Unexpected = Unexpected String [String]
  deriving (Int -> Unexpected -> ShowS
[Unexpected] -> ShowS
Unexpected -> String
(Int -> Unexpected -> ShowS)
-> (Unexpected -> String)
-> ([Unexpected] -> ShowS)
-> Show Unexpected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unexpected] -> ShowS
$cshowList :: [Unexpected] -> ShowS
show :: Unexpected -> String
$cshow :: Unexpected -> String
showsPrec :: Int -> Unexpected -> ShowS
$cshowsPrec :: Int -> Unexpected -> ShowS
Show, Typeable)

instance Exception Unexpected where

-- | We are sure it is 'Right'. Otherwise 'Corripted' is thrown
sure :: Either String a -> IO a
sure :: Either String a -> IO a
sure (Right a
a) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
sure (Left String
err) = Corrupted -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
err [])

-- | Catch 'Corrupted' and 'Unexpected'
-- and add a message to it before rethrowing
message :: String -> IO a -> IO a
message :: String -> IO a -> IO a
message String
msg IO a
a = IO a
a IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
`catches`
  [ (Corrupted -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((Corrupted -> IO a) -> Handler a)
-> (Corrupted -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(Corrupted String
err [String]
msgs) -> Corrupted -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
msg (String
err String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs))
  , (Unexpected -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((Unexpected -> IO a) -> Handler a)
-> (Unexpected -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(Unexpected String
err [String]
msgs) -> Unexpected -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Unexpected
Unexpected String
msg (String
err String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs))
  ]