git.iko.soy/effectful
on master help sign in
Added Timeout effect (#35)
commit23d789ab88bc4c6c22fa12149b42c6e258b46f63 authorMann mit Hut <mmhat@users.noreply.github.com> dateSun 3 Oct 2021, 15:16 (5 years ago) parentda56557
4 files changed+59
compare with master
unifiedsplit
effectful/effectful.cabal+2 effectful/src/Effectful/Timeout.hs+30 effectful/tests/Main.hs+2 effectful/tests/TimeoutTests.hs+25
effectful/effectful.cabal+2
@@ -77,6 +77,7 @@ library
7777 Effectful.Process
7878 Effectful.Resource
7979 Effectful.Temporary
80+ Effectful.Timeout
8081
8182 reexported-modules: Effectful.Error
8283 , Effectful.Error.Dynamic
@@ -117,6 +118,7 @@ test-suite test
117118 EnvironmentTests
118119 ErrorTests
119120 StateTests
121+ TimeoutTests
120122 Utils
121123 -- These are examples; We do not actually run them but list
122124 -- them here in order to check if they compile.
effectful/src/Effectful/Timeout.hsnew file+30
@@ -0,0 +1,30 @@
1+module Effectful.Timeout
2+ ( Timeout
3+ , runTimeout
4+ , timeout
5+ ) where
6+
7+import qualified System.Timeout as T
8+
9+import Effectful.Internal.Effect
10+import Effectful.Internal.Monad
11+
12+-- | An effect for timing out computations.
13+data Timeout :: Effect where
14+ Timeout :: Timeout m r
15+
16+-- | Run the 'Timeout' effect.
17+runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a
18+runTimeout = evalEffect (IdE Timeout)
19+
20+-- | Lifted 'T.timeout'.
21+timeout
22+ :: Timeout :> es
23+ => Int
24+ -- ^ The timeout in microseconds (1/10^6 seconds).
25+ -> Eff es a
26+ -- ^ The computation the timeout applies to.
27+ -> Eff es (Maybe a)
28+timeout n k = unsafeEff $ \es -> do
29+ seqUnliftEff es $ \unlift -> do
30+ T.timeout n $ unlift k
effectful/tests/Main.hs+2
@@ -7,6 +7,7 @@ import ConcurrencyTests
77import EnvironmentTests
88import ErrorTests
99import StateTests
10+import TimeoutTests
1011
1112main :: IO ()
1213main = defaultMain $ testGroup "effectful"
@@ -15,4 +16,5 @@ main = defaultMain $ testGroup "effectful"
1516 , environmentTests
1617 , errorTests
1718 , stateTests
19+ , timeoutTests
1820 ]
effectful/tests/TimeoutTests.hsnew file+25
@@ -0,0 +1,25 @@
1+module TimeoutTests (timeoutTests) where
2+
3+import Control.Concurrent (threadDelay)
4+import Test.Tasty
5+import Test.Tasty.HUnit
6+
7+import Effectful
8+import Effectful.Timeout
9+import qualified Utils as U
10+
11+timeoutTests :: TestTree
12+timeoutTests = testGroup "Timeout"
13+ [ testCase "return before timeout" test_returnBeforeTimeout
14+ , testCase "timeout before return" test_timeoutBeforeReturn
15+ ]
16+
17+test_returnBeforeTimeout :: Assertion
18+test_returnBeforeTimeout = runEff $ do
19+ result <- runTimeout $ timeout 1000 $ return ()
20+ U.assertEqual "return value" (Just ()) result
21+
22+test_timeoutBeforeReturn :: Assertion
23+test_timeoutBeforeReturn = runEff $ do
24+ result <- runTimeout $ timeout 0 $ liftIO $ threadDelay 1000
25+ U.assertEqual "no return value" Nothing result