serokell-util 0.1.2.1 → 0.1.2.2

raw patch · 4 files changed

+51/−5 lines, 4 filesdep +monad-controldep +stm

Dependencies added: monad-control, stm

Files

• serokell-util.cabal +4/−1
• src/Serokell/Util/Base.hs +17/−0
• src/Serokell/Util/Concurrent.hs +18/−3
• src/Serokell/Util/Lens.hs +12/−1

@@ -1,5 +1,5 @@ name:                serokell-util-version:             0.1.2.1+version:             0.1.2.2 synopsis:            General-purpose functions by Serokell homepage:            https://github.com/serokell/serokell-util license:             MIT@@ -29,6 +29,7 @@                        Serokell.Data.Memory.Units                        Serokell.Data.Variant                        Serokell.Util+                       Serokell.Util.Base                        Serokell.Util.Base16                        Serokell.Util.Base64                        Serokell.Util.Bench@@ -74,6 +75,7 @@                      , formatting                      , hashable >= 1.2.4.0                      , lens+                     , monad-control                      , mtl                      , optparse-applicative                      , parsec@@ -81,6 +83,7 @@                      , safecopy >= 0.9.0.1                      , scientific                      , semigroups+                     , stm >= 2.4.4                      , template-haskell                      , text                      , text-format

@@ -0,0 +1,17 @@+-- | Util for MonadBaseControl++{-# LANGUAGE FlexibleContexts #-}++module Serokell.Util.Base+       ( inCurrentContext+       ) where++import           Control.Monad               (void)+import           Control.Monad.Trans         (MonadIO (..))+import           Control.Monad.Trans.Control (MonadBaseControl (..))++-- | Remembers monadic context of an action and transforms it to `IO`.+-- Note that any changes in context would be lost.+inCurrentContext :: (MonadBaseControl IO m, MonadIO n) => m () -> m (n ())+inCurrentContext action =+    liftBaseWith $ \runInIO -> return . liftIO . void $ runInIO action

@@ -2,13 +2,28 @@  module Serokell.Util.Concurrent        ( threadDelay+       , modifyTVarS        ) where -import qualified Control.Concurrent  as Concurrent-import           Control.Monad.Trans (MonadIO (liftIO))-import           Data.Time.Units     (TimeUnit (toMicroseconds))+import qualified Control.Concurrent          as Concurrent+import           Control.Concurrent.STM      (STM)+import           Control.Concurrent.STM.TVar (TVar, readTVar, writeTVar)+import           Control.Monad.State         (StateT, runStateT)+import           Control.Monad.Trans         (MonadIO (liftIO))+import           Data.Time.Units             (TimeUnit (toMicroseconds)) + -- | Convenient version of Control.Concurrent.threadDelay which takes -- any time-unit and operates in any MonadIO threadDelay :: (MonadIO m, TimeUnit unit) => unit -> m () threadDelay = liftIO . Concurrent.threadDelay . fromIntegral . toMicroseconds++-- | Atomically modifies given `TVar`, associating state of given `StateT` with+-- `TVar` entry.+-- TODO: maybe generalize to any container and monad? Define as operator?+modifyTVarS :: TVar s -> StateT s STM a -> STM a+modifyTVarS t st = do+    s <- readTVar t+    (a, s') <- runStateT st s+    writeTVar t s'+    return a

@@ -1,9 +1,12 @@-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE Rank2Types   #-}+{-# LANGUAGE TypeFamilies #-}  -- | Extra operators on Lens module Serokell.Util.Lens        ( (%%=)        , (%?=)+       , WrappedM (..)+       , _UnwrappedM        ) where  import qualified Control.Lens               as L@@ -25,3 +28,11 @@ infix 4 %?= (%?=) :: L.Lens' s a -> ExceptT t (State a) b -> ExceptT t (State s) b (%?=) l = mapExceptT (l %%=)++-- | Similar to `Wrapped`, but for `Monad`s.+class Monad m => WrappedM m where+    type UnwrappedM m :: * -> *+    _WrappedM :: L.Iso' (m a) (UnwrappedM m a)++_UnwrappedM :: WrappedM m => L.Iso' (UnwrappedM m a) (m a)+_UnwrappedM = L.from _WrappedM