{-# LINE 1 "src/Client/CApi/Types.hsc" #-}
{-# Language RecordWildCards #-}

{-|
Module      : Client.CApi.Types
Description : Marshaling support for C API
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

Marshaling types and functions for the C API

-}



module Client.CApi.Types
  ( -- * Extension record
    FgnExtension(..)
  , StartExtension
  , StopExtension
  , ProcessMessage
  , ProcessCommand
  , ProcessChat
  , TimerCallback
  , TimerId

  -- * Strings
  , FgnStringLen(..)

  -- * Messages
  , FgnMsg(..)

  -- * Commands
  , FgnCmd(..)

  -- * Chat
  , FgnChat(..)

  -- * Function pointer calling
  , Dynamic
  , runStartExtension
  , runStopExtension
  , runProcessMessage
  , runProcessCommand
  , runProcessChat
  , runTimerCallback

  -- * report message codes
  , MessageCode(..), normalMessage, errorMessage

  -- * process message results
  , ProcessResult(..), passMessage, dropMessage

  -- * Marshaling helpers
  , withText0
  , exportText
  , poke'
  ) where

import           Control.Monad
import           Data.Text (Text)
import qualified Data.Text.Foreign as Text
import           Data.Word
import           Data.Int
import           Foreign.C
import           Foreign.Marshal.Array
import           Foreign.Ptr
import           Foreign.Storable

-- | Tag for describing the kind of message to display in the client
-- as used in `glirc_print`. See 'normalMessage' and 'errorMessage'.
--
-- @enum message_code;@
newtype MessageCode = MessageCode (Word32) deriving Eq
{-# LINE 75 "src/Client/CApi/Types.hsc" #-}

-- | Normal client message. Unread counter increments, but no client
-- bell or error status update.
normalMessage :: MessageCode
normalMessage = MessageCode (0)
{-# LINE 80 "src/Client/CApi/Types.hsc" #-}

-- | Important client message. Unread counter increments, bell rings,
-- and error status updates.
errorMessage :: MessageCode
errorMessage = MessageCode (1)
{-# LINE 85 "src/Client/CApi/Types.hsc" #-}

-- | Result used to determine what to do after processing a message with
-- the 'ProcessMessage' callback.
--
-- | @enum process_result@
newtype ProcessResult = ProcessResult (Word32) deriving Eq
{-# LINE 91 "src/Client/CApi/Types.hsc" #-}

-- | Allow the message to proceed through the client logic.
passMessage :: ProcessResult
passMessage = ProcessResult (0)
{-# LINE 95 "src/Client/CApi/Types.hsc" #-}

-- | Drop the message from further processing.
dropMessage :: ProcessResult
dropMessage = ProcessResult (1)
{-# LINE 99 "src/Client/CApi/Types.hsc" #-}

-- | @typedef void *start(void *glirc, const char *path)@
type StartExtension =
  Ptr ()           {- ^ api token                   -} ->
  CString          {- ^ path to extension           -} ->
  Ptr FgnStringLen {- ^ array of arguments          -} ->
  CSize            {- ^ number of arguments         -} ->
  IO (Ptr ())      {- ^ initialized extension state -}

-- | @typedef void stop(void *glirc, void *S)@
type StopExtension =
  Ptr () {- ^ extension state -} ->
  IO ()

-- | @typedef enum process_result process_message(void *glirc, void *S, const struct glirc_message *)@
type ProcessMessage =
  Ptr ()     {- ^ extention state -} ->
  Ptr FgnMsg {- ^ message to send -} ->
  IO ProcessResult

-- | @typedef void process_command(void *glirc, void *S, const struct glirc_command *)@
type ProcessCommand =
  Ptr ()     {- ^ extension state -} ->
  Ptr FgnCmd {- ^ command         -} ->
  IO ()

-- | @typedef void process_chat(void *glirc, void *S, const struct glirc_chat *)@
type ProcessChat =
  Ptr ()      {- ^ extension state -} ->
  Ptr FgnChat {- ^ chat info       -} ->
  IO ProcessResult

-- | Integer type of timer IDs
type TimerId = Int64
{-# LINE 133 "src/Client/CApi/Types.hsc" #-}

-- | Callback function when timer triggers
type TimerCallback =
  Ptr ()  {- ^ timer state     -} ->
  TimerId {- ^ timer ID        -} ->
  IO ()

-- | Type of dynamic function pointer wrappers. These convert C
-- function-pointers into Haskell functions.
type Dynamic a = FunPtr a -> a

-- | Dynamic import for 'StartExtension'.
foreign import ccall "dynamic" runStartExtension :: Dynamic StartExtension
-- | Dynamic import for 'StopExtension'.
foreign import ccall "dynamic" runStopExtension  :: Dynamic StopExtension
-- | Dynamic import for 'ProcessMessage'.
foreign import ccall "dynamic" runProcessMessage :: Dynamic ProcessMessage
-- | Dynamic import for 'ProcessCommand'.
foreign import ccall "dynamic" runProcessCommand :: Dynamic ProcessCommand
-- | Dynamic import for 'ProcessChat'.
foreign import ccall "dynamic" runProcessChat    :: Dynamic ProcessChat
-- | Dynamic import for timer callback
foreign import ccall "dynamic" runTimerCallback  :: Dynamic TimerCallback

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

-- | Information describing an extension's entry-points and metadata.
data FgnExtension = FgnExtension
  { fgnStart   :: FunPtr StartExtension -- ^ Optional startup callback
  , fgnStop    :: FunPtr StopExtension  -- ^ Optional shutdown callback
  , fgnMessage :: FunPtr ProcessMessage -- ^ Optional message received callback
  , fgnChat    :: FunPtr ProcessChat    -- ^ Optional message send callback
  , fgnCommand :: FunPtr ProcessCommand -- ^ Optional client command callback
  , fgnName    :: CString               -- ^ Null-terminated name
  , fgnMajorVersion, fgnMinorVersion :: CInt -- ^ extension version
  }

-- | @struct glirc_extension@
instance Storable FgnExtension where
  alignment _ = 8
{-# LINE 173 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (56)
{-# LINE 174 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnExtension
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 176 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 177 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 178 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 179 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 180 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 181 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 182 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p
{-# LINE 183 "src/Client/CApi/Types.hsc" #-}
  poke p FgnExtension{..} =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p fgnStart
{-# LINE 185 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p fgnStop
{-# LINE 186 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p fgnMessage
{-# LINE 187 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) p fgnChat
{-# LINE 188 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p fgnCommand
{-# LINE 189 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p fgnName
{-# LINE 190 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p fgnMajorVersion
{-# LINE 191 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p fgnMinorVersion
{-# LINE 192 "src/Client/CApi/Types.hsc" #-}

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

-- | @struct glirc_message@
data FgnMsg = FgnMsg
  { fmNetwork    :: FgnStringLen
  , fmPrefixNick :: FgnStringLen
  , fmPrefixUser :: FgnStringLen
  , fmPrefixHost :: FgnStringLen
  , fmCommand    :: FgnStringLen
  , fmParams     :: Ptr FgnStringLen -- ^ array
  , fmParamN     :: CSize            -- ^ array length
  , fmTagKeys    :: Ptr FgnStringLen -- ^ array
  , fmTagVals    :: Ptr FgnStringLen -- ^ array
  , fmTagN       :: CSize            -- ^ array length
  }

instance Storable FgnMsg where
  alignment _ = 8
{-# LINE 211 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (120)
{-# LINE 212 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnMsg
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 214 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 215 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 216 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 217 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) p
{-# LINE 218 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 80)) p
{-# LINE 219 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 88)) p
{-# LINE 220 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p
{-# LINE 221 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 104)) p
{-# LINE 222 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p
{-# LINE 223 "src/Client/CApi/Types.hsc" #-}

  poke p FgnMsg{..} =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p fmNetwork
{-# LINE 226 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p fmPrefixNick
{-# LINE 227 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p fmPrefixUser
{-# LINE 228 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) p fmPrefixHost
{-# LINE 229 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 64)) p fmCommand
{-# LINE 230 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 80)) p fmParams
{-# LINE 231 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 88)) p fmParamN
{-# LINE 232 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 96)) p fmTagKeys
{-# LINE 233 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 104)) p fmTagVals
{-# LINE 234 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 112)) p fmTagN
{-# LINE 235 "src/Client/CApi/Types.hsc" #-}

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

-- | Chat message data containing the source network, window target,
-- and message body.
data FgnChat = FgnChat
  { fhNetwork    :: FgnStringLen
  , fhTarget     :: FgnStringLen
  , fhMessage    :: FgnStringLen
  }

-- | @struct glirc_message@
instance Storable FgnChat where
  alignment _ = 8
{-# LINE 249 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (48)
{-# LINE 250 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnChat
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 252 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 253 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 254 "src/Client/CApi/Types.hsc" #-}

  poke p FgnChat{..} =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p fhNetwork
{-# LINE 257 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p fhTarget
{-# LINE 258 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p fhMessage
{-# LINE 259 "src/Client/CApi/Types.hsc" #-}

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

-- | Used to pass arguments from @/extension EXT_NAME@ client command into
-- an extension.
data FgnCmd = FgnCmd
  { fcCommand :: FgnStringLen
  }

-- | @struct glirc_command@
instance Storable FgnCmd where
  alignment _ = 8
{-# LINE 271 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (16)
{-# LINE 272 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnCmd
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 274 "src/Client/CApi/Types.hsc" #-}

  poke p FgnCmd{..} = ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p fcCommand
{-# LINE 276 "src/Client/CApi/Types.hsc" #-}

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

-- | Pointer to UTF-8 encoded string and as string length. Strings are
-- null-terminated. The null-terminator is not counted in the length.
data FgnStringLen = FgnStringLen !CString !CSize

-- | @struct glirc_string@
instance Storable FgnStringLen where
  alignment _ = 8
{-# LINE 286 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (16)
{-# LINE 287 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnStringLen
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 289 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 290 "src/Client/CApi/Types.hsc" #-}
  poke p (FgnStringLen x y) =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p x
{-# LINE 292 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p y
{-# LINE 293 "src/Client/CApi/Types.hsc" #-}

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

-- | Like 'poke' except it doesn't write to NULL
poke' :: Storable a => Ptr a -> a -> IO ()
poke' ptr x = unless (nullPtr == ptr) (poke ptr x)

-- | Marshal a text as a malloced null-terminated CStringLen
exportText :: Ptr CString -> Ptr CSize -> Text -> IO ()
exportText dstP dstL txt =

  Text.withCStringLen txt $ \(srcP, srcL) ->
    do poke' dstL (fromIntegral srcL)
       unless (dstP == nullPtr) $
         do a <- mallocArray0 srcL
            copyArray a srcP srcL
            pokeElemOff a srcL 0
            poke dstP a

-- | Marshal a text as a temporary null-terminated CStringLen
withText0 :: Text -> (CStringLen -> IO a) -> IO a
withText0 txt k =
  Text.withCStringLen txt $ \(p,l) ->
  allocaArray0 l $ \p' ->
    do copyArray p' p l
       pokeElemOff p' l 0
       k (p', l)