rio 0.1.3.0 → 0.1.4.0

raw patch · 7 files changed

+212/−2 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• rio.cabal +5/−2
• src/RIO/Prelude/RIO.hs +121/−0
• src/RIO/Prelude/Reexports.hs +8/−0
• src/RIO/State.hs +9/−0
• src/RIO/Writer.hs +9/−0
• test/RIO/Prelude/RIOSpec.hs +54/−0

@@ -1,5 +1,11 @@ # Changelog for rio +## 0.1.4.0++* Add `Const` and `Identity`+* Add `Reader` and `runReader`+* Add instances for `MonadWriter` and `MonadState` to `RIO` via mutable reference [#103](https://github.com/commercialhaskell/rio/issues/103)+ ## 0.1.3.0  * Add `newLogFunc` function to create `LogFunc` records outside of a callback scope

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 09edf1a8b8f03bf2d61519411bfb56b861ab82c696bf58407444fcb13d0c4e04+-- hash: 11d51864811c17133c8f1aecfbec3086de7f37c755fad2fb3e2c54ed8b85f817  name:           rio-version:        0.1.3.0+version:        0.1.4.0 synopsis:       A standard library for Haskell description:    See README and Haddocks at <https://www.stackage.org/package/rio> category:       Control@@ -50,6 +50,7 @@       RIO.Set       RIO.Set.Partial       RIO.Set.Unchecked+      RIO.State       RIO.Text       RIO.Text.Lazy       RIO.Text.Lazy.Partial@@ -67,6 +68,7 @@       RIO.Vector.Unboxed.Partial       RIO.Vector.Unboxed.Unsafe       RIO.Vector.Unsafe+      RIO.Writer   other-modules:       RIO.Prelude.Display       RIO.Prelude.Extra@@ -117,6 +119,7 @@       RIO.LoggerSpec       RIO.Prelude.ExtraSpec       RIO.Prelude.IOSpec+      RIO.Prelude.RIOSpec       RIO.Prelude.SimpleSpec       RIO.PreludeSpec       RIO.TextSpec

@@ -1,12 +1,31 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-} module RIO.Prelude.RIO   ( RIO (..)   , runRIO   , liftRIO+  -- * SomeRef for Writer/State interfaces+  , SomeRef+  , HasStateRef (..)+  , HasWriteRef (..)+  , newSomeRef+  , newUnboxedSomeRef+  , readSomeRef+  , writeSomeRef+  , modifySomeRef   ) where +import GHC.Exts (RealWorld)++import RIO.Prelude.Lens+import RIO.Prelude.URef import RIO.Prelude.Reexports+import Control.Monad.State (MonadState(..))+import Control.Monad.Writer (MonadWriter(..))  -- | The Reader+IO monad. This is different from a 'ReaderT' because: --@@ -35,3 +54,105 @@ instance PrimMonad (RIO env) where     type PrimState (RIO env) = PrimState IO     primitive = RIO . ReaderT . const . primitive++-- | Abstraction over how to read from and write to a mutable reference+--+-- @since 0.1.4.0+data SomeRef a+  = SomeRef !(IO a) !(a -> IO ())++-- | Read from a SomeRef+--+-- @since 0.1.4.0+readSomeRef :: MonadIO m => SomeRef a -> m a+readSomeRef (SomeRef x _) = liftIO x++-- | Write to a SomeRef+--+-- @since 0.1.4.0+writeSomeRef :: MonadIO m => SomeRef a -> a -> m ()+writeSomeRef (SomeRef _ x) = liftIO . x++-- | Modify a SomeRef+-- This function is subject to change due to the lack of atomic operations+--+-- @since 0.1.4.0+modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()+modifySomeRef (SomeRef read write) f =+  liftIO $ (f <$> read) >>= write++ioRefToSomeRef :: IORef a -> SomeRef a+ioRefToSomeRef ref = do+  SomeRef (readIORef ref)+          (\val -> modifyIORef' ref (\_ -> val))++uRefToSomeRef :: Unbox a => URef RealWorld a -> SomeRef a+uRefToSomeRef ref = do+  SomeRef (readURef ref) (writeURef ref)++-- | Environment values with stateful capabilities to SomeRef+--+-- @since 0.1.4.0+class HasStateRef s env | env -> s where+  stateRefL :: Lens' env (SomeRef s)++-- | Identity state reference where the SomeRef is the env+--+-- @since 0.1.4.0+instance HasStateRef a (SomeRef a) where+  stateRefL = lens id (\_ x -> x)++-- | Environment values with writing capabilities to SomeRef+--+-- @since 0.1.4.0+class HasWriteRef w env | env -> w where+  writeRefL :: Lens' env (SomeRef w)++-- | Identity write reference where the SomeRef is the env+--+-- @since 0.1.4.0+instance HasWriteRef a (SomeRef a) where+  writeRefL = lens id (\_ x -> x)++instance HasStateRef s env => MonadState s (RIO env) where+  get = do+    ref <- view stateRefL+    liftIO $ readSomeRef ref+  put st = do+    ref <- view stateRefL+    liftIO $ writeSomeRef ref st++instance (Monoid w, HasWriteRef w env) => MonadWriter w (RIO env) where+  tell value = do+    ref <- view writeRefL+    liftIO $ modifySomeRef ref (`mappend` value)++  listen action = do+    w1 <- view writeRefL >>= liftIO . readSomeRef+    a <- action+    w2 <- do+      refEnv <- view writeRefL+      v <- liftIO $ readSomeRef refEnv+      _ <- liftIO $ writeSomeRef refEnv w1+      return v+    return (a, w2)++  pass action = do+    (a, transF) <- action+    ref <- view writeRefL+    liftIO $ modifySomeRef ref transF+    return a++-- | create a new boxed SomeRef+--+-- @since 0.1.4.0+newSomeRef :: MonadIO m => a -> m (SomeRef a)+newSomeRef a = do+  ioRefToSomeRef <$> newIORef a++-- | create a new unboxed SomeRef+--+-- @since 0.1.4.0+newUnboxedSomeRef :: (MonadIO m, Unbox a) => a -> m (SomeRef a)+newUnboxedSomeRef a =+  uRefToSomeRef <$> (liftIO $ newURef a)

@@ -49,10 +49,12 @@   , Control.Monad.Catch.MonadThrow(..)   , Control.Monad.Reader.MonadReader   , Control.Monad.Reader.MonadTrans(..)+  , Control.Monad.Reader.Reader   , Control.Monad.Reader.ReaderT(..)   , Control.Monad.Reader.ask   , Control.Monad.Reader.asks   , Control.Monad.Reader.local+  , Control.Monad.Reader.runReader   , Data.Bool.Bool(..)   , Data.Bool.bool   , Data.Bool.not@@ -112,6 +114,8 @@   , Data.Functor.void   , (Data.Functor.$>)   , (Data.Functor.<$>)+  , Data.Functor.Const.Const(..)+  , Data.Functor.Identity.Identity(..)   , Data.Hashable.Hashable   , Data.HashMap.Strict.HashMap   , Data.HashSet.HashSet@@ -230,6 +234,8 @@ import           Control.Monad.Catch      (MonadThrow) import           Control.Monad.Primitive  (PrimMonad (..)) import           Control.Monad.Reader     (MonadReader, ReaderT (..), ask, asks)+import           Control.Monad.State      (MonadState(..))+import           Control.Monad.Writer     (MonadWriter (..)) import           Data.Bool                (otherwise) import           Data.ByteString          (ByteString) import           Data.ByteString.Builder  (Builder)@@ -273,6 +279,8 @@ import qualified Data.Foldable import qualified Data.Function import qualified Data.Functor+import qualified Data.Functor.Const+import qualified Data.Functor.Identity import qualified Data.Hashable import qualified Data.HashMap.Strict import qualified Data.HashSet

@@ -0,0 +1,9 @@+-- | Provides reexports of 'MonadState' and related helpers.+--+-- @since 0.1.4.0+module RIO.State+  (+    Control.Monad.State.MonadState (..)+  ) where++import qualified Control.Monad.State

@@ -0,0 +1,9 @@+-- | Provides reexports of 'MonadWriter' and related helpers.+--+-- @since 0.1.4.0+module RIO.Writer+  (+    Control.Monad.Writer.MonadWriter (..)+  ) where++import qualified Control.Monad.Writer

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ViewPatterns #-}+module RIO.Prelude.RIOSpec (spec) where++import RIO+import RIO.State+import RIO.Writer+import Test.Hspec+import Test.Hspec.QuickCheck++spec = do+  describe "RIO writer instance" $ do+    it "tell works" $ do+     ref <- newSomeRef (mempty :: Text)+     runRIO ref $ do+       tell "hello\n"+       tell "world\n"+     contents <- readSomeRef ref+     contents `shouldBe` "hello\nworld\n"++    it "listen works" $ do+      ref <- newSomeRef (mempty :: Text)+      ((), str) <- runRIO ref $ listen $ do+        tell "hello\n"+        tell "world\n"+      contents <- readSomeRef ref+      contents `shouldBe` ""+      str `shouldBe` "hello\nworld\n"++    it "pass works" $ do+      ref <- newSomeRef (mempty :: Text)+      result <- runRIO ref $ pass $ do+        tell "hello\n"+        tell "world\n"+        return ((), \a -> a <> "!")+      contents <- readSomeRef ref+      contents `shouldBe` "hello\nworld\n!"++  describe "RIO state instance" $ do+    it "get works" $ do+      ref <- newSomeRef (mempty :: Text)+      result <- runRIO ref $ do+        put "hello world"+        x <- get+        return x+      result `shouldBe` "hello world"++    it "state works" $ do+      ref <- newSomeRef (mempty :: Text)+      newRef <- newSomeRef ("Hello World!" :: Text)+      result <- runRIO ref $ state (\ref -> ((), "Hello World!"))+      contents <- readSomeRef ref+      contents `shouldBe` "Hello World!"