{-# LANGUAGE DeriveDataTypeable #-}
{- -*- Mode: haskell; -*-
Haskell LDAP Interface
Copyright (C) 2005-2009 John Goerzen <jgoerzen@complete.org>

This code is under a 3-clause BSD license; see COPYING for details.
-}

{- |
   Module     : LDAP.Exceptions
   Copyright  : Copyright (C) 2005-2009 John Goerzen
   License    : BSD

   Maintainer : John Goerzen,
   Maintainer : jgoerzen\@complete.org
   Stability  : provisional
   Portability: portable

Handling LDAP Exceptions

Written by John Goerzen, jgoerzen\@complete.org
-}

module LDAP.Exceptions (-- * Types
                        LDAPException(..),
                        -- * General Catching
                        catchLDAP,
                        handleLDAP,
                        failLDAP,
                        throwLDAP
                        )

where
import Data.Typeable
import Control.Exception
import LDAP.Types
import LDAP.Data

#if __GLASGOW_HASKELL__ < 610
import Data.Dynamic
#endif

{- | The basic type of LDAP exceptions.  These are raised when an operation
does not indicate success. -}

data LDAPException = LDAPException 
    {LDAPException -> LDAPReturnCode
code :: LDAPReturnCode,     -- ^ Numeric error code
     LDAPException -> String
description :: String,     -- ^ Description of error
     LDAPException -> String
caller :: String           -- ^ Calling function
    }
    deriving (Typeable)
instance Show LDAPException where
    show :: LDAPException -> String
show LDAPException
x = LDAPException -> String
caller LDAPException
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": LDAPException " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LDAPReturnCode -> String
forall a. Show a => a -> String
show (LDAPException -> LDAPReturnCode
code LDAPException
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ 
             String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (LDAPReturnCode -> Int
forall a. Enum a => a -> Int
fromEnum (LDAPReturnCode -> Int) -> LDAPReturnCode -> Int
forall a b. (a -> b) -> a -> b
$ LDAPException -> LDAPReturnCode
code LDAPException
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             LDAPException -> String
description LDAPException
x

instance Eq LDAPException where
    LDAPException
x == :: LDAPException -> LDAPException -> Bool
== LDAPException
y = LDAPException -> LDAPReturnCode
code LDAPException
x LDAPReturnCode -> LDAPReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== LDAPException -> LDAPReturnCode
code LDAPException
y

instance Ord LDAPException where
    compare :: LDAPException -> LDAPException -> Ordering
compare LDAPException
x LDAPException
y = LDAPReturnCode -> LDAPReturnCode -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (LDAPException -> LDAPReturnCode
code LDAPException
x) (LDAPException -> LDAPReturnCode
code LDAPException
y)

#if __GLASGOW_HASKELL__ >= 610
instance Exception LDAPException where
{-
    toException = SomeException
    fromException (SomeException e) = Just e
    fromException _ = Nothing
-}

{- | Execute the given IO action.

If it raises a 'LDAPException', then execute the supplied handler and return
its return value.  Otherwise, process as normal. -}
catchLDAP :: IO a -> (LDAPException -> IO a) -> IO a
catchLDAP :: forall a. IO a -> (LDAPException -> IO a) -> IO a
catchLDAP IO a
action LDAPException -> IO a
handler = 
    (LDAPException -> Maybe LDAPException)
-> IO a -> (LDAPException -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust LDAPException -> Maybe LDAPException
ldapExceptions IO a
action LDAPException -> IO a
handler

{- | Like 'catchLDAP', with the order of arguments reversed. -}
handleLDAP :: (LDAPException -> IO a) -> IO a -> IO a
handleLDAP :: forall a. (LDAPException -> IO a) -> IO a -> IO a
handleLDAP = (IO a -> (LDAPException -> IO a) -> IO a)
-> (LDAPException -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (LDAPException -> IO a) -> IO a
forall a. IO a -> (LDAPException -> IO a) -> IO a
catchLDAP

{- | Given an Exception, return Just LDAPException if it was an
'LDAPExcetion', or Nothing otherwise.  Useful with functions
like catchJust. -}
ldapExceptions :: LDAPException -> Maybe LDAPException
ldapExceptions :: LDAPException -> Maybe LDAPException
ldapExceptions LDAPException
e = LDAPException -> Maybe LDAPException
forall a. a -> Maybe a
Just LDAPException
e

#else

{- | Execute the given IO action.

If it raises a 'LDAPException', then execute the supplied handler and return
its return value.  Otherwise, process as normal. -}
catchLDAP :: IO a -> (LDAPException -> IO a) -> IO a
catchLDAP = catchDyn

{- | Like 'catchLDAP', with the order of arguments reversed. -}
handleLDAP :: (LDAPException -> IO a) -> IO a -> IO a
handleLDAP = flip catchLDAP

#endif

{- | Catches LDAP errors, and re-raises them as IO errors with fail.
Useful if you don't care to catch LDAP errors, but want to see a sane
error message if one happens.  One would often use this as a high-level
wrapper around LDAP calls.
-}
failLDAP :: IO a -> IO a
failLDAP :: forall a. IO a -> IO a
failLDAP IO a
action =
    IO a -> (LDAPException -> IO a) -> IO a
forall a. IO a -> (LDAPException -> IO a) -> IO a
catchLDAP IO a
action LDAPException -> IO a
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
handler
    where handler :: a -> m a
handler a
e = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"LDAP error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e)

{- | A utility function to throw an 'LDAPException'.  The mechanics of throwing
such a thing differ between GHC 6.8.x, Hugs, and GHC 6.10.  This function
takes care of the special cases to make it simpler.

With GHC 6.10, it is a type-restricted alias for throw.  On all other systems,
it is a type-restricted alias for throwDyn. -}
throwLDAP :: LDAPException -> IO a
#if __GLASGOW_HASKELL__ >= 610
throwLDAP :: forall a. LDAPException -> IO a
throwLDAP = LDAPException -> IO a
forall a e. Exception e => e -> a
throw
#else
throwLDAP = throwDyn
#endif