{-# LANGUAGE CApiFFI #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module HexChat.Internal
(
pri_HIGHEST, pri_HIGH, pri_NORM, pri_LOW, pri_LOWEST,
Hook, Eat(..), EventAttrs(..), Context, List,
command,
print,
emitPrint,
emitPrintAttrs,
sendModes,
nickCmp,
strip,
getPrefs,
listGet,
listFields,
listNext,
listStr,
listInt,
listTime,
hookCommand,
hookPrint,
hookPrintAttrs,
hookServer,
hookServerAttrs,
unhook,
findContext,
getContext,
setContext,
pluginguiAdd,
pluginguiRemove,
StaticData,
staticData,
lPlugin, lHandle, lHooks,
initStaticData,
joinStaticData,
getPlugin,
getHandle,
withHandle,
unhookHandle,
module Foreign.C.Types,
Plugin(..),
Plugin_Init(..),
Plugin_Deinit(..)
)
where
import Prelude hiding (print)
import Control.Monad
import Control.Exception
import Data.Coerce
import Data.IORef
import Foreign
import Foreign.C.Types
import Foreign.C.String
import GHC.StaticPtr
import System.IO.Unsafe
data HexChat_Plugin
newtype Plugin = Plugin (Ptr HexChat_Plugin) deriving (Show, Eq, Ord)
data HexChat_Hook
newtype Hook = Hook (Ptr HexChat_Hook) deriving (Show, Eq, Ord)
data HexChat_Context
newtype Context = Context (Ptr HexChat_Context) deriving (Show, Eq, Ord)
data HexChat_List
data List = List (IORef Bool) (ForeignPtr HexChat_List) deriving (Eq)
data HexChat_EventAttrs
foreign import capi "hexchat-plugin.h value HEXCHAT_PRI_HIGHEST" pri_HIGHEST :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_PRI_HIGH" pri_HIGH :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_PRI_NORM" pri_NORM :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_PRI_LOW" pri_LOW :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_PRI_LOWEST" pri_LOWEST :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_EAT_NONE" eat_NONE :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_EAT_HEXCHAT" eat_HEXCHAT :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_EAT_PLUGIN" eat_PLUGIN :: CInt
foreign import capi "hexchat-plugin.h value HEXCHAT_EAT_ALL" eat_ALL :: CInt
foreign import capi "hexchat-plugin.h hexchat_command" hexchat_command :: Plugin -> CString -> IO ()
foreign import capi "hexchat-plugin.h hexchat_print" hexchat_print :: Plugin -> CString -> IO ()
foreign import capi "hexchat-plugin.h hexchat_emit_print" hexchat_emit_print :: Plugin -> CString -> CString -> CString -> CString -> CString -> CString -> IO Bool
foreign import capi "hexchat-plugin.h hexchat_emit_print_attrs" hexchat_emit_print_attrs :: Plugin -> Ptr HexChat_EventAttrs -> CString -> CString -> CString -> CString -> CString -> CString -> IO Bool
foreign import capi "hexchat-plugin.h hexchat_send_modes" hexchat_send_modes :: Plugin -> Ptr CString -> CInt -> CInt -> CChar -> CChar -> IO ()
foreign import capi "hexchat-plugin.h hexchat_nickcmp" hexchat_nickcmp :: Plugin -> CString -> CString -> IO CInt
foreign import capi "hexchat-plugin.h hexchat_strip" hexchat_strip :: Plugin -> CString -> CInt -> CInt -> IO CString
foreign import capi "hexchat-plugin.h hexchat_free" hexchat_free :: Plugin -> Ptr a -> IO ()
foreign import capi "hexchat-plugin.h hexchat_event_attrs_create" hexchat_event_attrs_create :: Plugin -> IO (Ptr HexChat_EventAttrs)
foreign import capi "hexchat-plugin.h hexchat_event_attrs_free" hexchat_event_attrs_free :: Plugin -> Ptr HexChat_EventAttrs -> IO ()
foreign import capi "hexchat-plugin.h hexchat_get_info" hexchat_get_info :: Plugin -> CString -> IO CString
foreign import capi "hexchat-plugin.h hexchat_get_prefs" hexchat_get_prefs :: Plugin -> CString -> Ptr CString -> Ptr CInt -> IO CInt
foreign import capi "hexchat-plugin.h hexchat_list_get" hexchat_list_get :: Plugin -> CString -> IO (Ptr HexChat_List)
foreign import capi "hexchat-plugin.h hexchat_list_fields" hexchat_list_fields :: Plugin -> CString -> IO (Ptr CString)
foreign import capi "hexchat-plugin.h hexchat_list_next" hexchat_list_next :: Plugin -> Ptr HexChat_List -> IO Bool
foreign import capi "hexchat-plugin.h hexchat_list_str" hexchat_list_str :: Plugin -> Ptr HexChat_List -> CString -> IO CString
foreign import capi "hexchat-plugin.h hexchat_list_int" hexchat_list_int :: Plugin -> Ptr HexChat_List -> CString -> IO CInt
foreign import capi "hexchat-plugin.h hexchat_list_time" hexchat_list_time :: Plugin -> Ptr HexChat_List -> CString -> IO CTime
foreign import capi "hexchat-plugin.h hexchat_list_free" hexchat_list_free :: Plugin -> Ptr HexChat_List -> IO ()
foreign import capi "hexchat-plugin.h hexchat_hook_command" hexchat_hook_command :: Plugin -> CString -> CInt -> FunPtr (Ptr CString -> Ptr CString -> StablePtr a -> IO CInt) -> CString -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_hook_print" hexchat_hook_print :: Plugin -> CString -> CInt -> FunPtr (Ptr CString -> StablePtr a -> IO CInt) -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_hook_print_attrs" hexchat_hook_print_attrs :: Plugin -> CString -> CInt -> FunPtr (Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr a -> IO CInt) -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_hook_server" hexchat_hook_server :: Plugin -> CString -> CInt -> FunPtr (Ptr CString -> Ptr CString -> StablePtr a -> IO CInt) -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_hook_server_attrs" hexchat_hook_server_attrs :: Plugin -> CString -> CInt -> FunPtr (Ptr CString -> Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr a -> IO CInt) -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_hook_timer" hexchat_hook_timer :: Plugin -> CInt -> FunPtr (StablePtr a -> IO CInt) -> StablePtr a -> IO Hook
foreign import capi "hexchat-plugin.h hexchat_unhook" hexchat_unhook :: Plugin -> Hook -> IO (StablePtr a)
foreign import capi "hexchat-plugin.h hexchat_find_context" hexchat_find_context :: Plugin -> CString -> CString -> IO Context
foreign import capi "hexchat-plugin.h hexchat_get_context" hexchat_get_context :: Plugin -> IO Context
foreign import capi "hexchat-plugin.h hexchat_set_context" hexchat_set_context :: Plugin -> Context -> IO Bool
foreign import capi "hexchat-plugin.h hexchat_plugingui_add" hexchat_plugingui_add :: Plugin -> CString -> CString -> CString -> CString -> CString -> IO Plugin
foreign import capi "hexchat-plugin.h hexchat_plugingui_remove" hexchat_plugingui_remove :: Plugin -> Plugin -> IO ()
foreign import ccall "&call_haskell_command" ptr_call_haskell_command :: FunPtr (Ptr CString -> Ptr CString -> StablePtr ([String] -> [String] -> IO Eat) -> IO CInt)
foreign export ccall call_haskell_command :: Ptr CString -> Ptr CString -> StablePtr ([String] -> [String] -> IO Eat) -> IO CInt
call_haskell_command pw pwe sf = reportException (return eat_NONE) $ do
w <- peekStringArray pw 1 32
we <- peekStringArray pwe 1 32
f <- deRefStablePtr sf
fromEat <$> f w we
foreign import ccall "&call_haskell_print" ptr_call_haskell_print :: FunPtr (Ptr CString -> StablePtr ([String] -> IO Eat) -> IO CInt)
foreign export ccall call_haskell_print :: Ptr CString -> StablePtr ([String] -> IO Eat) -> IO CInt
call_haskell_print pw sf = reportException (return eat_NONE) $ do
ws <- peekStringArray pw 0 4
f <- deRefStablePtr sf
fromEat <$> f ws
foreign import ccall "&call_haskell_print_attrs" ptr_call_haskell_print_attrs :: FunPtr (Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr ([String] -> EventAttrs -> IO Eat) -> IO CInt)
foreign export ccall call_haskell_print_attrs :: Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr ([String] -> EventAttrs -> IO Eat) -> IO CInt
call_haskell_print_attrs pw pa sf = reportException (return eat_NONE) $ do
ws <- peekStringArray pw 0 4
attrs <- toAttrs pa
f <- deRefStablePtr sf
fromEat <$> f ws attrs
foreign import ccall "&call_haskell_server" ptr_call_haskell_server :: FunPtr (Ptr CString -> Ptr CString -> StablePtr ([String] -> [String] -> IO Eat) -> IO CInt)
foreign export ccall call_haskell_server :: Ptr CString -> Ptr CString -> StablePtr ([String] -> [String] -> IO Eat) -> IO CInt
call_haskell_server pw pwe sf = reportException (return eat_NONE) $ do
w <- peekStringArray pw 1 32
we <- peekStringArray pwe 1 32
f <- deRefStablePtr sf
fromEat <$> f w we
foreign import ccall "&call_haskell_server_attrs" ptr_call_haskell_server_attrs :: FunPtr (Ptr CString -> Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr ([String] -> [String] -> EventAttrs -> IO Eat) -> IO CInt)
foreign export ccall call_haskell_server_attrs :: Ptr CString -> Ptr CString -> Ptr HexChat_EventAttrs -> StablePtr ([String] -> [String] -> EventAttrs -> IO Eat) -> IO CInt
call_haskell_server_attrs pw pwe pa sf = reportException (return eat_NONE) $ do
w <- peekStringArray pw 1 32
we <- peekStringArray pwe 1 32
attrs <- toAttrs pa
f <- deRefStablePtr sf
fromEat <$> f w we attrs
foreign import capi "&hexchat_event_attrs_free" ptr_finalize_attrs :: FunPtr (Plugin -> Ptr HexChat_EventAttrs -> IO ())
foreign import capi "&hexchat_list_free" ptr_finalize_list :: FunPtr (Plugin -> Ptr HexChat_List -> IO ())
data Eat = EatNone
| EatHexChat
| EatPlugin
| EatAll
deriving (Show, Read, Eq)
fromEat :: Eat -> CInt
fromEat EatNone = eat_NONE
fromEat EatHexChat = eat_HEXCHAT
fromEat EatPlugin = eat_PLUGIN
fromEat EatAll = eat_ALL
data EventAttrs = EventAttrs { server_time_utc :: CTime } deriving (Show, Read, Eq)
fromAttrs :: Plugin -> EventAttrs -> IO (ForeignPtr HexChat_EventAttrs)
fromAttrs plugin attrs = do
ptr <- hexchat_event_attrs_create plugin
poke (castPtr ptr) (server_time_utc attrs)
newForeignPtrEnv (coerce ptr_finalize_attrs) (coerce plugin) ptr
withAttrs :: Plugin -> EventAttrs -> (Ptr HexChat_EventAttrs -> IO a) -> IO a
withAttrs plugin attrs f = do
fp <- fromAttrs plugin attrs
ret <- withForeignPtr fp f
finalizeForeignPtr fp
return ret
toAttrs :: Ptr HexChat_EventAttrs -> IO EventAttrs
toAttrs ptr = EventAttrs <$> peek (castPtr ptr)
peekStringArray :: Ptr CString -> Int -> Int -> IO [String]
peekStringArray ps i j | i >= j = return []
peekStringArray ps i j = do
p <- peekElemOff ps i
if p == nullPtr then return []
else do
s <- peekCString p
if null s then return []
else (s :) <$> peekStringArray ps (i + 1) j
with2CString :: String -> String -> (CString -> CString -> IO a) -> IO a
with2CString a b f = withCString a $ \a -> withCString b $ \b -> f a b
with3CString :: String -> String -> String -> (CString -> CString -> CString -> IO a) -> IO a
with3CString a b c f = withCString a $ \a -> withCString b $ \b -> withCString c $ \c -> f a b c
with4CString :: String -> String -> String -> String -> (CString -> CString -> CString -> CString -> IO a) -> IO a
with4CString a b c d f = withCString a $ \a -> withCString b $ \b -> withCString c $ \c -> withCString d $ \d -> f a b c d
with5CString :: String -> String -> String -> String -> String -> (CString -> CString -> CString -> CString -> CString -> IO a) -> IO a
with5CString a b c d e f = withCString a $ \a -> withCString b $ \b -> withCString c $ \c -> withCString d $ \d -> withCString e $ \e -> f a b c d e
reportException :: IO a -> IO a -> IO a
reportException def f = catch f $ \e -> do
plugin <- getPlugin
print plugin $ show (e :: SomeException)
def
command :: Plugin -> String -> IO ()
command plugin str = withCString str $ hexchat_command plugin
print :: Plugin -> String -> IO ()
print plugin str = withCString str $ hexchat_print plugin
emitPrint :: Plugin -> String -> [String] -> IO Bool
emitPrint plugin event (v1:v2:v3:v4:_) = with5CString event v1 v2 v3 v4 $ \event v1 v2 v3 v4 -> hexchat_emit_print plugin event v1 v2 v3 v4 nullPtr
emitPrint plugin event [v1, v2, v3] = with4CString event v1 v2 v3 $ \event v1 v2 v3 -> hexchat_emit_print plugin event v1 v2 v3 nullPtr nullPtr
emitPrint plugin event [v1, v2] = with3CString event v1 v2 $ \event v1 v2 -> hexchat_emit_print plugin event v1 v2 nullPtr nullPtr nullPtr
emitPrint plugin event [v1] = with2CString event v1 $ \event v1 -> hexchat_emit_print plugin event v1 nullPtr nullPtr nullPtr nullPtr
emitPrint plugin event [] = withCString event $ \event -> hexchat_emit_print plugin event nullPtr nullPtr nullPtr nullPtr nullPtr
emitPrintAttrs :: Plugin -> EventAttrs -> String -> [String] -> IO Bool
emitPrintAttrs plugin attrs event (v1:v2:v3:v4:_) = withAttrs plugin attrs $ \attrs -> with5CString event v1 v2 v3 v4 $ \event v1 v2 v3 v4 -> hexchat_emit_print_attrs plugin attrs event v1 v2 v3 v4 nullPtr
emitPrintAttrs plugin attrs event [v1, v2, v3] = withAttrs plugin attrs $ \attrs -> with4CString event v1 v2 v3 $ \event v1 v2 v3 -> hexchat_emit_print_attrs plugin attrs event v1 v2 v3 nullPtr nullPtr
emitPrintAttrs plugin attrs event [v1, v2] = withAttrs plugin attrs $ \attrs -> with3CString event v1 v2 $ \event v1 v2 -> hexchat_emit_print_attrs plugin attrs event v1 v2 nullPtr nullPtr nullPtr
emitPrintAttrs plugin attrs event [v1] = withAttrs plugin attrs $ \attrs -> with2CString event v1 $ \event v1 -> hexchat_emit_print_attrs plugin attrs event v1 nullPtr nullPtr nullPtr nullPtr
emitPrintAttrs plugin attrs event [] = withAttrs plugin attrs $ \attrs -> withCString event $ \event -> hexchat_emit_print_attrs plugin attrs event nullPtr nullPtr nullPtr nullPtr nullPtr
sendModes :: Plugin -> [String] -> Int -> Char -> Char -> IO ()
sendModes plugin targets modes sign mode = let len = length targets
in allocaBytes (sizeOf (undefined :: CString) * length targets) $ \arr -> do
bracket (mapM newCString targets) (mapM free) $ \strs -> do
sequence_ $ zipWith (pokeElemOff arr) [0..] strs
hexchat_send_modes plugin arr (fromIntegral len) (fromIntegral modes) (castCharToCChar sign) (castCharToCChar mode)
nickCmp :: Plugin -> String -> String -> IO Ordering
nickCmp plugin s1 s2 = with2CString s1 s2 $ \s1 s2 -> do
ret <- hexchat_nickcmp plugin s1 s2
return $ if ret > 0 then GT else if ret < 0 then LT else EQ
strip :: Plugin -> Bool -> Bool -> String -> IO String
strip plugin sc sf str = withCString str $ \str -> do
res <- hexchat_strip plugin str (-1) flags
r <- peekCString res
hexchat_free plugin res
return r
where flags = (if sc then 1 else 0) + (if sf then 2 else 0)
getInfo :: Plugin -> String -> IO (Maybe String)
getInfo plugin key
| key `elem` ["gtkwin_ptr", "win_ptr"] = return Nothing
| otherwise = withCString key $ \key -> do
ptr <- hexchat_get_info plugin key
if ptr == nullPtr then return Nothing
else Just <$> peekCString ptr
getPrefs :: Plugin -> String -> (String -> IO a) -> (Int -> IO a) -> (Bool -> IO a) -> IO (Maybe a)
getPrefs plugin key cstr cint cbool = withCString key $ \key -> alloca $ \ps -> alloca $ \pi -> do
ret <- hexchat_get_prefs plugin key ps pi
case ret of
0 -> return Nothing
1 -> Just <$> (peek ps >>= peekCString >>= cstr)
2 -> Just <$> (peek pi >>= cint . fromIntegral)
3 -> Just <$> (peek pi >>= cbool . (== 0))
listGet :: Plugin -> String -> IO (Maybe List)
listGet plugin key = withCString key $ \key -> do
ptr <- hexchat_list_get plugin key
if coerce ptr == nullPtr then return Nothing
else do
u <- newIORef False
Just <$> List u <$> newForeignPtrEnv (coerce ptr_finalize_list) (coerce plugin) ptr
listFields :: Plugin -> String -> IO [String]
listFields plugin key = withCString key $ \key -> do
ret <- hexchat_list_fields plugin key
if ret == nullPtr then return []
else walkList ret 0
where walkList ptr n = do
str <- peekElemOff ptr n
if str == nullPtr then return []
else (:) <$> peekCString str <*> walkList ptr (n + 1)
listNext :: Plugin -> List -> IO Bool
listNext plugin (List u ptr) = do
ret <- withForeignPtr ptr $ hexchat_list_next plugin
writeIORef u ret
return ret
listStr :: Plugin -> List -> String -> IO String
listStr _ _ "context" = error "Cannot listStr context"
listStr plugin (List u ptr) key = do
b <- readIORef u
unless b $ error "Attempted to use uninitialized List"
withCString key $ \key -> withForeignPtr ptr $ \ptr -> do
str <- hexchat_list_str plugin ptr key
if str == nullPtr then putStrLn "null" >> return ""
else peekCString str
listInt :: Plugin -> List -> String -> IO Int
listInt plugin (List u ptr) key = do
b <- readIORef u
unless b $ error "Attempted to use uninitialized List"
withCString key $ \key -> withForeignPtr ptr $ \ptr -> do
fromIntegral <$> hexchat_list_int plugin ptr key
listTime :: Plugin -> List -> String -> IO CTime
listTime plugin (List u ptr) key = do
b <- readIORef u
unless b $ error "Attempted to use uninitialized List"
withCString key $ \key -> withForeignPtr ptr $ \ptr -> do
hexchat_list_time plugin ptr key
hookCommand :: Plugin -> String -> CInt -> String -> ([String] -> [String] -> IO Eat) -> IO Hook
hookCommand plugin cmd pri desc f = do
sf <- newStablePtr f
hook <- with2CString cmd desc $ \cmd desc -> hexchat_hook_command plugin cmd pri ptr_call_haskell_command desc sf
return hook
hookPrint :: Plugin -> String -> CInt -> ([String] -> IO Eat) -> IO Hook
hookPrint plugin cmd pri f = do
sf <- newStablePtr f
hook <- withCString cmd $ \cmd -> hexchat_hook_print plugin cmd pri ptr_call_haskell_print sf
return hook
hookPrintAttrs :: Plugin -> String -> CInt -> ([String] -> EventAttrs -> IO Eat) -> IO Hook
hookPrintAttrs plugin cmd pri f = do
sf <- newStablePtr f
hook <- withCString cmd $ \cmd -> hexchat_hook_print_attrs plugin cmd pri ptr_call_haskell_print_attrs sf
return hook
hookServer :: Plugin -> String -> CInt -> ([String] -> [String] -> IO Eat) -> IO Hook
hookServer plugin cmd pri f = do
sf <- newStablePtr f
hook <- withCString cmd $ \cmd -> hexchat_hook_server plugin cmd pri ptr_call_haskell_server sf
return hook
hookServerAttrs :: Plugin -> String -> CInt -> ([String] -> [String] -> EventAttrs -> IO Eat) -> IO Hook
hookServerAttrs plugin cmd pri f = do
sf <- newStablePtr f
hook <- withCString cmd $ \cmd -> hexchat_hook_server_attrs plugin cmd pri ptr_call_haskell_server_attrs sf
return hook
unhook :: Plugin -> Hook -> IO ()
unhook plugin hook = do
sf <- hexchat_unhook plugin hook
freeStablePtr sf
findContext :: Plugin -> Maybe String -> Maybe String -> IO (Maybe Context)
findContext plugin server channel = do
ptr <- case (server, channel) of
(Just server, Just channel) -> with2CString server channel $ \server channel -> hexchat_find_context plugin server channel
(Nothing, Just channel) -> withCString channel $ \channel -> hexchat_find_context plugin nullPtr channel
(Just server, Nothing) -> withCString server $ \server -> hexchat_find_context plugin server nullPtr
if coerce ptr == nullPtr then return Nothing
else return (Just ptr)
getContext :: Plugin -> IO Context
getContext plugin = hexchat_get_context plugin
setContext :: Plugin -> Context -> IO Bool
setContext plugin context = hexchat_set_context plugin context
pluginguiAdd :: Plugin -> String -> String -> String -> String -> IO Plugin
pluginguiAdd plugin file name desc ver = with4CString file name desc ver $ \file name desc ver -> hexchat_plugingui_add plugin file name desc ver nullPtr
pluginguiRemove :: Plugin -> Plugin -> IO ()
pluginguiRemove = hexchat_plugingui_remove
type Plugin_Init = Plugin -> Ptr CString -> Ptr CString -> Ptr CString -> CString -> IO CInt
type Plugin_Deinit = Plugin -> IO CInt
data StaticData = StaticData
{
s_plugin :: IORef Plugin,
s_handle :: IORef (IORef Plugin),
s_hooks :: IORef (IORef [(Plugin, Hook)])
}
lPlugin = s_plugin staticData
lHandle = s_handle staticData
lHooks = s_hooks staticData
{-# NOINLINE staticData #-}
staticData = unsafePerformIO $ StaticData
<$> (newIORef $ error "unlinked plugin in StaticData")
<*> (newIORef $ error "unlinked handle in StaticData")
<*> (newIORef $ error "unlinked hooks in StaticData")
getPlugin :: IO Plugin
getPlugin = readIORef lPlugin
getHandle :: IO Plugin
getHandle = readIORef lHandle >>= readIORef
withHandle :: Plugin -> IO a -> IO a
withHandle handle f = bracket (swap handle) swap (const f)
where swap handle = do
loc <- readIORef lHandle
atomicModifyIORef loc (\old -> (handle, old))
initStaticData :: Plugin -> IO ()
initStaticData plugin = do
writeIORef lPlugin plugin
writeIORef lHandle =<< newIORef plugin
writeIORef lHooks =<< newIORef []
joinStaticData :: StaticData -> IO ()
joinStaticData s = do
readIORef lPlugin >>= writeIORef (s_plugin s)
readIORef lHandle >>= writeIORef (s_handle s)
readIORef lHooks >>= writeIORef (s_hooks s)
unhookHandle :: Plugin -> IO ()
unhookHandle handle = do
m <- readIORef lHooks >>= readIORef
plugin <- getPlugin
traverse (unhook plugin) $ map snd $ filter ((== handle) . fst) m
readIORef lHooks >>= flip modifyIORef (filter ((/= handle) . fst))