{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InterruptibleFFI #-}
module TDLib.TDJson
( Client,
newClient,
destroyClient,
clientReceive,
clientSend,
clientExecute,
setLogFilePath,
setLogMaxFileSize,
setLogVerbosityLevel,
setLogFatalErrorCallback,
)
where
import Data.ByteString
( ByteString,
packCString,
useAsCString,
)
import Data.Int
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Ptr
import TDLib.Types.Common
newtype Client = Client (ForeignPtr ())
deriving newtype (Client -> Client -> Bool
(Client -> Client -> Bool)
-> (Client -> Client -> Bool) -> Eq Client
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Client -> Client -> Bool
$c/= :: Client -> Client -> Bool
== :: Client -> Client -> Bool
$c== :: Client -> Client -> Bool
Eq, Eq Client
Eq Client =>
(Client -> Client -> Ordering)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Bool)
-> (Client -> Client -> Client)
-> (Client -> Client -> Client)
-> Ord Client
Client -> Client -> Bool
Client -> Client -> Ordering
Client -> Client -> Client
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Client -> Client -> Client
$cmin :: Client -> Client -> Client
max :: Client -> Client -> Client
$cmax :: Client -> Client -> Client
>= :: Client -> Client -> Bool
$c>= :: Client -> Client -> Bool
> :: Client -> Client -> Bool
$c> :: Client -> Client -> Bool
<= :: Client -> Client -> Bool
$c<= :: Client -> Client -> Bool
< :: Client -> Client -> Bool
$c< :: Client -> Client -> Bool
compare :: Client -> Client -> Ordering
$ccompare :: Client -> Client -> Ordering
$cp1Ord :: Eq Client
Ord, Int -> Client -> ShowS
[Client] -> ShowS
Client -> String
(Int -> Client -> ShowS)
-> (Client -> String) -> ([Client] -> ShowS) -> Show Client
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> String
$cshow :: Client -> String
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
Show)
type ClientPtr = Ptr ()
foreign import ccall interruptible "td_json_client_create"
tdJsonClientCreate :: IO ClientPtr
foreign import ccall interruptible "td_json_client_send"
tdJsonClientSend :: ClientPtr -> CString -> IO ()
foreign import ccall interruptible "td_json_client_receive"
tdJsonClientReceive :: ClientPtr -> CDouble -> IO CString
foreign import ccall interruptible "td_json_client_execute"
tdJsonClientExecute :: ClientPtr -> CString -> IO CString
foreign import ccall interruptible "td_json_client_destroy"
tdJsonClientDestroy :: ClientPtr -> IO ()
foreign import ccall interruptible "&td_json_client_destroy"
p_clientDestory :: FunPtr (ClientPtr -> IO ())
foreign import ccall interruptible "td_set_log_file_path"
tdSetLogFilePath :: CString -> IO CInt
foreign import ccall interruptible "td_set_log_max_file_size"
tdSetLogMaxFileSize :: CLLong -> IO ()
foreign import ccall interruptible "td_set_log_verbosity_level"
tdSetLogVerbosityLevel :: CInt -> IO ()
type CallbackPtr = FunPtr (CString -> IO ())
foreign import ccall interruptible "td_set_log_fatal_error_callback"
tdSetLogFatalErrorCallback :: CallbackPtr -> IO ()
foreign import ccall interruptible "wrapper"
mkCallbackPtr_ :: (CString -> IO ()) -> IO CallbackPtr
mkCallbackPtr :: (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr :: (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr cont :: ByteString -> IO ()
cont =
(CString -> IO ()) -> IO CallbackPtr
mkCallbackPtr_ CString -> IO ()
cont'
where
cont' :: CString -> IO ()
cont' cs :: CString
cs = do
ByteString
bs <- CString -> IO ByteString
packCString CString
cs
ByteString -> IO ()
cont ByteString
bs
newClient :: IO Client
newClient :: IO Client
newClient = do
ClientPtr
cptr <- IO ClientPtr
tdJsonClientCreate
ForeignPtr ()
fptr <- FinalizerPtr () -> ClientPtr -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
p_clientDestory ClientPtr
cptr
Client -> IO Client
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Client -> IO Client) -> Client -> IO Client
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> Client
Client ForeignPtr ()
fptr
clientSend ::
Client ->
ByteString ->
IO ()
clientSend :: Client -> ByteString -> IO ()
clientSend (Client fptr :: ForeignPtr ()
fptr) msg :: ByteString
msg =
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
msg ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
ForeignPtr () -> (ClientPtr -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO ()) -> IO ()) -> (ClientPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
ClientPtr -> CString -> IO ()
tdJsonClientSend ClientPtr
ptr CString
cstr
clientReceive ::
Client ->
Double ->
IO (Maybe ByteString)
clientReceive :: Client -> Double -> IO (Maybe ByteString)
clientReceive (Client fptr :: ForeignPtr ()
fptr) t :: Double
t =
ForeignPtr ()
-> (ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
CString
cs <- ClientPtr -> CDouble -> IO CString
tdJsonClientReceive ClientPtr
ptr (Double -> CDouble
CDouble Double
t)
if CString
cs CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
then Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
packCString CString
cs
clientExecute ::
Client ->
ByteString ->
IO (Maybe ByteString)
clientExecute :: Client -> ByteString -> IO (Maybe ByteString)
clientExecute (Client fptr :: ForeignPtr ()
fptr) cmd :: ByteString
cmd =
ByteString
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
cmd ((CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
ForeignPtr ()
-> (ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (ClientPtr -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \ptr :: ClientPtr
ptr -> do
CString
cs <- ClientPtr -> CString -> IO CString
tdJsonClientExecute ClientPtr
ptr CString
cstr
if CString
cs CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
then Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
packCString CString
cs
destroyClient ::
Client ->
IO ()
destroyClient :: Client -> IO ()
destroyClient (Client fptr :: ForeignPtr ()
fptr) = ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fptr
setLogFilePath ::
ByteString ->
IO Bool
setLogFilePath :: ByteString -> IO Bool
setLogFilePath fp :: ByteString
fp =
ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
fp ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr -> do
CInt
i <- CString -> IO CInt
tdSetLogFilePath CString
cstr
if | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Bool
otherwise -> String -> IO Bool
forall a. HasCallStack => String -> a
error (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ "Unknown return code" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
i
setLogMaxFileSize ::
Int64 ->
IO ()
setLogMaxFileSize :: Int64 -> IO ()
setLogMaxFileSize = CLLong -> IO ()
tdSetLogMaxFileSize (CLLong -> IO ()) -> (Int64 -> CLLong) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CLLong
CLLong
setLogVerbosityLevel :: Verbosity -> IO ()
setLogVerbosityLevel :: Verbosity -> IO ()
setLogVerbosityLevel = CInt -> IO ()
tdSetLogVerbosityLevel (CInt -> IO ()) -> (Verbosity -> CInt) -> Verbosity -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a. Enum a => Int -> a
toEnum (Int -> CInt) -> (Verbosity -> Int) -> Verbosity -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Int
forall a. Enum a => a -> Int
fromEnum
setLogFatalErrorCallback :: (ByteString -> IO ()) -> IO ()
setLogFatalErrorCallback :: (ByteString -> IO ()) -> IO ()
setLogFatalErrorCallback cont :: ByteString -> IO ()
cont = do
CallbackPtr
cbptr <- (ByteString -> IO ()) -> IO CallbackPtr
mkCallbackPtr ByteString -> IO ()
cont
CallbackPtr -> IO ()
tdSetLogFatalErrorCallback CallbackPtr
cbptr