MonadUnliftIO instances
This commit is contained in:
parent
5c8b1b542a
commit
1c2914eded
@ -13,3 +13,5 @@ packages:
|
|||||||
- ./yesod
|
- ./yesod
|
||||||
- ./yesod-eventsource
|
- ./yesod-eventsource
|
||||||
- ./yesod-websockets
|
- ./yesod-websockets
|
||||||
|
extra-deps:
|
||||||
|
- unliftio-core-0.1.0.0
|
||||||
|
|||||||
@ -66,6 +66,7 @@ import Data.Conduit.Lazy (MonadActive, monadActive)
|
|||||||
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
|
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
|
||||||
import Control.Monad.Logger (MonadLoggerIO (..))
|
import Control.Monad.Logger (MonadLoggerIO (..))
|
||||||
import Data.Semigroup (Semigroup)
|
import Data.Semigroup (Semigroup)
|
||||||
|
import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
|
||||||
|
|
||||||
-- Sessions
|
-- Sessions
|
||||||
type SessionMap = Map Text ByteString
|
type SessionMap = Map Text ByteString
|
||||||
@ -424,6 +425,12 @@ instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
|
|||||||
liftBaseWith $ \runInBase ->
|
liftBaseWith $ \runInBase ->
|
||||||
f $ runInBase . (\(WidgetT w) -> w ref reader')
|
f $ runInBase . (\(WidgetT w) -> w ref reader')
|
||||||
restoreM = WidgetT . const . const . restoreM
|
restoreM = WidgetT . const . const . restoreM
|
||||||
|
-- | @since 1.4.38
|
||||||
|
instance MonadUnliftIO m => MonadUnliftIO (WidgetT site m) where
|
||||||
|
{-# INLINE askUnliftIO #-}
|
||||||
|
askUnliftIO = WidgetT $ \ref r ->
|
||||||
|
withUnliftIO $ \u ->
|
||||||
|
return (UnliftIO (\(WidgetT w) -> unliftIO u $ w ref r))
|
||||||
instance Monad m => MonadReader site (WidgetT site m) where
|
instance Monad m => MonadReader site (WidgetT site m) where
|
||||||
ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
|
ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
|
||||||
local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
|
local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
|
||||||
@ -511,6 +518,12 @@ instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
|
|||||||
liftBaseWith $ \runInBase ->
|
liftBaseWith $ \runInBase ->
|
||||||
f $ runInBase . (\(HandlerT r) -> r reader')
|
f $ runInBase . (\(HandlerT r) -> r reader')
|
||||||
restoreM = HandlerT . const . restoreM
|
restoreM = HandlerT . const . restoreM
|
||||||
|
-- | @since 1.4.38
|
||||||
|
instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
|
||||||
|
{-# INLINE askUnliftIO #-}
|
||||||
|
askUnliftIO = HandlerT $ \r ->
|
||||||
|
withUnliftIO $ \u ->
|
||||||
|
return (UnliftIO (unliftIO u . flip unHandlerT r))
|
||||||
|
|
||||||
instance MonadThrow m => MonadThrow (HandlerT site m) where
|
instance MonadThrow m => MonadThrow (HandlerT site m) where
|
||||||
throwM = lift . monadThrow
|
throwM = lift . monadThrow
|
||||||
|
|||||||
@ -70,6 +70,7 @@ library
|
|||||||
, auto-update
|
, auto-update
|
||||||
, semigroups
|
, semigroups
|
||||||
, byteable
|
, byteable
|
||||||
|
, unliftio-core
|
||||||
|
|
||||||
exposed-modules: Yesod.Core
|
exposed-modules: Yesod.Core
|
||||||
Yesod.Core.Content
|
Yesod.Core.Content
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user