bluefin-internal 0.0.15.0 → 0.1.0.0

raw patch · 5 files changed

+148/−63 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• bluefin-internal.cabal +3/−1
• src/Bluefin/Internal.hs +56/−62
• src/Bluefin/Internal/Exception/Scoped.hs +33/−0
• src/Bluefin/Internal/Key.hs +32/−0

@@ -1,3 +1,27 @@+## 0.1.0.0++* Implement `Exception` using `Eff` not naked `IO`++* Remove unused `unsafeRemoveEff`++* Add `unsafeCoerceEff`++* Rename `UnsafeMkException` to `MkException`++* Add type roles for `StateSource`, `State`, `IOE`++* Correct implementation of `have`++* Add `withStateInIO`++* Correct type signature of `newState`++* Add safe scoped exceptions implementation++  * `Bluefin.Internal.Exception.Scoped`++  * `Bluefin.Internal..Scoped`+ ## 0.0.15.0  * Add `runEff_` and `ignoreStream`

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               bluefin-internal-version:            0.0.15.0+version:            0.1.0.0 license:            MIT license-file:       LICENSE author:             Tom Ellis@@ -87,6 +87,8 @@     exposed-modules:       Bluefin.Internal,       Bluefin.Internal.Examples,+      Bluefin.Internal.Exception.Scoped,+      Bluefin.Internal.Key,       Bluefin.Internal.Pipes,       Bluefin.Internal.System.IO 

@@ -9,9 +9,9 @@  module Bluefin.Internal where +import qualified Bluefin.Internal.Exception.Scoped as ScopedException import qualified Control.Concurrent.Async as Async import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Control.Exception (throwIO, tryJust) import qualified Control.Exception import Control.Monad (forever) import Control.Monad.Base (MonadBase (liftBase))@@ -24,7 +24,6 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Kind (Type) import Data.Type.Coercion (Coercion (Coercion))-import qualified Data.Unique import GHC.Exts (Proxy#, proxy#) import System.IO.Unsafe (unsafePerformIO) import Unsafe.Coerce (unsafeCoerce)@@ -67,7 +66,7 @@   ((forall r. (forall e1. IOE e1 -> Eff (e1 :& es) r) -> IO r) -> IO a) ->   IOE e2 ->   Eff es a-withEffToIO k io = effIO io (k (\f -> unsafeUnEff (f MkIOE)))+withEffToIO k io = effIO io (k (\f -> unsafeUnEff (f io)))  withEffToIO' ::   (e2 :> es) =>@@ -107,20 +106,10 @@     ((forall a. EffReader (IOE e) es a -> IO a) -> IO b) ->     EffReader (IOE e) es b   withRunInIO k =-    MkEffReader-      ( UnsafeMkEff-          . Reader.runReaderT-            ( withRunInIO-                ( \f ->-                    k-                      ( f-                          . Reader.ReaderT-                          . (unsafeUnEff .)-                          . unEffReader-                      )-                )-            )-      )+    MkEffReader $ \io -> do+      withEffToIO_ io $ \effToIO -> do+        k $ \(MkEffReader f) -> do+          effToIO (f io)  race ::   (e2 :> es) =>@@ -254,19 +243,15 @@   Eff es r withMonadFail f m = unEffReader m f --- | This function is really very unsafe and for internal use only.--- Unlike the similarly-named @unsafeEff_@ function from @effectful@,--- which is provided for use in user code, this function must never be--- used in user code.-unsafeRemoveEff :: Eff (e :& es) a -> Eff es a-unsafeRemoveEff = UnsafeMkEff . unsafeUnEff- -- | Run an 'Eff' that doesn't contain any unhandled effects. runPureEff :: (forall es. Eff es a) -> a-runPureEff e = unsafePerformIO (unsafeUnEff e)+runPureEff e = unsafePerformIO (runEff_ (\_ -> e)) +unsafeCoerceEff :: Eff t r -> Eff t' r+unsafeCoerceEff = coerce+ weakenEff :: t `In` t' -> Eff t r -> Eff t' r-weakenEff _ = UnsafeMkEff . unsafeUnEff+weakenEff _ = unsafeCoerceEff  insertFirst :: Eff b r -> Eff (c1 :& b) r insertFirst = weakenEff (drop (eq (# #)))@@ -326,12 +311,17 @@ -- | Handle to a capability to create strict mutable state handles data StateSource (e :: Effects) = StateSource +type role StateSource nominal+ -- | Handle to an exception of type @exn@-newtype Exception exn (e :: Effects) = UnsafeMkException (forall a. exn -> IO a)+newtype Exception exn (e :: Effects)+  = MkException (forall a. exn -> Eff e a)  -- | A handle to a strict mutable state of type @s@ newtype State s (e :: Effects) = UnsafeMkState (IORef s) +type role State representational nominal+ -- | A handle to a coroutine that yields values of type @a@ and then -- expects values of type @b@. newtype Coroutine a b (e :: Effects) = MkCoroutine (a -> Eff e b)@@ -383,7 +373,7 @@   mapHandle (UnsafeMkState s) = UnsafeMkState s  instance Handle (Exception s) where-  mapHandle (UnsafeMkException s) = UnsafeMkException s+  mapHandle (MkException s) = MkException (weakenEff has . s)  instance Handle (Coroutine a b) where   mapHandle (MkCoroutine f) = MkCoroutine (fmap useImpl f)@@ -478,7 +468,7 @@   -- | Value to throw   ex ->   Eff es a-throw (UnsafeMkException throw_) e = UnsafeMkEff (throw_ e)+throw h = case mapHandle h of MkException throw_ -> throw_  has :: forall a b. (a :> b) => a `In` b has = In# (# #)@@ -486,9 +476,12 @@ data Dict c where   Dict :: forall c. (c) => Dict c +unsafeCoerceDict :: forall c c'. Dict c -> Dict c'+unsafeCoerceDict = unsafeCoerce @(Dict c) @(Dict c')+ -- Seems like it could be better have :: forall a b. a `In` b -> Dict (a :> b)-have = unsafeCoerce (Dict @(a :> (a :& b)))+have _ = unsafeCoerceDict @(a :> (a :& b)) @(a :> b) Dict  -- | -- @@@ -503,7 +496,10 @@   -- | @Left@ if the exception was thrown, @Right@ otherwise   Eff es (Either exn a) try f =-  UnsafeMkEff $ withScopedException_ (\throw_ -> unsafeUnEff (f (UnsafeMkException throw_)))+  unsafeProvideIO $ \io -> do+    withEffToIO_ io $ \effToIO -> do+      withScopedException_ $ \throw_ -> do+        effToIO (f (MkException (effIO io . throw_)))  -- | 'handle', but with the argument order swapped --@@ -570,12 +566,11 @@   Eff es r ->   -- | ͘   Eff es r-rethrowIO MkIOE ex body =-  UnsafeMkEff-    ( Control.Exception.catch-        (unsafeUnEff body)-        (\e -> unsafeUnEff (throw @_ @es ex e))-    )+rethrowIO io ex body =+  withEffToIO_ io $ \effToIO -> do+    Control.Exception.catch+      (effToIO body)+      (\e -> effToIO (throw @_ @es ex e))  -- | @bracket acquire release body@: @acquire@ a resource, perform the -- @body@ with it, and @release@ the resource even if @body@ threw an@@ -608,12 +603,21 @@   (a -> Eff es b) ->   Eff es b bracket before after body =-  UnsafeMkEff $-    Control.Exception.bracket-      (unsafeUnEff before)-      (unsafeUnEff . after)-      (unsafeUnEff . body)+  unsafeProvideIO $ \io -> do+    withEffToIO_ io $ \effToIO -> do+      Control.Exception.bracket+        (effToIO (useImpl before))+        (effToIO . useImpl . after)+        (effToIO . useImpl . body) +withStateInIO ::+  (e1 :> es, e2 :> es) =>+  IOE e1 ->+  State s e2 ->+  (IORef s -> IO r) ->+  Eff es r+withStateInIO io (UnsafeMkState r) k = effIO io (k r)+ -- | -- @ -- >>> runPureEff $ runState 10 $ \\st -> do@@ -626,7 +630,7 @@   State s e ->   -- | The current value of the state   Eff es s-get (UnsafeMkState r) = UnsafeMkEff (readIORef r)+get st = unsafeProvideIO $ \io -> withStateInIO io st readIORef  -- | Set the value of the state --@@ -642,7 +646,7 @@   -- writing it to the state.   s ->   Eff es ()-put (UnsafeMkState r) s = UnsafeMkEff (writeIORef r $! s)+put st s = unsafeProvideIO $ \io -> withStateInIO io st (flip writeIORef s)  -- | -- @@@ -661,23 +665,9 @@   s <- get state   put state (f s) --- This is roughly how effectful does it-data MyException where-  MyException :: e -> Data.Unique.Unique -> MyException--instance Show MyException where-  show _ = "<MyException>"--instance Control.Exception.Exception MyException- withScopedException_ :: ((forall a. e -> IO a) -> IO r) -> IO (Either e r)-withScopedException_ f = do-  fresh <- Data.Unique.newUnique--  flip tryJust (f (\e -> throwIO (MyException e fresh))) $ \case-    MyException e tag ->-      -- unsafeCoerce is very unpleasant-      if tag == fresh then Just (unsafeCoerce e) else Nothing+withScopedException_ f =+  ScopedException.try (\ex -> f (ScopedException.throw ex))  -- | -- @@@ -716,12 +706,14 @@ -- 15 -- @ newState ::+  (e :> es) =>   StateSource e ->   -- | The initial value for the state handle   s ->   -- | A new state handle   Eff es (State s e)-newState StateSource s = UnsafeMkEff (fmap UnsafeMkState (newIORef s))+newState StateSource s = unsafeProvideIO $ \io -> do+  fmap UnsafeMkState (effIO io (newIORef s))  -- | -- @@@ -1159,6 +1151,8 @@ -- | Handle that allows you to run 'IO' operations data IOE (e :: Effects) = MkIOE +type role IOE nominal+ -- | Run an 'IO' operation in 'Eff' -- -- @@@ -1188,7 +1182,7 @@   (forall e es. IOE e -> Eff (e :& es) a) ->   -- | ͘   IO a-runEff eff = unsafeUnEff (eff MkIOE)+runEff eff = runEff_ (makeOp . eff)  -- | Run an 'Eff' whose only unhandled effect is 'IO'. --

@@ -0,0 +1,33 @@+module Bluefin.Internal.Exception.Scoped+  ( Exception,+    try,+    throw,+  )+where++import Bluefin.Internal.Key (Key, eqKey, newKey)+import Control.Exception (throwIO, tryJust)+import qualified Control.Exception+import Data.Type.Equality ((:~~:) (HRefl))++try :: (Exception e -> IO a) -> IO (Either e a)+try k = do+  key <- newKey+  tryJust+    (check key)+    (k (MkException key))++throw :: Exception e -> e -> IO a+throw ex e = throwIO (MkInFlight ex e)++newtype Exception e = MkException (Key e)++data InFlight = forall e. MkInFlight !(Exception e) !e++instance Show InFlight where+  show _ = "In-flight scoped exception"++instance Control.Exception.Exception InFlight++check :: Key a -> InFlight -> Maybe a+check k1 (MkInFlight (MkException k2) e) = fmap (\HRefl -> e) (k1 `eqKey` k2)

@@ -0,0 +1,32 @@+-- Like Key from vault:+--+-- https://github.com/HeinrichApfelmus/vault/blob/master/src/Data/Vault/ST/backends/GHC.h#L19C29-L20C1++{-# LANGUAGE RoleAnnotations #-}++module Bluefin.Internal.Key+  ( Key,+    newKey,+    eqKey,+  )+where++import Data.Coerce (coerce)+import Data.Type.Equality ((:~~:) (HRefl))+import Data.Unique (Unique, newUnique)+import Unsafe.Coerce (unsafeCoerce)++type role Key nominal++newtype Key (a :: k) = MkKey Unique++newKey :: IO (Key a)+newKey = coerce newUnique++-- 'Key' cannot lawfully be 'TestEquality', though it could be 'GEq'+-- and 'GOrd'.+eqKey :: forall a b. Key a -> Key b -> Maybe (a :~~: b)+eqKey (MkKey id1) (MkKey id2) =+  if id1 == id2+    then Just (unsafeCoerce (HRefl @a))+    else Nothing