{-# LANGUAGE ForeignFunctionInterface #-}

module MLP.Context where
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Control.Exception 
import qualified MLP
import qualified MLP.Error


foreign import ccall unsafe "mlp.h mlp_context_new" 
  c_new :: IO (Ptr MLP.C_context)
new :: IO MLP.Context
new = do
  MLP.withFuncDebug "Context new" $ do
    mlp_context <- c_new
    return $ MLP.Context mlp_context


foreign import ccall unsafe "mlp.h mlp_context_delete"
  c_delete :: Ptr MLP.C_context -> IO ()
delete :: MLP.Context -> IO ()
delete (MLP.Context ctx) = do
  MLP.withFuncDebug "Context delete" $ 
    c_delete ctx


foreign import ccall unsafe "mlp.h mlp_context_has_error" c_has_error :: Ptr MLP.C_context -> IO CInt
hasError :: MLP.Context -> IO Bool
hasError (MLP.Context ctx) = do
  cint <- c_has_error ctx
  return $ if cint == 0 then False else True


foreign import ccall unsafe "mlp.h mlp_context_get_error" c_get_error :: Ptr MLP.C_context -> IO CInt
getError :: MLP.Context -> IO MLP.Error
getError (MLP.Context ctx) = do
  mlp_error <- c_get_error ctx
  return $ MLP.Error.fromCInt mlp_error


foreign import ccall unsafe "mlp.h mlp_context_get_error_msg" c_get_error_msg :: Ptr MLP.C_context -> IO CString
getErrorMsg :: MLP.Context -> IO (Maybe String)
getErrorMsg (MLP.Context ctx) = do
  msg <- c_get_error_msg ctx
  if msg == nullPtr 
    then return Nothing
    else peekCString msg >>= (return . Just)


foreign import ccall unsafe "mlp.h mlp_context_set_error" c_set_error :: Ptr MLP.C_context -> CInt -> CString -> CString -> IO ()
setError :: MLP.Context -> MLP.Error -> String -> IO ()
setError (MLP.Context ctx) err s = do
  withCString "%s" $ \fmt -> do
    withCString s $ \msg -> do
      c_set_error ctx (MLP.Error.toCInt err) fmt msg


foreign import ccall unsafe "mlp.h mlp_context_clear_error" c_clear_error :: Ptr MLP.C_context -> IO ()
clearError :: MLP.Context -> IO ()
clearError (MLP.Context ctx) = do
    c_clear_error ctx


try :: MLP.Context -> IO a -> IO a
try ctx f = do
  res <- f
  nok <- hasError ctx
  if nok
    then do
      err <- getError ctx
      msg <- getErrorMsg ctx
      throw $ MLP.ErrorException err msg
    else
      return res

with :: MLP.Context -> IO a -> IO a
with ctx f = do
  ret <- f
  delete ctx
  return ret