freer-simple-catching (empty) → 0.1.0.0

raw patch · 7 files changed

+278/−0 lines, 7 filesdep +basedep +freer-simpledep +freer-simple-catching

Dependencies added: base, freer-simple, freer-simple-catching, hspec

Files

ChangeLog.md +3/−0
LICENSE +21/−0
README.md +37/−0
freer-simple-catching.cabal +55/−0
src/Control/Monad/Freer/Catching.hs +92/−0
test/Control/Monad/Freer/CatchingSpec.hs +69/−0
test/Spec.hs +1/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for freer-catching++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Co—Star Astrology, Ben Weitzman++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.

+ README.md view

@@ -0,0 +1,37 @@+# freer-catching++This is library for working with exceptions that are thrown during interpreation of free monad effects, at call time.++## How to use++This library exposes one effect:++```haskell+catching :: forall e f a r+          . (Exception e, Member (Catching f e) r)+         => Eff '[f] a+         -> Eff r (Either e a)+```++We take an effectful function over one effect `f` and we turn it into an effectful computation of a new effect which denotes that we have an obligation to catch exceptions when we interpret this effect.++We can then discharge this obligation by interpretting the effect `f` and and any `Catching` effects built on `f` by interpretting them both at the same time: ++```haskell+runCatching :: forall e r v f+             . (Member IO r, Member IO (f ': r))+            => (forall a q . Member IO q => Eff (f ': q) a -> Eff q a)+            -> Eff (Catching f e : f : r) v+            -> Eff r v+``` ++We can also interpret a `Catching f e` effect by way of another effect `g`:++```haskell+runCatching2 :: forall e r v f g+             . (Member IO r, Member IO (f : r), Member IO (f : g : r))+            => (forall a q. Member g q => Eff (f : q) a -> Eff q a)+            -> (forall a q. Member IO q => Eff (g : q) a -> Eff q a)+            -> Eff (Catching f e : f : g : r) v+            -> Eff r v+```

+ freer-simple-catching.cabal view

@@ -0,0 +1,55 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0772a1bfb6665ce76c6a2873fff53b7df0d4c8140c85d8e2345f189a0cae3ade++name:           freer-simple-catching+version:        0.1.0.0+synopsis:       Checked runtime exceptions with freer-simple+description:    Please see the README on Gitlab at <https://gitlab.com/costar-astrology/freer-simple-contrib/tree/master/freer-simple-catching>+category:       Control+author:         Ben Weitzman+maintainer:     ben@costarastrology.com+copyright:      2018 Ben Weitzman, Co-Star Astrology+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://gitlab.com/costar-astrology/freer-simple-contrib/tree/master/freer-simple-catching++library+  exposed-modules:+      Control.Monad.Freer.Catching+  other-modules:+      Paths_freer_simple_catching+  hs-source-dirs:+      src+  default-extensions: GADTs FlexibleContexts TypeOperators DataKinds StandaloneDeriving DeriveDataTypeable MultiParamTypeClasses FlexibleInstances UndecidableInstances TypeApplications ScopedTypeVariables TypeFamilies RankNTypes DeriveAnyClass OverloadedStrings FunctionalDependencies ConstraintKinds EmptyCase BangPatterns+  build-depends:+      base >=4.7 && <5+    , freer-simple >=1.1 && <1.2+  default-language: Haskell2010++test-suite freer-simple-catching-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Control.Monad.Freer.CatchingSpec+      Paths_freer_simple_catching+  hs-source-dirs:+      test+  default-extensions: GADTs FlexibleContexts TypeOperators DataKinds StandaloneDeriving DeriveDataTypeable MultiParamTypeClasses FlexibleInstances UndecidableInstances TypeApplications ScopedTypeVariables TypeFamilies RankNTypes DeriveAnyClass OverloadedStrings FunctionalDependencies ConstraintKinds EmptyCase BangPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , freer-simple >=1.1 && <1.2+    , freer-simple-catching+    , hspec+  default-language: Haskell2010

+ src/Control/Monad/Freer/Catching.hs view

@@ -0,0 +1,92 @@+{-|+Module      : Control.Monad.Freer.Catching+Description : Handle exceptions that are thrown during interpreation of free monad effects, at call time.+Copyright   : (c) Ben Weitzman 2018+License     : MIT+Maintainer  : ben@costarastrolgoy.com+Stability   : experimental+Portability : POSIX++The 'Catching' effect allows a way to keep track of effects that we might expect to throw+exceptions during their handling, but whose signatures don't indicate this.++As an example, consider an effect @Div@ that divides numbers:++@+  data Div a where+   Div :: Int -> Int -> Div Int+@++The keen programmer is aware that this can throw an error. However, suppose that there is reason to believe that+this effect will be rarely used in a way that fails. Adding an indicator to the interface (such as by saying @Div :: Int -> Int -> Div (Maybe Int)@) makes using this effect more annoying most of the time. ++Nevertheless, it should be possible to handle this case when we want to. This is where 'Catching' can help.+-}+module Control.Monad.Freer.Catching+  (Catching+  ,catching+  ,runCatching+  ,runCatching2+  )+where++import           Control.Exception+import           Control.Monad+import           Control.Monad.Freer+import           Control.Monad.Freer.Internal+import           Data.OpenUnion.Internal++-- | The 'Catching' effect is parameterized by the effect it is handling and the type of exceptions it will+-- attempt to handle (e.g. @Catching Div ArithException@)+data Catching f e a where+    Catching :: forall f e a . (Exception e)+             => (forall r . Member f r => Eff r a)+             -> Catching f e (Either e a)+             +-- | @catching@ will turn an effectful computation producing an @a@ and using effect @f@ into one that produces+-- an @Either e a@. This allows any exception that is thrown during normal handling of @f@ be handled explicitly.+catching :: forall e f a r+          . (Exception e, Member (Catching f e) r)+         => Eff '[f] a+         -> Eff r (Either e a)+catching f = send @(Catching f e) $ Catching (generalize f)++generalize :: Member f r => Eff '[f] a -> Eff r a+generalize (Val x)  = return x+generalize (E u' q) = send (extract u') >>= qComp q generalize++-- | Handle an effect @f@ and a @Catching f e@ simultaneously. In cases where 'catching' was called, on an+-- effect, exceptions of type @e@ will be caught and handled. In cases where 'catching' was not called but+-- @f@ was used directly, exceptions will not be caught and will bubble up.+runCatching :: forall e r v f+             . (Member IO r, LastMember IO (f ': r))+            => (forall a q . Member IO q => Eff (f ': q) a -> Eff q a)+            -> Eff (Catching f e : f : r) v+            -> Eff r v+runCatching runner = runner . interpretM handler+    where handler :: Catching f e a -> IO a+          handler (Catching f) = do+            x <- try . runM $ evaluate <$> runner f+            case x of+              Left e -> return $ Left e+              Right y -> try y++-- | 'runCatching2' can catch exceptions in effects that don't interpret directly to 'IO' but instead+-- go through an intermediary effect. In this case, three effects will be handled in one go:+--+--   * The effect @f@ that is being called and is expected to be the source of an exception+--   * The effect @g@ which is not being called directly but is called instead by the handler @f@+--   * The effect @Catching f e@ +runCatching2 :: forall e r v f g+             . (Member IO r, Member IO (f : r), LastMember IO (f : g : r))+            => (forall a q. Member g q => Eff (f : q) a -> Eff q a)+            -> (forall a q. Member IO q => Eff (g : q) a -> Eff q a)+            -> Eff (Catching f e : f : g : r) v+            -> Eff r v+runCatching2 runner1 runner2 = runner2 . runner1 . interpretM handler+    where handler :: Catching f e a -> IO a+          handler (Catching f) = do+            x <- try . runM $ evaluate <$> (runner2 . runner1 $ f)+            case x of+              Left e -> return $ Left e+              Right y -> try y

+ test/Control/Monad/Freer/CatchingSpec.hs view

@@ -0,0 +1,69 @@+module Control.Monad.Freer.CatchingSpec where++import           Control.Monad+import           Control.Exception+import           Control.Monad.Freer+import           Control.Monad.Freer.Catching+import           Test.Hspec++data Div a where+  Div :: Int -> Int -> Div Int++runDiv :: forall r v . Eff (Div ': r) v -> Eff r v+runDiv = interpret handler+  where+    handler :: Div a -> Eff r a+    handler (Div x y) = return $ x `div` y++data Test a where+  Succeed :: Test Int+  Fail :: Test Bool++data TestException = TestException deriving (Show, Exception, Eq)++runTest :: forall r v . (Member IO r)+        => Eff (Test ': r) v+       -> Eff r v+runTest = interpret handler+  where+    handler :: Test a -> Eff r a+    handler Succeed = return 3+    handler Fail = throw TestException++spec :: Spec+spec = do+  describe "div" $ do+    it "divides" $ do+      (run . runDiv . send $ Div 4 2) `shouldBe` 2++  describe "catching" $ do+    it "lets unexceptional values through from pure code" $ do+      result <- runM . runCatching @ArithException runDiv $+        catching @ArithException @Div (send $ Div 2 1)+      result `shouldBe` Right 2++    it "catches exceptions from pure code" $ do+      result <- runM . runCatching @ArithException runDiv $+        catching @ArithException @Div (send $ Div 2 0)+      result `shouldBe` Left DivideByZero++    it "lets unexceptional io values through" $ do+      result <- runM . runCatching @TestException runTest $+        catching @TestException @Test (send Succeed)+      result `shouldBe` Right 3++    it "catches io exceptions" $ do+      result <- runM . runCatching @TestException runTest $+        catching @TestException @Test (send Fail)+      result `shouldBe` Left TestException++    it "catches inside forM" $ do+      result <- runM . runCatching @TestException runTest $+        forM [1,2,3] $ \i -> do+          x <- catching @TestException @Test (send Fail)+          y <- case x of+            Left e -> return i+            Right v -> if v then return 1 else return 2+          z <- send Succeed+          return $ y + z+      result `shouldBe` [4,5,6]

+ test/Spec.hs view

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