bluefin-internal 0.0.13.0 → 0.0.14.0
raw patch · 5 files changed
+117/−3 lines, 5 filesdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Bluefin.Internal: MkConstEffect :: r -> ConstEffect r e
+ Bluefin.Internal: UnsafeMkHandleReader :: State (h e) e -> HandleReader h e
+ Bluefin.Internal: askHandle :: (e :> es, Handle h) => HandleReader h e -> Eff es (h es)
+ Bluefin.Internal: instance Bluefin.Internal.Handle (Bluefin.Internal.ConstEffect r)
+ Bluefin.Internal: instance Bluefin.Internal.Handle h => Bluefin.Internal.Handle (Bluefin.Internal.HandleReader h)
+ Bluefin.Internal: localHandle :: (e :> es, Handle h) => HandleReader h e -> (h es -> h es) -> Eff es r -> Eff es r
+ Bluefin.Internal: mapHandleReader :: forall h e es. (Handle h, e :> es) => HandleReader h e -> HandleReader h es
+ Bluefin.Internal: newtype ConstEffect r e
+ Bluefin.Internal: newtype HandleReader h e
+ Bluefin.Internal: runConstEffect :: r -> (forall e. ConstEffect r e -> Eff (e :& es) a) -> Eff es a
+ Bluefin.Internal: runHandleReader :: (e1 :> es, Handle h) => h e1 -> (forall e. HandleReader h e -> Eff (e :& es) r) -> Eff es r
+ Bluefin.Internal.System.IO: hGetLine :: e :> es => Handle e -> Eff es String
+ Bluefin.Internal.System.IO: hIsEOF :: e :> es => Handle e -> Eff es Bool
- Bluefin.Internal: withState :: s -> (forall st. State s st -> Eff (st :& es) (s -> a)) -> Eff es a
+ Bluefin.Internal: withState :: s -> (forall e. State s e -> Eff (e :& es) (s -> a)) -> Eff es a
Files
- CHANGELOG.md +13/−0
- bluefin-internal.cabal +1/−1
- src/Bluefin/Internal.hs +81/−2
- src/Bluefin/Internal/System/IO.hs +14/−0
- test/Main.hs +8/−0
CHANGELOG.md view
@@ -1,3 +1,16 @@+## 0.0.14.0++* Add `hGetLine` and `hIsEOF`++* Add `ConstEffect`, `runConstEffect`++* Add `HandleReader`, `mapHandleReader`, `localHandle`, `askHandle`,+ `runHandleReader`++## 0.0.13.0++* Added some examples+ ## 0.0.12.0 * Add `asks` and `local`
bluefin-internal.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: bluefin-internal-version: 0.0.13.0+version: 0.0.14.0 license: MIT license-file: LICENSE author: Tom Ellis
src/Bluefin/Internal.hs view
@@ -19,9 +19,11 @@ import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM) import qualified Control.Monad.Trans.Reader as Reader+import Data.Coerce (coerce) import Data.Foldable (for_) 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)@@ -58,7 +60,7 @@ runEffReader :: r -> EffReader r es a -> Eff es a runEffReader r (MkEffReader m) = m r --- | Deprecated. Use @withEffToIO_@ instead.+-- | Deprecated. Use 'withEffToIO_' instead. withEffToIO :: (e2 :> es) => -- | Continuation with the unlifting function in scope.@@ -919,7 +921,7 @@ -- | Initial state s -> -- | Stateful computation- (forall st. State s st -> Eff (st :& es) (s -> a)) ->+ (forall e. State s e -> Eff (e :& es) (s -> a)) -> -- | Result Eff es a withState s f = do@@ -1302,3 +1304,80 @@ (put st (f orig)) (\() -> put st orig) (\() -> k)++newtype HandleReader h e = UnsafeMkHandleReader (State (h e) e)++-- In general this is really tremendously unsafe because we could take+-- an `HandleReader h e`, map it to `HandleReader h es`, write an `h+-- es` to it and then use the original handle to use the `h es` at+-- type `h e`. We must be very careful to only ever write to the+-- mapped handle in such a way that we can only use the new value at+-- the correct effect tag. That is, we should only ever write to the+-- handle via `localHandle`.+mapHandleReader ::+ forall h e es.+ (Handle h, e :> es) =>+ HandleReader h e ->+ -- | ͘+ HandleReader h es+mapHandleReader = case coerceH of Coercion -> coerce+ where+ coerceH :: Coercion (h e) (h es)+ coerceH = unsafeCoerce (Coercion :: Coercion (h e) (h e))++localHandle ::+ (e :> es, Handle h) =>+ HandleReader h e ->+ (h es -> h es) ->+ Eff es r ->+ -- | ͘+ Eff es r+localHandle hh@(UnsafeMkHandleReader st) f k = do+ let UnsafeMkHandleReader st' = mapHandle hh+ orig <- get st+ bracket+ (put st' (f (mapHandle orig)))+ (\() -> put st orig)+ (\() -> k)++askHandle ::+ (e :> es, Handle h) =>+ HandleReader h e ->+ -- | ͘+ Eff es (h es)+askHandle hh = let UnsafeMkHandleReader st = mapHandle hh in get st++runHandleReader ::+ (e1 :> es, Handle h) =>+ h e1 ->+ (forall e. HandleReader h e -> Eff (e :& es) r) ->+ -- | ͘+ Eff es r+runHandleReader h k = do+ evalState (mapHandle h) $ \(st :: State (h es) e) -> do+ let coerceH :: Coercion (h es) (h (e :& es))+ coerceH = unsafeCoerce (Coercion :: Coercion (h es) (h es))++ let mapS :: State (h es) e' -> State (h (e :& es)) e'+ mapS = case coerceH of Coercion -> coerce++ let h' :: HandleReader h (e :& es)+ h' = case coerceH of+ Coercion ->+ UnsafeMkHandleReader (mapS (mapHandle st))++ useImplIn k h'++instance (Handle h) => Handle (HandleReader h) where mapHandle = mapHandleReader++newtype ConstEffect r e = MkConstEffect r++runConstEffect ::+ r ->+ (forall e. ConstEffect r e -> Eff (e :& es) a) ->+ -- | ͘+ Eff es a+runConstEffect r k = useImplIn k (MkConstEffect r)++instance Handle (ConstEffect r) where+ mapHandle = coerce
src/Bluefin/Internal/System/IO.hs view
@@ -72,6 +72,20 @@ Eff es () hFlush h = unsafeWithHandle h System.IO.hFlush +hGetLine ::+ (e :> es) =>+ Handle e ->+ -- | ͘+ Eff es String+hGetLine h = unsafeWithHandle h System.IO.hGetLine++hIsEOF ::+ (e :> es) =>+ Handle e ->+ -- | ͘+ Eff es Bool+hIsEOF h = unsafeWithHandle h System.IO.hIsEOF+ -- | If there's a "System.IO.Handle"-using function you need that -- isn't included here then you can [open an -- issue](https://github.com/tomjaguarpaw/bluefin/issues/new) to
test/Main.hs view
@@ -35,6 +35,8 @@ (runPureEff (yieldToList (listEff ([20, 30, 40], "Hello")))) ([20, 30, 40], "Hello") + test_localInHandler y+ -- A SpecH yields pairs of -- -- (name, Maybe (stream of error text))@@ -154,3 +156,9 @@ listEff (as, r) y = do for_ as (yield y) pure r++test_localInHandler :: (e :> es) => SpecH e -> Eff es ()+test_localInHandler y = runReader "global" $ \re ->+ forEach+ (\y2 -> local re (const "local") (yield y2 ()))+ (\() -> assertEqual y "Reader local" "local" =<< ask re)