bluefin-internal 0.4.2.0 → 0.4.3.0

raw patch · 5 files changed

+209/−5 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• bluefin-internal.cabal +2/−1
• src/Bluefin/Internal.hs +26/−2
• src/Bluefin/Internal/GadtEffect.hs +168/−0
• src/Bluefin/Internal/Prim.hs +2/−2

@@ -1,3 +1,14 @@+# 0.4.3.0++* Add `Bluefin.Internal.GadtEffect`++* Add `Bluefin.Internal.asksHandle`++* Restrict type parameter of `PrimStateEff` to `Effects`++  This is technically a breaking change, but we did not enforce a+  major version bump for it.+ # 0.4.2.0  * Add `Bluefin.Internal.DslBuilderEff`

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               bluefin-internal-version:            0.4.2.0+version:            0.4.3.0 license:            MIT license-file:       LICENSE author:             Tom Ellis@@ -91,6 +91,7 @@       Bluefin.Internal.Examples,       Bluefin.Internal.Exception,       Bluefin.Internal.Exception.Scoped,+      Bluefin.Internal.GadtEffect,       Bluefin.Internal.Key,       Bluefin.Internal.OneWayCoercible,       Bluefin.Internal.Pipes,

@@ -540,7 +540,21 @@ -- { OneWayCoercibleHandle  -- | 'OneWayCoercibleHandle' is used to derive 'Handle' instances--- using @DerivingVia@+-- using @DerivingVia@.  Make sure you import the constructor, for+-- example using a wildcard import like this+--+-- @+-- import Bluefin.Compound (OneWayCoercibleHandle (..))+-- @+--+-- because if you /only/ import the type like this+--+-- @+-- import Bluefin.Compound (OneWayCoercibleHandle)+-- @+--+-- then @deriving via OneWayCoercibleHandle ...@ will not work. The+-- constructor needs to be in scope. newtype OneWayCoercibleHandle a es = MkOneWayCoercibleHandle (a es)   deriving stock (Generic) @@ -638,7 +652,7 @@ instanceProof2 = drop  -- Do we want this?--- instance {-# incoherent #-} (e :> es) => (e' :& e) :> (e' :> es)+-- instance {-# incoherent #-} (e :> es) => (e' :& e) :> (e' :& es)  -- This seems a bit wobbly @@ -1673,6 +1687,16 @@   -- | ͘   Eff es (h es) askHandle hh = let UnsafeMkHandleReader st = mapHandle hh in get st++asksHandle ::+  (e1 :> es, Handle h) =>+  HandleReader h e1 ->+  (forall e. h e -> Eff (e :& es) r) ->+  -- | ͘+  Eff es r+asksHandle hh k = do+  h <- askHandle hh+  makeOp (k h)  runHandleReader ::   (e1 :> es, Handle h) =>

@@ -0,0 +1,168 @@+{-# LANGUAGE DerivingVia #-}++module Bluefin.Internal.GadtEffect where++import Bluefin.Internal+  ( Eff,+    Effects,+    Handle,+    HandleReader,+    OneWayCoercibleHandle (..),+    localHandle,+    mapHandle,+    oneWayCoercibleTrustMe,+    useImplIn,+    useImplUnder,+    (:&),+    (:>),+  )+import Bluefin.Internal.OneWayCoercible (OneWayCoercible (oneWayCoercibleImpl), OneWayCoercibleD)+import Data.Kind (Type)++type Send :: Effect -> Effects -> Type+-- | Bring a 'Send' into scope with 'interpret'.+newtype Send f e = MkSend (EffectHandler f e)+  deriving (Handle) via OneWayCoercibleHandle (Send f)++-- | A convenient type synoynm matching+-- [@effectful@](https://hackage-content.haskell.org/package/effectful-core/docs/Effectful.html#t:Effect)+-- and+-- [@polysemy@](https://hackage.haskell.org/package/polysemy/docs/Polysemy.html#t:Effect)'s+-- usages provided for people who are migrating from those libraries.+type Effect = (Type -> Type) -> Type -> Type++instance (e :> es) => OneWayCoercible (Send f e) (Send f es) where+  oneWayCoercibleImpl =+    oneWayCoercibleTrustMe (\(MkSend g) -> MkSend (useImplUnder . g))++-- | Send a primitive operation to the handler for interpretation.+-- This is the Bluefin analog of @effectful@'s+-- [@send@](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html#v:send)+-- and @polysemy@'s+-- [@send@](https://hackage.haskell.org/package/polysemy/docs/Polysemy.html#v:send).+send ::+  (e1 :> es) =>+  Send f e1 ->+  -- | Handle this operation using the effect handler currently in+  -- scope for the @Send f@ handle.+  f (Eff es) r ->+  Eff es r+send (MkSend g) = useImplIn g++-- | A convenient type synonym.  This is like @effectful@'s+-- [@EffectHandler@](https://hackage-content.haskell.org/package/effectful-core-2.6.1.0/docs/Effectful-Dispatch-Dynamic.html#t:EffectHandler).+-- A similar type also appears in @polysemy@ as the argument to+-- functions like+-- [@intercept@](https://hackage.haskell.org/package/polysemy-1.9.2.0/docs/Polysemy.html#v:intercept).+type EffectHandler f es =+  forall e r.+  f (Eff e) r ->+  -- | ͘+  Eff (e :& es) r++-- |+-- @+-- import System.IO qualified as IO+--+-- runFileSystem ::+--   forall es e1 e2 r.+--   (e1 :> es, e2 :> es) =>+--   t'Bluefin.IO.IOE' e1 ->+--   t'Bluefin.Exception.Exception' t'Control.Exception.IOException' e2 ->+--   (forall e. 'Send' FileSystem e -> Eff (e :& es) r) ->+--   Eff es r+-- runFileSystem io ex = 'interpret' $ \\case+--   ReadFile path ->+--     adapt (IO.'System.IO.readFile' path)+--   WriteFile path contents ->+--     adapt (IO.'System.IO.writeFile' path contents)+--   Trace msg body -> do+--     'Bluefin.IO.effIO' io (putStrLn ("Start: " <> msg))+--     r <- 'Bluefin.Compound.useImpl' body+--     effIO io (putStrLn ("End: " <> msg))+--     pure r+--   where+--     -- If you don't want to write this signature you can use+--     -- {-# LANGUAGE NoMonoLocalBinds #-}+--     adapt :: (e1 :> es', e2 :> es') => IO r' -> Eff es' r'+--     adapt m = 'Bluefin.IO.rethrowIO' io ex (effIO io m)+-- @+interpret ::+  -- | Implementation of effect handler for @Send f@+  EffectHandler f es ->+  -- | Within this block, @send@ has the implementation given above.+  (forall e. Send f e -> Eff (e :& es) r) ->+  Eff es r+interpret g k = useImplIn k (MkSend g)++type GadtEffect :: ((Type -> Type) -> Type -> Type) -> Type -> Effects -> Type+newtype GadtEffect f a e = MkGadtEffect {unGadtEffect :: f (Eff e) a}++mapGadtEffect ::+  (f1 (Eff e1) r1 -> f2 (Eff e2) r2) ->+  GadtEffect f1 r1 e1 ->+  GadtEffect f2 r2 e2+mapGadtEffect f = MkGadtEffect . f . unGadtEffect++-- |+-- @+-- instance+--   (e :> es) =>+--   t'Bluefin.Compound.OneWayCoercible' ('GadtEffect' FileSystem r e) (GadtEffect FileSystem r es)+--   where+--   'Bluefin.Compound.oneWayCoercibleImpl' = 'oneWayCoercibleGadtEffectTrustMe' $ \\case+--     ReadFile path -> ReadFile path+--     WriteFile path contents -> WriteFile path contents+--     Trace msg body -> Trace msg (useImpl body)+-- @+oneWayCoercibleGadtEffectTrustMe ::+  (e :> es) =>+  (forall e' es'. (e' :> es') => f (Eff e') r -> f (Eff es') r) ->+  -- | ͘+  OneWayCoercibleD (GadtEffect f r e) (GadtEffect f r es)+oneWayCoercibleGadtEffectTrustMe k = oneWayCoercibleTrustMe (mapGadtEffect k)++-- | Version of 'send' for use when pattern matching in 'interpose'+--+-- @+-- augmentOp2Interpose ::+--   (e1 :> es, e2 :> es) =>+--   IOE e2 ->+--   t'Bluefin.HandleReader.HandleReader' (Send E) e1 ->+--   Eff es r ->+--   Eff es r+-- augmentOp2Interpose io = 'interpose' $ \\fc -> \\case+--   Op2 -> effIO io (putStrLn "augmented op2") >> send fc Op2+--   op -> 'passthrough' fc op+-- @+passthrough ::+  (Handle (GadtEffect f r), e1 :> es, e2 :> es) =>+  Send f e1 ->+  f (Eff e2) r ->+  -- | ͘+  Eff es r+passthrough fc = send fc . unGadtEffect . mapHandle . MkGadtEffect++-- |+-- @+-- augmentOp2Interpose ::+--   (e1 :> es, e2 :> es) =>+--   IOE e2 ->+--   t'Bluefin.HandleReader.HandleReader' (Send E) e1 ->+--   Eff es r ->+--   Eff es r+-- augmentOp2Interpose io = 'interpose' $ \\fc -> \\case+--   Op2 -> effIO io (putStrLn "augmented op2") >> send fc Op2+--   op -> 'passthrough' fc op+-- @+interpose ::+  (e1 :> es) =>+  -- | Reimplementation of effect handler for @Send f@ in terms of the+  -- the original effect handler, which is passed as the argument+  (Send f es -> EffectHandler f es) ->+  -- | Original effect handler+  HandleReader (Send f) e1 ->+  -- | Within this block, @send@ has the implementation given above.+  Eff es r ->+  Eff es r+interpose h hr = localHandle hr (\fcOrig -> MkSend (h fcOrig))

@@ -12,14 +12,14 @@  -- I suppose morally this is -----   (State# (PrimStateEff e -> (# State# (PrimStateEff e), a #))+--   (State# (PrimStateEff e) -> (# State# (PrimStateEff e), a #)) -- -- but since there can only be one valid implementation it doesn't -- seem worth doing it like that. data Prim (e :: Effects) = UnsafeMkPrim   deriving Handle via OneWayCoercibleHandle Prim -data PrimStateEff es+data PrimStateEff (es :: Effects)  instance (e :> es) => OneWayCoercible (Prim e) (Prim es) where   oneWayCoercibleImpl = unsafeOneWayCoercible