{-# LANGUAGE CPP        #-}
{-# LANGUAGE RankNTypes #-}

{-| An example Haskell program to copy data from one handle to another might
    look like this:

> main =
>     withFile "inFile.txt" ReadMode $ \inHandle ->
>         withFile "outFile.txt" WriteMode $ \outHandle ->
>             copy inHandle outHandle
>
> -- A hypothetical function that copies data from one handle to another
> copy :: Handle -> Handle -> IO ()

    `System.IO.withFile` is one of many functions that acquire some resource in
    an exception-safe way.  These functions take a callback function as an
    argument and they invoke the callback on the resource when it becomes
    available, guaranteeing that the resource is properly disposed if the
    callback throws an exception.

    These functions usually have a type that ends with the following pattern:

>                    Callback
> --                -----------
> withXXX :: ... -> (a -> IO r) -> IO r

    Here are some examples of this pattern from the @base@ libraries:

> withArray      :: Storable a => [a] -> (Ptr a   -> IO r) -> IO r
> withBuffer     ::          Buffer e -> (Ptr e   -> IO r) -> IO r
> withCAString   ::            String -> (CString -> IO r) -> IO r
> withForeignPtr ::      ForeignPtr a -> (Ptr a   -> IO r) -> IO r
> withMVar       ::            Mvar a -> (a       -> IO r) -> IO r
> withPool       ::                      (Pool    -> IO r) -> IO r

    Acquiring multiple resources in this way requires nesting callbacks.
    However, you can wrap anything of the form @((a -> IO r) -> IO r)@ in the
    `Managed` monad, which translates binds to callbacks for you:

> import Control.Monad.Managed
> import System.IO
>
> inFile :: FilePath -> Managed Handle
> inFile filePath = managed (withFile filePath ReadMode)
>
> outFile :: FilePath -> Managed Handle
> outFile filePath = managed (withFile filePath WriteMode)
>
> main = runManaged $ do
>     inHandle  <- inFile "inFile.txt"
>     outHandle <- outFile "outFile.txt"
>     liftIO (copy inHandle outHandle)

    ... or you can just wrap things inline:

> main = runManaged $ do
>     inHandle  <- managed (withFile "inFile.txt" ReadMode)
>     outHandle <- managed (withFile "outFile.txt" WriteMode)
>     liftIO (copy inHandle outHandle)

    Additionally, since `Managed` is a `Monad`, you can take advantage of all
    your favorite combinators from "Control.Monad".  For example, the
    `Foreign.Marshal.Utils.withMany` function from "Foreign.Marshal.Utils"
    becomes a trivial wrapper around `mapM`:

> withMany :: (a -> (b -> IO r) -> IO r) -> [a] -> ([b] -> IO r) -> IO r
> withMany f = with . mapM (Managed . f)

    Another reason to use `Managed` is that if you wrap a `Monoid` value in
    `Managed` you get back a new `Monoid`:

> instance Monoid a => Monoid (Managed a)

    This lets you combine managed resources transparently.  You can also lift
    operations from some numeric type classes this way, too, such as the `Num`
    type class.

    NOTE: `Managed` may leak space if used in an infinite loop like this
    example:

> import Control.Monad
> import Control.Monad.Managed
>
> main = runManaged (forever (liftIO (print 1)))

    If you need to acquire a resource for a long-lived loop, you can instead
    acquire the resource first and run the loop in `IO`, using either of the
    following two equivalent idioms:

> with resource (\r -> forever (useThe r))
>
> do r <- resource
>    liftIO (forever (useThe r))
-}

module Control.Monad.Managed (
    -- * Managed
    Managed,
    MonadManaged(..),
    managed,
    managed_,
    with,
    runManaged,

    -- * Re-exports
    -- $reexports
    module Control.Monad.IO.Class
    ) where

import Control.Monad.IO.Class (MonadIO(liftIO))
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail as MonadFail (MonadFail(..))
#endif
import Control.Monad.Trans.Class (lift)

#if MIN_VERSION_base(4,8,0)
import Control.Applicative (liftA2)
#else
import Control.Applicative
import Data.Monoid (Monoid(..))
#endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

import qualified Control.Monad.Trans.Cont          as Cont
#if MIN_VERSION_transformers(0,4,0)
import qualified Control.Monad.Trans.Except        as Except
#endif
import qualified Control.Monad.Trans.Identity      as Identity
import qualified Control.Monad.Trans.Maybe         as Maybe
import qualified Control.Monad.Trans.Reader        as Reader
import qualified Control.Monad.Trans.RWS.Lazy      as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict    as RWS.Strict
import qualified Control.Monad.Trans.State.Lazy    as State.Lazy
import qualified Control.Monad.Trans.State.Strict  as State.Strict
import qualified Control.Monad.Trans.Writer.Lazy   as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict

-- | A managed resource that you acquire using `with`
newtype Managed a = Managed { Managed a -> forall r. (a -> IO r) -> IO r
(>>-) :: forall r . (a -> IO r) -> IO r }

instance Functor Managed where
    fmap :: (a -> b) -> Managed a -> Managed b
fmap a -> b
f Managed a
mx = (forall r. (b -> IO r) -> IO r) -> Managed b
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\b -> IO r
return_ ->
        Managed a
mx Managed a -> (a -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- \a
x ->
        b -> IO r
return_ (a -> b
f a
x) )

instance Applicative Managed where
    pure :: a -> Managed a
pure a
r    = (forall r. (a -> IO r) -> IO r) -> Managed a
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\a -> IO r
return_ ->
        a -> IO r
return_ a
r )

    Managed (a -> b)
mf <*> :: Managed (a -> b) -> Managed a -> Managed b
<*> Managed a
mx = (forall r. (b -> IO r) -> IO r) -> Managed b
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\b -> IO r
return_ ->
        Managed (a -> b)
mf Managed (a -> b) -> ((a -> b) -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- \a -> b
f ->
        Managed a
mx Managed a -> (a -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- \a
x ->
        b -> IO r
return_ (a -> b
f a
x) )

instance Monad Managed where
    Managed a
ma >>= :: Managed a -> (a -> Managed b) -> Managed b
>>= a -> Managed b
f = (forall r. (b -> IO r) -> IO r) -> Managed b
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\b -> IO r
return_ ->
        Managed a
ma  Managed a -> (a -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- \a
a ->
        a -> Managed b
f a
a Managed b -> (b -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- \b
b ->
        b -> IO r
return_ b
b )

instance MonadIO Managed where
    liftIO :: IO a -> Managed a
liftIO IO a
m = (forall r. (a -> IO r) -> IO r) -> Managed a
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\a -> IO r
return_ -> do
        a
a <- IO a
m
        a -> IO r
return_ a
a )

#if MIN_VERSION_base(4,9,0)
instance MonadFail Managed where
    fail :: String -> Managed a
fail String
s = (forall r. (a -> IO r) -> IO r) -> Managed a
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed (\a -> IO r
return_ -> do
        a
a <- String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
s
        a -> IO r
return_ a
a )
#endif

instance Semigroup a => Semigroup (Managed a) where
    <> :: Managed a -> Managed a -> Managed a
(<>) = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (Managed a) where
    mempty :: Managed a
mempty = a -> Managed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

#if !(MIN_VERSION_base(4,11,0))
    mappend = liftA2 mappend
#endif

instance Num a => Num (Managed a) where
    fromInteger :: Integer -> Managed a
fromInteger = a -> Managed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Managed a) -> (Integer -> a) -> Integer -> Managed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
    negate :: Managed a -> Managed a
negate = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
    abs :: Managed a -> Managed a
abs    = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
    signum :: Managed a -> Managed a
signum = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
    + :: Managed a -> Managed a -> Managed a
(+) = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
    * :: Managed a -> Managed a -> Managed a
(*) = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
    (-) = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)

instance Fractional a => Fractional (Managed a) where
    fromRational :: Rational -> Managed a
fromRational = a -> Managed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Managed a) -> (Rational -> a) -> Rational -> Managed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
    recip :: Managed a -> Managed a
recip = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
    / :: Managed a -> Managed a -> Managed a
(/) = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)

instance Floating a => Floating (Managed a) where
    pi :: Managed a
pi = a -> Managed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
    exp :: Managed a -> Managed a
exp   = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
    sqrt :: Managed a -> Managed a
sqrt  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
    log :: Managed a -> Managed a
log   = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
    sin :: Managed a -> Managed a
sin   = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
    tan :: Managed a -> Managed a
tan   = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tan
    cos :: Managed a -> Managed a
cos   = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
    asin :: Managed a -> Managed a
asin  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
    atan :: Managed a -> Managed a
atan  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
    acos :: Managed a -> Managed a
acos  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
    sinh :: Managed a -> Managed a
sinh  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
    tanh :: Managed a -> Managed a
tanh  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tanh
    cosh :: Managed a -> Managed a
cosh  = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
    asinh :: Managed a -> Managed a
asinh = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
    atanh :: Managed a -> Managed a
atanh = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
    acosh :: Managed a -> Managed a
acosh = (a -> a) -> Managed a -> Managed a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
    ** :: Managed a -> Managed a -> Managed a
(**)    = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
    logBase :: Managed a -> Managed a -> Managed a
logBase = (a -> a -> a) -> Managed a -> Managed a -> Managed a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase

{-| You can embed a `Managed` action within any `Monad` that implements
    `MonadManaged` by using the `using` function

    All instances must obey the following two laws:

> using (return x) = return x
>
> using (m >>= f) = using m >>= \x -> using (f x)
-}
class MonadIO m => MonadManaged m where
    using :: Managed a -> m a

instance MonadManaged Managed where
    using :: Managed a -> Managed a
using = Managed a -> Managed a
forall a. a -> a
id

instance MonadManaged m => MonadManaged (Cont.ContT r m) where
    using :: Managed a -> ContT r m a
using Managed a
m = m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

#if MIN_VERSION_transformers(0,4,0)
instance MonadManaged m => MonadManaged (Except.ExceptT e m) where
    using :: Managed a -> ExceptT e m a
using Managed a
m = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)
#endif

instance MonadManaged m => MonadManaged (Identity.IdentityT m) where
    using :: Managed a -> IdentityT m a
using Managed a
m = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance MonadManaged m => MonadManaged (Maybe.MaybeT m) where
    using :: Managed a -> MaybeT m a
using Managed a
m = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance MonadManaged m => MonadManaged (Reader.ReaderT r m) where
    using :: Managed a -> ReaderT r m a
using Managed a
m = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance (Monoid w, MonadManaged m) => MonadManaged (RWS.Lazy.RWST r w s m) where
    using :: Managed a -> RWST r w s m a
using Managed a
m = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance (Monoid w, MonadManaged m) => MonadManaged (RWS.Strict.RWST r w s m) where
    using :: Managed a -> RWST r w s m a
using Managed a
m = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance MonadManaged m => MonadManaged (State.Strict.StateT s m) where
    using :: Managed a -> StateT s m a
using Managed a
m = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance MonadManaged m => MonadManaged (State.Lazy.StateT s m) where
    using :: Managed a -> StateT s m a
using Managed a
m = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance (Monoid w, MonadManaged m) => MonadManaged (Writer.Strict.WriterT w m) where
    using :: Managed a -> WriterT w m a
using Managed a
m = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

instance (Monoid w, MonadManaged m) => MonadManaged (Writer.Lazy.WriterT w m) where
    using :: Managed a -> WriterT w m a
using Managed a
m = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using Managed a
m)

-- | Build a `Managed` value
managed :: MonadManaged m => (forall r . (a -> IO r) -> IO r) -> m a
managed :: (forall r. (a -> IO r) -> IO r) -> m a
managed forall r. (a -> IO r) -> IO r
f = Managed a -> m a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. (a -> IO r) -> IO r) -> Managed a
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed forall r. (a -> IO r) -> IO r
f)

-- | Like 'managed' but for resource-less operations.
managed_ :: MonadManaged m => (forall r. IO r -> IO r) -> m ()
managed_ :: (forall r. IO r -> IO r) -> m ()
managed_ forall r. IO r -> IO r
f = (forall r. (() -> IO r) -> IO r) -> m ()
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed ((forall r. (() -> IO r) -> IO r) -> m ())
-> (forall r. (() -> IO r) -> IO r) -> m ()
forall a b. (a -> b) -> a -> b
$ \() -> IO r
g -> IO r -> IO r
forall r. IO r -> IO r
f (IO r -> IO r) -> IO r -> IO r
forall a b. (a -> b) -> a -> b
$ () -> IO r
g ()

{-| Acquire a `Managed` value

    This is a potentially unsafe function since it allows a resource to escape
    its scope.  For example, you might use `Managed` to safely acquire a
    file handle, like this:

> import qualified System.IO as IO
>
> example :: Managed Handle
> example = managed (IO.withFile "foo.txt" IO.ReadMode)

    ... and if you never used the `with` function then you would never run the
    risk of accessing the `Handle` after the file was closed.  However, if you
    use `with` then you can incorrectly access the handle after the handle is
    closed, like this:

> bad :: IO ()
> bad = do
>     handle <- with example return
>     IO.hPutStrLn handle "bar"  -- This will fail because the handle is closed

    ... so only use `with` if you know what you are doing and you're returning
    a value that is not a resource being managed.
-}
with :: Managed a -> (a -> IO r) -> IO r
with :: Managed a -> (a -> IO r) -> IO r
with Managed a
m = Managed a -> forall r. (a -> IO r) -> IO r
forall a. Managed a -> forall r. (a -> IO r) -> IO r
(>>-) Managed a
m

-- | Run a `Managed` computation, enforcing that no acquired resources leak
runManaged :: Managed () -> IO ()
runManaged :: Managed () -> IO ()
runManaged Managed ()
m = Managed ()
m Managed () -> (() -> IO ()) -> IO ()
forall a. Managed a -> forall r. (a -> IO r) -> IO r
>>- () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return

{- $reexports
    "Control.Monad.IO.Class" re-exports 'MonadIO'
-}