HsSVN-0.2: Subversion/Error.hs

{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}
{-# OPTIONS_GHC -optc-DDARWIN #-}
{-# OPTIONS_GHC -optc-DSIGPROCMASK_SETS_THREAD_MASK #-}
{-# INCLUDE "HsSVN.h" #-}
{-# LINE 1 "Subversion/Error.hsc" #-}
{- -*- haskell -*- -}
{-# LINE 2 "Subversion/Error.hsc" #-}

-- #prune

-- |Common exception handling for Subversion. The C API of the
-- Subversion returns an error as a function result, but in HsSVN
-- errors are thrown as a DynException.


{-# LINE 10 "Subversion/Error.hsc" #-}

module Subversion.Error
    ( SvnError
    , SVN_ERROR_T -- private

    , wrapSvnError -- private

    , svnErrCode
    , svnErrMsg

    , svnErr -- private

    , throwSvnErr

    , SvnErrCode(..)
    )
    where

import           Control.Exception
import           Data.Dynamic
import           Foreign
import           Foreign.C.String
import           Foreign.C.Types
import           Subversion.Types

-- |@'SvnError'@ represents a Subversion error.
newtype SvnError
    = SvnError (ForeignPtr SVN_ERROR_T)
      deriving (Typeable)

data SVN_ERROR_T


foreign import ccall "svn_err_best_message"
        _best_message :: Ptr SVN_ERROR_T -> Ptr CChar -> APR_SIZE_T -> IO (Ptr CChar)

foreign import ccall "&svn_error_clear"
        _clear :: FunPtr (Ptr SVN_ERROR_T -> IO ())


maxErrMsgLen :: Int
maxErrMsgLen = 255


withSvnErrorPtr :: SvnError -> (Ptr SVN_ERROR_T -> IO a) -> IO a
withSvnErrorPtr (SvnError err) = withForeignPtr err

-- |@'svnErrCode' err@ returns a 'SvnErrCode' for an error object.
svnErrCode :: SvnError -> SvnErrCode
svnErrCode err
    = unsafePerformIO $
      withSvnErrorPtr err $ \ errPtr -> 
      do num <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) errPtr
{-# LINE 63 "Subversion/Error.hsc" #-}
         return $ statusToErrCode num

-- |@'svnErrMsg' err@ returns an error message for an error object.
svnErrMsg :: SvnError -> String
svnErrMsg err
    = unsafePerformIO $
      withSvnErrorPtr err $ \ errPtr ->
      allocaArray maxErrMsgLen $ \ bufPtr ->
          _best_message errPtr bufPtr (fromIntegral maxErrMsgLen)
               >>= peekCString


wrapSvnError :: Ptr SVN_ERROR_T -> IO (Maybe SvnError)
wrapSvnError errPtr
    | errPtr == nullPtr
        = return Nothing
    | otherwise
        = newForeignPtr _clear errPtr >>= return . Just . SvnError


svnErr :: IO (Ptr SVN_ERROR_T) -> IO ()
svnErr f
    = do err <- wrapSvnError =<< f
         case err of
           Nothing -> return ()
           Just e  -> throwSvnErr e

-- |@'throwSvnErr' err@ throws an 'SvnError' object in an IO
-- monad. You usually don't need to use this directly.
throwSvnErr :: SvnError -> IO a
throwSvnErr = throwIO . DynException . toDyn

-- |@'SvnErrCode'@ represents a Subversion error code. As you see, not
-- all errors are translated to Haskell constructors yet. Uncovered
-- error codes are temporarily represented as @'UnknownError' num@.
data SvnErrCode
    = AprEEXIST         -- ^ APR EEXIST error: typically it means
                        --   something you tried to create was already
                        --   there.
    | AprENOENT         -- ^ APR ENOENT error: typically it means
                        --   something you tried to use wasn't there.
    | DirNotEmpty       -- ^ The directory needs to be empty but it's not.
    | ReposLocked       -- ^ The repository was locked, perhaps for db
                        --   recovery.
    | FsAlreadyExists   -- ^ The item already existed in filesystem.
    | FsConflict        -- ^ Merge conflict has occured during commit.
    | FsNoSuchRevision  -- ^ It was an invalid filesystem revision
                        --   number.
    | FsNotDirectory    -- ^ It was not a filesystem directory entry.
    | FsNotFile         -- ^ It was not a filesystem file entry.
    | FsNotFound        -- ^ It wasn't there in filesystem.
    | UnknownError !Int -- ^ Any other errors than above. You
                        --   shouldn't rely on the absence of
                        --   appropriate 'SvnErrCode' constructors
                        --   because they may be added in the future
                        --   version of HsSVN. If that happens to you,
                        --   your code stops working.
      deriving (Show, Eq, Typeable)

statusToErrCode :: APR_STATUS_T -> SvnErrCode
statusToErrCode (17) = AprEEXIST
{-# LINE 124 "Subversion/Error.hsc" #-}
statusToErrCode (2) = AprENOENT
{-# LINE 125 "Subversion/Error.hsc" #-}
statusToErrCode (200011) = DirNotEmpty
{-# LINE 126 "Subversion/Error.hsc" #-}
statusToErrCode (165000) = ReposLocked
{-# LINE 127 "Subversion/Error.hsc" #-}
statusToErrCode (160020) = FsAlreadyExists
{-# LINE 128 "Subversion/Error.hsc" #-}
statusToErrCode (160024) = FsConflict
{-# LINE 129 "Subversion/Error.hsc" #-}
statusToErrCode (160006) = FsNoSuchRevision
{-# LINE 130 "Subversion/Error.hsc" #-}
statusToErrCode (160016) = FsNotDirectory
{-# LINE 131 "Subversion/Error.hsc" #-}
statusToErrCode (160017) = FsNotFile
{-# LINE 132 "Subversion/Error.hsc" #-}
statusToErrCode (160013) = FsNotFound
{-# LINE 133 "Subversion/Error.hsc" #-}
statusToErrCode n                                    = UnknownError (fromIntegral n)