hs-irc/IRC/Plugins/Loader.hs

{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE UnboxedTuples #-}

module IRC.Plugins.Loader ( load ) where

import qualified Data.HashMap.Lazy as M

import Control.Exception  ( catch, ErrorCall )
import GHC.Exts           ( addrToAny# )
import GHC.Ptr            ( Ptr(..) )
import System.Info        ( os, arch )
import GHCi.ObjLink
import Encoding

type PluginSet = M.HashMap String Plugin

data Plugin = Plugin { pluginEvent :: String, -- e.g. PRIVMSG
                       pluginEntry :: Int }

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",_) -> "_"
      _ -> ""