{- Module      :  XChat.Plugin
   Copyright   :
   License     :  GNU/GPL

   Maintainer  :  sedrikov@gmail.com
   Stability   :  experimental
-}
{-# LANGUAGE ForeignFunctionInterface #-}

{-
TODO:

Check memory usage, ie.
newCstring should be freed and so on

Complete documentation
-}

module Network.IRC.XChat.Plugin ( -- $intro

                      -- * Versionning
                      XchatVersion (..)
                    , currentVersion
                    , numericVersion
                      -- * Functions
                    , PluginDescriptor (..)
                    , XchatPlugin
                    , XchatPluginHandle
                    , XChatPlugin (..)
                      -- ** The Lists
                      -- $lists

                      -- *** Channels
                    , xChatGetChanList
                    , ChanFlgs (..)
                    , ChanType (..)
                    , Chan (..)
                      -- *** DCC
                    , xChatGetDccList
                    , DccStatus (..)
                    , DccType (..)
                    , Dcc (..)
                      -- *** Ignore
                    , xChatGetIgnList
                    , IgnFlgs (..)
                    , Ign (..)
                      -- *** Notify
                    , xChatGetNotifyList
                    , Notify (..)
                      -- *** Users
                    , xChatGetUserList
                    , User (..)
                      -- ** The hooks system
                      -- $hooks

                      -- *** Types
                    , XChatHook
                    , Eating (..)
                    , Hook
                    , PriorityC (..)
                    , PriorityA
                    , abstractPriority
                    , concretePriority
                    , Flags (..)
                      -- *** Hooks
                    , xChatHookCommand
                    , xChatHookServer
                    , xChatHookPrint
                    , xChatHookTimer
                    , xChatHookFd
                      -- *** Removing hooks
                    , xChatUnhook
                      -- ** Contexts
                      -- $contexts
                    , XChatContext
                    , xChatSetContext
                    , xChatFindContext
                    , xChatGetContext
                      -- ** Some other commands
                    , xChatPrint
                    , xChatCommand
                    , xChatNickcmp
                    , SettingResult (..)
                    , xChatGetPrefs
                    , xChatGetInfo
                    , xChatEmitPrint
                    , xChatSendModes
                    , StripRules (..)
                    , xChatStrip
                      -- ** Undocumented
                    , 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)

{- $intro
   This is my first binding in Haskell (and in any other language btw),
   so I probably lack of good practice.

   I tried to do bindings for the XChat plugin system, but some
   functions were not documented (these are tagged [Undocumented]),
   those function are expect to have their signature changed once
   they become documented (and I understand what they truly are for).
   For these functions, I would gladly accept some enlightment of what
   they really do.

   For the other functions, I would also accept advice on how to improve
   the binding.

   There are also some lacking functions:

 - xChatPrintF   (special case of xChatPrint)

 - xChatCommandF (special case of xChatCommand)

 - xChatFree     (automatically called)

 - all functions on lists but the xChatGetList specialized in 5 versions

 To contact me: sed?rikov\@gma?il.com (remove the question marks)
 For more information, read the README.txt file
-}

-- | version numbering system
data XchatVersion = XchatVersion { major :: Int32
                                 , minor :: Int32
                                 , micro :: Int32
                                 } deriving Show
-- | the current version of XChat
currentVersion :: XchatVersion
currentVersion = XchatVersion { major = 1
                              , minor = 9
                              , micro = 11
                              }
-- | a function converting a version to an Int32
numericVersion :: XchatVersion -> Int32
numericVersion v = major v * 10000 +
                   minor v * 100 +
                   micro v
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)

-- | The plugin descriptor
data PluginDescriptor = PluginDescriptor { pluginName :: String
                                         , pluginDescription :: String
                                         , pluginVersion :: String
                                         }

-- | The result of a setting request
data SettingResult = SetFailure
                   | SetString String
                   | SetBool Bool
                   | SetInt Int32

data XchatList = XchatList
data XchatContext = XchatContext
type XchatListHandle = Ptr XchatList
type XchatContextHandle = Ptr XchatContext


-- | the type of contexts
newtype XChatContext = XCC XchatContextHandle

{- It seems that the nullPtr is never used and that
 - the list is just empty string terminated
 - there is also a limit of 31 entries (+ a reserved one)
 - Since the stacked calls are limited to 31, I am not sure
 - being tail-recursive is very usefull here.
 -}
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 :: Storable a => Ptr a -> (a -> IO (b, a)) -> IO b
sideEffect ptra trans = peek ptra >>= trans >>= \ p ->
                        poke ptra (snd p) >> return (fst p)

-- -----------------------------------------------------------------------------

data XchatPlugin a = XchatPlugin
type XchatPluginHandle a = Ptr (XchatPlugin a)
{- | The type of plugins; it is associated to a memory
     which can be used and modified by the hooked callbacks.

     All the following functions needs a @'XChatPlugin'@ as
     argument. In fact it is a handle which needs to be initialized
     by the @init@ function, and will be freed by an optional @deinit@
     function.
-}
newtype XChatPlugin a = XCP (Ptr a, XchatPluginHandle a)

{- $hooks
   All @'XChatHook'@s returned can be passed to @'xChatUnhook'@.
   This is not mandatory, as they are automatically unhooked
   at unloading time. All hooks return a @'Hook' a b c@ type.

   The hook system is not exactly the one used in the original
   @C@\/@C++@ library. In the original library, some memory was
   attached to each hook, but that meant that shared memory
   had to be done through pointers. Now all functions of
   the original library are given the same plugin memory pointer,
   and this memory is attached to the plugin itself,
   so all hooking functions are only given a @'XChatPlugin'@
   (which internally contains a memory) and
   its memory is not explicitly given anymore at hooking time.
-}

data XchatHook a = XchatHook
type XchatHookHandle a = Ptr (XchatHook a)
{- | The type of hooks; it has three type arguments.

    - The first is the type of the plugin memory

    - The second one is the type returned at hook creation,
      it can be used to restore the memory at unhooking time,
      or to print some debugging information.

    - The third one is the type returned at unhooking time,
      it can be used to display debugging information.

-}
newtype XChatHook a b c = XCH (XchatHookHandle a)

{- | The way callbacks are managed; a callback function can be eat an event,
     that is make the event unprocessable, either to XChat or
     to the other plgins.
-}
data Eating = Eating { eatXChat :: Bool
                     , eatPlugin :: Bool
                     }

-- a boilerplate function for the callbacks
retHook :: Storable a => Ptr a -> (a -> IO (Eating, a)) -> IO CInt
retHook pa cb = sideEffect pa cb >>= \ i ->
                return (cIntOfBools [eatXChat, eatPlugin] i)

{- | The returned type of all hooking functions;
     if /f/ is a @'Hook' /a/ /b/ /c/ /d/@ hooking function, then:

    @
      /f/ /ph/ /cb/ /init/
    @

    means that a new @'XChatHook' /a/ /b/ /c/@ hook
    using the callback @/cb/@ function is
    created for the @/ph/@ plugin; the hooking modifies
    the @/a/@ plugin memory according to @/init/@,
    and returns the @/b/@ returned by @/init/@ as well as the
    created hook.

   The callback function itself is a function which takes some
   @/d/@ data, the @/a/@ plugin memory at the moment when the
   callback function is called and returns how the event which
   triggered the callback call is eaten as well as the new
   @/a/@ plugin memory.
-}
type Hook a b c d = XChatPlugin a -> (d -> a -> IO (Eating, a)) ->
                    (a -> IO (b, a)) -> IO (b, XChatHook a b c)

-- a boilerplate function for hooks introduction
hook :: Storable a =>
         (Ptr a -> IO (XchatHookHandle a)) -> Ptr a -> (a -> IO (b, a)) ->
          IO (b, XChatHook a b c)
hook ioXCHH xCPHa init =
  ioXCHH xCPHa >>= \ r -> sideEffect xCPHa init >>= \ b -> return (b, XCH r)

-- | a concrete type to define the priority of a command
data PriorityC = Highest      -- ^ Highest priority (127)
               | High         -- ^ High priority (64)
               | Norm         -- ^ Normal priority (0)
               | Low          -- ^ Low priority (-64)
               | Lowest       -- ^ Lowest priority (-128)
               | Custom Int32 -- ^ Custom, is normalized when cast to
                              -- 'PriorityA'

-- | an abstract type to define the priority of a command
newtype PriorityA = P Int32 deriving (Eq, Ord)

-- | to get a (normalized) abstract priority from a concrete one
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

-- | to get a concrete priority from an abstract one
concretePriority :: PriorityA -> PriorityC
concretePriority (P i)
  | i <  -128 = Lowest
  | i >   127 = Highest
  | i ==  -64 = Low
  | i ==    0 = Norm
  | i ==   64 = High
  | otherwise = Custom i

-- | flags for file descriptors
data Flags = Flags { fgRead :: Bool
                   , fgWrite :: Bool
                   , fgExn :: Bool
                   , fgNsock :: Bool
                   }

-- | flags on how to strip rules
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
        }

-- a bundle of functions used for wrapping
type Cb a = a -> IO (FunPtr a)
type Cb1 a = Ptr CString -> Ptr CString -> Ptr a -> IO CInt
foreign import ccall "wrapper" wrap1
 :: Cb (Cb1 a)
type Cb2 a = Ptr CString -> Ptr a -> IO CInt
foreign import ccall "wrapper" wrap2
 :: Cb (Cb2 a)
type Cb3 a = Ptr a -> IO CInt
foreign import ccall "wrapper" wrap3
 :: Cb (Cb3 a)
type Cb4 a = CInt -> CInt -> Ptr a -> IO CInt
foreign import ccall "wrapper" wrap4
 :: Cb (Cb4 a)

-- -----------------------------------------------------------------------------

foreign import ccall "xchat-plugin-hack.h xchat_hook_command"
 xChatHookCommandFFI
 :: XchatPluginHandle a -> CString -> CInt -> FunPtr (Cb1 a) -> CString ->
     Ptr a -> IO (XchatHookHandle a)
{- |

@
'xChatHookCommand' /cmd/ /pri/ /help/
@

/Description:/

Hooking to the @\//cmd/@ input box command at priority @/pri/@ with an
optional @/help/@ message.

To capture text without a \'@\/@\' at the start (non-commands),
you may hook a special name of \"\" as in:

@
let eatAll           = 'Eating' { 'eatXChat' = 'True', 'eatPlugin' = 'True' }
    startWithYou s a = 'xChatPrint' p (\"you: \"'++'s) '>>' 'return' (eatAll, a)
in  'xChatHookCommand' \"\" 'Norm' 'Nothing' p startWithYou ()
@

which automatically adds \"@you: @\" at the beginning of each sentence you type
(and is undocumented as the help message argument is @'Nothing'@).

Commands hooked that begin with a period (\'.\') will be hidden in
@\/HELP@ and @\/HELP -l@.

/Arguments:/

 [cmd]  The command (without the forward slash) with some special
        treatment if it is the empty string or if it begins with a dot

 [pri]  Priority of the hook, you should probably use 'Norm'

 [help] Optionnal help message, displayed at @\/HELP /cmd/@ command

/Callback Function Main Argument:/

The callback function expects a string containing all the arguments passed
to the command.
-}
xChatHookCommand
 :: Storable a => String -> PriorityA -> Maybe String -> Hook a b c String
xChatHookCommand com (P pri) help (XCP (pa, ph)) cb init =
  let w _ s pa = 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 a) ->
     Ptr a -> IO (XchatHookHandle a)
{- |

/Description:/

@
'xChatHookServer' /ev/ /pri/
@

Hooking to the server event @/ev/@ at priority @/pri/@.

To capture all server events, use @\"RAW LINE\"@.

/Arguments:/

 [ev]   The server event to be captured

 [pri]  Priority of the hook, you should probably use 'Norm'

/Callback Function Main Argument:/

The callback function expects a string containing all the arguments of
the captured server event.
-}
xChatHookServer :: Storable a => String -> PriorityA -> Hook a b c String
xChatHookServer ev (P pri) (XCP (pa, ph)) cb init =
  let w _ s pa = 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 a) -> Ptr a ->
     IO (XchatHookHandle a)
{- |

/Description:/

@
'xChatHookPrint' /prev/ /pri/
@

Hooking to the print event @/prev/@ at priority @/pri/@.

Available events are those in \"Advanced > Text Events\" plus these ones:

 [@\"Open Context\"@] Called when a new 'XChatContext' is created.

 [@\"Close Context\"@] Called when a xchat_context pointer is closed.

 [@\"Focus Tab\"@] Called when a tab is brought to front.

 [@\"Focus Window\"@] Called a toplevel window is focused,
                      or the main tab-window is focused by the window manager.

 [@\"DCC Chat Text\"@] Called when some text from a DCC Chat arrives.
                       It provides these arguments for the callback function:
                       @[_, Address, Port, Nick, The Message]@

 [@\"Key Press\"@] Called when some keys are pressed in the input-box.
                   It provides these arguments for the callback function:
                   @[_, Key Value, State Bitfield (shift, capslock, alt),
                     String version of the key, Length of the string
                     (may be 0 for unprintable keys)]@

/Arguments:/

 [prev] The print event to be captured

 [pri]  Priority of the hook, you should probably use 'Norm'

/Callback Function Main Argument:/

The callback function expects a list of strings containing all the arguments of
the captured print event.
-}
xChatHookPrint
 :: Storable a => 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 pa -> 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 a) -> Ptr a ->
     IO (XchatHookHandle a)
{- |

/Description:/

@
'xChatHookTimeout' /timeout/
@

Hooking to call a function every @/timeout/@ milliseconds.

/Arguments:/

 [timeout] The time(ms) to wait before the next triggering of the callback.

/Callback Function Main Argument:/

The callback function expects just a unit type.
-}
xChatHookTimer
 :: Storable a => Int32 -> Hook a b c ()
xChatHookTimer to (XCP (pa, ph)) cb init =
  let tmo = fromIntegral to in
  wrap3 (\ pa -> 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 a) -> Ptr a ->
     IO (XchatHookHandle a)
{- |

/Description:/

@
'xChatHookFd' /fd/ /flgs/
@

Hooking to the file descriptor @/fd/@ with flags @/flgs/@.
The callback function is called every time the file descriptor is available
to an action described by the flags.

/Arguments:/

 [fd] The file descriptor or socket

 [flgs] The flags of the file descriptor

/Callback Function Main Argument:/

The callback function expects a file descriptor and a flag (that may be
removed in a newer version).
-}
xChatHookFd :: Storable a => Fd -> Flags -> Hook a b c (Fd, Flags)
xChatHookFd (Fd fd) f (XCP (pa, ph)) cb init =
  wrap4 (\ fd f pa -> 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)
{- |

/Description:/

@
'xChatUnhook' /ph/ /hook/ /restore/
@

Unhooking of the given @/hook/@.
According to the xchat plugin documentation,
hooks are automatically removed at deinit time.
But you may wish for some reason to hook or unhook
dynamically some function.
There is an argument that allows you to modify the
memory at unhook time. For example, if you have a counter,
your memory could be a @'Maybe' 'Int'@. When you hook, you may want
to put it @'Just' 0@ and when you unhook to put it back to @'Nothing'@.

/Arguments:/

 [ph] The plugin handle of which we want to unhook.

 [hook] The hook to remove from the plugin.

 [restore] The function to be called on the memory of the plugin.

-}
xChatUnhook
 :: Storable a => 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 ()
{- |

/Description:/

@
'xChatPrint' /ph/ /text/
@

Displays some text in the xchat window.

/Arguments:/

 [ph] The plugin handle which manages the printing.

 [text] The text to display. May contain mIRC color codes.

-}
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 ()
{- |

/Description:/

@
'xChatCommand' /ph/ /cmd/
@

Executes a command as if it were typed in xchat's input box.

/Arguments:/

 [ph] The plugin handle which manages the command.

 [text] The command to execute without the heading \'\/\'.

-}
xChatCommand :: XChatPlugin a -> String -> IO ()
xChatCommand (XCP (_, ph)) s =
  newCString s >>= \ s ->
  xChatCommandFFI ph s >>
  free s

{- $contexts
   Contexts are mainly a tab+window pair.
   I do not know more as the original documentation is rather sparse on it.

   You have 3 functions on contexts (find, get and set).

   The @'xChatHookPrint'@ can detect opening and closing of contexts.
-}
foreign import ccall "xchat-plugin-hack.h xchat_set_context"
 xChatSetContextFFI
 :: XchatPluginHandle a -> XchatContextHandle -> IO CInt
{- |

/Description:/

@
'xChatSetContext' /ph/ /ctx/
@

Changes the current context.

/Arguments:/

 [ph] Plugin handle whose context is to be changed.

 [ctx] Context (given by @'xChatGetContext'@ or @'xChatFindContext'@).

/Returns:/

 @'True'@ if successful, @'False'@ else.

-}
xChatSetContext :: XChatPlugin a -> XChatContext -> IO Bool
xChatSetContext (XCP (_, ph)) (XCC ctx) =
  xChatSetContextFFI ph ctx >>= \ i ->
  return (i == 1) -- the documentation say that the result must be 0 or 1

foreign import ccall "xchat-plugin-hack.h xchat_find_context"
 xChatFindContextFFI
 :: XchatPluginHandle a -> CString -> CString -> IO XchatContextHandle
{- |

/Description:/

@
'xChatFindContext' /ph/ /servname/ /channel/
@

Finds a context based on a channel and servername.

If @/servname/@ is @'Nothing'@, it finds the channel (or query) by the
given name in the same server group as the current context. If that doesn't
exists then find any by the given name.

If channel is @'Nothing'@, it finds the front-most tab\/window of the given servname.

/Arguments:/

 [ph] Plugin handle.

 [servname] Servername.

 [channel] Channelname.

/Returns:/

 Context (for use with xChatSetContext).

-}
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
{- |

/Description:/

@
'xChatGetContext' /ph/
@

Get the current context.

/Arguments:/

 [ph] Plugin handle whose context is to be taken.

/Returns:/

 The current context.

-}
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
{- |

/Description:/

@
'xChatNickcmp' /ph/ /s1/ /s2/
@

Performs a nick name comparision, based on the current server
connection. This might be a RFC1459 compliant string compare, or plain ascii
(in the case of DALNet). Use this to compare channels and nicknames. The
function works the same way as strcasecmp.

/Quote from RFC1459:/

    Because of IRC's scandanavian origin, the characters {}| are considered to
    be the lower case equivalents of the characters \[\]\\, respectively.
    This is a critical issue when determining the equivalence of two nicknames.

/Arguments:/

 [ph] Plugin handle whose context is to be taken.

 [s1] 1st string to compare

 [s2] 2nd string to compare

/Returns:/

 The comparison of the two strings.

-}
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
{- |

/Description:/

@
'xChatGetInfo' /ph/ /info/
@

Returns information based on your current context.

/Arguments:/

 [ph] Plugin handle.

 [id] ID of the information you want. Currently supported IDs are
      (case sensitive):

-  [away]         away reason or @'Nothing'@ if you are not away.

-  [channel]      current channel name.

-  [charset]      character-set used in the current context.

-  [event_text]   text event format string for name.

-  [host]         real hostname of the server you connected to.

-  [inputbox]     the input-box contents, what the user has typed.

-  [libdirfs]     library directory. e.g. \/usr\/lib\/xchat. The same
                 directory used for auto-loading plugins.
                 This string isn't necessarily UTF-8, but local file
                 system encoding.

-  [modes]        channel modes, if known, or @'Nothing'@.

-  [network]      current network name or @'Nothing'@.

-  [nick]         your current nick name.

-  [nickserv]     nickserv password for this network or @'Nothing'@.

-  [server]       current server name (what the server claims to be).
                 @'Nothing'@ if you are not connected.

-  [topic]        current channel topic.

-  [version]      xchat version number.

-  [win_ptr]      native window pointer. Unix: (GtkWindow *) Win32: HWND.

-  [win_status]   window status: \"active\", \"hidden\" or \"normal\".

-  [xchatdir]     xchat config directory, e.g.: \/home\/user\/.xchat2 This
                 string is encoded in UTF-8, which means you _should_
                 convert it to \"locale\" encoding before using functions
                 like open() or OpenFile(). For best Unicode support on
                 Linux, convert this string using g_filename_from_utf8 and
                 on Windows convert this string to UTF-16LE (wide) and use
                 OpenFileW() etc.

-  [xchatdirfs]   xchat config directory, e.g.: \/home\/user\/.xchat2.
                 This string is encoded in local file system
                 encoding, making it ideal for direct use with functions
                 like open() or OpenFile(). For real Unicode support on
                 Windows, it's best not to use xchatdirfs, but xchatdir
                 instead.

/Returns:/

 A string of the requested information, or @'Nothing'@.
-}
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
{- |

/Description:/

@
'xChatGetPrefs' /ph/ /pref/
@

Provides xchat's setting information
(that which is available through the \"\/set\" command).
A few extra bits of information are available that
don't appear in the \"\/set list\", currently they are:

 [state_cursor] Current input-box cursor position (characters, not bytes).

 [id] Unique server id.

/Arguments:/

 [ph] Plugin handle.

 [pref] Setting name required.

/Returns:/

 A failure, a @'String'@, a @'Bool'@ or an @'Int32'@ according to
 the @'SettingResult'@ case.

-}
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
{- |

/Description:/

@
'xChatEmitPrint' /ph/ /ev/ /args/
@

Generates a print event.
This can be any event found in the Preferences > Advanced > Text Events window.
The @/args/@ are the arguments of the event.
Special care should be taken when calling this
function inside a print callback (from @'xChatHookPrint'@),
as not to cause endless recursion.

/Arguments:/

 [ph] Plugin handle.

 [ev] Text event to print.

 [args] Arguments of the event to print.

/Returns:/

 @'True'@ in case of success @'False'@ else.

/Example:/

@
'xChatEmitPrint' \"Channel Message\" [\"John\", \"Hi there\", \"\@\"]
@

-}
xChatEmitPrint :: XChatPlugin a -> String -> [String] -> IO Bool
xChatEmitPrint (XCP (_, ph)) ev l =
-- xxxx
  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 >> -- probably not the best thing to do...
  return res

foreign import ccall "xchat-plugin-hack.h xchat_send_modes"
 xChatSendModesFFI
 :: XchatPluginHandle a -> Ptr CString -> CInt -> CInt -> CChar -> CChar ->
     IO ()
{- |

/Description:/

@
'xChatSendModes' /ph/ /str_list/ /mpl/ /sgn/ /mode/
@
 Sends a number of channel mode changes to the current channel.
 For example, you can Op a whole group of people in one go.
 It may send multiple MODE lines if the request doesn't fit on one.
 Pass @'Nothing'@ for /mpl/ to use the current server's maximum possible.
 This function should only be called while in a channel context.

/Arguments:/

 [ph] The plugin handle

 [str_list] The targets

 [mpl] The number of modes per line

 [sgn] The sign (@True@ is \'+\', @False@ is \'-\')

 [mode] The mode char, e.g. \'o\' for Ops

/Example:/

@'xChatSendModes' \"Alice\":\"Bob\":[] 3 True \'o\'@
-}
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
{- |

/Description:/

@
'xChatStrip' /str/ /rules/
@

Strips mIRC color codes and\/or text attributes (bold, underlined etc)
from the given string and returns a new string.
The original function had an unused plugin handle.

/Arguments:/

 [str] The string to strip

 [rules] The description of the plugin to add
-}
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)
{- |

[Undocumented]

/Description:/

@
'xChatPluginguiAdd' /ph/ /filename/ /pdesc/
@

Add of a new GUI plugin to the list of the current plugins.
Due to lack of documentation, it is not further documented.
In the original source code, such added plugins are tagged \'fake\'.
It seems that beside their name, file name, version, description and position
in the list, there is no memory allocation. Furthermore, the original code
had an extra unused argument.

/Arguments:/

 [ph] The plugin handle to be used by default if the USE_PLUGIN directive
      was not given at compile time for XChat, if the USE_PLUGIN directive
      was provided, a new plugin handle is created, with the data of
      [ph] passed by

 [filename] The path name of the file containing the plugin to add

 [pdesc] The description of the plugin to add
-}
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 ()
{- |

[Undocumented]

/Description:/

@
'xChatPluginguiRemove' /ph/
@

The counterpart of @'xChatPluginguiAdd'@ function.
So it is used to remove \'fake\' plugins. Once again, one of the arguments
is unused in the original source code, so I removed it.

/Arguments:/

 [ph] The plugin handle to be removed
-}
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
{- |

[Undocumented]

/Description:/

@
'xChatGettext' /str/
@

Converts a string to its internal XChat representation.
I automatically free it to avoid memory leak, although as
I don't know what it really does, it may be a bad idea.
The original code had an unused plugin handle.

/Arguments:/

 [str] The string to convert
-}
xChatGettext :: String -> IO String
xChatGettext s =
  newCString s >>= \ cs ->
  xChatGettextFFI nullPtr cs >>= \ ds ->
  peekCString ds >>= \ t ->
  free ds >>
  free cs >>
  return t
-- -----------------------------------------------------
{- $lists
   All /XChat/ informations are stored in lists.
   There are 5 lists, each of them having its own section for
   a further description.

   To get access to such a list, you have to request it from /XChat/,
   using the provided function. There is no magic you have to get the list
   each time you have get informations, since it may have changed since the last
   time.
-}

data ChanFlgs = ChanFlgs { connected  :: Bool -- ^ Already connected
                         , connecting :: Bool -- ^ Connecting in progress
                         , away       :: Bool -- ^ You are away
                         , logged     :: Bool -- ^ Login complete
                         , whox       :: Bool -- ^ Has WHOX (ircu)
                         , idmsg      :: Bool -- ^ Has IDMSG (FreeNode)
                         , jPmsg      :: Bool -- ^ Hide Join\/Part messages
                         -- unused flag not figuring in the ChanFlgs
                         , beep       :: Bool -- ^ Beep on message
                         , blinkTray  :: Bool -- ^ Blink tray
                         , blinkTask  :: Bool -- ^ Blink task bar
                         }

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
                         -- unused flag not figuring in the ChanFlgs
                         , 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   -- ^ Channel or query name
                 , cChantypes    :: String   -- ^ Channel type e.g. \"#!&\"
                 , cContext      :: XChatContext -- ^ Context of the channel
                 , cFlags        :: ChanFlgs -- ^ Server\/Channel bits
                 , cId           :: Int32    -- ^ Unique server ID
                 , cLag          :: Int32    -- ^ Lag in milliseconds
                 , cMaxmodes     :: Int32    -- ^ Maximum modes per line
                 , cNetwork      :: String   -- ^ Network name of the channel
                 , cNickprefixes :: String   -- ^ Nickname prefixes e.g. \"\@+\"
                 , cNickmodes    :: String   -- ^ Nickname mod chars e.g. \"ov\"
                 , cQueue        :: Int32    -- ^ Number of bytes in send-queue
                 , cServer       :: String   -- ^ Server name of the channel
                 , cType         :: ChanType -- ^ Type of context
                 , cUsers        :: Int32    -- ^ Number of users in the channel
                 }

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
                 -- ^ ipv4 address of remote user (dunno how to have ipv6)
               , dCps       :: Int32
                 -- ^ Bytes per seconds
               , dDestfile  :: String
                 -- ^ Destination full pathname
               , dFile      :: String
                 -- ^ File name
               , dNick      :: String
                 -- ^ Nickname of the person who the file is from\/to (Receive\/Send mode)
               , dPort      :: Int32
                 -- ^ TCP port number
               , dPos       :: Int32
                 -- ^ Bytes send\/received up to now for the current transfert
               , dResume    :: Int32
                 -- ^ Offset of file from which it is resumed (0 if not resumed)
               , dSize      :: Int64
                 -- ^ File size in bytes
               , dStatus    :: DccStatus
                 -- ^ Status of the DCC transfert
               , dType      :: DccType
                 -- ^ Type of the DCC transfert
               }

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  -- ^ Ignore mask. .e.g: *!*\@*.aol.com
               , iFlags :: IgnFlgs -- ^ Flags
               }

data Notify = Notify { nNetworks :: [String]   -- ^ Networks to which this nick applies
                     , nNick     :: String     -- ^ Nickname
                     , nOnline   :: Bool       -- ^ Currently on-line
                     , nOn       :: Int32      -- ^ Time when nick came online
                     , nOff      :: Int32      -- ^ Time when nick went offline
                     , nSeen     :: Int32      -- ^ Time when nick was last seen
                     }

data User = User { uAway     :: Bool          -- ^ Away status
                 , uLasttalk :: Int32         -- ^ Last time when user talked
                 , uNick     :: String        -- ^ Nickname
                 , uHost     :: Maybe String  -- ^ Host name, /user/\@/host/
                 , uPrefix   :: String        -- ^ e.g. \@ or +
                 , uRealname :: Maybe String  -- ^ Real name
                 , uSelected :: Bool          -- ^ If user belongs to the focused tab
                 }

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

strListChan    = newCString "channels"
strListDcc     = newCString "dcc"
strListIgn     = newCString "ignore"
strListNotify  = newCString "notify"
strListUser    = newCString "users"

strAddress      = newCString "address32"
strCps          = newCString "cps"
strDestfile     = newCString "destfile"
strFile         = newCString "file"
strNick         = newCString "nick"
strPort         = newCString "port"
strPos          = newCString "pos"
strResume       = newCString "iresume"
strSize         = newCString "isize"
strSizehigh     = newCString "isizehigh"
strStatus       = newCString "istatus"
strChannel      = newCString "channel"
strChantypes    = newCString "chantypes"
strContext      = newCString "context"
strFlags        = newCString "flags"
strId           = newCString "id"
strLag          = newCString "lag"
strMaxmodes     = newCString "maxmodes"
strNetwork      = newCString "network"
strNickprefixes = newCString "nickprefixes"
strNickmodes    = newCString "nickmodes"
strQueue        = newCString "queue"
strServer       = newCString "server"
strType         = newCString "type"
strUsers        = newCString "users"
strMask         = newCString "mask"
strAway         = newCString "away"
strLasttalk     = newCString "lasttalk"
strHost         = newCString "host"
strPrefix       = newCString "prefix"
strRealname     = newCString "realname"
strSelected     = newCString "seleceted"
strNetworks     = newCString "networks"
strOn           = newCString "on"
strOff          = newCString "off"
strSeen         = newCString "seen"

getString :: XchatPluginHandle a -> XchatListHandle -> IO CString -> IO String
getString h l i = i >>= \ s ->
                  xChatListStrFFI h l s >>= peekCString >>= \ t ->
                  free s >>
                  return t

getMString :: XchatPluginHandle a -> XchatListHandle -> IO CString -> IO (Maybe String)
getMString h l i = i >>= \ s ->
                   xChatListStrFFI h l s >>= \ ms ->
                   free s >>
                   if ms == nullPtr
                   then return Nothing
                   else fmap return $ peekCString ms

getInt :: XchatPluginHandle a -> XchatListHandle -> IO CString -> IO Int32
getInt h l i = i >>= xChatListIntFFI h l >>= \ k -> return $ fromIntegral k

getTime :: XchatPluginHandle a -> XchatListHandle -> IO CString -> IO Int32
getTime h l i = i >>= xChatListTimeFFI h l >>= \ (CTime k) -> return k

xChatGetNotifyList :: XChatPlugin a -> IO [Notify]
xChatGetNotifyList (XCP (_, ph)) =
  strListNotify >>= xChatListGetFFI ph >>= \ 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)) =
  strListUser >>= xChatListGetFFI ph >>= \ 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)) =
  strListIgn >>= xChatListGetFFI ph >>= \ 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)) =
  strListDcc >>= xChatListGetFFI ph >>= \ 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)) =
  strListChan >>= xChatListGetFFI ph >>= \ l ->
  let getChan = let gStr = getString ph l
                    gInt = getInt ph l
                in
                gStr strChannel      >>= \ channel      ->
                gStr strChantypes    >>= \ chantypes    ->
                (strContext >>= xChatListContextFFI ph l)
                                     >>= \ 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