{-# LINE 1 "libraries/unix/System/Posix/DynamicLinker/Module.hsc" #-}
{-# LANGUAGE Safe #-}
module System.Posix.DynamicLinker.Module (
Module
, moduleOpen
, moduleSymbol
, moduleClose
, moduleError
, withModule
, withModule_
)
where
import Prelude hiding (head, tail)
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
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
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
moduleClose :: Module -> IO ()
moduleClose :: Module -> IO ()
moduleClose Module
file = DL -> IO ()
dlclose (Ptr () -> DL
DLHandle (Module -> Ptr ()
unModule Module
file))
moduleError :: IO String
moduleError :: IO String
moduleError = IO String
dlerror
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]
++ case String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
dir of
Just (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
error String
"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
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 ()
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
foldr a -> Maybe ([a], a) -> Maybe ([a], a)
forall {a}. a -> Maybe ([a], a) -> Maybe ([a], a)
go Maybe ([a], a)
forall a. Maybe a
Nothing
where
go :: 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)