{-# LINE 1 "src/Client/CApi/Types.hsc" #-}
{-# Language RecordWildCards #-}
module Client.CApi.Types
(
FgnExtension(..)
, StartExtension
, StopExtension
, ProcessMessage
, ProcessCommand
, ProcessChat
, TimerCallback
, TimerId
, ThreadFinish
, FgnStringLen(..)
, FgnMsg(..)
, FgnCmd(..)
, FgnChat(..)
, Dynamic
, runStartExtension
, runStopExtension
, runProcessMessage
, runProcessCommand
, runProcessChat
, runTimerCallback
, runThreadStart
, runThreadFinish
, MessageCode(..), normalMessage, errorMessage
, ProcessResult(..), passMessage, dropMessage
, 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
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" #-}
normalMessage :: MessageCode
normalMessage :: MessageCode
normalMessage = Word32 -> MessageCode
MessageCode (Word32
0)
{-# LINE 83 "src/Client/CApi/Types.hsc" #-}
errorMessage :: MessageCode
errorMessage :: MessageCode
errorMessage = Word32 -> MessageCode
MessageCode (Word32
1)
{-# LINE 88 "src/Client/CApi/Types.hsc" #-}
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" #-}
passMessage :: ProcessResult
passMessage :: ProcessResult
passMessage = Word32 -> ProcessResult
ProcessResult (Word32
0)
{-# LINE 98 "src/Client/CApi/Types.hsc" #-}
dropMessage :: ProcessResult
dropMessage :: ProcessResult
dropMessage = Word32 -> ProcessResult
ProcessResult (Word32
1)
{-# LINE 102 "src/Client/CApi/Types.hsc" #-}
type StartExtension =
Ptr () ->
CString ->
Ptr FgnStringLen ->
CSize ->
IO (Ptr ())
type StopExtension =
Ptr () ->
IO ()
type ProcessMessage =
Ptr () ->
Ptr FgnMsg ->
IO ProcessResult
type ProcessCommand =
Ptr () ->
Ptr FgnCmd ->
IO ()
type ProcessChat =
Ptr () ->
Ptr FgnChat ->
IO ProcessResult
type TimerId = Int64
{-# LINE 136 "src/Client/CApi/Types.hsc" #-}
type TimerCallback =
Ptr () ->
TimerId ->
IO ()
type ThreadStart =
Ptr () ->
IO (Ptr ())
type ThreadFinish =
Ptr () ->
IO ()
type Dynamic a = FunPtr a -> a
foreign import ccall "dynamic" runStartExtension :: Dynamic StartExtension
foreign import ccall "dynamic" runStopExtension :: Dynamic StopExtension
foreign import ccall "dynamic" runProcessMessage :: Dynamic ProcessMessage
foreign import ccall "dynamic" runProcessCommand :: Dynamic ProcessCommand
foreign import ccall "dynamic" runProcessChat :: Dynamic ProcessChat
foreign import ccall "dynamic" runTimerCallback :: Dynamic TimerCallback
foreign import ccall "dynamic" runThreadStart :: Dynamic ThreadStart
foreign import ccall "dynamic" runThreadFinish :: Dynamic ThreadFinish
data FgnExtension = FgnExtension
{ FgnExtension -> FunPtr StartExtension
fgnStart :: FunPtr StartExtension
, FgnExtension -> FunPtr StopExtension
fgnStop :: FunPtr StopExtension
, FgnExtension -> FunPtr ProcessMessage
fgnMessage :: FunPtr ProcessMessage
, FgnExtension -> FunPtr ProcessChat
fgnChat :: FunPtr ProcessChat
, FgnExtension -> FunPtr ProcessCommand
fgnCommand :: FunPtr ProcessCommand
, FgnExtension -> CString
fgnName :: CString
, FgnExtension -> CInt
fgnMajorVersion, FgnExtension -> CInt
fgnMinorVersion :: CInt
}
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" #-}
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
, FgnMsg -> CSize
fmParamN :: CSize
, FgnMsg -> Ptr FgnStringLen
fmTagKeys :: Ptr FgnStringLen
, FgnMsg -> Ptr FgnStringLen
fmTagVals :: Ptr FgnStringLen
, FgnMsg -> CSize
fmTagN :: CSize
}
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" #-}
data FgnChat = FgnChat
{ FgnChat -> FgnStringLen
fhNetwork :: FgnStringLen
, FgnChat -> FgnStringLen
fhTarget :: FgnStringLen
, FgnChat -> FgnStringLen
fhMessage :: FgnStringLen
}
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" #-}
data FgnCmd = FgnCmd
{ FgnCmd -> FgnStringLen
fcCommand :: FgnStringLen
}
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" #-}
data FgnStringLen = FgnStringLen !CString !CSize
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" #-}
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)
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
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)