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 { wew :: Int,
                       lad :: Int }

load :: PluginSet -> IO (Either String (IO PluginSet))
load = 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 :: String -> IO PluginSet
unload plugin = catch (unloadObj $ plugin <> ".o") exceptionHandler

exceptionHandler :: ErrorCall -> IO PluginSet
exceptionHandler _ = return ()

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