{-# LINE 1 "libraries/unix/System/Posix/DynamicLinker/ByteString.hsc" #-}

{-# LINE 2 "libraries/unix/System/Posix/DynamicLinker/ByteString.hsc" #-}
{-# LANGUAGE Safe #-}

{-# LINE 6 "libraries/unix/System/Posix/DynamicLinker/ByteString.hsc" #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.DynamicLinker.ByteString
-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  vs@foldr.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- Dynamic linker support through dlopen()
-----------------------------------------------------------------------------

module System.Posix.DynamicLinker.ByteString (

    module System.Posix.DynamicLinker.Prim,
    dlopen,
    dlsym,
    dlerror,
    dlclose,
    withDL, withDL_,
    undl,
    )

--  Usage:
--  ******
--
--  Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
--  offering a function
--    @char \* mogrify (char\*,int)@
--  and invoke @str = mogrify("test",1)@:
--
--
--  type Fun = CString -> Int -> IO CString
--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
--
--  withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
--     funptr <- dlsym mod "mogrify"
--     let fun = fun__ funptr
--     withCString "test" \$ \\ str -> do
--       strptr <- fun str 1
--       strstr <- peekCString strptr
--       ...
--

where

import System.Posix.DynamicLinker.Common
import System.Posix.DynamicLinker.Prim



import Control.Exception        ( bracket )
import Control.Monad    ( liftM )
import Foreign
import System.Posix.ByteString.FilePath

dlopen :: RawFilePath -> [RTLDFlags] -> IO DL
dlopen :: RawFilePath -> [RTLDFlags] -> IO DL
dlopen RawFilePath
path [RTLDFlags]
flags = do
  RawFilePath -> (CString -> IO DL) -> IO DL
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
path ((CString -> IO DL) -> IO DL) -> (CString -> IO DL) -> IO DL
forall a b. (a -> b) -> a -> b
$ \ CString
p -> do
    (Ptr () -> DL) -> IO (Ptr ()) -> IO DL
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> DL
DLHandle (IO (Ptr ()) -> IO DL) -> IO (Ptr ()) -> IO DL
forall a b. (a -> b) -> a -> b
$ String -> (Ptr () -> Bool) -> IO (Ptr ()) -> IO (Ptr ())
forall a. String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf String
"dlopen" (Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr) (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CString -> CInt -> IO (Ptr ())
c_dlopen CString
p ([RTLDFlags] -> CInt
packRTLDFlags [RTLDFlags]
flags)

withDL :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
withDL :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
withDL RawFilePath
file [RTLDFlags]
flags DL -> IO a
f = IO DL -> (DL -> IO ()) -> (DL -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (RawFilePath -> [RTLDFlags] -> IO DL
dlopen RawFilePath
file [RTLDFlags]
flags) (DL -> IO ()
dlclose) DL -> IO a
f

withDL_ :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
withDL_ :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
withDL_ RawFilePath
file [RTLDFlags]
flags DL -> IO a
f = RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
forall a. RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
withDL RawFilePath
file [RTLDFlags]
flags DL -> IO a
f IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()