{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

-- The code and documentation before modification is BSD3 licensed,
-- (c) 2019-2023 The Polysemy Lounge: [Polysemy.Resource]
-- (https://hackage.haskell.org/package/polysemy-1.9.1.2/docs/Polysemy-Resource.html).

{- |
Copyright   :  (c) 2019-2023 The Polysemy Lounge
               (c) 2023 Sayo Koyoneda
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable

An effect capable of providing [bracket]
(https://hackage.haskell.org/package/base-4.16.4.0/docs/Control-Exception.html#v:bracket) semantics.
-}
module Data.Effect.Resource where

import Data.Functor (void)

{- |
An effect capable of providing [bracket]
(https://hackage.haskell.org/package/base-4.16.4.0/docs/Control-Exception.html#v:bracket) semantics.
-}
data Resource f a where
    -- | Allocate a resource, use it, and clean it up afterwards.
    Bracket :: f a -> (a -> f ()) -> (a -> f b) -> Resource f b
    -- | Allocate a resource, use it, and clean it up afterwards if an error occurred.
    BracketOnExcept :: f a -> (a -> f ()) -> (a -> f b) -> Resource f b

makeEffectH [''Resource]

bracket_ :: (Resource <<: f, Functor f) => f a -> f b -> f c -> f c
bracket_ :: forall (f :: * -> *) a b c.
(Resource <<: f, Functor f) =>
f a -> f b -> f c -> f c
bracket_ f a
acquire f b
release f c
thing =
    f a -> (a -> f ()) -> (a -> f c) -> f c
forall a b (f :: * -> *).
SendHOE Resource f =>
f a -> (a -> f ()) -> (a -> f b) -> f b
bracket f a
acquire (f () -> a -> f ()
forall a b. a -> b -> a
const (f () -> a -> f ()) -> f () -> a -> f ()
forall a b. (a -> b) -> a -> b
$ f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
release) (f c -> a -> f c
forall a b. a -> b -> a
const f c
thing)

bracketOnExcept_ :: (Resource <<: f, Functor f) => f a -> f b -> f c -> f c
bracketOnExcept_ :: forall (f :: * -> *) a b c.
(Resource <<: f, Functor f) =>
f a -> f b -> f c -> f c
bracketOnExcept_ f a
acquire f b
onExc f c
thing =
    f a -> (a -> f ()) -> (a -> f c) -> f c
forall a b (f :: * -> *).
SendHOE Resource f =>
f a -> (a -> f ()) -> (a -> f b) -> f b
bracketOnExcept f a
acquire (f () -> a -> f ()
forall a b. a -> b -> a
const (f () -> a -> f ()) -> f () -> a -> f ()
forall a b. (a -> b) -> a -> b
$ f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
onExc) (f c -> a -> f c
forall a b. a -> b -> a
const f c
thing)

finally :: (Resource <<: f, Applicative f) => f a -> f () -> f a
finally :: forall (f :: * -> *) a.
(Resource <<: f, Applicative f) =>
f a -> f () -> f a
finally f a
thing f ()
release = f () -> (() -> f ()) -> (() -> f a) -> f a
forall a b (f :: * -> *).
SendHOE Resource f =>
f a -> (a -> f ()) -> (a -> f b) -> f b
bracket (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (f () -> () -> f ()
forall a b. a -> b -> a
const f ()
release) (f a -> () -> f a
forall a b. a -> b -> a
const f a
thing)

finally_ :: (Resource <<: f, Applicative f) => f a -> f b -> f a
finally_ :: forall (f :: * -> *) a b.
(Resource <<: f, Applicative f) =>
f a -> f b -> f a
finally_ f a
thing f b
release = f a -> f () -> f a
forall (f :: * -> *) a.
(Resource <<: f, Applicative f) =>
f a -> f () -> f a
finally f a
thing (f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
release)

onException :: (Resource <<: f, Applicative f) => f a -> f () -> f a
onException :: forall (f :: * -> *) a.
(Resource <<: f, Applicative f) =>
f a -> f () -> f a
onException f a
thing f ()
onExc = f () -> (() -> f ()) -> (() -> f a) -> f a
forall a b (f :: * -> *).
SendHOE Resource f =>
f a -> (a -> f ()) -> (a -> f b) -> f b
bracketOnExcept (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (f () -> () -> f ()
forall a b. a -> b -> a
const f ()
onExc) (f a -> () -> f a
forall a b. a -> b -> a
const f a
thing)

onException_ :: (Resource <<: f, Applicative f) => f a -> f b -> f a
onException_ :: forall (f :: * -> *) a b.
(Resource <<: f, Applicative f) =>
f a -> f b -> f a
onException_ f a
thing f b
onExc = f a -> f () -> f a
forall (f :: * -> *) a.
(Resource <<: f, Applicative f) =>
f a -> f () -> f a
onException f a
thing (f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
onExc)