{-# Language OverloadedStrings, RecordWildCards #-}
{-|
Module      : Client.CApi.Exports
Description : Foreign exports which expose functionality for extensions
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module exports the C functions that extensions can used to query the state
of the client.

C Extensions can include @glirc-api.h@
-}
module Client.CApi.Exports
 ( -- * Extension entry-points
   Glirc_send_message
 , glirc_send_message

 , Glirc_print
 , glirc_print

 , Glirc_list_networks
 , glirc_list_networks

 , Glirc_list_channels
 , glirc_list_channels

 , Glirc_list_channel_users
 , glirc_list_channel_users

 , Glirc_my_nick
 , glirc_my_nick

 , Glirc_user_account
 , glirc_user_account

 , Glirc_user_channel_modes
 , glirc_user_channel_modes

 , Glirc_channel_modes
 , glirc_channel_modes

 , Glirc_channel_masks
 , glirc_channel_masks

 , Glirc_identifier_cmp
 , glirc_identifier_cmp

 , Glirc_is_channel
 , glirc_is_channel

 , Glirc_is_logged_on
 , glirc_is_logged_on

 , Glirc_mark_seen
 , glirc_mark_seen

 , Glirc_clear_window
 , glirc_clear_window

 , Glirc_current_focus
 , glirc_current_focus

 , Glirc_set_focus
 , glirc_set_focus

 , Glirc_free_string
 , glirc_free_string

 , Glirc_free_strings
 , glirc_free_strings

 , Glirc_inject_chat
 , glirc_inject_chat

 , Glirc_resolve_path
 , glirc_resolve_path

 , Glirc_set_timer
 , glirc_set_timer

 , Glirc_cancel_timer
 , glirc_cancel_timer

 , Glirc_window_lines
 , glirc_window_lines

 , Glirc_thread
 , glirc_thread
 ) where

import Client.CApi (cancelTimer, pushTimer, ThreadEntry(..), ActiveExtension(aeThreads))
import Client.CApi.Types
import Client.Configuration ( newFilePathContext, resolveFilePath )
import Client.Message
import Client.State
import Client.State.Channel ( chanLists, chanModes, chanUsers )
import Client.State.Focus (Focus(ChannelFocus, Unfocused, NetworkFocus))
import Client.State.Network (csChannels, csNick, csUsers, isChannelIdentifier, sendMsg)
import Client.State.Window (windowClear, windowSeen, winMessages, wlText)
import Client.UserHost (uhAccount)
import Control.Concurrent (forkOS)
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, readMVar)
import Control.Concurrent.STM (atomically, writeTQueue)
import Control.Exception (SomeException(SomeException), catch)
import Control.Lens
import Control.Monad (unless)
import Data.Char (chr)
import Data.Foldable (traverse_)
import Data.Functor.Compose ( Compose(Compose) )
import Data.HashMap.Strict qualified as HashMap
import Data.Map qualified as Map
import Data.Monoid (First(..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Foreign qualified as Text
import Data.Text.Lazy qualified as LText
import Data.Time (addUTCTime, getCurrentTime, getZonedTime)
import Foreign.C (CString, CInt, CChar, CSize, newCString, CULong)
import Foreign.Marshal (newArray0, peekArray, peekArray0, free)
import Foreign.Ptr (Ptr, FunPtr, nullPtr)
import Foreign.StablePtr (castPtrToStablePtr, deRefStablePtr)
import Foreign.Storable (Storable(peek))
import Irc.Identifier (idText, mkId)
import Irc.Message (IrcMsg(Privmsg), Source(Source))
import Irc.RawIrcMsg (RawIrcMsg(..), TagEntry(TagEntry))
import Irc.UserInfo (UserInfo(UserInfo), parseUserInfo)
import LensUtils (overStrict)

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

-- | Dereference the stable pointer passed to extension callbacks
derefToken :: Ptr () -> IO (MVar (Int, ClientState))
derefToken :: Ptr () -> IO (MVar (Int, ClientState))
derefToken = forall a. StablePtr a -> IO a
deRefStablePtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ptr () -> StablePtr a
castPtrToStablePtr


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

-- | Import a 'FgnMsg' into an 'RawIrcMsg'
peekFgnMsg :: FgnMsg -> IO RawIrcMsg
peekFgnMsg :: FgnMsg -> IO RawIrcMsg
peekFgnMsg FgnMsg{Ptr FgnStringLen
CSize
FgnStringLen
fmTagN :: FgnMsg -> CSize
fmTagVals :: FgnMsg -> Ptr FgnStringLen
fmTagKeys :: FgnMsg -> Ptr FgnStringLen
fmParamN :: FgnMsg -> CSize
fmParams :: FgnMsg -> Ptr FgnStringLen
fmCommand :: FgnMsg -> FgnStringLen
fmPrefixHost :: FgnMsg -> FgnStringLen
fmPrefixUser :: FgnMsg -> FgnStringLen
fmPrefixNick :: FgnMsg -> FgnStringLen
fmNetwork :: FgnMsg -> FgnStringLen
fmTagN :: CSize
fmTagVals :: Ptr FgnStringLen
fmTagKeys :: Ptr FgnStringLen
fmParamN :: CSize
fmParams :: Ptr FgnStringLen
fmCommand :: FgnStringLen
fmPrefixHost :: FgnStringLen
fmPrefixUser :: FgnStringLen
fmPrefixNick :: FgnStringLen
fmNetwork :: FgnStringLen
..} =
  do let strArray :: a -> Ptr FgnStringLen -> IO [Text]
strArray a
n Ptr FgnStringLen
p = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FgnStringLen -> IO Text
peekFgnStringLen forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                        forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr FgnStringLen
p

     [Text]
tagKeys <- forall {a}. Integral a => a -> Ptr FgnStringLen -> IO [Text]
strArray CSize
fmTagN Ptr FgnStringLen
fmTagKeys
     [Text]
tagVals <- forall {a}. Integral a => a -> Ptr FgnStringLen -> IO [Text]
strArray CSize
fmTagN Ptr FgnStringLen
fmTagVals
     Text
prefixN  <- FgnStringLen -> IO Text
peekFgnStringLen FgnStringLen
fmPrefixNick
     Text
prefixU  <- FgnStringLen -> IO Text
peekFgnStringLen FgnStringLen
fmPrefixUser
     Text
prefixH  <- FgnStringLen -> IO Text
peekFgnStringLen FgnStringLen
fmPrefixHost
     Text
command <- FgnStringLen -> IO Text
peekFgnStringLen FgnStringLen
fmCommand
     [Text]
params  <- forall {a}. Integral a => a -> Ptr FgnStringLen -> IO [Text]
strArray CSize
fmParamN Ptr FgnStringLen
fmParams

     forall (m :: * -> *) a. Monad m => a -> m a
return RawIrcMsg
       { _msgTags :: [TagEntry]
_msgTags    = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Text -> TagEntry
TagEntry [Text]
tagKeys [Text]
tagVals
       , _msgPrefix :: Maybe UserInfo
_msgPrefix  = if Text -> Bool
Text.null Text
prefixN
                         then forall a. Maybe a
Nothing
                         else forall a. a -> Maybe a
Just (Identifier -> Text -> Text -> UserInfo
UserInfo (Text -> Identifier
mkId Text
prefixN) Text
prefixU Text
prefixH)
       , _msgCommand :: Text
_msgCommand = Text
command
       , _msgParams :: [Text]
_msgParams  = [Text]
params
       }

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

-- | Peek a 'FgnStringLen' as UTF-8 encoded bytes.
peekFgnStringLen :: FgnStringLen -> IO Text
peekFgnStringLen :: FgnStringLen -> IO Text
peekFgnStringLen (FgnStringLen CString
ptr CSize
len) =
  CStringLen -> IO Text
Text.peekCStringLen (CString
ptr, forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

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

-- | Type of 'glirc_send_message' extension entry-point
type Glirc_send_message =
  Ptr ()     {- ^ api token          -} ->
  Ptr FgnMsg {- ^ pointer to message -} ->
  IO CInt    {- ^ 0 on success       -}

-- | Entry-point into the client when an extern extension wants send an IRC
-- command to a connected server.
glirc_send_message :: Glirc_send_message
glirc_send_message :: Glirc_send_message
glirc_send_message Ptr ()
token Ptr FgnMsg
msgPtr =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
token
     FgnMsg
fgn     <- forall a. Storable a => Ptr a -> IO a
peek Ptr FgnMsg
msgPtr
     RawIrcMsg
msg     <- FgnMsg -> IO RawIrcMsg
peekFgnMsg FgnMsg
fgn
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (FgnMsg -> FgnStringLen
fmNetwork FgnMsg
fgn)
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
       Maybe NetworkState
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1
       Just NetworkState
cs -> CInt
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
msg
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException{} -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1

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

-- | Type of 'glirc_print' extension entry-point
type Glirc_print =
  Ptr ()      {- ^ api token         -} ->
  MessageCode {- ^ enum message_code -} ->
  CString     {- ^ message           -} ->
  CSize       {- ^ message length    -} ->
  IO CInt     {- ^ 0 on success      -}

-- | Entry-point for extensions to append a message to the client buffer.
-- The @message_code@ can be used to render the message normally or to
-- cause the client to draw attention to the message as an error.
glirc_print :: Glirc_print
glirc_print :: Glirc_print
glirc_print Ptr ()
stab MessageCode
code CString
msgPtr CSize
msgLen =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     Text
txt  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
msgPtr CSize
msgLen)
     ZonedTime
now  <- IO ZonedTime
getZonedTime

     let con :: Text -> MessageBody
con | MessageCode
code forall a. Eq a => a -> a -> Bool
== MessageCode
normalMessage = Text -> MessageBody
NormalBody
             | Bool
otherwise             = Text -> MessageBody
ErrorBody
         msg :: ClientMessage
msg = ClientMessage
                 { _msgBody :: MessageBody
_msgBody    = Text -> MessageBody
con Text
txt
                 , _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
                 , _msgNetwork :: Text
_msgNetwork = Text
Text.empty
                 }
     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       do forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg ClientState
st)
     forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException{} -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1

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

-- | Type of 'glirc_inject_chat' extension entry-point.
type Glirc_inject_chat =
  Ptr ()  {- ^ api token         -} ->
  CString {- ^ network           -} ->
  CSize   {- ^ network length    -} ->
  CString {- ^ source            -} ->
  CSize   {- ^ source length     -} ->
  CString {- ^ target            -} ->
  CSize   {- ^ target length     -} ->
  CString {- ^ message           -} ->
  CSize   {- ^ message length    -} ->
  IO CInt {- ^ 0 on success      -}

-- | Add a message to a chat window as if it was received
-- directly from the IRC server. This is useful when implementing
-- extensions that intercept incoming chat messages and transform
-- them before showing the user.
glirc_inject_chat :: Glirc_inject_chat
glirc_inject_chat :: Glirc_inject_chat
glirc_inject_chat Ptr ()
stab CString
netPtr CSize
netLen CString
srcPtr CSize
srcLen CString
tgtPtr CSize
tgtLen CString
msgPtr CSize
msgLen =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     Text
net  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
netPtr CSize
netLen)
     Text
src  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
srcPtr CSize
srcLen)
     Identifier
tgt  <- Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
tgtPtr CSize
tgtLen)
     Text
txt  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
msgPtr CSize
msgLen)
     ZonedTime
now  <- IO ZonedTime
getZonedTime

     let msg :: ClientMessage
msg = ClientMessage
                 { _msgBody :: MessageBody
_msgBody    = IrcMsg -> MessageBody
IrcBody (Source -> Identifier -> Text -> IrcMsg
Privmsg (UserInfo -> Text -> Source
Source (Text -> UserInfo
parseUserInfo Text
src) Text
"") Identifier
tgt Text
txt)
                 , _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
                 , _msgNetwork :: Text
_msgNetwork = Text
net
                 }
     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i, ClientState
st) ->
       do forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage Text
net Identifier
tgt ClientMessage
msg ClientState
st)
     forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException{} -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1

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

-- | Type of 'glirc_list_networks' extension entry-point
type Glirc_list_networks =
  Ptr ()           {- ^ api token                                        -} ->
  IO (Ptr CString) {- ^ null terminated array of null terminated strings -}

-- | This extension entry-point allocates a list of all the identifiers for
-- the active networks on the client. @NULL@ returned on failure.
-- The caller is responsible for freeing successful result with
-- @glirc_free_strings@.
glirc_list_networks :: Glirc_list_networks
glirc_list_networks :: Glirc_list_networks
glirc_list_networks Ptr ()
stab =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st) <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     let networks :: [Text]
networks = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (HashMap Text NetworkState)
clientConnections forall k v. HashMap k v -> [k]
HashMap.keys ClientState
st
     [CString]
strs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO CString
newCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) [Text]
networks
     forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
strs

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

-- | Type of 'glirc_identifier_cmp' extension entry-point
type Glirc_identifier_cmp =
  CString {- ^ identifier 1     -} ->
  CSize   {- ^ identifier 1 len -} ->
  CString {- ^ identifier 2     -} ->
  CSize   {- ^ identifier 2 len -} ->
  IO CInt

-- | Case insensitive comparison suitable for use on channels and nicknames.
-- Returns -1 if the first identifier is less than the second
-- Returns 0 if the first identifier is equal to the second
-- Returns 1 if the first identifier is greater than the second
glirc_identifier_cmp :: Glirc_identifier_cmp
glirc_identifier_cmp :: Glirc_identifier_cmp
glirc_identifier_cmp CString
p1 CSize
n1 CString
p2 CSize
n2 =
  do Text
txt1 <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
p1 CSize
n1)
     Text
txt2 <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
p2 CSize
n2)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case forall a. Ord a => a -> a -> Ordering
compare (Text -> Identifier
mkId Text
txt1) (Text -> Identifier
mkId Text
txt2) of
                 Ordering
LT -> -CInt
1
                 Ordering
EQ ->  CInt
0
                 Ordering
GT ->  CInt
1

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

-- | Type of 'glirc_list_channels' extension entry-point
type Glirc_list_channels =
  Ptr ()  {- ^ api token   -} ->
  CString {- ^ network     -} ->
  CSize   {- ^ network len -} ->
  IO (Ptr CString) {- ^ null terminated array of null terminated strings -}

-- | Generate a list of connected channels for the network identified in
-- the arguments. @NULL@ returned on failure. Caller is responsible for
-- freeing successful result with @glirc_free_strings@.
glirc_list_channels :: Glirc_list_channels
glirc_list_channels :: Glirc_list_channels
glirc_list_channels Ptr ()
stab CString
networkPtr CSize
networkLen =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st) <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels) ClientState
st of
        Maybe (HashMap Identifier ChannelState)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
        Just HashMap Identifier ChannelState
m  ->
          do [CString]
strs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO CString
newCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
idText) (forall k v. HashMap k v -> [k]
HashMap.keys HashMap Identifier ChannelState
m)
             forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
strs

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

-- | Type of 'glirc_list_channel_users' extension entry-point
type Glirc_list_channel_users =
  Ptr ()  {- ^ api token   -} ->
  CString {- ^ network     -} ->
  CSize   {- ^ network len -} ->
  CString {- ^ channel     -} ->
  CSize   {- ^ channel len -} ->
  IO (Ptr CString) {- ^ null terminated array of null terminated strings -}

-- | Generate a list of IRC nicknames currently connected to the identified
-- channel on the identified network. @NULL@ returned on failure.
-- Caller is responsible for freeing successful result with
-- @glirc_free_strings@.
glirc_list_channel_users :: Glirc_list_channel_users
glirc_list_channel_users :: Glirc_list_channel_users
glirc_list_channel_users Ptr ()
stab CString
networkPtr CSize
networkLen CString
channelPtr CSize
channelLen =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_, ClientState
st) <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     Text
channel <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
channelPtr CSize
channelLen)
     let mb :: Maybe (HashMap Identifier String)
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
channel)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers
                      ) ClientState
st
     case Maybe (HashMap Identifier String)
mb of
       Maybe (HashMap Identifier String)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
       Just HashMap Identifier String
m  ->
         do [CString]
strs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO CString
newCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
idText) (forall k v. HashMap k v -> [k]
HashMap.keys HashMap Identifier String
m)
            forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
strs

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

-- | Type of 'glirc_my_nick' extension entry-point
type Glirc_my_nick =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  IO CString

-- | Return the IRC nickname associated with the active network
-- connection identified in the arguments. @NULL@ returned on failure.
-- Caller is responsible for freeing successful result with
-- @glirc_free_string@.
glirc_my_nick :: Glirc_my_nick
glirc_my_nick :: Glirc_my_nick
glirc_my_nick Ptr ()
stab CString
networkPtr CSize
networkLen =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     let mb :: Maybe Identifier
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState Identifier
csNick) ClientState
st
     case Maybe Identifier
mb of
       Maybe Identifier
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
       Just Identifier
me -> String -> IO CString
newCString (Text -> String
Text.unpack (Identifier -> Text
idText Identifier
me))

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

-- | Type of 'glirc_user_account' extension entry-point
type Glirc_user_account =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ nickname            -} ->
  CSize   {- ^ nickname length     -} ->
  IO CString

-- | Return the services account name associated with a nickname on
-- a server as tracked by the client. Caller is responsible for freeing
-- successful result with @glirc_free_string@. If no account is
-- known, @NULL@ is returned.
glirc_user_account :: Glirc_user_account
glirc_user_account :: Glirc_user_account
glirc_user_account Ptr ()
stab CString
networkPtr CSize
networkLen CString
nickPtr CSize
nickLen =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     Text
nick    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
nickPtr    CSize
nickLen   )
     let mb :: Maybe Text
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
nick)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UserAndHost Text
uhAccount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)) ClientState
st
     case Maybe Text
mb of
       Just Text
acct -> String -> IO CString
newCString (Text -> String
Text.unpack Text
acct)
       Maybe Text
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr

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

-- | Type of 'glirc_user_account' extension entry-point
type Glirc_user_channel_modes =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ channel             -} ->
  CSize   {- ^ channel length      -} ->
  CString {- ^ nickname            -} ->
  CSize   {- ^ nickname length     -} ->
  IO CString

-- | Return the sigils associated with a nickname on a particular channel.
-- Caller is responsible for freeing successful result with
-- @glirc_free_string@. If user is on channel without any sigils an empty
-- string is returned. If user is not on channel @NULL@ is returned.
glirc_user_channel_modes :: Glirc_user_channel_modes
glirc_user_channel_modes :: Glirc_user_channel_modes
glirc_user_channel_modes Ptr ()
stab CString
netPtr CSize
netLen CString
chanPtr CSize
chanLen CString
nickPtr CSize
nickLen =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
netPtr  CSize
netLen)
     Text
chan    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
chanPtr CSize
chanLen   )
     Text
nick    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
nickPtr CSize
nickLen   )
     let mb :: Maybe String
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
chan)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
nick) ) ClientState
st
     case Maybe String
mb of
       Just String
sigils -> String -> IO CString
newCString String
sigils
       Maybe String
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr

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

-- | Type of 'glirc_channel_modes' extension entry-point
type Glirc_channel_modes =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ channel             -} ->
  CSize   {- ^ channel length      -} ->
  IO (Ptr CString)

-- | Return all of the modes of a given channel. The first
-- letter of each string returned is the mode. Any remaining
-- characters are the mode argument.
-- Caller is responsible for freeing successful result with
-- @glirc_free_strings@. If the user is not on a channel @NULL@
-- is returned. The modes might not be known to the client for
-- a particular channel which can result in an empty list of
-- modes being returned.
glirc_channel_modes :: Glirc_channel_modes
glirc_channel_modes :: Glirc_list_channel_users
glirc_channel_modes Ptr ()
stab CString
netPtr CSize
netLen CString
chanPtr CSize
chanLen =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
netPtr  CSize
netLen)
     Text
chan    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
chanPtr CSize
chanLen   )
     let mb :: Maybe (Map Char Text)
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
chan)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char Text)
chanModes
                      ) ClientState
st
     case Maybe (Map Char Text)
mb of
       Maybe (Map Char Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
       Just Map Char Text
modeMap ->
         do let strings :: [String]
strings = [ Char
mode forall a. a -> [a] -> [a]
: Text -> String
Text.unpack Text
arg | (Char
mode,Text
arg) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Char Text
modeMap ]
            [CString]
strs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO CString
newCString [String]
strings
            forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
strs

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

-- | Type of 'glirc_channel_masks' extension entry-point
type Glirc_channel_masks =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ channel             -} ->
  CSize   {- ^ channel length      -} ->
  CChar   {- ^ mode                -} ->
  IO (Ptr CString)

-- | Return all of the modes of a given channel. The first
-- letter of each string returned is the mode. Any remaining
-- characters are the mode argument.
-- Caller is responsible for freeing successful result with
-- @glirc_free_strings@. If the user is not on a channel @NULL@
-- is returned. The modes might not be known to the client for
-- a particular channel which can result in an empty list of
-- modes being returned.
glirc_channel_masks :: Glirc_channel_masks
glirc_channel_masks :: Glirc_channel_masks
glirc_channel_masks Ptr ()
stab CString
netPtr CSize
netLen CString
chanPtr CSize
chanLen CChar
cmode =
  do let mode :: Char
mode = Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral CChar
cmode) :: Char
     MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
netPtr  CSize
netLen)
     Text
chan    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
chanPtr CSize
chanLen   )
     let mb :: Maybe (HashMap Text MaskListEntry)
mb = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
chan)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
mode
                      ) ClientState
st
     case Maybe (HashMap Text MaskListEntry)
mb of
       Maybe (HashMap Text MaskListEntry)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
       Just HashMap Text MaskListEntry
listMap ->
         do [CString]
strs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO CString
newCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text MaskListEntry
listMap)
            forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
strs

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

-- | Type of 'glirc_mark_seen' extension entry-point
type Glirc_mark_seen =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ channel name        -} ->
  CSize   {- ^ channel name length -} ->
  IO ()

-- | Mark a window as being seen, clearing the new message counter.
-- To specify the client window send an empty network name.
-- To specify a network window send an empty channel name.
glirc_mark_seen :: Glirc_mark_seen
glirc_mark_seen :: Glirc_mark_seen
glirc_mark_seen Ptr ()
stab CString
networkPtr CSize
networkLen CString
channelPtr CSize
channelLen =
  do Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     Text
channel <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
channelPtr CSize
channelLen)

     let focus :: Focus
focus
           | Text -> Bool
Text.null Text
network = Focus
Unfocused
           | Text -> Bool
Text.null Text
channel = Text -> Focus
NetworkFocus Text
network
           | Bool
otherwise         = Text -> Identifier -> Focus
ChannelFocus Text
network (Text -> Identifier
mkId Text
channel)

     MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       let st' :: ClientState
st' = forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus) Window -> Window
windowSeen ClientState
st
       in ClientState
st' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i,ClientState
st')

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

-- | Type of 'glirc_clear_window' extension entry-point
type Glirc_clear_window =
  Ptr ()  {- ^ api token           -} ->
  CString {- ^ network name        -} ->
  CSize   {- ^ network name length -} ->
  CString {- ^ channel name        -} ->
  CSize   {- ^ channel name length -} ->
  IO ()

-- | Clear contents of a specified window.
-- To specify the client window send an empty network name.
-- To specify a network window send an empty channel name.
glirc_clear_window :: Glirc_clear_window
glirc_clear_window :: Glirc_mark_seen
glirc_clear_window Ptr ()
stab CString
networkPtr CSize
networkLen CString
channelPtr CSize
channelLen =
  do Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
networkPtr CSize
networkLen)
     Text
channel <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
channelPtr CSize
channelLen)

     let focus :: Focus
focus
           | Text -> Bool
Text.null Text
network = Focus
Unfocused
           | Text -> Bool
Text.null Text
channel = Text -> Focus
NetworkFocus Text
network
           | Bool
otherwise         = Text -> Identifier -> Focus
ChannelFocus Text
network (Text -> Identifier
mkId Text
channel)

     MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       let st' :: ClientState
st' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus) Window -> Window
windowClear ClientState
st
       in ClientState
st' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i,ClientState
st')

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

-- | Type of 'glirc_free_string' extension entry-point
type Glirc_free_string =
  CString {- ^ glirc allocated string -} ->
  IO ()

-- | Free one of the heap allocated strings found as a return value
-- from the extension API. If argument is @NULL@, nothing happens.
glirc_free_string :: Glirc_free_string
glirc_free_string :: Glirc_free_string
glirc_free_string = forall a. Ptr a -> IO ()
free

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

-- | Type of 'glirc_free_strings' extension entry-point
type Glirc_free_strings =
  Ptr CString {- ^ glirc allocated strings, null-terminated -} ->
  IO ()

-- | Free an array of heap allocated strings found as a return value
-- from the extension API. If argument is @NULL@, nothing happens.
glirc_free_strings :: Glirc_free_strings
glirc_free_strings :: Glirc_free_strings
glirc_free_strings Ptr CString
p =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr CString
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
    do forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a. Ptr a -> IO ()
free forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 forall a. Ptr a
nullPtr Ptr CString
p
       forall a. Ptr a -> IO ()
free Ptr CString
p

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

-- | Type of 'glirc_current_focus' extension entry-point
type Glirc_current_focus =
  Ptr ()      {- ^ api token                           -} ->
  Ptr CString {- ^ OUT: newly allocated network string -} ->
  Ptr CSize   {- ^ OUT: network length                 -} ->
  Ptr CString {- ^ OUT: newly allocated target string  -} ->
  Ptr CSize   {- ^ OUT: target length                  -} ->
  IO ()

-- | Find the network and target identifier associated with the
-- currently focused window.
--
-- Free the allocated strings with @glirc_free_string@.
--
-- Strings set to @NULL@ if there is no current network or no
-- current target.
glirc_current_focus :: Glirc_current_focus
glirc_current_focus :: Glirc_current_focus
glirc_current_focus Ptr ()
stab Ptr CString
netP Ptr CSize
netL Ptr CString
tgtP Ptr CSize
tgtL =
  do MVar (Int, ClientState)
mvar   <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st) <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     let (Text
net,Text
tgt) = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
                       Focus
Unfocused        -> (Text
Text.empty, Text
Text.empty)
                       NetworkFocus Text
n   -> (Text
n         , Text
Text.empty)
                       ChannelFocus Text
n Identifier
t -> (Text
n         , Identifier -> Text
idText Identifier
t  )
     Ptr CString -> Ptr CSize -> Text -> IO ()
exportText Ptr CString
netP Ptr CSize
netL Text
net
     Ptr CString -> Ptr CSize -> Text -> IO ()
exportText Ptr CString
tgtP Ptr CSize
tgtL Text
tgt

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

-- | Type of 'glirc_set_focus' extension entry-point
type Glirc_set_focus =
  Ptr ()  {- ^ api token      -} ->
  CString {- ^ network        -} ->
  CSize   {- ^ network length -} ->
  CString {- ^ target         -} ->
  CSize   {- ^ target length  -} ->
  IO ()

-- | Assign window focus to a new value.
--
-- Set to client window if network is empty.
--
-- Set to network window if channel is empty.
--
-- Set to chat window otherwise.
glirc_set_focus :: Glirc_set_focus
glirc_set_focus :: Glirc_mark_seen
glirc_set_focus Ptr ()
stab CString
netP CSize
netL CString
tgtP CSize
tgtL =
  do MVar (Int, ClientState)
mvar   <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     Text
net    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
netP CSize
netL)
     Text
tgt    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
tgtP CSize
tgtL)

     let focus :: Focus
focus
           | Text -> Bool
Text.null Text
net = Focus
Unfocused
           | Text -> Bool
Text.null Text
tgt = Text -> Focus
NetworkFocus Text
net
           | Bool
otherwise     = Text -> Identifier -> Focus
ChannelFocus Text
net (Text -> Identifier
mkId Text
tgt)

     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       let st' :: ClientState
st' = Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
       in ClientState
st' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i,ClientState
st')

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

-- | Type of 'glirc_is_channel' extension entry-point
type Glirc_is_channel =
  Ptr ()  {- ^ api token       -} ->
  CString {- ^ network name    -} ->
  CSize   {- ^ network length  -} ->
  CString {- ^ target name     -} ->
  CSize   {- ^ target length   -} ->
  IO CInt {- ^ boolean         -}

-- | Returns @1@ when the given target on the given network is a channel
-- name, otherwise returns @0@.
--
-- If the given network is not currently active this returns @0@.
glirc_is_channel :: Glirc_is_channel
glirc_is_channel :: Glirc_is_channel
glirc_is_channel Ptr ()
stab CString
net CSize
netL CString
tgt CSize
tgtL =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
net CSize
netL)
     Text
target  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
tgt CSize
tgtL)

     case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
       Just NetworkState
cs | NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs (Text -> Identifier
mkId Text
target) -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1
       Maybe NetworkState
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0

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

-- | Type of 'glirc_is_logged_on' extension entry-point
type Glirc_is_logged_on =
  Ptr ()  {- ^ api token       -} ->
  CString {- ^ network name    -} ->
  CSize   {- ^ network length  -} ->
  CString {- ^ target name     -} ->
  CSize   {- ^ target length   -} ->
  IO CInt {- ^ boolean         -}

-- | Returns @1@ when the given target on the given network shares a
-- channel with the user, @0@ otherwise.
--
-- If the given network is not currently active this returns @0@.
glirc_is_logged_on :: Glirc_is_logged_on
glirc_is_logged_on :: Glirc_is_channel
glirc_is_logged_on Ptr ()
stab CString
net CSize
netL CString
tgt CSize
tgtL =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
net CSize
netL)
     Text
target  <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
tgt CSize
tgtL)

     let online :: Bool
online = forall s a. Getting Any s a -> s -> Bool
has (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
target)) ClientState
st
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Bool
online then CInt
1 else CInt
0

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

-- | Type of 'glirc_resolve_path' extension entry-point
type Glirc_resolve_path =
  Ptr ()     {- ^ api token     -} ->
  CString    {- ^ path          -} ->
  CSize      {- ^ path length   -} ->
  IO CString {- ^ resolved path -}

-- | Resolve the given string to an absolute path. This expands @~@ for
-- the home directory and computes paths relative to the configuration
-- file.
--
-- Free the allocated string with @glirc_free_string@.
glirc_resolve_path :: Glirc_resolve_path
glirc_resolve_path :: Glirc_my_nick
glirc_resolve_path Ptr ()
stab CString
pathP CSize
pathL =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st)  <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
path    <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
pathP CSize
pathL)

     let cfgPath :: String
cfgPath = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState String
clientConfigPath ClientState
st
     FilePathContext
cxt <- String -> IO FilePathContext
newFilePathContext String
cfgPath
     String -> IO CString
newCString (FilePathContext -> String -> String
resolveFilePath FilePathContext
cxt (Text -> String
Text.unpack Text
path))

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

-- | Type of 'glirc_set_timer' extension entry-point
type Glirc_set_timer =
  Ptr ()               {- ^ api token          -} ->
  CULong               {- ^ milliseconds delay -} ->
  FunPtr TimerCallback {- ^ function           -} ->
  Ptr ()               {- ^ callback state     -} ->
  IO TimerId           {- ^ timer ID           -}

-- | Register a function to be called after a given number of milliseconds
-- of delay. The returned timer ID can be used to cancel the timer.
glirc_set_timer :: Glirc_set_timer
glirc_set_timer :: Glirc_set_timer
glirc_set_timer Ptr ()
stab CULong
millis FunPtr TimerCallback
fun Ptr ()
ptr =
  do MVar (Int, ClientState)
mvar    <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     UTCTime
time    <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
millis forall a. Fractional a => a -> a -> a
/ NominalDiffTime
1000) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
     forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       let (Int
timer,ClientState
st') = ClientState
st forall a b. a -> (a -> b) -> b
& Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i)
                            forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ UTCTime
-> FunPtr TimerCallback
-> Ptr ()
-> ActiveExtension
-> (Int, ActiveExtension)
pushTimer UTCTime
time FunPtr TimerCallback
fun Ptr ()
ptr
       in ClientState
st' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
i,ClientState
st'), forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timer)

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

-- | Type of 'glirc_cancel_timer' extension entry-point
type Glirc_cancel_timer =
  Ptr ()               {- ^ api token                   -} ->
  TimerId              {- ^ timer ID                    -} ->
  IO (Ptr ())          {- ^ returns held callback state -}

-- | Register a function to be called after a given number of milliseconds
-- of delay. The returned timer ID can be used to cancel the timer.
glirc_cancel_timer :: Glirc_cancel_timer
glirc_cancel_timer :: Glirc_cancel_timer
glirc_cancel_timer Ptr ()
stab TimerId
timerId =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       let Compose Maybe (First (Ptr ()), ClientState)
mb = ClientState
st forall a b. a -> (a -> b) -> b
& Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i
                   forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ \ActiveExtension
ae -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$
                              do (Ptr ()
entry, ActiveExtension
ae') <- Int -> ActiveExtension -> Maybe (Ptr (), ActiveExtension)
cancelTimer (forall a b. (Integral a, Num b) => a -> b
fromIntegral TimerId
timerId) ActiveExtension
ae
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> First a
First (forall a. a -> Maybe a
Just Ptr ()
entry), ActiveExtension
ae')
       in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case Maybe (First (Ptr ()), ClientState)
mb of
            Just (First (Just Ptr ()
ptr), ClientState
st') -> ((Int
i,ClientState
st'), Ptr ()
ptr)
            Maybe (First (Ptr ()), ClientState)
_ -> ((Int
i, ClientState
st), forall a. Ptr a
nullPtr)

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

-- | Type of 'glirc_window_lines' extension entry-point
type Glirc_window_lines =
  Ptr ()  {- ^ api token       -} ->
  CString {- ^ network name    -} ->
  CSize   {- ^ network length  -} ->
  CString {- ^ target name     -} ->
  CSize   {- ^ target length   -} ->
  CInt    {- ^ use filter      -} ->
  IO (Ptr CString) {- ^ null terminated array of null terminated strings -}

-- | This extension entry-point allocates a list of all the window lines for
-- the requested window. The lines are presented with newest line at the head
-- of the list.
-- The caller is responsible for freeing successful result with
-- @glirc_free_strings@.
glirc_window_lines :: Glirc_window_lines
glirc_window_lines :: Glirc_window_lines
glirc_window_lines Ptr ()
stab CString
net CSize
netL CString
tgt CSize
tgtL CInt
filt =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     (Int
_,ClientState
st) <- forall a. MVar a -> IO a
readMVar MVar (Int, ClientState)
mvar
     Text
network <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
net CSize
netL)
     Text
channel <- FgnStringLen -> IO Text
peekFgnStringLen (CString -> CSize -> FgnStringLen
FgnStringLen CString
tgt CSize
tgtL)
     let focus :: Focus
focus
           | Text -> Bool
Text.null Text
network = Focus
Unfocused
           | Text -> Bool
Text.null Text
channel = Text -> Focus
NetworkFocus Text
network
           | Bool
otherwise         = Text -> Identifier -> Focus
ChannelFocus Text
network (Text -> Identifier
mkId Text
channel)
         filterFun :: [Text] -> [Text]
filterFun
           | CInt
filt forall a. Eq a => a -> a -> Bool
== CInt
0 = forall a. a -> a
id
           | Bool
otherwise = forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st forall a. a -> a
id
         strs :: [Text]
strs = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window WindowLines
winMessages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Each s t a b => Traversal s t a b
each forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter WindowLine Text
wlText) ClientState
st
     [CString]
ptrs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO CString
newCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LText.unpack) ([Text] -> [Text]
filterFun [Text]
strs)
     forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 forall a. Ptr a
nullPtr [CString]
ptrs

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

-- | Type of 'glirc_thread' extension entry-point
type Glirc_thread =
  Ptr ()  {- ^ api token -} ->
  FunPtr (Ptr () -> IO (Ptr ())) {- ^ start -} ->
  FunPtr (Ptr () -> IO ()) {- ^ finish -} ->
  Ptr () {- ^ start argument  -} ->
  IO ()  {- ^ null terminated array of null terminated strings -}

-- | This extension entry-point allocates a list of all the window lines for
-- the requested window. The lines are presented with newest line at the head
-- of the list.
-- The caller is responsible for freeing successful result with
-- @glirc_free_strings@.
glirc_thread :: Glirc_thread
glirc_thread :: Glirc_thread
glirc_thread Ptr ()
stab FunPtr (Ptr () -> IO (Ptr ()))
start FunPtr (Ptr () -> IO ())
finish Ptr ()
arg =
  do MVar (Int, ClientState)
mvar <- Ptr () -> IO (MVar (Int, ClientState))
derefToken Ptr ()
stab
     forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Int, ClientState)
mvar forall a b. (a -> b) -> a -> b
$ \(Int
i,ClientState
st) ->
       do ThreadId
_ <- IO () -> IO ThreadId
forkOS forall a b. (a -> b) -> a -> b
$
            do Ptr ()
result <- Dynamic (Ptr () -> IO (Ptr ()))
runThreadStart FunPtr (Ptr () -> IO (Ptr ()))
start Ptr ()
arg
               forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (TQueue (Int, ThreadEntry))
clientThreadJoins ClientState
st) (Int
i, FunPtr (Ptr () -> IO ()) -> Ptr () -> ThreadEntry
ThreadEntry FunPtr (Ptr () -> IO ())
finish Ptr ()
result))
          let incThreads :: ActiveExtension -> ActiveExtension
incThreads ActiveExtension
ae = ActiveExtension
ae { aeThreads :: Int
aeThreads = ActiveExtension -> Int
aeThreads ActiveExtension
ae forall a. Num a => a -> a -> a
+ Int
1}
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i) ActiveExtension -> ActiveExtension
incThreads ClientState
st)