context-resource (empty) → 0.1.0.0

raw patch · 8 files changed

+328/−0 lines, 8 filesdep +asyncdep +basedep +context

Dependencies added: async, base, context, context-resource, hspec

Files

• CHANGELOG.md +5/−0
• LICENSE.md +23/−0
• README.md +14/−0
• context-resource.cabal +64/−0
• library/Context/Resource.hs +96/−0
• package.yaml +44/−0
• test-suite/Driver.hs +1/−0
• test-suite/Test/Context/ResourceSpec.hs +81/−0

@@ -0,0 +1,5 @@+# Change log++## 0.1.0.0++Initial release

@@ -0,0 +1,23 @@+[The MIT License (MIT)][]++Copyright (c) 2020 Jason Shipman++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++[The MIT License (MIT)]: https://opensource.org/licenses/MIT

@@ -0,0 +1,14 @@+# [context-resource][]++[![Version badge][]][version]++🚧 This README is under construction and could use some love. 🚧++`context-resource` contains a thread-safe, pool-compatible resource provider+abstraction that supports resource-sharing within nested actions.++See the Haddocks for more info on the library.++[context-resource]: https://github.com/jship/context+[Version badge]: https://img.shields.io/hackage/v/context-resource?color=brightgreen&label=version&logo=haskell+[version]: https://hackage.haskell.org/package/context-resource

@@ -0,0 +1,64 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 25e9584bac69d5f10c59d16e951839e19321a6ec9958b9edf594a1256b310ff9++name:           context-resource+version:        0.1.0.0+synopsis:       Thread-safe, pool-compatible resource provider+description:    A thread-safe, pool-compatible resource provider abstraction that supports+                resource-sharing within nested actions.+category:       Data+homepage:       https://github.com/jship/context#readme+bug-reports:    https://github.com/jship/context/issues+author:         Jason Shipman+maintainer:     Jason Shipman+copyright:      2020 (c) Jason Shipman+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+extra-source-files:+    CHANGELOG.md+    LICENSE.md+    package.yaml+    README.md++source-repository head+  type: git+  location: https://github.com/jship/context+  subdir: context-resource++library+  exposed-modules:+      Context.Resource+  other-modules:+      Paths_context_resource+  hs-source-dirs:+      library+  ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.12 && <5+    , context >=0.1.0.0 && <0.2+  default-language: Haskell2010++test-suite context-resource-test-suite+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+      Test.Context.ResourceSpec+      Paths_context_resource+  hs-source-dirs:+      test-suite+  ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      async+    , base+    , context+    , context-resource+    , hspec+  default-language: Haskell2010

@@ -0,0 +1,96 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}++module Context.Resource+  ( -- * Introduction+    -- $intro++    -- * Provider+    Provider+  , withProvider++    -- * Core operations+  , withResource+  , shareResource++    -- * Convenience+  , withSharedResource+  ) where++import Prelude+import qualified Context++-- | An opaque resource provider.+--+-- @since 0.1.0.0+newtype Provider res = Provider+  { store :: Context.Store (WithRes res)+  }++newtype WithRes res = WithRes (forall r. (res -> IO r) -> IO r)++-- | Given a @with@-style function to acquire a resource, supplies the caller+-- with a resource 'Provider'. This 'Provider' should ideally be long-lived and+-- threaded throughout the application to the components that need to acquire+-- resources.+--+-- @since 0.1.0.0+withProvider+  :: (forall r. (res -> IO r) -> IO r)+  -> (Provider res -> IO a)+  -> IO a+withProvider withRes f = do+  Context.withStore Context.noPropagation (Just (WithRes withRes)) \store -> do+    f Provider { store }++-- | Acquire a resource from the specified 'Provider', for the duration of the+-- specified action.+--+-- @since 0.1.0.0+withResource :: Provider res -> (res -> IO a) -> IO a+withResource Provider { store } f = do+  WithRes withRes <- Context.mine store+  withRes f++-- | Tell the specified 'Provider' to share the specified resource for the+-- duration of the specified action. All calls to 'withResource' (or+-- 'withSharedResource') within the action will return the shared resource.+--+-- @since 0.1.0.0+shareResource :: Provider res -> res -> IO a -> IO a+shareResource Provider { store } resource action = do+  Context.use store (WithRes ($ resource)) action++-- | Acquire a resource from the specified 'Provider' and share that resource+-- for the duration of the specified action. All calls to 'withResource' (or+-- 'withSharedResource') within the action will return the shared resource.+--+-- This is a convenience function combining 'withResource' and 'shareResource'.+--+-- @since 0.1.0.0+withSharedResource :: Provider res -> (res -> IO a) -> IO a+withSharedResource provider f = do+  withResource provider \resource -> do+    shareResource provider resource do+      f resource++-- $intro+--+-- This module provides a thread-safe, pool-compatible resource provider+-- abstraction that supports resource-sharing within nested actions. While it+-- was designed with resource pools in mind, the interface supports any+-- @with@-style means of acquiring a resource.+--+-- 'withResource' can be used to acquire a resource from the provider, and+-- 'shareResource' can be used to share a particular resource for the duration+-- of an action. Subsequent calls to 'shareResource' in that action are+-- idempotent. Note that if a resource-shared action spins up new threads, the+-- shared resource will /not/ be shared implicitly across thread boundaries.+--+-- While 'shareResource' offers the most control over resource-sharing,+-- 'withSharedResource' can be used as a convenience in the relatively common+-- case where a resource is acquired and then immediately shared within an+-- inner action.

@@ -0,0 +1,44 @@+name: context-resource+version: '0.1.0.0'+github: "jship/context/context-resource"+license: MIT+license-file: LICENSE.md+copyright: 2020 (c) Jason Shipman+author: "Jason Shipman"+maintainer: "Jason Shipman"+synopsis: Thread-safe, pool-compatible resource provider+description: |+  A thread-safe, pool-compatible resource provider abstraction that supports+  resource-sharing within nested actions.+category: Data++extra-source-files:+- CHANGELOG.md+- LICENSE.md+- package.yaml+- README.md++ghc-options:+  - -Wall+  - -fwarn-tabs+  - -Wincomplete-uni-patterns+  - -Wredundant-constraints++library:+  dependencies:+  - base >=4.12 && <5+  - context >=0.1.0.0 && <0.2+  source-dirs: library++tests:+  context-resource-test-suite:+    source-dirs: test-suite+    main: Driver.hs+    build-tools:+    - hspec-discover+    dependencies:+    - async+    - base+    - context+    - context-resource+    - hspec

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,81 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Context.ResourceSpec+  ( spec+  ) where++import Context.Resource (shareResource, withProvider, withResource, withSharedResource)+import Foreign (Ptr)+import Prelude+import Test.Hspec+import qualified Context+import qualified Control.Concurrent.Async as Async+import qualified Control.Monad as Monad+import qualified Foreign++spec :: Spec+spec = do+  describe "withResource" do+    it "concurrent test" do+      Async.forConcurrently_ [1 :: Int ..10] $ const do+        withProvider withRes \provider -> do+          withResource provider \ptr1 -> do+            withResource provider \ptr2 -> do+              ptr1 `shouldNotBe` ptr2++  describe "shareResource" do+    it "concurrent test" do+      Async.forConcurrently_ [1 :: Int ..10] $ const do+        withProvider withRes \provider -> do+          withResource provider \ptr1 -> do+            shareResource provider ptr1 do+              withResource provider \ptr2 -> do+                ptr1 `shouldBe` ptr2+                withResource provider \ptr3 -> do+                  ptr2 `shouldBe` ptr3+            withResource provider \ptr4 -> do+              ptr1 `shouldNotBe` ptr4+    it "cannot implicitly share across thread boundaries" do+      withProvider withRes \provider -> do+        withResource provider \parentThread'sPtr1 -> do+          shareResource provider parentThread'sPtr1 do+            withResource provider \parentThread'sPtr2 -> do+              parentThread'sPtr1 `shouldBe` parentThread'sPtr2+            threadDone <- Context.newEmptyMVar+            Monad.void $ Context.forkIO do+              withResource provider \childThread'sPtr1 -> do+                parentThread'sPtr1 `shouldNotBe` childThread'sPtr1+              Context.putMVar threadDone ()+            Context.takeMVar threadDone+          withResource provider \parentThread'sPtr3 -> do+            parentThread'sPtr1 `shouldNotBe` parentThread'sPtr3++  describe "withSharedResource" do+    it "concurrent test" do+      Async.forConcurrently_ [1 :: Int ..10] $ const do+        withProvider withRes \provider -> do+          withSharedResource provider \ptr1 -> do+            withResource provider \ptr2 -> do+              ptr1 `shouldBe` ptr2+              shareResource provider ptr2 do+                withResource provider \ptr3 -> do+                  ptr2 `shouldBe` ptr3+            withResource provider \ptr4 -> do+              ptr1 `shouldBe` ptr4+    it "cannot implicitly share across thread boundaries" do+      withProvider withRes \provider -> do+        withSharedResource provider \parentThread'sPtr1 -> do+          withResource provider \parentThread'sPtr2 -> do+            parentThread'sPtr1 `shouldBe` parentThread'sPtr2+          threadDone <- Context.newEmptyMVar+          Monad.void $ Context.forkIO do+            withResource provider \childThread'sPtr1 -> do+              parentThread'sPtr1 `shouldNotBe` childThread'sPtr1+            Context.putMVar threadDone ()+          Context.takeMVar threadDone+          withResource provider \parentThread'sPtr3 -> do+            parentThread'sPtr1 `shouldBe` parentThread'sPtr3++withRes :: (Ptr Int -> IO a) -> IO a+withRes = Foreign.withArray [1..3]