{-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} module IRC.Plugins.Loader ( load ) where import qualified Data.HashMap.Lazy as M import IRC.Plugins.Plugin import Control.Exception ( catch, ErrorCall ) import GHC.Exts ( addrToAny# ) import GHC.Ptr ( Ptr(..) ) import System.Info ( os, arch ) import GHCi.ObjLink import Encoding load :: PluginSet -> String -> IO (Either String PluginSet) load set path = do initObjLinker RetainCAFs loadObj "Plugin.o" _ret <- resolveObjs ptr <- lookupSymbol (mangleSymbol Nothing "Plugin" "f") case ptr of Nothing -> return $ Left "Couldn’t load symbol" Just (Ptr addr) -> case addrToAny# addr of (# f #) -> return $ Right f unload :: PluginSet -> String -> IO PluginSet unload set plugin = catch unloadPlugin exceptionHandler where exceptionHandler :: ErrorCall -> IO PluginSet exceptionHandler _ = return set unloadPlugin :: IO PluginSet unloadPlugin = do unloadObj $ plugin <> ".o" return $ M.delete plugin set mangleSymbol :: Maybe String -> String -> String -> String mangleSymbol pkg module' valsym = prefixUnderscore <> maybe "" (\p -> zEncodeString p <> "_") pkg <> zEncodeString module' <> "_" <> zEncodeString valsym <> "_closure" prefixUnderscore :: String prefixUnderscore = case (os,arch) of ("mingw32","x86_64") -> "" ("cygwin","x86_64") -> "" ("mingw32",_) -> "_" ("darwin",_) -> "_" ("cygwin",_) -> "_" _ -> ""