1{-# LANGUAGE CPP        #-}
2{-# LANGUAGE RankNTypes #-}
3
4{-| An example Haskell program to copy data from one handle to another might
5    look like this:
6
7> main =
8>     withFile "inFile.txt" ReadMode $ \inHandle ->
9>         withFile "outFile.txt" WriteMode $ \outHandle ->
10>             copy inHandle outHandle
11>
12> -- A hypothetical function that copies data from one handle to another
13> copy :: Handle -> Handle -> IO ()
14
15    `System.IO.withFile` is one of many functions that acquire some resource in
16    an exception-safe way.  These functions take a callback function as an
17    argument and they invoke the callback on the resource when it becomes
18    available, guaranteeing that the resource is properly disposed if the
19    callback throws an exception.
20
21    These functions usually have a type that ends with the following pattern:
22
23>                    Callback
24> --                -----------
25> withXXX :: ... -> (a -> IO r) -> IO r
26
27    Here are some examples of this pattern from the @base@ libraries:
28
29> withArray      :: Storable a => [a] -> (Ptr a   -> IO r) -> IO r
30> withBuffer     ::          Buffer e -> (Ptr e   -> IO r) -> IO r
31> withCAString   ::            String -> (CString -> IO r) -> IO r
32> withForeignPtr ::      ForeignPtr a -> (Ptr a   -> IO r) -> IO r
33> withMVar       ::            Mvar a -> (a       -> IO r) -> IO r
34> withPool       ::                      (Pool    -> IO r) -> IO r
35
36    Acquiring multiple resources in this way requires nesting callbacks.
37    However, you can wrap anything of the form @((a -> IO r) -> IO r)@ in the
38    `Managed` monad, which translates binds to callbacks for you:
39
40> import Control.Monad.Managed
41> import System.IO
42>
43> inFile :: FilePath -> Managed Handle
44> inFile filePath = managed (withFile filePath ReadMode)
45>
46> outFile :: FilePath -> Managed Handle
47> outFile filePath = managed (withFile filePath WriteMode)
48>
49> main = runManaged $ do
50>     inHandle  <- inFile "inFile.txt"
51>     outHandle <- outFile "outFile.txt"
52>     liftIO (copy inHandle outHandle)
53
54    ... or you can just wrap things inline:
55
56> main = runManaged $ do
57>     inHandle  <- managed (withFile "inFile.txt" ReadMode)
58>     outHandle <- managed (withFile "outFile.txt" WriteMode)
59>     liftIO (copy inHandle outHandle)
60
61    Additionally, since `Managed` is a `Monad`, you can take advantage of all
62    your favorite combinators from "Control.Monad".  For example, the
63    `Foreign.Marshal.Utils.withMany` function from "Foreign.Marshal.Utils"
64    becomes a trivial wrapper around `mapM`:
65
66> withMany :: (a -> (b -> IO r) -> IO r) -> [a] -> ([b] -> IO r) -> IO r
67> withMany f = with . mapM (Managed . f)
68
69    Another reason to use `Managed` is that if you wrap a `Monoid` value in
70    `Managed` you get back a new `Monoid`:
71
72> instance Monoid a => Monoid (Managed a)
73
74    This lets you combine managed resources transparently.  You can also lift
75    operations from some numeric type classes this way, too, such as the `Num`
76    type class.
77
78    NOTE: `Managed` may leak space if used in an infinite loop like this
79    example:
80
81> import Control.Monad
82> import Control.Monad.Managed
83>
84> main = runManaged (forever (liftIO (print 1)))
85
86    If you need to acquire a resource for a long-lived loop, you can instead
87    acquire the resource first and run the loop in `IO`, using either of the
88    following two equivalent idioms:
89
90> with resource (\r -> forever (useThe r))
91>
92> do r <- resource
93>    liftIO (forever (useThe r))
94-}
95
96module Control.Monad.Managed (
97    -- * Managed
98    Managed,
99    MonadManaged(..),
100    managed,
101    managed_,
102    with,
103    runManaged,
104
105    -- * Re-exports
106    -- $reexports
107    module Control.Monad.IO.Class
108    ) where
109
110import Control.Monad.IO.Class (MonadIO(liftIO))
111#if MIN_VERSION_base(4,9,0)
112import Control.Monad.Fail as MonadFail (MonadFail(..))
113#endif
114import Control.Monad.Trans.Class (lift)
115
116#if MIN_VERSION_base(4,8,0)
117import Control.Applicative (liftA2)
118#else
119import Control.Applicative
120import Data.Monoid (Monoid(..))
121#endif
122
123#if !(MIN_VERSION_base(4,11,0))
124import Data.Semigroup (Semigroup(..))
125#endif
126
127import qualified Control.Monad.Trans.Cont          as Cont
128#if MIN_VERSION_transformers(0,4,0)
129import qualified Control.Monad.Trans.Except        as Except
130#endif
131import qualified Control.Monad.Trans.Identity      as Identity
132import qualified Control.Monad.Trans.Maybe         as Maybe
133import qualified Control.Monad.Trans.Reader        as Reader
134import qualified Control.Monad.Trans.RWS.Lazy      as RWS.Lazy
135import qualified Control.Monad.Trans.RWS.Strict    as RWS.Strict
136import qualified Control.Monad.Trans.State.Lazy    as State.Lazy
137import qualified Control.Monad.Trans.State.Strict  as State.Strict
138import qualified Control.Monad.Trans.Writer.Lazy   as Writer.Lazy
139import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
140
141-- | A managed resource that you acquire using `with`
142newtype Managed a = Managed { (>>-) :: forall r . (a -> IO r) -> IO r }
143
144instance Functor Managed where
145    fmap f mx = Managed (\return_ ->
146        mx >>- \x ->
147        return_ (f x) )
148
149instance Applicative Managed where
150    pure r    = Managed (\return_ ->
151        return_ r )
152
153    mf <*> mx = Managed (\return_ ->
154        mf >>- \f ->
155        mx >>- \x ->
156        return_ (f x) )
157
158instance Monad Managed where
159    return r = Managed (\return_ ->
160        return_ r )
161
162    ma >>= f = Managed (\return_ ->
163        ma  >>- \a ->
164        f a >>- \b ->
165        return_ b )
166
167instance MonadIO Managed where
168    liftIO m = Managed (\return_ -> do
169        a <- m
170        return_ a )
171
172#if MIN_VERSION_base(4,9,0)
173instance MonadFail Managed where
174    fail s = Managed (\return_ -> do
175        a <- MonadFail.fail s
176        return_ a )
177#endif
178
179instance Semigroup a => Semigroup (Managed a) where
180    (<>) = liftA2 (<>)
181
182instance Monoid a => Monoid (Managed a) where
183    mempty = pure mempty
184
185#if !(MIN_VERSION_base(4,11,0))
186    mappend = liftA2 mappend
187#endif
188
189instance Num a => Num (Managed a) where
190    fromInteger = pure . fromInteger
191    negate = fmap negate
192    abs    = fmap abs
193    signum = fmap signum
194    (+) = liftA2 (+)
195    (*) = liftA2 (*)
196    (-) = liftA2 (-)
197
198instance Fractional a => Fractional (Managed a) where
199    fromRational = pure . fromRational
200    recip = fmap recip
201    (/) = liftA2 (/)
202
203instance Floating a => Floating (Managed a) where
204    pi = pure pi
205    exp   = fmap exp
206    sqrt  = fmap sqrt
207    log   = fmap log
208    sin   = fmap sin
209    tan   = fmap tan
210    cos   = fmap cos
211    asin  = fmap sin
212    atan  = fmap atan
213    acos  = fmap acos
214    sinh  = fmap sinh
215    tanh  = fmap tanh
216    cosh  = fmap cosh
217    asinh = fmap asinh
218    atanh = fmap atanh
219    acosh = fmap acosh
220    (**)    = liftA2 (**)
221    logBase = liftA2 logBase
222
223{-| You can embed a `Managed` action within any `Monad` that implements
224    `MonadManaged` by using the `using` function
225
226    All instances must obey the following two laws:
227
228> using (return x) = return x
229>
230> using (m >>= f) = using m >>= \x -> using (f x)
231-}
232class MonadIO m => MonadManaged m where
233    using :: Managed a -> m a
234
235instance MonadManaged Managed where
236    using = id
237
238instance MonadManaged m => MonadManaged (Cont.ContT r m) where
239    using m = lift (using m)
240
241#if MIN_VERSION_transformers(0,4,0)
242instance MonadManaged m => MonadManaged (Except.ExceptT e m) where
243    using m = lift (using m)
244#endif
245
246instance MonadManaged m => MonadManaged (Identity.IdentityT m) where
247    using m = lift (using m)
248
249instance MonadManaged m => MonadManaged (Maybe.MaybeT m) where
250    using m = lift (using m)
251
252instance MonadManaged m => MonadManaged (Reader.ReaderT r m) where
253    using m = lift (using m)
254
255instance (Monoid w, MonadManaged m) => MonadManaged (RWS.Lazy.RWST r w s m) where
256    using m = lift (using m)
257
258instance (Monoid w, MonadManaged m) => MonadManaged (RWS.Strict.RWST r w s m) where
259    using m = lift (using m)
260
261instance MonadManaged m => MonadManaged (State.Strict.StateT s m) where
262    using m = lift (using m)
263
264instance MonadManaged m => MonadManaged (State.Lazy.StateT s m) where
265    using m = lift (using m)
266
267instance (Monoid w, MonadManaged m) => MonadManaged (Writer.Strict.WriterT w m) where
268    using m = lift (using m)
269
270instance (Monoid w, MonadManaged m) => MonadManaged (Writer.Lazy.WriterT w m) where
271    using m = lift (using m)
272
273-- | Build a `Managed` value
274managed :: MonadManaged m => (forall r . (a -> IO r) -> IO r) -> m a
275managed f = using (Managed f)
276
277-- | Like 'managed' but for resource-less operations.
278managed_ :: MonadManaged m => (forall r. IO r -> IO r) -> m ()
279managed_ f = managed $ \g -> f $ g ()
280
281{-| Acquire a `Managed` value
282
283    This is a potentially unsafe function since it allows a resource to escape
284    its scope.  For example, you might use `Managed` to safely acquire a
285    file handle, like this:
286
287> import qualified System.IO as IO
288>
289> example :: Managed Handle
290> example = managed (IO.withFile "foo.txt" IO.ReadMode)
291
292    ... and if you never used the `with` function then you would never run the
293    risk of accessing the `Handle` after the file was closed.  However, if you
294    use `with` then you can incorrectly access the handle after the handle is
295    closed, like this:
296
297> bad :: IO ()
298> bad = do
299>     handle <- with example return
300>     IO.hPutStrLn handle "bar"  -- This will fail because the handle is closed
301
302    ... so only use `with` if you know what you are doing and you're returning
303    a value that is not a resource being managed.
304-}
305with :: Managed a -> (a -> IO r) -> IO r
306with m = (>>-) m
307
308-- | Run a `Managed` computation, enforcing that no acquired resources leak
309runManaged :: Managed () -> IO ()
310runManaged m = m >>- return
311
312{- $reexports
313    "Control.Monad.IO.Class" re-exports 'MonadIO'
314-}
315