{-# 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
  , ThreadFinish

  -- * Strings
  , FgnStringLen(..)

  -- * Messages
  , FgnMsg(..)

  -- * Commands
  , FgnCmd(..)

  -- * Chat
  , FgnChat(..)

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

  -- * 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 MessageCode -> MessageCode -> Bool
(MessageCode -> MessageCode -> Bool)
-> (MessageCode -> MessageCode -> Bool) -> Eq MessageCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageCode -> MessageCode -> Bool
$c/= :: MessageCode -> MessageCode -> Bool
== :: MessageCode -> MessageCode -> Bool
$c== :: MessageCode -> MessageCode -> Bool
Eq
{-# LINE 78 "src/Client/CApi/Types.hsc" #-}

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

-- | Important client message. Unread counter increments, bell rings,
-- and error status updates.
errorMessage :: MessageCode
errorMessage :: MessageCode
errorMessage = Word32 -> MessageCode
MessageCode (Word32
1)
{-# LINE 88 "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 ProcessResult -> ProcessResult -> Bool
(ProcessResult -> ProcessResult -> Bool)
-> (ProcessResult -> ProcessResult -> Bool) -> Eq ProcessResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessResult -> ProcessResult -> Bool
$c/= :: ProcessResult -> ProcessResult -> Bool
== :: ProcessResult -> ProcessResult -> Bool
$c== :: ProcessResult -> ProcessResult -> Bool
Eq
{-# LINE 94 "src/Client/CApi/Types.hsc" #-}

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

-- | Drop the message from further processing.
dropMessage :: ProcessResult
dropMessage :: ProcessResult
dropMessage = Word32 -> ProcessResult
ProcessResult (Word32
1)
{-# LINE 102 "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 136 "src/Client/CApi/Types.hsc" #-}

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

-- | Startup function for threads
type ThreadStart =
  Ptr () {- ^ initial argument -} ->
  IO (Ptr ()) {- ^ result for ThreadFinish -}

-- | @typedef void thread_finish(void *glirc, void *S)@
type ThreadFinish =
  Ptr () {- ^ thread result -} ->
  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
-- | Dynamic import for thread starts
foreign import ccall "dynamic" runThreadStart    :: Dynamic ThreadStart
-- | Dynamic import for 'ThreadFinish'.
foreign import ccall "dynamic" runThreadFinish   :: Dynamic ThreadFinish

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

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

-- | @struct glirc_extension@
instance Storable FgnExtension where
  alignment :: FgnExtension -> Int
alignment FgnExtension
_ = Int
8
{-# LINE 190 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (56)
{-# LINE 191 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnExtension
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 193 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 194 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 195 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 196 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 197 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 198 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 199 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p
{-# LINE 200 "src/Client/CApi/Types.hsc" #-}
  poke p FgnExtension{..} =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p fgnStart
{-# LINE 202 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p fgnStop
{-# LINE 203 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p fgnMessage
{-# LINE 204 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) p fgnChat
{-# LINE 205 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p fgnCommand
{-# LINE 206 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p fgnName
{-# LINE 207 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p fgnMajorVersion
{-# LINE 208 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p fgnMinorVersion
{-# LINE 209 "src/Client/CApi/Types.hsc" #-}

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

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

instance Storable FgnMsg where
  alignment :: FgnMsg -> Int
alignment FgnMsg
_ = Int
8
{-# LINE 228 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (120)
{-# LINE 229 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnMsg
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 231 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 232 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 233 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 234 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) p
{-# LINE 235 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 80)) p
{-# LINE 236 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 88)) p
{-# LINE 237 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p
{-# LINE 238 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 104)) p
{-# LINE 239 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p
{-# LINE 240 "src/Client/CApi/Types.hsc" #-}

  poke :: Ptr FgnMsg -> FgnMsg -> IO ()
poke Ptr FgnMsg
p FgnMsg{Ptr FgnStringLen
CSize
FgnStringLen
fmTagN :: CSize
fmTagVals :: Ptr FgnStringLen
fmTagKeys :: Ptr FgnStringLen
fmParamN :: CSize
fmParams :: Ptr FgnStringLen
fmCommand :: FgnStringLen
fmPrefixHost :: FgnStringLen
fmPrefixUser :: FgnStringLen
fmPrefixNick :: FgnStringLen
fmNetwork :: 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
..} =
             do ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
0)) Ptr FgnMsg
p FgnStringLen
fmNetwork
{-# LINE 243 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
16)) Ptr FgnMsg
p FgnStringLen
fmPrefixNick
{-# LINE 244 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
32)) Ptr FgnMsg
p FgnStringLen
fmPrefixUser
{-# LINE 245 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
48)) Ptr FgnMsg
p FgnStringLen
fmPrefixHost
{-# LINE 246 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
64)) Ptr FgnMsg
p FgnStringLen
fmCommand
{-# LINE 247 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> Ptr FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
80)) Ptr FgnMsg
p Ptr FgnStringLen
fmParams
{-# LINE 248 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
88)) Ptr FgnMsg
p CSize
fmParamN
{-# LINE 249 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> Ptr FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
96)) Ptr FgnMsg
p Ptr FgnStringLen
fmTagKeys
{-# LINE 250 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> Ptr FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
104)) Ptr FgnMsg
p Ptr FgnStringLen
fmTagVals
{-# LINE 251 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnMsg
hsc_ptr -> Ptr FgnMsg -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnMsg
hsc_ptr Int
112)) Ptr FgnMsg
p CSize
fmTagN
{-# LINE 252 "src/Client/CApi/Types.hsc" #-}

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

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

-- | @struct glirc_message@
instance Storable FgnChat where
  alignment :: FgnChat -> Int
alignment FgnChat
_ = Int
8
{-# LINE 266 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (48)
{-# LINE 267 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnChat
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 269 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 270 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 271 "src/Client/CApi/Types.hsc" #-}

  poke :: Ptr FgnChat -> FgnChat -> IO ()
poke Ptr FgnChat
p FgnChat{FgnStringLen
fhMessage :: FgnStringLen
fhTarget :: FgnStringLen
fhNetwork :: FgnStringLen
fhMessage :: FgnChat -> FgnStringLen
fhTarget :: FgnChat -> FgnStringLen
fhNetwork :: FgnChat -> FgnStringLen
..} =
             do ((\Ptr FgnChat
hsc_ptr -> Ptr FgnChat -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnChat
hsc_ptr Int
0)) Ptr FgnChat
p FgnStringLen
fhNetwork
{-# LINE 274 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnChat
hsc_ptr -> Ptr FgnChat -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnChat
hsc_ptr Int
16)) Ptr FgnChat
p FgnStringLen
fhTarget
{-# LINE 275 "src/Client/CApi/Types.hsc" #-}
                ((\Ptr FgnChat
hsc_ptr -> Ptr FgnChat -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnChat
hsc_ptr Int
32)) Ptr FgnChat
p FgnStringLen
fhMessage
{-# LINE 276 "src/Client/CApi/Types.hsc" #-}

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

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

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

  poke :: Ptr FgnCmd -> FgnCmd -> IO ()
poke Ptr FgnCmd
p FgnCmd{FgnStringLen
fcCommand :: FgnStringLen
fcCommand :: FgnCmd -> FgnStringLen
..} = ((\Ptr FgnCmd
hsc_ptr -> Ptr FgnCmd -> Int -> FgnStringLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FgnCmd
hsc_ptr Int
0)) Ptr FgnCmd
p FgnStringLen
fcCommand
{-# LINE 293 "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 :: FgnStringLen -> Int
alignment FgnStringLen
_ = Int
8
{-# LINE 303 "src/Client/CApi/Types.hsc" #-}
  sizeOf    _ = (16)
{-# LINE 304 "src/Client/CApi/Types.hsc" #-}
  peek p      = FgnStringLen
            <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 306 "src/Client/CApi/Types.hsc" #-}
            <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 307 "src/Client/CApi/Types.hsc" #-}
  poke p (FgnStringLen x y) =
             do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p x
{-# LINE 309 "src/Client/CApi/Types.hsc" #-}
                ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p y
{-# LINE 310 "src/Client/CApi/Types.hsc" #-}

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

-- | Like 'poke' except it doesn't write to NULL
poke' :: Storable a => Ptr a -> a -> IO ()
poke' :: Ptr a -> a -> IO ()
poke' Ptr a
ptr a
x = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr a
forall a. Ptr a
nullPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
ptr) (Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x)

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

  Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
Text.withCStringLen Text
txt ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
srcP, Int
srcL) ->
    do Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke' Ptr CSize
dstL (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcL)
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr CString
dstP Ptr CString -> Ptr CString -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CString
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         do CString
a <- Int -> IO CString
forall a. Storable a => Int -> IO (Ptr a)
mallocArray0 Int
srcL
            CString -> CString -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
a CString
srcP Int
srcL
            CString -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff CString
a Int
srcL CChar
0
            Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
dstP CString
a

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