1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.Acquire.Internal
( Acquire (..)
, Allocated (..)
, with
, mkAcquire
, ReleaseType (.., ReleaseException)
, mkAcquireType
) where
import Control.Applicative (Applicative (..))
import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)
import qualified Control.Exception as E
import Data.Typeable (Typeable)
import Control.Monad (liftM, ap)
import qualified Control.Monad.Catch as C ()
-- | The way in which a release is called.
--
-- @since 1.1.2
data ReleaseType = ReleaseEarly
| ReleaseNormal
| ReleaseExceptionWith E.SomeException
deriving (Show, Typeable)
{-# COMPLETE ReleaseEarly, ReleaseNormal, ReleaseException #-}
{-# DEPRECATED ReleaseException "Use `ReleaseExceptionWith`, which has the exception in the constructor. This pattern synonym hides the exception and can obscure problems." #-}
pattern ReleaseException :: ReleaseType
pattern ReleaseException <- ReleaseExceptionWith _
data Allocated a = Allocated !a !(ReleaseType -> IO ())
-- | A method for acquiring a scarce resource, providing the means of freeing
-- it when no longer needed. This data type provides
-- @Functor@\/@Applicative@\/@Monad@ instances for composing different resources
-- together. You can allocate these resources using either the @bracket@
-- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@).
--
-- This concept was originally introduced by Gabriel Gonzalez and described at:
-- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. The
-- implementation in this package is slightly different, due to taking a
-- different approach to async exception safety.
--
-- @since 1.1.0
newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a))
deriving Typeable
instance Functor Acquire where
fmap = liftM
instance Applicative Acquire where
pure a = Acquire (\_ -> return (Allocated a (const $ return ())))
(<*>) = ap
instance Monad Acquire where
return = pure
Acquire f >>= g' = Acquire $ \restore -> do
Allocated x free1 <- f restore
let Acquire g = g' x
Allocated y free2 <- g restore `E.catch` (\e -> free1 (ReleaseExceptionWith e) >> E.throwIO e)
return $! Allocated y (\rt -> free2 rt `E.finally` free1 rt)
instance MonadIO Acquire where
liftIO f = Acquire $ \restore -> do
x <- restore f
return $! Allocated x (const $ return ())
-- | Create an @Acquire@ value using the given allocate and free functions.
--
-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,
-- do the following:
--
-- > acquire <- withRunInIO $ \runInIO ->
-- > return $ mkAcquire (runInIO create) (runInIO . free)
--
-- Note that this is only safe if the Acquire is run and freed within the same
-- monadic scope it was created in.
--
-- @since 1.1.0
mkAcquire :: IO a -- ^ acquire the resource
-> (a -> IO ()) -- ^ free the resource
-> Acquire a
mkAcquire create free = mkAcquireType create (\a _ -> free a)
-- | Same as 'mkAcquire', but the cleanup function will be informed of /how/
-- cleanup was initiated. This allows you to distinguish, for example, between
-- normal and exceptional exits.
--
-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,
-- do the following:
--
-- > acquire <- withRunInIO $ \runInIO ->
-- > return $ mkAcquireType (runInIO create) (\a -> runInIO . free a)
--
-- Note that this is only safe if the Acquire is run and freed within the same
-- monadic scope it was created in.
--
-- @since 1.1.2
mkAcquireType
:: IO a -- ^ acquire the resource
-> (a -> ReleaseType -> IO ()) -- ^ free the resource
-> Acquire a
mkAcquireType create free = Acquire $ \_ -> do
x <- create
return $! Allocated x (free x)
-- | Allocate the given resource and provide it to the provided function. The
-- resource will be freed as soon as the inner block is exited, whether
-- normally or via an exception. This function is similar in function to
-- @bracket@.
--
-- @since 1.1.0
with :: MonadUnliftIO m
=> Acquire a
-> (a -> m b)
-> m b
with (Acquire f) g = withRunInIO $ \run -> E.mask $ \restore -> do
Allocated x free <- f restore
res <- restore (run (g x)) `E.catch` (\e -> free (ReleaseExceptionWith e) >> E.throwIO e)
free ReleaseNormal
return res
|
