diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +# resourcet-effectful-0.1 (2022-07-14) +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021-2022, Andrzej Rybczak + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Andrzej Rybczak nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +# resourcet-effectful + +[![Build Status](https://github.com/haskell-effectful/resourcet-effectful/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/haskell-effectful/resourcet-effectful/actions?query=branch%3Amaster) +[![Hackage](https://img.shields.io/hackage/v/resourcet-effectful.svg)](https://hackage.haskell.org/package/resourcet-effectful) +[![Dependencies](https://img.shields.io/hackage-deps/v/resourcet-effectful.svg)](https://packdeps.haskellers.com/feed?needle=andrzej@rybczak.net) +[![Stackage LTS](https://www.stackage.org/package/resourcet-effectful/badge/lts)](https://www.stackage.org/lts/package/resource-teffectful) +[![Stackage Nightly](https://www.stackage.org/package/resourcet-effectful/badge/nightly)](https://www.stackage.org/nightly/package/resourcet-effectful) + + +Adaptation of the [resourcet](https://hackage.haskell.org/package/resourcet) library for the [effectful](https://hackage.haskell.org/package/effectful) ecosystem. diff --git a/resourcet-effectful.cabal b/resourcet-effectful.cabal new file mode 100644 --- /dev/null +++ b/resourcet-effectful.cabal @@ -0,0 +1,60 @@ +cabal-version: 2.4 +build-type: Simple +name: resourcet-effectful +version: 1.0.0.0 +license: BSD-3-Clause +license-file: LICENSE +category: Control +maintainer: andrzej@rybczak.net +author: Andrzej Rybczak +synopsis: Adaptation of the resourcet library for the effectful ecosystem. + +description: Adaptation of the @@ library for the @@ ecosystem. + +extra-source-files: + CHANGELOG.md + README.md + +tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 + +bug-reports: https://github.com/haskell-effectful/resourcet-effectful/issues +source-repository head + type: git + location: https://github.com/haskell-effectful/resourcet-effectful.git + +common language + ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors + + default-language: Haskell2010 + + default-extensions: BangPatterns + ConstraintKinds + DataKinds + DeriveFunctor + DeriveGeneric + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + LambdaCase + MultiParamTypeClasses + NoStarIsType + RankNTypes + RoleAnnotations + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeOperators + +library + import: language + + build-depends: base >= 4.13 && < 5 + , effectful-core >= 1.0.0.0 && < 1.0.1.0 + , resourcet >= 1.2.4.3 && < 1.3 + + hs-source-dirs: src + + exposed-modules: Effectful.Resource diff --git a/src/Effectful/Resource.hs b/src/Effectful/Resource.hs new file mode 100644 --- /dev/null +++ b/src/Effectful/Resource.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} +-- | Resource management via 'R.MonadResource'. +module Effectful.Resource + ( -- * Effect + Resource + + -- ** Handlers + , runResource + + -- * Registering and releasing resources + , R.allocate + , R.allocate_ + , R.register + , R.release + , R.unprotect + + -- * Internal state + , R.InternalState + , getInternalState + , runInternalState + , R.createInternalState + , R.closeInternalState + ) where + +import Control.Exception +import qualified Control.Monad.Trans.Resource as R +import qualified Control.Monad.Trans.Resource.Internal as RI + +import Effectful +import Effectful.Dispatch.Static +import Effectful.Dispatch.Static.Primitive + +-- | Provide the ability to use the 'R.MonadResource' instance of 'Eff'. +data Resource :: Effect + +type instance DispatchOf Resource = Static WithSideEffects +newtype instance StaticRep Resource = Resource R.InternalState + +-- | Run the resource effect. +runResource :: IOE :> es => Eff (Resource : es) a -> Eff es a +runResource m = unsafeEff $ \es0 -> do + istate <- R.createInternalState + mask $ \unmask -> do + es <- consEnv (Resource istate) dummyRelinker es0 + a <- unmask (unEff m es) `catch` \e -> do + unconsEnv es + RI.stateCleanupChecked (Just e) istate + throwIO e + unconsEnv es + RI.stateCleanupChecked Nothing istate + pure a + +---------------------------------------- +-- Internal state + +-- | Get the 'R.InternalState' of the current 'Resource' effect. +getInternalState :: Resource :> es => Eff es R.InternalState +getInternalState = do + Resource istate <- getStaticRep + pure istate + +-- | Run the 'Resource' effect with existing 'R.InternalState'. +-- +-- /Note:/ the 'R.InternalState' will not be closed at the end. +runInternalState :: IOE :> es => R.InternalState -> Eff (Resource : es) a -> Eff es a +runInternalState istate = evalStaticRep (Resource istate) + +---------------------------------------- +-- Orphan instance + +instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where + liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do + getEnv es >>= \(Resource istate) -> m istate