Fix conditional pragma to work with 6.12
[packages/unix.git] / System / Posix / DynamicLinker / Module.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 #if __GLASGOW_HASKELL__ >= 701
3 {-# LANGUAGE Trustworthy #-}
4 #endif
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module      :  System.Posix.DynamicLinker.Module
8 -- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
9 -- License     :  BSD-style (see the file libraries/base/LICENSE)
10 -- 
11 -- Maintainer  :  vs@foldr.org
12 -- Stability   :  provisional
13 -- Portability :  non-portable (requires POSIX)
14 --
15 -- DLOpen support, old API
16 --  Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
17 --  I left the API more or less the same, mostly the flags are different.
18 --
19 -----------------------------------------------------------------------------
20
21 module System.Posix.DynamicLinker.Module (
22
23 --  Usage:
24 --  ******
25 --  
26 --  Let's assume you want to open a local shared library 'foo' (./libfoo.so)
27 --  offering a function
28 --    char * mogrify (char*,int)
29 --  and invoke str = mogrify("test",1):
30 -- 
31 --  type Fun = CString -> Int -> IO CString
32 --  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
33 -- 
34 --  withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
35 --     funptr <- moduleSymbol mod "mogrify"
36 --     let fun = fun__ funptr
37 --     withCString "test" $ \ str -> do
38 --       strptr <- fun str 1
39 --       strstr <- peekCString strptr
40 --       ...
41
42       Module
43     , moduleOpen             -- :: String -> ModuleFlags -> IO Module
44     , moduleSymbol           -- :: Source -> String -> IO (FunPtr a)
45     , moduleClose            -- :: Module -> IO Bool
46     , moduleError            -- :: IO String
47     , withModule             -- :: Maybe String 
48                              -- -> String 
49                              -- -> [ModuleFlags ]
50                              -- -> (Module -> IO a) 
51                              -- -> IO a
52     , withModule_            -- :: Maybe String 
53                              -- -> String 
54                              -- -> [ModuleFlags] 
55                              -- -> (Module -> IO a) 
56                              -- -> IO ()
57     )
58 where
59
60 #include "HsUnix.h"
61
62 import System.Posix.DynamicLinker
63 import Foreign.Ptr      ( Ptr, nullPtr, FunPtr )
64 #if __GLASGOW_HASKELL__ > 611
65 import System.Posix.Internals ( withFilePath )
66 #else
67 import Foreign.C.String ( withCString )
68
69 withFilePath :: FilePath -> (CString -> IO a) -> IO a
70 withFilePath = withCString
71 #endif
72
73 -- abstract handle for dynamically loaded module (EXPORTED)
74 --
75 newtype Module = Module (Ptr ())
76
77 unModule              :: Module -> (Ptr ())
78 unModule (Module adr)  = adr
79
80 -- Opens a module (EXPORTED)
81 --
82
83 moduleOpen :: String -> [RTLDFlags] -> IO Module
84 moduleOpen file flags = do
85   modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
86   if (modPtr == nullPtr)
87       then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
88       else return $ Module modPtr
89
90 -- Gets a symbol pointer from a module (EXPORTED)
91 --
92 moduleSymbol :: Module -> String -> IO (FunPtr a)
93 moduleSymbol file sym = dlsym (DLHandle (unModule file)) sym
94
95 -- Closes a module (EXPORTED)
96 -- 
97 moduleClose     :: Module -> IO ()
98 moduleClose file  = dlclose (DLHandle (unModule file))
99
100 -- Gets a string describing the last module error (EXPORTED)
101 -- 
102 moduleError :: IO String
103 moduleError  = dlerror
104
105
106 -- Convenience function, cares for module open- & closing
107 -- additionally returns status of `moduleClose' (EXPORTED)
108 -- 
109 withModule :: Maybe String 
110            -> String 
111            -> [RTLDFlags]
112            -> (Module -> IO a) 
113            -> IO a
114 withModule mdir file flags p = do
115   let modPath = case mdir of
116                   Nothing -> file
117                   Just dir  -> dir ++ if ((head (reverse dir)) == '/')
118                                        then file
119                                        else ('/':file)
120   modu <- moduleOpen modPath flags
121   result <- p modu
122   moduleClose modu
123   return result
124
125 withModule_ :: Maybe String 
126             -> String 
127             -> [RTLDFlags]
128             -> (Module -> IO a) 
129             -> IO ()
130 withModule_ dir file flags p = withModule dir file flags p >>= \ _ -> return ()