module Acquire where

import Acquire.Prelude

-- * IO

-- |
-- Acquire resources and use them by lifting IO into acquire.
acquire :: Acquire.Acquire a -> IO a
acquire :: forall a. Acquire a -> IO a
acquire (Acquire.Acquire IO (a, IO ())
setup) =
  IO (a, IO ())
-> ((a, IO ()) -> IO ()) -> ((a, IO ()) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (a, IO ())
setup (a, IO ()) -> IO ()
forall a b. (a, b) -> b
snd (a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> ((a, IO ()) -> a) -> (a, IO ()) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, IO ()) -> a
forall a b. (a, b) -> a
fst)

-- |
-- Execute an action, which uses a resource,
-- having a resource provider.
acquireAndUse :: Acquire env -> Use env err res -> IO (Either err res)
acquireAndUse :: forall env err res.
Acquire env -> Use env err res -> IO (Either err res)
acquireAndUse (Acquire IO (env, IO ())
acquireIo) (Use ReaderT env (ExceptT err IO) res
useRdr) =
  IO (env, IO ())
-> ((env, IO ()) -> IO ())
-> ((env, IO ()) -> IO (Either err res))
-> IO (Either err res)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (env, IO ())
acquireIo (env, IO ()) -> IO ()
forall a b. (a, b) -> b
snd (ExceptT err IO res -> IO (Either err res)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT err IO res -> IO (Either err res))
-> ((env, IO ()) -> ExceptT err IO res)
-> (env, IO ())
-> IO (Either err res)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ReaderT env (ExceptT err IO) res -> env -> ExceptT err IO res
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT env (ExceptT err IO) res
useRdr (env -> ExceptT err IO res)
-> ((env, IO ()) -> env) -> (env, IO ()) -> ExceptT err IO res
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (env, IO ()) -> env
forall a b. (a, b) -> a
fst)

-- |
-- Run use on an acquired environment.
useAcquired :: env -> Use env err res -> IO (Either err res)
useAcquired :: forall env err res. env -> Use env err res -> IO (Either err res)
useAcquired env
env (Use (ReaderT env -> ExceptT err IO res
run)) =
  env -> ExceptT err IO res
run env
env ExceptT err IO res
-> (ExceptT err IO res -> IO (Either err res))
-> IO (Either err res)
forall a b. a -> (a -> b) -> b
& ExceptT err IO res -> IO (Either err res)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- * Acquire

-- |
-- Resource provider.
-- Abstracts over resource acquisition and releasing.
--
-- Composes well, allowing you to merge multiple providers into one.
--
-- Implementation of http://www.haskellforall.com/2013/06/the-resource-applicative.html
newtype Acquire env
  = Acquire (IO (env, IO ()))

instance Functor Acquire where
  fmap :: forall a b. (a -> b) -> Acquire a -> Acquire b
fmap a -> b
f (Acquire IO (a, IO ())
io) =
    IO (b, IO ()) -> Acquire b
forall env. IO (env, IO ()) -> Acquire env
Acquire (IO (b, IO ()) -> Acquire b) -> IO (b, IO ()) -> Acquire b
forall a b. (a -> b) -> a -> b
$ do
      (a
env, IO ()
release) <- IO (a, IO ())
io
      (b, IO ()) -> IO (b, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
env, IO ()
release)

instance Applicative Acquire where
  pure :: forall a. a -> Acquire a
pure a
env =
    IO (a, IO ()) -> Acquire a
forall env. IO (env, IO ()) -> Acquire env
Acquire ((a, IO ()) -> IO (a, IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
env, () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  Acquire IO (a -> b, IO ())
io1 <*> :: forall a b. Acquire (a -> b) -> Acquire a -> Acquire b
<*> Acquire IO (a, IO ())
io2 =
    IO (b, IO ()) -> Acquire b
forall env. IO (env, IO ()) -> Acquire env
Acquire (IO (b, IO ()) -> Acquire b) -> IO (b, IO ()) -> Acquire b
forall a b. (a -> b) -> a -> b
$ do
      (a -> b
f, IO ()
release1) <- IO (a -> b, IO ())
io1
      (a
x, IO ()
release2) <- IO (a, IO ()) -> IO () -> IO (a, IO ())
forall a b. IO a -> IO b -> IO a
onException IO (a, IO ())
io2 IO ()
release1
      (b, IO ()) -> IO (b, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x, IO ()
release2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
release1)

instance Monad Acquire where
  return :: forall a. a -> Acquire a
return = a -> Acquire a
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: forall a b. Acquire a -> (a -> Acquire b) -> Acquire b
(>>=) (Acquire IO (a, IO ())
io1) a -> Acquire b
k2 =
    IO (b, IO ()) -> Acquire b
forall env. IO (env, IO ()) -> Acquire env
Acquire (IO (b, IO ()) -> Acquire b) -> IO (b, IO ()) -> Acquire b
forall a b. (a -> b) -> a -> b
$ do
      (a
resource1, IO ()
release1) <- IO (a, IO ())
io1
      (b
resource2, IO ()
release2) <- case a -> Acquire b
k2 a
resource1 of Acquire IO (b, IO ())
io2 -> IO (b, IO ()) -> IO () -> IO (b, IO ())
forall a b. IO a -> IO b -> IO a
onException IO (b, IO ())
io2 IO ()
release1
      (b, IO ()) -> IO (b, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
resource2, IO ()
release2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
release1)

instance MonadIO Acquire where
  liftIO :: forall a. IO a -> Acquire a
liftIO IO a
io =
    IO (a, IO ()) -> Acquire a
forall env. IO (env, IO ()) -> Acquire env
Acquire ((a -> (a, IO ())) -> IO a -> IO (a, IO ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) IO a
io)

-- | Construct 'Acquire' by specifying a resource initializer and finalizer actions.
startAndStop ::
  -- | Start the service.
  IO a ->
  -- | Stop the service.
  (a -> IO ()) ->
  Acquire a
startAndStop :: forall a. IO a -> (a -> IO ()) -> Acquire a
startAndStop IO a
start a -> IO ()
stop =
  IO (a, IO ()) -> Acquire a
forall env. IO (env, IO ()) -> Acquire env
Acquire (IO (a, IO ()) -> Acquire a) -> IO (a, IO ()) -> Acquire a
forall a b. (a -> b) -> a -> b
$ do
    a
logger <- IO a
start
    (a, IO ()) -> IO (a, IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
logger, a -> IO ()
stop a
logger)

-- * Use

-- |
-- Resource handler, which has a notion of pure errors.
newtype Use env err res = Use (ReaderT env (ExceptT err IO) res)
  deriving ((forall a b. (a -> b) -> Use env err a -> Use env err b)
-> (forall a b. a -> Use env err b -> Use env err a)
-> Functor (Use env err)
forall a b. a -> Use env err b -> Use env err a
forall a b. (a -> b) -> Use env err a -> Use env err b
forall env err a b. a -> Use env err b -> Use env err a
forall env err a b. (a -> b) -> Use env err a -> Use env err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall env err a b. (a -> b) -> Use env err a -> Use env err b
fmap :: forall a b. (a -> b) -> Use env err a -> Use env err b
$c<$ :: forall env err a b. a -> Use env err b -> Use env err a
<$ :: forall a b. a -> Use env err b -> Use env err a
Functor, Functor (Use env err)
Functor (Use env err) =>
(forall a. a -> Use env err a)
-> (forall a b.
    Use env err (a -> b) -> Use env err a -> Use env err b)
-> (forall a b c.
    (a -> b -> c) -> Use env err a -> Use env err b -> Use env err c)
-> (forall a b. Use env err a -> Use env err b -> Use env err b)
-> (forall a b. Use env err a -> Use env err b -> Use env err a)
-> Applicative (Use env err)
forall a. a -> Use env err a
forall env err. Functor (Use env err)
forall a b. Use env err a -> Use env err b -> Use env err a
forall a b. Use env err a -> Use env err b -> Use env err b
forall a b. Use env err (a -> b) -> Use env err a -> Use env err b
forall env err a. a -> Use env err a
forall a b c.
(a -> b -> c) -> Use env err a -> Use env err b -> Use env err c
forall env err a b. Use env err a -> Use env err b -> Use env err a
forall env err a b. Use env err a -> Use env err b -> Use env err b
forall env err a b.
Use env err (a -> b) -> Use env err a -> Use env err b
forall env err a b c.
(a -> b -> c) -> Use env err a -> Use env err b -> Use env err c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall env err a. a -> Use env err a
pure :: forall a. a -> Use env err a
$c<*> :: forall env err a b.
Use env err (a -> b) -> Use env err a -> Use env err b
<*> :: forall a b. Use env err (a -> b) -> Use env err a -> Use env err b
$cliftA2 :: forall env err a b c.
(a -> b -> c) -> Use env err a -> Use env err b -> Use env err c
liftA2 :: forall a b c.
(a -> b -> c) -> Use env err a -> Use env err b -> Use env err c
$c*> :: forall env err a b. Use env err a -> Use env err b -> Use env err b
*> :: forall a b. Use env err a -> Use env err b -> Use env err b
$c<* :: forall env err a b. Use env err a -> Use env err b -> Use env err a
<* :: forall a b. Use env err a -> Use env err b -> Use env err a
Applicative, Applicative (Use env err)
Applicative (Use env err) =>
(forall a. Use env err a)
-> (forall a. Use env err a -> Use env err a -> Use env err a)
-> (forall a. Use env err a -> Use env err [a])
-> (forall a. Use env err a -> Use env err [a])
-> Alternative (Use env err)
forall a. Use env err a
forall a. Use env err a -> Use env err [a]
forall a. Use env err a -> Use env err a -> Use env err a
forall env err. Monoid err => Applicative (Use env err)
forall env err a. Monoid err => Use env err a
forall env err a. Monoid err => Use env err a -> Use env err [a]
forall env err a.
Monoid err =>
Use env err a -> Use env err a -> Use env err a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall env err a. Monoid err => Use env err a
empty :: forall a. Use env err a
$c<|> :: forall env err a.
Monoid err =>
Use env err a -> Use env err a -> Use env err a
<|> :: forall a. Use env err a -> Use env err a -> Use env err a
$csome :: forall env err a. Monoid err => Use env err a -> Use env err [a]
some :: forall a. Use env err a -> Use env err [a]
$cmany :: forall env err a. Monoid err => Use env err a -> Use env err [a]
many :: forall a. Use env err a -> Use env err [a]
Alternative, Applicative (Use env err)
Applicative (Use env err) =>
(forall a b.
 Use env err a -> (a -> Use env err b) -> Use env err b)
-> (forall a b. Use env err a -> Use env err b -> Use env err b)
-> (forall a. a -> Use env err a)
-> Monad (Use env err)
forall a. a -> Use env err a
forall env err. Applicative (Use env err)
forall a b. Use env err a -> Use env err b -> Use env err b
forall a b. Use env err a -> (a -> Use env err b) -> Use env err b
forall env err a. a -> Use env err a
forall env err a b. Use env err a -> Use env err b -> Use env err b
forall env err a b.
Use env err a -> (a -> Use env err b) -> Use env err b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall env err a b.
Use env err a -> (a -> Use env err b) -> Use env err b
>>= :: forall a b. Use env err a -> (a -> Use env err b) -> Use env err b
$c>> :: forall env err a b. Use env err a -> Use env err b -> Use env err b
>> :: forall a b. Use env err a -> Use env err b -> Use env err b
$creturn :: forall env err a. a -> Use env err a
return :: forall a. a -> Use env err a
Monad, Monad (Use env err)
Alternative (Use env err)
(Alternative (Use env err), Monad (Use env err)) =>
(forall a. Use env err a)
-> (forall a. Use env err a -> Use env err a -> Use env err a)
-> MonadPlus (Use env err)
forall a. Use env err a
forall a. Use env err a -> Use env err a -> Use env err a
forall env err. Monoid err => Monad (Use env err)
forall env err. Monoid err => Alternative (Use env err)
forall env err a. Monoid err => Use env err a
forall env err a.
Monoid err =>
Use env err a -> Use env err a -> Use env err a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall env err a. Monoid err => Use env err a
mzero :: forall a. Use env err a
$cmplus :: forall env err a.
Monoid err =>
Use env err a -> Use env err a -> Use env err a
mplus :: forall a. Use env err a -> Use env err a -> Use env err a
MonadPlus, Monad (Use env err)
Monad (Use env err) =>
(forall a. IO a -> Use env err a) -> MonadIO (Use env err)
forall a. IO a -> Use env err a
forall env err. Monad (Use env err)
forall env err a. IO a -> Use env err a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall env err a. IO a -> Use env err a
liftIO :: forall a. IO a -> Use env err a
MonadIO, MonadError err, MonadReader env)

instance Bifunctor (Use env) where
  first :: forall a b c. (a -> b) -> Use env a c -> Use env b c
first = (a -> b) -> Use env a c -> Use env b c
forall a b env res. (a -> b) -> Use env a res -> Use env b res
mapErr
  second :: forall b c a. (b -> c) -> Use env a b -> Use env a c
second = (b -> c) -> Use env a b -> Use env a c
forall a b. (a -> b) -> Use env a a -> Use env a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- |
-- Map the environment of a resource handler.
mapEnv :: (b -> a) -> Use a err res -> Use b err res
mapEnv :: forall b a err res. (b -> a) -> Use a err res -> Use b err res
mapEnv b -> a
fn (Use ReaderT a (ExceptT err IO) res
rdr) = ReaderT b (ExceptT err IO) res -> Use b err res
forall env err res.
ReaderT env (ExceptT err IO) res -> Use env err res
Use ((b -> a)
-> ReaderT a (ExceptT err IO) res -> ReaderT b (ExceptT err IO) res
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT b -> a
fn ReaderT a (ExceptT err IO) res
rdr)

-- |
-- Map the error of a resource handler.
mapErr :: (a -> b) -> Use env a res -> Use env b res
mapErr :: forall a b env res. (a -> b) -> Use env a res -> Use env b res
mapErr a -> b
fn (Use ReaderT env (ExceptT a IO) res
rdr) = ReaderT env (ExceptT b IO) res -> Use env b res
forall env err res.
ReaderT env (ExceptT err IO) res -> Use env err res
Use ((ExceptT a IO res -> ExceptT b IO res)
-> ReaderT env (ExceptT a IO) res -> ReaderT env (ExceptT b IO) res
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((a -> b) -> ExceptT a IO res -> ExceptT b IO res
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT a -> b
fn) ReaderT env (ExceptT a IO) res
rdr)

-- |
-- Map both the environment and the error of a resource handler.
mapEnvAndErr :: (envB -> envA) -> (errA -> errB) -> Use envA errA res -> Use envB errB res
mapEnvAndErr :: forall envB envA errA errB res.
(envB -> envA)
-> (errA -> errB) -> Use envA errA res -> Use envB errB res
mapEnvAndErr envB -> envA
envProj errA -> errB
errProj (Use ReaderT envA (ExceptT errA IO) res
rdr) = ReaderT envB (ExceptT errB IO) res -> Use envB errB res
forall env err res.
ReaderT env (ExceptT err IO) res -> Use env err res
Use ((envB -> envA)
-> ReaderT envA (ExceptT errB IO) res
-> ReaderT envB (ExceptT errB IO) res
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT envB -> envA
envProj ((ExceptT errA IO res -> ExceptT errB IO res)
-> ReaderT envA (ExceptT errA IO) res
-> ReaderT envA (ExceptT errB IO) res
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((errA -> errB) -> ExceptT errA IO res -> ExceptT errB IO res
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT errA -> errB
errProj) ReaderT envA (ExceptT errA IO) res
rdr))