diff --git a/LDAP.cabal b/LDAP.cabal --- a/LDAP.cabal +++ b/LDAP.cabal @@ -1,33 +1,63 @@ -Extra-Libraries: ldap --- End detected settings section. Everything below here should not --- need editing. Name: LDAP -Version: 0.6.4 +Version: 0.6.5 License: BSD3 Maintainer: John Goerzen Author: John Goerzen Stability: Beta -Copyright: Copyright (c) 2005-2008 John Goerzen +Copyright: Copyright (c) 2005-2009 John Goerzen homepage: http://software.complete.org/ldap-haskell Category: Network Synopsis: Haskell binding for C LDAP API license-file: COPYRIGHT extra-source-files: COPYING --- C-Sources: glue/glue.c -Exposed-Modules: LDAP, - LDAP.Types, - LDAP.Init, - LDAP.Constants, - LDAP.Data, - LDAP.Exceptions, - LDAP.Search, - LDAP.Modify -Other-Modules: LDAP.Utils, - LDAP.TypesLL, - LDAP.Result -Build-Depends: base -GHC-Options: -O2 --- CC-Options: -Iglue -CC-Options: -DLDAP_DEPRECATED=1 -Extensions: ForeignFunctionInterface, TypeSynonymInstances, - EmptyDataDecls, PatternSignatures + +Build-Type: Simple +Cabal-Version: >=1.2.3 + +Flag buildtests + description: Build the executable to run unit tests + default: False + +Library + -- C-Sources: glue/glue.c + Exposed-Modules: LDAP, + LDAP.Types, + LDAP.Init, + LDAP.Constants, + LDAP.Data, + LDAP.Exceptions, + LDAP.Search, + LDAP.Modify + Other-Modules: LDAP.Utils, + LDAP.TypesLL, + LDAP.Result + Build-Depends: base + + -- Hack for cabal-install weirdness. cabal-install forces base 3, + -- though it works fine for Setup.lhs manually. Fix. + if impl(ghc >= 6.9) + build-depends: base >= 4 + + Extra-Libraries: ldap + + GHC-Options: -O2 + -- CC-Options: -Iglue + CC-Options: -DLDAP_DEPRECATED=1 + Extensions: ForeignFunctionInterface, TypeSynonymInstances, + EmptyDataDecls, PatternSignatures, CPP + +Executable runtests + if flag(buildtests) + Buildable: True + else + Buildable: False + Extra-Libraries: ldap + Main-Is: runtests.hs + CC-Options: -DLDAP_DEPRECATED=1 + Extensions: ForeignFunctionInterface, TypeSynonymInstances, + EmptyDataDecls, PatternSignatures, CPP + Hs-Source-Dirs: testsrc, . + GHC-Options: -O2 + + if impl(ghc >= 6.9) + build-depends: base >= 4 diff --git a/LDAP/Exceptions.hs b/LDAP/Exceptions.hs --- a/LDAP/Exceptions.hs +++ b/LDAP/Exceptions.hs @@ -1,13 +1,13 @@ {- -*- Mode: haskell; -*- Haskell LDAP Interface -Copyright (C) 2005 John Goerzen +Copyright (C) 2005-2009 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Exceptions - Copyright : Copyright (C) 2005-2006 John Goerzen + Copyright : Copyright (C) 2005-2009 John Goerzen License : BSD Maintainer : John Goerzen, @@ -25,16 +25,20 @@ -- * General Catching catchLDAP, handleLDAP, - failLDAP + failLDAP, + throwLDAP ) where -import Data.Dynamic 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. -} @@ -54,23 +58,53 @@ instance Ord LDAPException where compare x y = compare (code x) (code y) +instance Typeable LDAPException where + typeOf _ = mkTyConApp ldapExceptionTc [] + ldapExceptionTc :: TyCon ldapExceptionTc = mkTyCon "LDAP.LDAPException" -instance Typeable LDAPException where - typeOf _ = mkTyConApp ldapExceptionTc [] +#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 action handler = + catchJust ldapExceptions action handler + +{- | Like 'catchLDAP', with the order of arguments reversed. -} +handleLDAP :: (LDAPException -> IO a) -> IO a -> IO a +handleLDAP = flip 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 e = Just 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 @@ -80,3 +114,16 @@ failLDAP action = catchLDAP action handler where handler e = fail ("LDAP error: " ++ show 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 = throw +#else +throwLDAP = throwDyn +#endif diff --git a/LDAP/Utils.hsc b/LDAP/Utils.hsc --- a/LDAP/Utils.hsc +++ b/LDAP/Utils.hsc @@ -77,14 +77,14 @@ let exc = LDAPException {code = hserror, description = desc, caller = callername } - throwDyn exc + throwLDAP exc {- else do s <- (ldap_err2string result >>= peekCString) let exc = LDAPException {code = (toEnum (fromIntegral result)), description = s, caller = callername} - throwDyn exc + throwLDAP exc -} {- | Raise an IOError based on errno if getting a NULL. Identical diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhugs +import Distribution.Simple + +main = defaultMain + diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/env runhugs -arch-tag: Main setup script - -> import Distribution.Simple - -> main = defaultMain - diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs new file mode 100644 --- /dev/null +++ b/testsrc/runtests.hs @@ -0,0 +1,11 @@ +{- arch-tag: Test runner +Copyright (C) 2005 John Goerzen +-} + +module Main where + +import Test.HUnit +import Tests + +main = runTestTT tests +