bluefin-internal 0.10.1.0 → 0.11.0.0

raw patch · 10 files changed

+199/−71 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• bluefin-internal.cabal +4/−3
• src/Bluefin/Internal.hs +31/−6
• src/Bluefin/Internal/Capability/ThrowCatch.hs +88/−0
• src/Bluefin/Internal/DslBuilder.hs +4/−8
• src/Bluefin/Internal/DslBuilderEff.hs +17/−5
• src/Bluefin/Internal/DslBuilderEffects.hs +0/−48
• src/Bluefin/Internal/Exception/Scoped.hs +6/−1
• test/Main.hs +2/−0
• test/Test/ThrowCatch.hs +29/−0

@@ -1,3 +1,21 @@+# 0.11.0.0++* Add `Bluefin.Internal.Capability.ThrowCatch`++* Add `ThrowCatch`, `throwCatchThrow`, `throwCatchTry`++* Remove `withScopedException_`++* Add `Bluefin.Internal.DslBuilderEff.runDslBuilderEffMappedArgs`++* Remove `Bluefin.Internal.DslBuilderEffects`++# 0.10.1.0++* Add `runPureEffAsyncSafe` and `runPureEffAsyncSafeRestarting`++* Use `INLINE [0]` on `runDslBuilderEff` for improved performance+ # 0.10.0.0  * Make `Ask`, `AskCapability`, `Await`, `JumpTo`, `Modify`, `Request`,

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               bluefin-internal-version:            0.10.1.0+version:            0.11.0.0 license:            MIT license-file:       LICENSE author:             Tom Ellis@@ -89,9 +89,9 @@       Bluefin.Internal.CloneableHandle,       Bluefin.Internal.DslBuilder,       Bluefin.Internal.DslBuilderEff,-      Bluefin.Internal.DslBuilderEffects,       Bluefin.Internal.Examples,       Bluefin.Internal.Exception,+      Bluefin.Internal.Capability.ThrowCatch,       Bluefin.Internal.Exception.Scoped,       Bluefin.Internal.GadtEffect,       Bluefin.Internal.Key,@@ -108,7 +108,8 @@     main-is:          Main.hs     other-modules:    Test.GeneralBracket,                       Test.RunPureEff,-                      Test.SpecH+                      Test.SpecH,+                      Test.ThrowCatch     build-depends:         base,         async,

@@ -441,6 +441,20 @@ instance (e <: es) => OneWayCoercible (Throw ex e) (Throw ex es) where   oneWayCoercibleImpl = oneWayCoercible +-- | A scoped exception capability that can catch within its own scope.+type ThrowCatch :: Type -> Effects -> Type+newtype ThrowCatch ex e+  = MkThrowCatch (ScopedException.Exception ex)+  deriving (Handle) via OneWayCoercibleHandle (ThrowCatch ex)++type role ThrowCatch nominal nominal++instance+  (e <: es) =>+  OneWayCoercible (ThrowCatch ex e) (ThrowCatch ex es)+  where+  oneWayCoercibleImpl = unsafeOneWayCoercible+ -- | Capability to modify a reference to an @s@ newtype Modify s (e :: Effects) = UnsafeMkState (IORef s)   deriving (Handle) via OneWayCoercibleHandle (Modify s)@@ -847,6 +861,14 @@   Eff es a throw h = case mapHandle h of MkException throw_ -> throw_ +throwCatchThrow ::+  (e <: es) =>+  ThrowCatch ex e ->+  ex ->+  Eff es a+throwCatchThrow (MkThrowCatch ex) exn =+  unsafeProvideIO $ \io -> effIO io (ScopedException.throw ex exn)+ has :: forall a b. (a <: b) => a `In` b -- This is safe because, as shown by instanceProof1/2/3, the only way -- to construct `a <: b` is if `a `In` b`.@@ -875,10 +897,17 @@   -- | @Left@ if the exception was thrown, @Right@ otherwise   Eff es (Either exn a) try f =+  throwCatchTry $ \ex ->+    f (MkException (throwCatchThrow ex))++throwCatchTry ::+  (forall e. ThrowCatch ex e -> Eff (e :& es) a) ->+  Eff es (Either ex a)+throwCatchTry f =   unsafeProvideIO $ \io -> do     withEffToIO_ io $ \effToIO -> do-      withScopedException_ $ \throw_ -> do-        effToIO (f (MkException (effIO io . throw_)))+      ScopedException.try $ \ex -> do+        effToIO (f (MkThrowCatch ex))  -- | -- @@@ -1059,10 +1088,6 @@ modify state f = do   s <- get state   put state (f s)--withScopedException_ :: ((forall a. e -> IO a) -> IO r) -> IO (Either e r)-withScopedException_ f =-  ScopedException.try (\ex -> f (ScopedException.throw ex))  -- | -- @

@@ -0,0 +1,88 @@+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}++module Bluefin.Internal.Capability.ThrowCatch+  ( ThrowCatch,+    module Bluefin.Internal.Capability.ThrowCatch,+  )+where++import Bluefin.Internal+  ( ThrowCatch (MkThrowCatch),+    Eff,+    throwCatchTry,+    throwCatchThrow,+    unsafeProvideIO,+    useImpl,+    withEffToIO_,+    (:&),+    type (<:),+  )+import Bluefin.Internal.Exception.Scoped qualified as Scoped++try ::+  (forall e. ThrowCatch ex e -> Eff (e :& es) a) ->+  -- | ͘+  Eff es (Either ex a)+try = throwCatchTry++handle ::+  (ex -> Eff es a) ->+  (forall e. ThrowCatch ex e -> Eff (e :& es) a) ->+  -- | ͘+  Eff es a+handle h f =+  try f >>= \case+    Left ex -> h ex+    Right a -> pure a++catch ::+  (forall e. ThrowCatch ex e -> Eff (e :& es) a) ->+  (ex -> Eff es a) ->+  -- | ͘+  Eff es a+catch f h = handle h f++localCatch ::+  (e <: es) =>+  ThrowCatch ex e ->+  Eff es a ->+  (ex -> Eff es a) ->+  -- | ͘+  Eff es a+localCatch h action handler =+  localTry h action >>= \case+    Left ex -> handler ex+    Right a -> pure a++localHandle ::+  (e <: es) =>+  ThrowCatch ex e ->+  (ex -> Eff es a) ->+  Eff es a ->+  -- | ͘+  Eff es a+localHandle h handler action = localCatch h action handler++throw ::+  (e <: es) =>+  ThrowCatch ex e ->+  ex ->+  -- | ͘+  Eff es a+throw = throwCatchThrow++localTry ::+  (e <: es) =>+  ThrowCatch ex e ->+  Eff es a ->+  -- | ͘+  Eff es (Either ex a)+localTry h action = case h of+  MkThrowCatch ex ->+    unsafeProvideIO $ \io ->+      withEffToIO_ io $ \runInIO ->+        Scoped.localTry ex (runInIO (useImpl action))

@@ -3,11 +3,7 @@ module Bluefin.Internal.DslBuilder where  import Bluefin.Internal-import Bluefin.Internal.DslBuilderEffects-  ( DslBuilderEffects,-    dslBuilderEffects,-    runDslBuilderEffects,-  )+import Bluefin.Internal.DslBuilderEff  newtype Forall f r = MkForall {unForall :: forall es. f es r} @@ -27,13 +23,13 @@     unForall (f r)  newtype DslBuilder h r-  = MkDslBuilder {unMkDslBuilder :: Forall (DslBuilderEffects h) r}+  = MkDslBuilder {unMkDslBuilder :: Forall (DslBuilderEff h) r}  runDslBuilder :: (Handle h) => h es -> DslBuilder h r -> Eff es r-runDslBuilder h f = runDslBuilderEffects h (unForall (unMkDslBuilder f))+runDslBuilder h f = runDslBuilderEff h (unForall (unMkDslBuilder f))  dslBuilder :: (forall e. h e -> Eff e r) -> DslBuilder h r-dslBuilder k = MkDslBuilder (mkForall (dslBuilderEffects (useImpl . k)))+dslBuilder k = MkDslBuilder (mkForall (dslBuilderEff (useImpl . k)))  instance (Handle h) => Functor (DslBuilder h) where   fmap f g = dslBuilder (\h -> fmap f (runDslBuilder h g))

@@ -38,6 +38,18 @@  -- oneShot is essential for good performance. I don't fully understand -- why.++runDslBuilderEffMappedArgs ::+  forall e1 e2 es h r.+  (Handle h, e1 <: es, e2 <: es) =>+  h e1 ->+  DslBuilderEff h e2 r ->+  -- | ͘+  Eff es r+runDslBuilderEffMappedArgs h f =+  runDslBuilderEff (mapHandle h) (useImplDslBuilderEff f)+{-# INLINE runDslBuilderEffMappedArgs #-}+ dslBuilderEff ::   (forall e. h e -> Eff (e :& es) r) ->   -- | ͘@@ -56,15 +68,15 @@ instance (Handle h) => Functor (DslBuilderEff h es) where   fmap f g =     dslBuilderEff $ \h ->-      fmap f (runDslBuilderEff (mapHandle h) (useImplDslBuilderEff g))+      fmap f (runDslBuilderEffMappedArgs h g)  instance (Handle h) => Applicative (DslBuilderEff h es) where   pure x = dslBuilderEff (pure (pure x))   f <*> x = dslBuilderEff $ \h ->-    runDslBuilderEff (mapHandle h) (useImplDslBuilderEff f)-      <*> runDslBuilderEff (mapHandle h) (useImplDslBuilderEff x)+    runDslBuilderEffMappedArgs h f+      <*> runDslBuilderEffMappedArgs h x  instance (Handle h) => Monad (DslBuilderEff h es) where   m >>= f = dslBuilderEff $ \h -> do-    r <- runDslBuilderEff (mapHandle h) (useImplDslBuilderEff m)-    runDslBuilderEff (mapHandle h) (useImplDslBuilderEff (f r))+    r <- runDslBuilderEffMappedArgs h m+    runDslBuilderEffMappedArgs h (f r)

@@ -1,48 +0,0 @@--- This will probably be superseded by DslBuilderEff because the--- latter has a better name-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE QuantifiedConstraints #-}--module Bluefin.Internal.DslBuilderEffects where--import Bluefin.Internal-import Bluefin.Internal.OneWayCoercible-  ( OneWayCoercible,-    oneWayCoerce,-    oneWayCoercible,-    oneWayCoercibleImpl,-  )--newtype DslBuilderEffects h es r-  = MkDslBuilderEffects {unMkDslBuilderEffects :: forall e. h e -> Eff (e :& es) r}--useImplDslBuilderEffects :: (e <: es) => DslBuilderEffects h e r -> DslBuilderEffects h es r-useImplDslBuilderEffects = oneWayCoerce--runDslBuilderEffects :: h es -> DslBuilderEffects h es r -> Eff es r-runDslBuilderEffects h f = makeOp (unMkDslBuilderEffects f h)--dslBuilderEffects :: (forall e. h e -> Eff (e :& es) r) -> DslBuilderEffects h es r-dslBuilderEffects = MkDslBuilderEffects--instance-  (e <: es) =>-  OneWayCoercible (DslBuilderEffects h e r) (DslBuilderEffects h es r)-  where-  oneWayCoercibleImpl = oneWayCoercible--instance (Handle h) => Functor (DslBuilderEffects h es) where-  fmap f g =-    dslBuilderEffects $ \h ->-      fmap f (runDslBuilderEffects (mapHandle h) (useImplDslBuilderEffects g))--instance (Handle h) => Applicative (DslBuilderEffects h es) where-  pure x = dslBuilderEffects (pure (pure x))-  f <*> x = dslBuilderEffects $ \h ->-    runDslBuilderEffects (mapHandle h) (useImplDslBuilderEffects f)-      <*> runDslBuilderEffects (mapHandle h) (useImplDslBuilderEffects x)--instance (Handle h) => Monad (DslBuilderEffects h es) where-  m >>= f = dslBuilderEffects $ \h -> do-    r <- runDslBuilderEffects (mapHandle h) (useImplDslBuilderEffects m)-    runDslBuilderEffects (mapHandle h) (useImplDslBuilderEffects (f r))

@@ -2,6 +2,7 @@   ( Exception,     InFlight,     try,+    localTry,     throw,     newException,     checkException,@@ -17,9 +18,13 @@ try :: (Exception e -> IO a) -> IO (Either e a) try k = do   ex <- newException+  localTry ex (k ex)++localTry :: Exception e -> IO a -> IO (Either e a)+localTry ex action =   tryJust     (checkException ex)-    (k ex)+    action  throw :: Exception e -> e -> IO a throw ex e = throwIO (MkInFlight ex e)

@@ -19,6 +19,7 @@     test_runPureEffAsyncSafeReapsWorker,   ) import Test.SpecH (SpecH, assertEqual, runSpecH)+import Test.ThrowCatch (test_throwCatch) import Prelude hiding (break, read)  main :: IO ()@@ -81,6 +82,7 @@     test_localInHandler y     test_readerCleanup y     test_generalBracket io y+    test_throwCatch y     test_streamConsumeReader y     test_streamConsumeHandleReader y     test_unliftIOReader io y

@@ -0,0 +1,29 @@+module Test.ThrowCatch where++import Bluefin.Internal+import Bluefin.Internal.Capability.ThrowCatch qualified as ThrowCatch+import Test.SpecH (SpecH, assertEqual)++test_throwCatch :: (e <: es) => SpecH e -> Eff es ()+test_throwCatch y = do+  assertEqual+    y+    "ThrowCatch.try catches a thrown exception"+    (Left @String @() "caught")+    (runPureEff (ThrowCatch.try $ \ex -> ThrowCatch.throw ex "caught"))+  assertEqual+    y+    "ThrowCatch.try returns a successful result"+    (Right @String @Int 42)+    (runPureEff (ThrowCatch.try $ \_ -> pure 42))+  assertEqual+    y+    "ThrowCatch.localTry catches a thrown exception"+    (Left @String @() "outer")+    ( runPureEff $ ThrowCatch.try $ \ex -> do+        localResult <- ThrowCatch.localTry ex (ThrowCatch.throw ex "inner")+        ThrowCatch.throw ex $ case localResult of+          Left "inner" -> "outer"+          Left _ -> "unexpected local exception"+          Right () -> "localTry did not catch"+    )