tdlib 0.2.0 → 0.3.0
raw patch · 4 files changed
+41/−51 lines, 4 filesdep −unagi-chandep ~tdlib-types
Dependencies removed: unagi-chan
Dependency ranges changed: tdlib-types
Files
- CHANGELOG.md +5/−0
- src/TDLib/EventLoop.hs +8/−7
- tdlib.cabal +3/−5
- test/Spec.hs +25/−39
CHANGELOG.md view
@@ -15,3 +15,8 @@ ## 0.2.0 * Update the dependency tdlib-types to 0.2.0++## 0.3.0++* Get rid of unagi-chan+
src/TDLib/EventLoop.hs view
@@ -6,13 +6,14 @@ runTDLibEventLoop, -- * low level functions+ Ans,+ Locks, runCommand, loop, ) where import Control.Concurrent (forkIO, killThread)-import Control.Concurrent.Chan.Unagi import Control.Concurrent.STM import Control.Exception import Control.Monad@@ -89,8 +90,8 @@ _ -> writeTVar ans (M.delete index m) -- | runs the event loop that receives updates from the client and dispatches them-loop :: Client -> Double -> Locks -> Ans -> InChan Update -> IO a-loop client timeout lck ans chan = forever $ do+loop :: Client -> Double -> Locks -> Ans -> (Update -> IO ()) -> IO a+loop client timeout lck ans cont = forever $ do bs <- untilJust $ clientReceive client timeout let m = decodeStrict bs case m of@@ -101,7 +102,7 @@ let r = fromJSON v case r of Error _ -> throwIO $ UnableToParseValue v- Success u -> writeChan chan u+ Success u -> cont u Just i -> atomically $ insertAns i lck ans v -- | runs a command and waits for its answer@@ -119,12 +120,12 @@ v -> throwIO $ UnableToParseValue v -- | runs the TDLib effect-runTDLibEventLoop :: Members '[Embed IO] r => Double -> InChan Update -> Sem (TDLib ': r) a -> Sem r a-runTDLibEventLoop timeout chan m = do+runTDLibEventLoop :: Members '[Embed IO] r => Double -> (Update -> IO ()) -> Sem (TDLib ': r) a -> Sem r a+runTDLibEventLoop timeout cont m = do lck <- embed $ newTVarIO mempty ans <- embed $ newTVarIO mempty c <- embed newClient- tid <- embed $ forkIO $ loop c timeout lck ans chan+ tid <- embed $ forkIO $ loop c timeout lck ans cont counter <- embed newCounter let runTD = interpret $ \case RunCmd cmd -> do
tdlib.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.33.1. -- -- see: https://github.com/sol/hpack ----- hash: 4ccf45088eb19ab7965b8244cc769024a1e27467bf2778658af51c1de63c67c4+-- hash: dc1c28d2cc8a143c24b58b160748acf69dc1481af8d4b7ddfccaf23b3a796c14 name: tdlib-version: 0.2.0+version: 0.3.0 license: BSD3 license-file: LICENSE copyright: (c) 2020 Poscat@@ -52,7 +52,6 @@ stm >=2.5.0.0 && <2.6, tdlib-types >=0.3.0 && <0.4, text,- unagi-chan >=0.4.1.3 && <0.5, unordered-containers >=0.2.10.0 && <0.3 test-suite tdlib-test@@ -82,5 +81,4 @@ tdlib, tdlib-types >=0.3.0 && <0.4, text,- unagi-chan >=0.4.1.3 && <0.5, unordered-containers >=0.2.10.0 && <0.3
test/Spec.hs view
@@ -1,14 +1,11 @@ module Main where -import Control.Concurrent (forkIO)-import Control.Concurrent.Chan.Unagi 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 hiding (Text) import TDLib.Types.Common@@ -19,80 +16,69 @@ mm :: Testable a =>- InChan Update -> PropertyM (Sem '[TDLib, Embed IO]) a -> Property-mm ichan = monadic (rr ichan)+mm = monadic rr 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+rr m = (monadicIO . run . runM . runTDLibEventLoop 0.1 (const (pure ()))) (setVerbosity Fatal >> m) -- ** Main main :: IO () main = do- (ichan, ochan) <- newChan- forkIO $ updateConsumer ochan- quickCheck $ squareInt ichan- quickCheck $ callEmpty ichan- quickCheck $ callString ichan- quickCheck $ callVecInt ichan- quickCheck $ callVecIntObject ichan- quickCheck $ callVecString ichan- quickCheck $ callVecStringObject ichan+ quickCheck $ squareInt+ quickCheck $ callEmpty+ quickCheck $ callString+ quickCheck $ callVecInt+ quickCheck $ callVecIntObject+ quickCheck $ callVecString+ quickCheck $ callVecStringObject -- ** Properties -squareInt :: InChan Update -> I32 -> Property-squareInt ichan i = mm ichan $ do+squareInt :: I32 -> Property+squareInt i = mm $ do r <- run $ testSquareInt i assert $ Inr (TestInt $ (i :: Int) ^ (2 :: Int)) == r -callEmpty :: InChan Update -> Property-callEmpty ichan = mm ichan $ do+callEmpty :: Property+callEmpty = mm $ do ok <- run $ testCallEmpty assert $ Inr Ok == ok -callString :: InChan Update -> Text -> Property-callString ichan t = mm ichan $ do+callString :: Text -> Property+callString t = mm $ do r <- run $ testCallString t assert $ Inr (TestString t) == r -callVecInt :: InChan Update -> [I32] -> Property-callVecInt ichan vec = mm ichan $ do+callVecInt :: [I32] -> Property+callVecInt vec = mm $ do r <- run $ testCallVectorInt vec assert $ Inr (TestVectorInt vec) == r -callVecIntObject :: InChan Update -> [I32] -> Property-callVecIntObject ichan vec = mm ichan $ do+callVecIntObject :: [I32] -> Property+callVecIntObject vec = mm $ do let v' = fmap TestInt vec r <- run $ testCallVectorIntObject v' assert $ Inr (TestVectorIntObject v') == r -callVecString :: InChan Update -> [Text] -> Property-callVecString ichan vec = mm ichan $ do+callVecString :: [Text] -> Property+callVecString vec = mm $ do r <- run $ testCallVectorString vec assert $ Inr (TestVectorString vec) == r -callVecStringObject :: InChan Update -> [Text] -> Property-callVecStringObject ichan vec = mm ichan $ do+callVecStringObject :: [Text] -> Property+callVecStringObject vec = mm $ do let v' = fmap TestString vec r <- run $ testCallVectorStringObject v' assert $ Inr (TestVectorStringObject v') == r -callBytes :: InChan Update -> ByteString -> Property-callBytes ichan bs = mm ichan $ do+callBytes :: ByteString -> Property+callBytes bs = mm $ do let bs' = makeByteString64 bs r <- run $ testCallBytes bs' assert $ Inr (TestBytes bs') == r