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

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

{-# LINE 6 "libraries/unix/System/Posix/DynamicLinker/Module.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.DynamicLinker.Module
-- 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)
--
-- DLOpen support, old API
--  Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
--  I left the API more or less the same, mostly the flags are different.
--
-----------------------------------------------------------------------------

module System.Posix.DynamicLinker.Module (

--  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
--
--  withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
--     funptr <- moduleSymbol mod "mogrify"
--     let fun = fun__ funptr
--     withCString "test" $ \ str -> do
--       strptr <- fun str 1
--       strstr <- peekCString strptr
--       ...

      Module
    , moduleOpen             -- :: String -> ModuleFlags -> IO Module
    , moduleSymbol           -- :: Source -> String -> IO (FunPtr a)
    , moduleClose            -- :: Module -> IO Bool
    , moduleError            -- :: IO String
    , withModule             -- :: Maybe String
                             -- -> String
                             -- -> [ModuleFlags ]
                             -- -> (Module -> IO a)
                             -- -> IO a
    , withModule_            -- :: Maybe String
                             -- -> String
                             -- -> [ModuleFlags]
                             -- -> (Module -> IO a)
                             -- -> IO ()
    )
where



import System.Posix.DynamicLinker
import System.Posix.DynamicLinker.Common
import Foreign.Ptr      ( Ptr, nullPtr, FunPtr )
import System.Posix.Internals ( withFilePath )

unModule              :: Module -> (Ptr ())
unModule :: Module -> Ptr ()
unModule (Module Ptr ()
adr)  = Ptr ()
adr

-- Opens a module (EXPORTED)
--

moduleOpen :: String -> [RTLDFlags] -> IO Module
moduleOpen :: String -> [RTLDFlags] -> IO Module
moduleOpen String
file [RTLDFlags]
flags = do
  Ptr ()
modPtr <- String -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CString -> IO a) -> IO a
withFilePath String
file ((CString -> IO (Ptr ())) -> IO (Ptr ()))
-> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \ CString
modAddr -> CString -> CInt -> IO (Ptr ())
c_dlopen CString
modAddr ([RTLDFlags] -> CInt
packRTLDFlags [RTLDFlags]
flags)
  if (Ptr ()
modPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr)
      then IO String
moduleError IO String -> (String -> IO Module) -> IO Module
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
err -> IOError -> IO Module
forall a. IOError -> IO a
ioError (String -> IOError
userError (String
"dlopen: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err))
      else Module -> IO Module
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> IO Module) -> Module -> IO Module
forall a b. (a -> b) -> a -> b
$ Ptr () -> Module
Module Ptr ()
modPtr

-- Gets a symbol pointer from a module (EXPORTED)
--
moduleSymbol :: Module -> String -> IO (FunPtr a)
moduleSymbol :: forall a. Module -> String -> IO (FunPtr a)
moduleSymbol Module
file String
sym = DL -> String -> IO (FunPtr a)
forall a. DL -> String -> IO (FunPtr a)
dlsym (Ptr () -> DL
DLHandle (Module -> Ptr ()
unModule Module
file)) String
sym

-- Closes a module (EXPORTED)
--
moduleClose     :: Module -> IO ()
moduleClose :: Module -> IO ()
moduleClose Module
file  = DL -> IO ()
dlclose (Ptr () -> DL
DLHandle (Module -> Ptr ()
unModule Module
file))

-- Gets a string describing the last module error (EXPORTED)
--
moduleError :: IO String
moduleError :: IO String
moduleError  = IO String
dlerror


-- Convenience function, cares for module open- & closing
-- additionally returns status of `moduleClose' (EXPORTED)
--
withModule :: Maybe String
           -> String
           -> [RTLDFlags]
           -> (Module -> IO a)
           -> IO a
withModule :: forall a.
Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO a
withModule Maybe String
mdir String
file [RTLDFlags]
flags Module -> IO a
p = do
  let modPath :: String
modPath = case Maybe String
mdir of
                  Maybe String
Nothing -> String
file
                  Just String
dir  -> String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ if ((String -> Char
forall a. HasCallStack => [a] -> a
head (String -> String
forall a. [a] -> [a]
reverse String
dir)) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
                                       then String
file
                                       else (Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
file)
  Module
modu <- String -> [RTLDFlags] -> IO Module
moduleOpen String
modPath [RTLDFlags]
flags
  a
result <- Module -> IO a
p Module
modu
  Module -> IO ()
moduleClose Module
modu
  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

withModule_ :: Maybe String
            -> String
            -> [RTLDFlags]
            -> (Module -> IO a)
            -> IO ()
withModule_ :: forall a.
Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO ()
withModule_ Maybe String
dir String
file [RTLDFlags]
flags Module -> IO a
p = Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO a
forall a.
Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO a
withModule Maybe String
dir String
file [RTLDFlags]
flags Module -> IO a
p IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()