packages feed

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 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)