composite-base 0.5.4.0 → 0.5.5.0
raw patch · 2 files changed
+50/−11 lines, 2 filesdep +unliftio-coredep ~exceptionsdep ~template-haskelldep ~vinyl
Dependencies added: unliftio-core
Dependency ranges changed: exceptions, template-haskell, vinyl
Files
- composite-base.cabal +13/−10
- src/Control/Monad/Composite/Context.hs +37/−1
composite-base.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack ----- hash: 0e7b65fc80c01f09bbc6c5d29da7e17ba09561542cffc9f1780105d9c863f54d+-- hash: 1ecc9858c092eb474a62472e1f3bd7ed1a5c0acc8d511e17137072db07a68cbf name: composite-base-version: 0.5.4.0+version: 0.5.5.0 synopsis: Shared utilities for composite-* packages. description: Shared helpers for the various composite packages. category: Records@@ -15,7 +17,6 @@ copyright: 2017 Confer Health, Inc. license: BSD3 build-type: Simple-cabal-version: >= 1.10 library hs-source-dirs:@@ -24,16 +25,17 @@ ghc-options: -Wall -O2 build-depends: base >=4.7 && <5- , exceptions >=0.8.3 && <0.9+ , exceptions >=0.8.3 && <0.11 , lens >=4.15.4 && <4.17 , monad-control >=1.0.2.2 && <1.1 , mtl >=2.2.1 && <2.3 , profunctors >=5.2.1 && <5.3- , template-haskell >=2.11.1.0 && <2.13+ , template-haskell >=2.11.1.0 && <2.14 , text >=1.2.2.2 && <1.3 , transformers >=0.5.2.0 && <0.6 , transformers-base >=0.4.4 && <0.5- , vinyl >=0.5.3 && <0.8+ , unliftio-core >=0.1.0.0 && <0.2.0.0+ , vinyl >=0.5.3 && <0.9 exposed-modules: Composite Composite.CoRecord@@ -55,17 +57,18 @@ QuickCheck , base >=4.7 && <5 , composite-base- , exceptions >=0.8.3 && <0.9+ , exceptions >=0.8.3 && <0.11 , hspec , lens >=4.15.4 && <4.17 , monad-control >=1.0.2.2 && <1.1 , mtl >=2.2.1 && <2.3 , profunctors >=5.2.1 && <5.3- , template-haskell >=2.11.1.0 && <2.13+ , template-haskell >=2.11.1.0 && <2.14 , text >=1.2.2.2 && <1.3 , transformers >=0.5.2.0 && <0.6 , transformers-base >=0.4.4 && <0.5- , vinyl >=0.5.3 && <0.8+ , unliftio-core >=0.1.0.0 && <0.2.0.0+ , vinyl >=0.5.3 && <0.9 other-modules: RecordSpec THSpec
src/Control/Monad/Composite/Context.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} -- Required to make passthrough instances for MonadContext for things like ReaderT work as they do not satisfy the functional dependency | m -> c @@ -12,7 +13,14 @@ import Control.Lens (Getter, view) import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.Base (MonadBase(liftBase))-import Control.Monad.Catch (MonadThrow(throwM), MonadCatch(catch), MonadMask(mask, uninterruptibleMask))+import Control.Monad.Catch+ ( MonadThrow(throwM), MonadCatch(catch)+#if MIN_VERSION_exceptions(0,9,0)+ , MonadMask(mask, uninterruptibleMask, generalBracket)+#else+ , MonadMask(mask, uninterruptibleMask)+#endif+ ) import Control.Monad.Cont (ContT(ContT), runContT) import Control.Monad.Cont.Class (MonadCont(callCC)) import Control.Monad.Error.Class (MonadError(throwError, catchError))@@ -38,6 +46,12 @@ import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass)) import Data.Monoid (Monoid) +#if MIN_VERSION_unliftio_core(0,1,1)+import Control.Monad.IO.Unlift (askUnliftIO, MonadUnliftIO, UnliftIO(UnliftIO), unliftIO, withUnliftIO, withRunInIO)+#else+import Control.Monad.IO.Unlift (askUnliftIO, MonadUnliftIO, UnliftIO(UnliftIO), unliftIO, withUnliftIO)+#endif+ -- |Class of monad (stacks) which have context reading functionality baked in. Similar to 'Control.Monad.Reader.MonadReader' but can coexist with a -- another monad that provides 'Control.Monad.Reader.MonadReader' and requires the context to be a record. class Monad m => MonadContext (c :: [*]) m | m -> c where@@ -162,6 +176,19 @@ liftBaseWith $ \ runInBase -> f (runInBase . ($ c) . runContextT) +instance MonadUnliftIO m => MonadUnliftIO (ContextT c m) where+ {-# INLINE askUnliftIO #-}+ askUnliftIO = ContextT $ \c ->+ withUnliftIO $ \u ->+ return (UnliftIO (unliftIO u . flip runContextT c))+#if MIN_VERSION_unliftio_core(0,1,1)+ {-# INLINE withRunInIO #-}+ withRunInIO inner =+ ContextT $ \c ->+ withRunInIO $ \run ->+ inner (run . flip runContextT c)+#endif+ instance MonadReader r m => MonadReader r (ContextT c m) where ask = lift ask local = mapContextT . local@@ -211,3 +238,12 @@ ContextT $ \e -> uninterruptibleMask $ \u -> runContextT (a $ q u) e where q :: (m a -> m a) -> ContextT c' m a -> ContextT c' m a q u (ContextT b) = ContextT (u . b)++#if MIN_VERSION_exceptions(0,9,0)+ generalBracket acquire release use =+ ContextT $ \ r ->+ generalBracket+ (runContextT acquire r)+ (\ a ec -> runContextT (release a ec) r)+ (\ a -> runContextT (use a) r)+#endif