module Network.IRC.XChat.Plugin (
PluginDescriptor (..)
, XchatPlugin
, XChatPlugin
, xChatPluginInit
, xChatGetChanList
, ChanFlgs (..)
, ChanType (..)
, Chan (..)
, xChatGetDccList
, DccStatus (..)
, DccType (..)
, Dcc (..)
, xChatGetIgnList
, IgnFlgs (..)
, Ign (..)
, xChatGetNotifyList
, Notify (..)
, xChatGetUserList
, User (..)
, XChatHook
, Eating (..)
, Hook
, PriorityC (..)
, PriorityA
, abstractPriority
, concretePriority
, Flags (..)
, xChatHookCommand
, xChatHookServer
, xChatHookPrint
, xChatHookTimer
, xChatHookFd
, xChatUnhook
, XChatContext
, xChatSetContext
, xChatFindContext
, xChatGetContext
, xChatPrint
, xChatCommand
, xChatNickcmp
, SettingResult (..)
, xChatGetPrefs
, xChatGetInfo
, xChatEmitPrint
, xChatSendModes
, StripRules (..)
, xChatStrip
, xChatPluginguiAdd
, xChatPluginguiRemove
, xChatGettext
) where
import Data.List (reverse)
import Foreign (peek, poke, shiftL, shiftR, (.|.), (.&.), testBit,
Int32, Int64, Ptr, FunPtr, Storable,
advancePtr, malloc, free, nullPtr, mallocArray)
import Foreign.C.Types (CInt (..), CChar (..), CTime (..))
import Foreign.C.String (CString (..), newCString, peekCString)
import System.Posix.Types (Fd (..))
import Control.Monad (unless)
import Data.Foldable (foldlM)
import Data.IORef (IORef (..), readIORef, writeIORef, newIORef)
cIntOfBools :: [a -> Bool] -> a -> CInt
cIntOfBools l a =
let step i f = (shiftL (i :: Int32) 1) .|. (if f a then 1 else 0)
in
fromIntegral $! foldl step 0 (reverse l)
data PluginDescriptor = PluginDescriptor { pluginName :: String
, pluginDescription :: String
, pluginVersion :: String
}
data SettingResult = SetFailure
| SetString String
| SetBool Bool
| SetInt Int32
data XchatList = XchatList
data XchatContext = XchatContext
type XchatListHandle = Ptr XchatList
type XchatContextHandle = Ptr XchatContext
newtype XChatContext = XCC XchatContextHandle
getArgs :: Ptr CString -> IO [String]
getArgs p =
let getAllArgs 0 acc _ = return $! reverse acc
getAllArgs n acc p = peek p >>= peekCString >>= \ s ->
if s == ""
then return $! reverse acc
else let m = n 1
q = advancePtr p 1
in
(seq m . seq q $
getAllArgs m (s : acc) q)
in
getAllArgs 31 [] (advancePtr p 1)
putArgs :: [String] -> IO (Ptr CString, IO ())
putArgs l =
let step (ptr, freer) str = newCString str >>= \ p ->
poke ptr p >>
return (advancePtr ptr 1, free p >> freer)
in
mallocArray (length l) >>= \ arr ->
foldlM step (arr, return ()) l >>= \ res ->
case res of
(_, freer) -> return (arr, freer >> free arr)
getOptString :: Maybe String -> IO CString
getOptString Nothing = return nullPtr
getOptString (Just s) = newCString s
freeOptString :: CString -> IO ()
freeOptString s = unless (s == nullPtr) $ free s
sideEffect :: IORef a -> (a -> IO (b, a)) -> IO b
sideEffect ptra trans = readIORef ptra >>= trans >>= \ p ->
writeIORef ptra (snd p) >> return (fst p)
data XchatPlugin a = XchatPlugin
type XchatPluginHandle a = Ptr (XchatPlugin a)
newtype XChatPlugin a = XCP (IORef a, XchatPluginHandle a)
xChatPluginInit :: Ptr (XchatPlugin a) -> a -> IO (XChatPlugin a)
xChatPluginInit ph pa = newIORef pa >>= \ ra -> return $ XCP (ra, ph)
data XchatHook a = XchatHook
type XchatHookHandle a = Ptr (XchatHook a)
newtype XChatHook a b c = XCH (XchatHookHandle a)
data Eating = Eating { eatXChat :: Bool
, eatPlugin :: Bool
}
retHook :: IORef a -> (a -> IO (Eating, a)) -> IO CInt
retHook pa cb = sideEffect pa cb >>= \ i ->
return (cIntOfBools [eatXChat, eatPlugin] i)
type Hook a b c d = XChatPlugin a -> (d -> a -> IO (Eating, a)) ->
(a -> IO (b, a)) -> IO (b, XChatHook a b c)
hook :: (Ptr () -> IO (XchatHookHandle a)) -> IORef a -> (a -> IO (b, a)) ->
IO (b, XChatHook a b c)
hook ioXCHH refa init =
ioXCHH nullPtr >>= \ r -> sideEffect refa init >>= \ b -> return (b, XCH r)
data PriorityC = Highest
| High
| Norm
| Low
| Lowest
| Custom Int32
newtype PriorityA = P Int32 deriving (Eq, Ord)
abstractPriority :: PriorityC -> PriorityA
abstractPriority Highest = P 127
abstractPriority High = P 64
abstractPriority Norm = P 0
abstractPriority Low = P (64)
abstractPriority Lowest = P (128)
abstractPriority (Custom i)
| i < 128 = P (128)
| i > 127 = P 127
| otherwise = P i
concretePriority :: PriorityA -> PriorityC
concretePriority (P i)
| i < 128 = Lowest
| i > 127 = Highest
| i == 64 = Low
| i == 0 = Norm
| i == 64 = High
| otherwise = Custom i
data Flags = Flags { fgRead :: Bool
, fgWrite :: Bool
, fgExn :: Bool
, fgNsock :: Bool
}
data StripRules = StripRules { noColor :: Bool
, noAttribute :: Bool
}
cIntOfFlag :: Flags -> CInt
cIntOfFlag = cIntOfBools [fgRead, fgWrite, fgExn, fgNsock]
flagOfCInt :: CInt -> Flags
flagOfCInt c =
Flags { fgRead = testBit c 0
, fgWrite = testBit c 1
, fgExn = testBit c 2
, fgNsock = testBit c 3
}
type Cb a = a -> IO (FunPtr a)
type Cb1 = Ptr CString -> Ptr CString -> Ptr () -> IO CInt
foreign import ccall "wrapper" wrap1 :: Cb Cb1
type Cb2 = Ptr CString -> Ptr () -> IO CInt
foreign import ccall "wrapper" wrap2 :: Cb Cb2
type Cb3 = Ptr () -> IO CInt
foreign import ccall "wrapper" wrap3 :: Cb Cb3
type Cb4 = CInt -> CInt -> Ptr () -> IO CInt
foreign import ccall "wrapper" wrap4 :: Cb Cb4
foreign import ccall "xchat-plugin-hack.h xchat_hook_command"
xChatHookCommandFFI
:: XchatPluginHandle a -> CString -> CInt -> FunPtr Cb1 -> CString ->
Ptr () -> IO (XchatHookHandle a)
xChatHookCommand
:: String -> PriorityA -> Maybe String -> Hook a b c String
xChatHookCommand com (P pri) help (XCP (pa, ph)) cb init =
let w _ s _ = peek (advancePtr s 1) >>= peekCString >>= retHook pa . cb
prio = fromIntegral pri
in
newCString com >>= \ com ->
getOptString help >>= \ help ->
wrap1 w >>= \ cb ->
hook (xChatHookCommandFFI ph com prio cb help) pa init >>= \ res ->
freeOptString help >>
free com >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_hook_server"
xChatHookServerFFI
:: XchatPluginHandle a -> CString -> CInt -> FunPtr Cb1 ->
Ptr () -> IO (XchatHookHandle a)
xChatHookServer :: String -> PriorityA -> Hook a b c String
xChatHookServer ev (P pri) (XCP (pa, ph)) cb init =
let w _ s _ = peek (advancePtr s 1) >>= peekCString >>= retHook pa . cb
prio = fromIntegral pri
in
newCString ev >>= \ ev ->
wrap1 w >>= \ cb ->
hook (xChatHookServerFFI ph ev prio cb) pa init >>= \ res ->
free ev >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_hook_print"
xChatHookPrintFFI
:: XchatPluginHandle a -> CString -> CInt -> FunPtr Cb2 -> Ptr () ->
IO (XchatHookHandle a)
xChatHookPrint :: String -> PriorityA -> Hook a b c [String]
xChatHookPrint ev (P pri) (XCP (pa, ph)) cb init =
let prio = fromIntegral pri in
newCString ev >>= \ ev ->
wrap2 (\ s _ -> getArgs s >>= \ l -> retHook pa (cb l)) >>= \ cb ->
hook (xChatHookPrintFFI ph ev prio cb) pa init >>= \ res ->
free ev >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_hook_timer"
xChatHookTimerFFI
:: XchatPluginHandle a -> CInt -> FunPtr Cb3 -> Ptr () ->
IO (XchatHookHandle a)
xChatHookTimer
:: Int32 -> Hook a b c ()
xChatHookTimer to (XCP (pa, ph)) cb init =
let tmo = fromIntegral to in
wrap3 (\ _ -> retHook pa (cb ())) >>= \ cb ->
hook (xChatHookTimerFFI ph tmo cb) pa init
foreign import ccall "xchat-plugin-hack.h xchat_hook_fd"
xChatHookFdFFI
:: XchatPluginHandle a -> CInt -> CInt -> FunPtr Cb4 -> Ptr () ->
IO (XchatHookHandle a)
xChatHookFd :: Fd -> Flags -> Hook a b c (Fd, Flags)
xChatHookFd (Fd fd) f (XCP (pa, ph)) cb init =
wrap4 (\ fd f _ -> retHook pa (cb (Fd fd, flagOfCInt f))) >>= \ cb ->
hook (xChatHookFdFFI ph fd (cIntOfFlag f) cb) pa init
foreign import ccall "xchat-plugin-hack.h xchat_unhook"
xChatUnhookFFI
:: XchatPluginHandle a -> XchatHookHandle a -> IO (Ptr a)
xChatUnhook
:: XChatPlugin a -> XChatHook a b c -> (a -> IO (c, a)) -> IO c
xChatUnhook (XCP (pa, ph)) (XCH ha) deinit =
xChatUnhookFFI ph ha >> sideEffect pa deinit
foreign import ccall "xchat-plugin-hack.h xchat_print"
xChatPrintFFI :: XchatPluginHandle a -> CString -> IO ()
xChatPrint :: XChatPlugin a -> String -> IO ()
xChatPrint (XCP (_, ph)) s =
newCString s >>= \ p ->
xChatPrintFFI ph p >>
free p
foreign import ccall "xchat-plugin-hack.h xchat_command"
xChatCommandFFI :: XchatPluginHandle a -> CString -> IO ()
xChatCommand :: XChatPlugin a -> String -> IO ()
xChatCommand (XCP (_, ph)) s =
newCString s >>= \ s ->
xChatCommandFFI ph s >>
free s
foreign import ccall "xchat-plugin-hack.h xchat_set_context"
xChatSetContextFFI
:: XchatPluginHandle a -> XchatContextHandle -> IO CInt
xChatSetContext :: XChatPlugin a -> XChatContext -> IO Bool
xChatSetContext (XCP (_, ph)) (XCC ctx) =
xChatSetContextFFI ph ctx >>= \ i ->
return (i == 1)
foreign import ccall "xchat-plugin-hack.h xchat_find_context"
xChatFindContextFFI
:: XchatPluginHandle a -> CString -> CString -> IO XchatContextHandle
xChatFindContext :: XChatPlugin a -> Maybe String -> Maybe String ->
IO XChatContext
xChatFindContext (XCP (_, ph)) serv chan =
getOptString serv >>= \ t1 ->
getOptString chan >>= \ t2 ->
fmap XCC $ xChatFindContextFFI ph t1 t2 >>= \ res ->
freeOptString t1 >>
freeOptString t2 >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_get_context"
xChatGetContextFFI
:: XchatPluginHandle a -> IO XchatContextHandle
xChatGetContext :: XChatPlugin a -> IO XChatContext
xChatGetContext (XCP (_, ph)) =
fmap XCC $ xChatGetContextFFI ph
foreign import ccall "xchat-plugin-hack.h xchat_nickcmp"
xChatNickcmpFFI :: XchatPluginHandle a -> CString -> CString -> IO CInt
xChatNickcmp :: XChatPlugin a -> String -> String -> IO Ordering
xChatNickcmp (XCP (_, ph)) s1 s2 =
newCString s1 >>= \ t1 ->
newCString s2 >>= \ t2 ->
xChatNickcmpFFI ph t1 t2 >>= \ i ->
free t1 >>
free t2 >>
return (if i < 0 then LT else if i > 0 then GT else EQ)
foreign import ccall "xchat-plugin-hack.h xchat_get_info"
xChatGetInfoFFI
:: XchatPluginHandle a -> CString -> IO CString
xChatGetInfo :: XChatPlugin a -> String -> IO (Maybe String)
xChatGetInfo (XCP (_, ph)) s =
newCString s >>= \ p ->
xChatGetInfoFFI ph p >>= \ c ->
free p >>
if c == nullPtr
then return Nothing
else fmap Just $ peekCString c
foreign import ccall "xchat-plugin-hack.h xchat_get_prefs"
xChatGetPrefsFFI
:: XchatPluginHandle a -> CString -> Ptr CString -> Ptr CInt -> IO CInt
xChatGetPrefs :: XChatPlugin a -> String -> IO SettingResult
xChatGetPrefs (XCP (_, ph)) s =
newCString s >>= \ c ->
malloc >>= \ sptr ->
malloc >>= \ iptr ->
xChatGetPrefsFFI ph c sptr iptr >>= \ i ->
(case i of 1 -> peek sptr >>= fmap SetString . peekCString
2 -> fmap (SetInt . fromIntegral) (peek iptr)
3 -> peek iptr >>= \ i -> return . SetBool $ (i /= 0)
otherwise -> return SetFailure) >>= \ res ->
free c >>
free sptr >>
free iptr >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_emit_print0"
xChatEmitPrintFFI0
:: XchatPluginHandle a -> CString ->
IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_emit_print1"
xChatEmitPrintFFI1
:: XchatPluginHandle a -> CString ->
CString -> IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_emit_print2"
xChatEmitPrintFFI2
:: XchatPluginHandle a -> CString ->
CString -> CString -> IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_emit_print3"
xChatEmitPrintFFI3
:: XchatPluginHandle a -> CString ->
CString -> CString -> CString -> IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_emit_print4"
xChatEmitPrintFFI4
:: XchatPluginHandle a -> CString ->
CString -> CString -> CString -> CString -> IO CInt
xChatEmitPrint :: XChatPlugin a -> String -> [String] -> IO Bool
xChatEmitPrint (XCP (_, ph)) ev l =
newCString ev >>= \ s ->
mapM newCString l >>= \ l ->
fmap (== 1) (case l of
[] -> xChatEmitPrintFFI0 ph s
[a0] -> xChatEmitPrintFFI1 ph s a0
[a0, a1] -> xChatEmitPrintFFI2 ph s a0 a1
[a0, a1, a2] -> xChatEmitPrintFFI3 ph s a0 a1 a2
a0 : a1 : a2 : a3 : _ -> xChatEmitPrintFFI4 ph s a0 a1 a2 a3
) >>= \ res ->
free s >>
mapM free l >>
return res
foreign import ccall "xchat-plugin-hack.h xchat_send_modes"
xChatSendModesFFI
:: XchatPluginHandle a -> Ptr CString -> CInt -> CInt -> CChar -> CChar ->
IO ()
xChatSendModes :: XChatPlugin a -> [String] -> Maybe Int32 -> Bool -> Char -> IO ()
xChatSendModes (XCP (_, ph)) l n b c =
let mpp = case n of { Nothing -> 0 ; Just i -> fromIntegral i } in
putArgs l >>= \ (arr, freer) ->
let len = fromIntegral $ length l in
let sign = toEnum $ fromEnum (if b then '+' else '-') in
xChatSendModesFFI ph arr len mpp sign
(toEnum $ fromEnum c) >>
freer
foreign import ccall "xchat-plugin-hack.h xchat_free"
xChatFreeFFI
:: XchatPluginHandle a -> CString -> IO ()
foreign import ccall "xchat-plugin-hack.h xchat_strip"
xChatStripFFI
:: XchatPluginHandle a -> CString -> CInt -> CInt -> IO CString
xChatStrip :: String -> StripRules -> IO String
xChatStrip s r =
newCString s >>= \ ps ->
xChatStripFFI nullPtr ps (fromIntegral $ length s)
(cIntOfBools [noColor, noAttribute] r) >>= \ cs ->
peekCString cs >>= \ s ->
xChatFreeFFI nullPtr cs >>
free ps >>
return s
foreign import ccall "xchat-plugin-hack.h xchat_plugingui_add"
xChatPluginguiAddFFI
:: XchatPluginHandle a -> CString -> CString -> CString -> CString ->
Ptr () -> IO (XchatPluginHandle a)
xChatPluginguiAdd :: XChatPlugin a -> String -> PluginDescriptor -> IO (XChatPlugin a)
xChatPluginguiAdd (XCP (a, ph)) flnm d =
newCString flnm >>= \ fn ->
newCString (pluginName d) >>= \ n ->
newCString (pluginDescription d) >>= \ ds ->
newCString (pluginVersion d) >>= \ v ->
xChatPluginguiAddFFI ph fn n ds v nullPtr >>= \ pph ->
free fn >>
free n >>
free ds >>
free v >>
return (XCP (a, pph))
foreign import ccall "xchat-plugin-hack.h xchat_plugingui_remove"
xChatPluginguiRemoveFFI
:: XchatPluginHandle a -> XchatPluginHandle b -> IO ()
xChatPluginguiRemove :: XChatPlugin a -> IO ()
xChatPluginguiRemove (XCP (_, ph)) = xChatPluginguiRemoveFFI nullPtr ph
foreign import ccall "xchat-plugin-hack.h xchat_gettext"
xChatGettextFFI
:: XchatPluginHandle a -> CString -> IO CString
xChatGettext :: String -> IO String
xChatGettext s =
newCString s >>= \ cs ->
xChatGettextFFI nullPtr cs >>= \ ds ->
peekCString ds >>= \ t ->
free ds >>
free cs >>
return t
data ChanFlgs = ChanFlgs { connected :: Bool
, connecting :: Bool
, away :: Bool
, logged :: Bool
, whox :: Bool
, idmsg :: Bool
, jPmsg :: Bool
, beep :: Bool
, blinkTray :: Bool
, blinkTask :: Bool
}
chanFlgsOfInt :: Int32 -> ChanFlgs
chanFlgsOfInt i =
ChanFlgs { connected = testBit i 0
, connecting = testBit i 1
, away = testBit i 2
, logged = testBit i 3
, whox = testBit i 4
, idmsg = testBit i 6
, jPmsg = testBit i 6
, beep = testBit i 8
, blinkTray = testBit i 9
, blinkTask = testBit i 10
}
data ChanType = ChanServer
| ChanChannel
| ChanDialog
chanTypeOfInt :: Int32 -> ChanType
chanTypeOfInt c = case c of
0 -> ChanServer
1 -> ChanChannel
_ -> ChanDialog
data Chan = Chan { cChannel :: String
, cChantypes :: String
, cContext :: XChatContext
, cFlags :: ChanFlgs
, cId :: Int32
, cLag :: Int32
, cMaxmodes :: Int32
, cNetwork :: String
, cNickprefixes :: String
, cNickmodes :: String
, cQueue :: Int32
, cServer :: String
, cType :: ChanType
, cUsers :: Int32
}
data DccStatus = DccQueued
| DccActive
| DccFailed
| DccDone
| DccConnecting
| DccAborted
dccStatusOfInt :: Int32 -> DccStatus
dccStatusOfInt c = case c of
0 -> DccQueued
1 -> DccActive
2 -> DccFailed
3 -> DccDone
4 -> DccConnecting
_ -> DccAborted
data DccType = DccSend
| DccReceive
| DccChatRecv
| DccChatSend
dccTypeOfInt :: Int32 -> DccType
dccTypeOfInt c = case c of
0 -> DccSend
1 -> DccReceive
2 -> DccChatRecv
_ -> DccChatSend
data Dcc = Dcc { dAddress32 :: Int32
, dCps :: Int32
, dDestfile :: String
, dFile :: String
, dNick :: String
, dPort :: Int32
, dPos :: Int32
, dResume :: Int32
, dSize :: Int64
, dStatus :: DccStatus
, dType :: DccType
}
data IgnFlgs = IgnFlgs { private :: Bool
, notice :: Bool
, channel :: Bool
, ctcp :: Bool
, invite :: Bool
, unIgnore :: Bool
, noSave :: Bool
, dcc :: Bool
}
ignFlgsOfInt :: Int32 -> IgnFlgs
ignFlgsOfInt i =
IgnFlgs { private = testBit i 0
, notice = testBit i 1
, channel = testBit i 2
, ctcp = testBit i 3
, invite = testBit i 4
, unIgnore = testBit i 5
, noSave = testBit i 6
, dcc = testBit i 7
}
data Ign = Ign { iMask :: String
, iFlags :: IgnFlgs
}
data Notify = Notify { nNetworks :: [String]
, nNick :: String
, nOnline :: Bool
, nOn :: Int32
, nOff :: Int32
, nSeen :: Int32
}
data User = User { uAway :: Bool
, uLasttalk :: Int32
, uNick :: String
, uHost :: Maybe String
, uPrefix :: String
, uRealname :: Maybe String
, uSelected :: Bool
}
foreign import ccall "xchat-plugin-hack.h xchat_list_get"
xChatListGetFFI
:: XchatPluginHandle a -> CString -> IO XchatListHandle
foreign import ccall "xchat-plugin-hack.h xchat_list_free"
xChatListFreeFFI
:: XchatPluginHandle a -> XchatListHandle -> IO ()
foreign import ccall "xchat-plugin-hack.h xchat_list_next"
xChatListNextFFI
:: XchatPluginHandle a -> XchatListHandle -> IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_list_str"
xChatListStrFFI
:: XchatPluginHandle a -> XchatListHandle -> CString -> IO CString
foreign import ccall "xchat-plugin-hack.h xchat_list_int"
xChatListIntFFI
:: XchatPluginHandle a -> XchatListHandle -> CString -> IO CInt
foreign import ccall "xchat-plugin-hack.h xchat_list_time"
xChatListTimeFFI
:: XchatPluginHandle a -> XchatListHandle -> CString -> IO CTime
foreign import ccall "xchat-plugin-hack.h xchat_list_context"
xChatListContextFFI
:: XchatPluginHandle a -> XchatListHandle -> CString -> IO XchatContextHandle
foreign import ccall "xchat-plugin-hack.h strListChan " strListChan :: CString
foreign import ccall "xchat-plugin-hack.h strListDcc " strListDcc :: CString
foreign import ccall "xchat-plugin-hack.h strListIgn " strListIgn :: CString
foreign import ccall "xchat-plugin-hack.h strListNotify " strListNotify :: CString
foreign import ccall "xchat-plugin-hack.h strListUser " strListUser :: CString
foreign import ccall "xchat-plugin-hack.h strAddress " strAddress :: CString
foreign import ccall "xchat-plugin-hack.h strCps " strCps :: CString
foreign import ccall "xchat-plugin-hack.h strDestfile " strDestfile :: CString
foreign import ccall "xchat-plugin-hack.h strFile " strFile :: CString
foreign import ccall "xchat-plugin-hack.h strNick " strNick :: CString
foreign import ccall "xchat-plugin-hack.h strPort " strPort :: CString
foreign import ccall "xchat-plugin-hack.h strPos " strPos :: CString
foreign import ccall "xchat-plugin-hack.h strResume " strResume :: CString
foreign import ccall "xchat-plugin-hack.h strSize " strSize :: CString
foreign import ccall "xchat-plugin-hack.h strSizehigh " strSizehigh :: CString
foreign import ccall "xchat-plugin-hack.h strStatus " strStatus :: CString
foreign import ccall "xchat-plugin-hack.h strChannel " strChannel :: CString
foreign import ccall "xchat-plugin-hack.h strChantypes " strChantypes :: CString
foreign import ccall "xchat-plugin-hack.h strContext " strContext :: CString
foreign import ccall "xchat-plugin-hack.h strFlags " strFlags :: CString
foreign import ccall "xchat-plugin-hack.h strId " strId :: CString
foreign import ccall "xchat-plugin-hack.h strLag " strLag :: CString
foreign import ccall "xchat-plugin-hack.h strMaxmodes " strMaxmodes :: CString
foreign import ccall "xchat-plugin-hack.h strNetwork " strNetwork :: CString
foreign import ccall "xchat-plugin-hack.h strNickprefixes" strNickprefixes :: CString
foreign import ccall "xchat-plugin-hack.h strNickmodes " strNickmodes :: CString
foreign import ccall "xchat-plugin-hack.h strQueue " strQueue :: CString
foreign import ccall "xchat-plugin-hack.h strServer " strServer :: CString
foreign import ccall "xchat-plugin-hack.h strType " strType :: CString
foreign import ccall "xchat-plugin-hack.h strUsers " strUsers :: CString
foreign import ccall "xchat-plugin-hack.h strMask " strMask :: CString
foreign import ccall "xchat-plugin-hack.h strAway " strAway :: CString
foreign import ccall "xchat-plugin-hack.h strLasttalk " strLasttalk :: CString
foreign import ccall "xchat-plugin-hack.h strHost " strHost :: CString
foreign import ccall "xchat-plugin-hack.h strPrefix " strPrefix :: CString
foreign import ccall "xchat-plugin-hack.h strRealname " strRealname :: CString
foreign import ccall "xchat-plugin-hack.h strSelected " strSelected :: CString
foreign import ccall "xchat-plugin-hack.h strNetworks " strNetworks :: CString
foreign import ccall "xchat-plugin-hack.h strOn " strOn :: CString
foreign import ccall "xchat-plugin-hack.h strOff " strOff :: CString
foreign import ccall "xchat-plugin-hack.h strSeen " strSeen :: CString
getString :: XchatPluginHandle a -> XchatListHandle -> CString -> IO String
getString h l s = xChatListStrFFI h l s >>= peekCString
getMString :: XchatPluginHandle a -> XchatListHandle -> CString ->
IO (Maybe String)
getMString h l s = xChatListStrFFI h l s >>= \ ms ->
if ms == nullPtr
then return Nothing
else fmap return $ peekCString ms
getInt :: XchatPluginHandle a -> XchatListHandle -> CString -> IO Int32
getInt h l s = xChatListIntFFI h l s >>= \ k -> return $ fromIntegral k
getTime :: XchatPluginHandle a -> XchatListHandle -> CString -> IO Int32
getTime h l s = xChatListTimeFFI h l s >>= \ (CTime k) -> return k
xChatGetNotifyList :: XChatPlugin a -> IO [Notify]
xChatGetNotifyList (XCP (_, ph)) =
xChatListGetFFI ph strListNotify >>= \ l ->
let getNotify = let gStr = getString ph l
gInt = getInt ph l
gMSt = getMString ph l
gTim = getTime ph l
splitOn a1 a2 [] = (reverse a1) : a2
splitOn a1 a2 (',' : l) = splitOn [] ((reverse a1) : a2) l
splitOn a1 a2 (a : l) = splitOn (a : a1) a2 l
net ns = case ns of
Nothing -> []
Just n -> splitOn [] [] n
in
gMSt strNetworks >>= \ networks ->
gStr strNick >>= \ nick ->
gInt strFlags >>= \ online ->
gTim strOn >>= \ on ->
gTim strOff >>= \ off ->
gTim strSeen >>= \ seen ->
return $ Notify { nNetworks = net networks
, nNick = nick
, nOnline = online /= 0
, nOn = on
, nOff = off
, nSeen = seen
}
getNotifies acc = xChatListNextFFI ph l >>= \ c ->
case fromIntegral c of
0 -> return acc
_ -> getNotify >>= \ not -> getNotifies (not : acc)
in
getNotifies [] >>= \ list ->
xChatListFreeFFI ph l >>
return list
xChatGetUserList :: XChatPlugin a -> IO [User]
xChatGetUserList (XCP (_, ph)) =
xChatListGetFFI ph strListUser >>= \ l ->
let getUser = let gStr = getString ph l
gInt = getInt ph l
gTim = getTime ph l
gMSt = getMString ph l
in
gInt strAway >>= \ away ->
gTim strLasttalk >>= \ last ->
gStr strNick >>= \ nick ->
gMSt strHost >>= \ host ->
gStr strPrefix >>= \ prefix ->
gMSt strRealname >>= \ realname ->
gInt strSelected >>= \ selected ->
return $ User { uAway = away /= 0
, uLasttalk = last
, uNick = nick
, uHost = host
, uPrefix = prefix
, uRealname = realname
, uSelected = selected /= 0
}
getUsers acc = xChatListNextFFI ph l >>= \ c ->
case fromIntegral c of
0 -> return acc
_ -> getUser >>= \ usr -> getUsers (usr : acc)
in
getUsers [] >>= \ list ->
xChatListFreeFFI ph l >>
return list
xChatGetIgnList :: XChatPlugin a -> IO [Ign]
xChatGetIgnList (XCP (_, ph)) =
xChatListGetFFI ph strListIgn >>= \ l ->
let getIgn = let gStr = getString ph l
gInt = getInt ph l
in
gStr strMask >>= \ mask ->
gInt strFlags >>= \ flags ->
return $ Ign { iMask = mask
, iFlags = ignFlgsOfInt flags
}
getIgns acc = xChatListNextFFI ph l >>= \ c ->
case fromIntegral c of
0 -> return acc
_ -> getIgn >>= \ ign -> getIgns (ign : acc)
in
getIgns [] >>= \ list ->
xChatListFreeFFI ph l >>
return list
xChatGetDccList :: XChatPlugin a -> IO [Dcc]
xChatGetDccList (XCP (_, ph)) =
xChatListGetFFI ph strListDcc >>= \ l ->
let getDcc = let gStr = getString ph l
gInt = getInt ph l
in
gInt strAddress >>= \ address ->
gInt strCps >>= \ cps ->
gStr strDestfile >>= \ destfile ->
gStr strFile >>= \ file ->
gStr strNick >>= \ nick ->
gInt strPort >>= \ port ->
gInt strPos >>= \ pos ->
gInt strResume >>= \ resume ->
gInt strSize >>= \ sizeL ->
gInt strSizehigh >>= \ sizeH ->
gInt strStatus >>= \ status ->
gInt strType >>= \ typ ->
let bsizeH :: Int64
bsizeH = shiftL (fromIntegral sizeH) 32
bsizeL :: Int64
bsizeL = (fromIntegral sizeL) .&. (shiftR 1 32 1)
bsize = bsizeH .|. bsizeL
in
return $ Dcc { dAddress32 = address
, dCps = cps
, dDestfile = destfile
, dFile = file
, dNick = nick
, dPort = port
, dPos = pos
, dResume = resume
, dSize = bsize
, dStatus = dccStatusOfInt status
, dType = dccTypeOfInt typ
}
getDccs acc = xChatListNextFFI ph l >>= \ c ->
case fromIntegral c of
0 -> return acc
_ -> getDcc >>= \ dcc -> getDccs (dcc : acc)
in
getDccs [] >>= \ list ->
xChatListFreeFFI ph l >>
return list
xChatGetChanList :: XChatPlugin a -> IO [Chan]
xChatGetChanList (XCP (_, ph)) =
xChatListGetFFI ph strListChan >>= \ l ->
let getChan = let gStr = getString ph l
gInt = getInt ph l
in
gStr strChannel >>= \ channel ->
gStr strChantypes >>= \ chantypes ->
(xChatListContextFFI ph l strContext)
>>= \ ctx ->
gInt strFlags >>= \ flags ->
gInt strId >>= \ id ->
gInt strLag >>= \ lag ->
gInt strMaxmodes >>= \ maxmodes ->
gStr strNetwork >>= \ network ->
gStr strNickprefixes >>= \ nickprefixes ->
gStr strNickmodes >>= \ nickmodes ->
gInt strQueue >>= \ queue ->
gStr strServer >>= \ server ->
gInt strType >>= \ typ ->
gInt strUsers >>= \ users ->
return $ Chan { cChannel = channel
, cChantypes = chantypes
, cContext = XCC ctx
, cFlags = chanFlgsOfInt flags
, cId = id
, cLag = lag
, cMaxmodes = maxmodes
, cNetwork = network
, cNickprefixes = nickprefixes
, cNickmodes = nickmodes
, cQueue = queue
, cServer = server
, cType = chanTypeOfInt typ
, cUsers = users
}
getChans acc = xChatListNextFFI ph l >>= \ c ->
case fromIntegral c of
0 -> return acc
_ -> getChan >>= \ chan -> getChans (chan : acc)
in
getChans [] >>= \ list ->
xChatListFreeFFI ph l >>
return list