data-timeout 0.3 → 0.3.1

raw patch · 3 files changed

+72/−9 lines, 3 filesdep +stm

Dependencies added: stm

Files

README.md +14/−0
data-timeout.cabal +15/−9
src/Control/Concurrent/STM/Timeout.hs +43/−0

+ README.md view

@@ -0,0 +1,14 @@+Data-Timeout+===========++[![Travis](https://img.shields.io/travis/mvv/data-timeout/master.svg)](https://travis-ci.org/mvv/data-timeout) [![Hackage](https://img.shields.io/hackage/v/data-timeout.svg)](http://hackage.haskell.org/package/data-timeout)++This package provides data types and functions for working with 64-bit+timeouts of nanosecond precision.++Installation+------------+The usual:++	$ cabal install+

data-timeout.cabal view

@@ -1,5 +1,5 @@ Name: data-timeout-Version: 0.3+Version: 0.3.1 Category: Data, Concurrency Stability: experimental Synopsis: 64-bit timeouts of nanosecond precision@@ -16,6 +16,12 @@ License: BSD3 License-File: LICENSE +Extra-Source-Files:+  README.md++Tested-With: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2,+             GHC==8.4.4, GHC==8.6.1+ Cabal-Version: >= 1.6.0 Build-Type: Simple @@ -24,16 +30,16 @@   Location: https://github.com/mvv/data-timeout.git  Library-  Build-Depends:-    base              >= 4 && < 5,-    tagged            >= 0.2,-    text-printer      >= 0.4,-    data-textual      >= 0.2,-    parsers           >= 0.5,-    transformers-base >= 0.3+  Build-Depends: base              >= 4 && < 5+               , tagged            >= 0.2+               , text-printer      >= 0.4+               , data-textual      >= 0.2+               , parsers           >= 0.5+               , transformers-base >= 0.3+               , stm               >= 2.2   Hs-Source-Dirs: src   GHC-Options: -Wall   Exposed-Modules:     Data.Timeout     Control.Concurrent.Timeout-+    Control.Concurrent.STM.Timeout

+ src/Control/Concurrent/STM/Timeout.hs view

@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++module Control.Concurrent.STM.Timeout+  ( registerDelay+  ) where++import Data.Timeout+import Control.Monad (void)+import Control.Monad.Base+import Control.Monad.STM+import Control.Concurrent.STM.TVar hiding (registerDelay)+import GHC.Event (registerTimeout)+#if MIN_VERSION_base(4,7,0)+import GHC.Event (getSystemTimerManager)+#else+import GHC.Event (getSystemEventManager)+#endif++registerDelay ∷ MonadBase IO μ ⇒ Timeout → μ (TVar Bool)+registerDelay tt = liftBase $+  if tt == instantly+    then newTVarIO True+    else do+      ttv ← newTVarIO False+#if MIN_VERSION_base(4,7,0)+      tmm ← getSystemTimerManager+#else+      Just tmm ← getSystemEventManager+#endif+      let us = tt #> MicroSecond+          maxUs = fromIntegral (maxBound ∷ Int)+          us' = maxUs `min` us+          rearm passed =+            case us - passed of+              0 → atomically $ writeTVar ttv True+              left → do+                let us'' = maxUs `min` left+                void $ registerTimeout tmm (fromIntegral us'') $+                  rearm $ passed + us''+      void $ registerTimeout tmm (fromIntegral us') $ rearm us'+      return ttv