tdlib 0.1.4 → 0.1.5
raw patch · 4 files changed
+127/−51 lines, 4 filesdep +quickcheck-textdep −generic-randomdep −hspecdep ~QuickCheckdep ~aesondep ~base64-bytestring-type
Dependencies added: quickcheck-text
Dependencies removed: generic-random, hspec
Dependency ranges changed: QuickCheck, aeson, base64-bytestring-type, bytestring, containers, polysemy, polysemy-plugin, stm, unagi-chan, unordered-containers
Files
- src/TDLib/EventLoop.hs +1/−2
- src/TDLib/TDJson.hs +18/−14
- tdlib.cabal +23/−25
- test/Spec.hs +85/−10
src/TDLib/EventLoop.hs view
@@ -18,10 +18,8 @@ import Control.Monad import Control.Monad.Loops import Data.Aeson-import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy (toStrict) import qualified Data.HashMap.Strict as HM-import qualified Data.HashMap.Strict as HM import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as M import Data.Maybe@@ -119,6 +117,7 @@ case m of Error _ -> throwIO $ UnableToParseValue v Success r -> pure r+ v -> throwIO $ UnableToParseValue v -- | runs the TDLib effect runTDLibEventLoop :: Members '[Embed IO] r => Double -> InChan Update -> Sem (TDLib ': r) a -> Sem r a
src/TDLib/TDJson.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InterruptibleFFI #-} -- | Bindings to TDLib Json interface module TDLib.TDJson@@ -38,39 +39,39 @@ type ClientPtr = Ptr () -foreign import ccall "td_json_client_create"+foreign import ccall interruptible "td_json_client_create" tdJsonClientCreate :: IO ClientPtr -foreign import ccall "td_json_client_send"+foreign import ccall interruptible "td_json_client_send" tdJsonClientSend :: ClientPtr -> CString -> IO () -foreign import ccall "td_json_client_receive"+foreign import ccall interruptible "td_json_client_receive" tdJsonClientReceive :: ClientPtr -> CDouble -> IO CString -foreign import ccall "td_json_client_execute"- tdJsonClientExecute :: ClientPtr -> CString -> IO ()+foreign import ccall interruptible "td_json_client_execute"+ tdJsonClientExecute :: ClientPtr -> CString -> IO CString -foreign import ccall "td_json_client_destroy"+foreign import ccall interruptible "td_json_client_destroy" tdJsonClientDestroy :: ClientPtr -> IO () -foreign import ccall "&td_json_client_destroy"+foreign import ccall interruptible "&td_json_client_destroy" p_clientDestory :: FunPtr (ClientPtr -> IO ()) -foreign import ccall "td_set_log_file_path"+foreign import ccall interruptible "td_set_log_file_path" tdSetLogFilePath :: CString -> IO CInt -foreign import ccall "td_set_log_max_file_size"+foreign import ccall interruptible "td_set_log_max_file_size" tdSetLogMaxFileSize :: CLLong -> IO () -foreign import ccall "td_set_log_verbosity_level"+foreign import ccall interruptible "td_set_log_verbosity_level" tdSetLogVerbosityLevel :: CInt -> IO () type CallbackPtr = FunPtr (CString -> IO ()) -foreign import ccall "td_set_log_fatal_error_callback"+foreign import ccall interruptible "td_set_log_fatal_error_callback" tdSetLogFatalErrorCallback :: CallbackPtr -> IO () -foreign import ccall "wrapper"+foreign import ccall interruptible "wrapper" mkCallbackPtr_ :: (CString -> IO ()) -> IO CallbackPtr mkCallbackPtr :: (ByteString -> IO ()) -> IO CallbackPtr@@ -121,11 +122,14 @@ Client -> -- | JSON-serialized null-terminated request to TDLib. ByteString ->- IO ()+ IO (Maybe ByteString) clientExecute (Client fptr) cmd = useAsCString cmd $ \cstr -> withForeignPtr fptr $ \ptr -> do- tdJsonClientExecute ptr cstr+ cs <- tdJsonClientExecute ptr cstr+ if cs == nullPtr+ then pure Nothing+ else Just <$> packCString cs -- | Destroys the TDLib client instance. After this is called the client instance shouldn't be used anymore. destroyClient ::
tdlib.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e0350137321b986ba9d30546b221776f1fc4d0f228d731766e5bfeb99f0842bb+-- hash: d287bd2284586f7f41e71152629ccc38f4bf2443d1ad489bcca5499b9b6c9a5f name: tdlib-version: 0.1.4+version: 0.1.5 license: BSD3 license-file: LICENSE copyright: (c) 2020 Poscat@@ -42,19 +42,18 @@ tdjson ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively build-depends:- aeson,+ aeson >=1.4.7 && <1.6, base >=4.10 && <5,- base64-bytestring-type,- bytestring >=0.10.10.0 && <0.11,- containers,+ bytestring,+ containers >=1.6.2.1 && <1.7, monad-loops,- polysemy,- polysemy-plugin,- stm,- tdlib-types,+ polysemy >=1.3.0.0 && <1.4,+ polysemy-plugin >=0.2.5.0 && <0.3,+ stm >=2.5.0.0 && <2.6,+ tdlib-types >=0.1.0 && <0.2, text,- unagi-chan,- unordered-containers+ unagi-chan >=0.2.5.0 && <0.3,+ unordered-containers >=0.2.10.0 && <0.3 test-suite tdlib-test type: exitcode-stdio-1.0@@ -69,20 +68,19 @@ tdjson ghc-options: -fplugin=Polysemy.Plugin -flate-specialise -fspecialise-aggressively -threaded -rtsopts -with-rtsopts=-N build-depends:- QuickCheck,- aeson,+ QuickCheck >=2.14 && <2.15,+ aeson >=1.4.7 && <1.6, base >=4.10 && <5,- base64-bytestring-type,- bytestring >=0.10.10.0 && <0.11,- containers,- generic-random,- hspec,+ base64-bytestring-type >=1.0.1 && <1.1,+ bytestring,+ containers >=1.6.2.1 && <1.7, monad-loops,- polysemy,- polysemy-plugin,- stm,+ polysemy >=1.3.0.0 && <1.4,+ polysemy-plugin >=0.2.5.0 && <0.3,+ quickcheck-text >=0.1.2.1 && <0.2,+ stm >=2.5.0.0 && <2.6, tdlib,- tdlib-types,+ tdlib-types >=0.1.0 && <0.2, text,- unagi-chan,- unordered-containers+ unagi-chan >=0.2.5.0 && <0.3,+ unordered-containers >=0.2.10.0 && <0.3
test/Spec.hs view
@@ -1,23 +1,98 @@ module Main where +import Control.Concurrent (forkIO) import Control.Concurrent.Chan.Unagi-import Polysemy+import Data.ByteString (ByteString)+import Data.ByteString.Base64.Type+import Data.Text.Arbitrary+import Polysemy hiding (run) import TDLib.Effect import TDLib.EventLoop import TDLib.Generated.FunArgs import TDLib.Generated.Functions-import TDLib.Generated.Types-import Test.Hspec+import TDLib.Generated.Types hiding (Text)+import TDLib.Types.Common import Test.QuickCheck+import Test.QuickCheck.Monadic +-- ** Helper functions++mm ::+ Testable a =>+ InChan Update ->+ PropertyM (Sem '[TDLib, Embed IO]) a ->+ Property+mm ichan = monadic (rr ichan)++rr ::+ Testable a =>+ InChan Update ->+ Sem '[TDLib, Embed IO] a ->+ Property+rr ichan m = (monadicIO . run . runM . runTDLibEventLoop 0.1 ichan) (setVerbosity Fatal >> m)++updateConsumer :: OutChan Update -> IO ()+updateConsumer chan = go+ where+ go = do+ readChan chan+ go++-- ** Main+ main :: IO () main = do (ichan, ochan) <- newChan- runM $ runTDLibEventLoop 5 ichan $ do- setLogPath "test-log.txt"- r <- testSquareInt (TestSquareInt 2)- embed $ print r+ forkIO $ updateConsumer ochan+ quickCheck $ squareInt ichan+ quickCheck $ callEmpty ichan+ quickCheck $ callString ichan+ quickCheck $ callVecInt ichan+ quickCheck $ callVecIntObject ichan+ quickCheck $ callVecString ichan+ quickCheck $ callVecStringObject ichan -hspecTest :: IO ()-hspecTest = hspec $ do- pure ()+-- ** Properties++squareInt :: InChan Update -> I32 -> Property+squareInt ichan i = mm ichan $ do+ r <- run $ testSquareInt (TestSquareInt i)+ assert $ Inr (TestInt $ (i :: Int) ^ (2 :: Int)) == r++callEmpty :: InChan Update -> Property+callEmpty ichan = mm ichan $ do+ ok <- run $ testCallEmpty TestCallEmpty+ assert $ Inr Ok == ok++callString :: InChan Update -> Text -> Property+callString ichan t = mm ichan $ do+ r <- run $ testCallString (TestCallString t)+ assert $ Inr (TestString t) == r++callVecInt :: InChan Update -> [I32] -> Property+callVecInt ichan vec = mm ichan $ do+ r <- run $ testCallVectorInt (TestCallVectorInt vec)+ assert $ Inr (TestVectorInt vec) == r++callVecIntObject :: InChan Update -> [I32] -> Property+callVecIntObject ichan vec = mm ichan $ do+ let v' = fmap TestInt vec+ r <- run $ testCallVectorIntObject (TestCallVectorIntObject v')+ assert $ Inr (TestVectorIntObject v') == r++callVecString :: InChan Update -> [Text] -> Property+callVecString ichan vec = mm ichan $ do+ r <- run $ testCallVectorString (TestCallVectorString vec)+ assert $ Inr (TestVectorString vec) == r++callVecStringObject :: InChan Update -> [Text] -> Property+callVecStringObject ichan vec = mm ichan $ do+ let v' = fmap TestString vec+ r <- run $ testCallVectorStringObject (TestCallVectorStringObject v')+ assert $ Inr (TestVectorStringObject v') == r++callBytes :: InChan Update -> ByteString -> Property+callBytes ichan bs = mm ichan $ do+ let bs' = makeByteString64 bs+ r <- run $ testCallBytes (TestCallBytes bs')+ assert $ Inr (TestBytes bs') == r