{-# LINE 1 "System/Posix/DynamicLinker/Module.hsc" #-}{-# LANGUAGE Safe #-}------------------------------------------------------------------------------- |-- 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.-------------------------------------------------------------------------------moduleSystem.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 ())whereimportPreludehiding(head,tail)importSystem.Posix.DynamicLinker importSystem.Posix.DynamicLinker.Common importForeign.Ptr(Ptr,nullPtr,FunPtr)importSystem.Posix.Internals(withFilePath)unModule ::Module ->(Ptr())unModule :: Module -> Ptr ()
unModule (Module Ptr ()
adr )=Ptr ()
adr -- Opens a module (EXPORTED)--moduleOpen ::String->[RTLDFlags ]->IOModule moduleOpen :: String -> [RTLDFlags] -> IO Module
moduleOpen String
file [RTLDFlags]
flags =doPtr ()
modPtr <-String -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CString -> IO a) -> IO a
withFilePathString
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)thenIO 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 ))elseModule -> 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(FunPtra )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 ::IOStringmoduleError :: IO String
moduleError =IO String
dlerror -- Convenience function, cares for module open- & closing-- additionally returns status of `moduleClose' (EXPORTED)--withModule ::MaybeString->String->[RTLDFlags ]->(Module ->IOa )->IOa withModule :: forall a.
Maybe String -> String -> [RTLDFlags] -> (Module -> IO a) -> IO a
withModule Maybe String
mdir String
file [RTLDFlags]
flags Module -> IO a
p =doletmodPath :: String
modPath =caseMaybe String
mdir ofMaybe String
Nothing->String
file JustString
dir ->String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++caseString -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
dir ofJust(String
_,Char
'/')->String
file Just{}->Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
file Maybe (String, Char)
Nothing->String -> String
forall a. HasCallStack => String -> a
errorString
"System.Posix.DynamicLinker.Module.withModule: directory should not be Just \"\", pass Nothing instead"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
returna
result withModule_ ::MaybeString->String->[RTLDFlags ]->(Module ->IOa )->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()-- Dual to 'Data.List.uncons'.unsnoc ::[a ]->Maybe([a ],a )unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc =(a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldra -> Maybe ([a], a) -> Maybe ([a], a)
forall {a}. a -> Maybe ([a], a) -> Maybe ([a], a)
go Maybe ([a], a)
forall a. Maybe a
Nothingwherego :: a -> Maybe ([a], a) -> Maybe ([a], a)
go a
x Maybe ([a], a)
Nothing=([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just([],a
x )go a
x (Just([a]
xs ,a
lst ))=([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs ,a
lst )