Hello community, here is the log from the commit of package ghc-rio for openSUSE:Factory checked in at 2018-07-24 17:21:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-rio (Old) and /work/SRC/openSUSE:Factory/.ghc-rio.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-rio" Tue Jul 24 17:21:37 2018 rev:2 rq:623847 version:0.1.4.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-rio/ghc-rio.changes 2018-05-30 13:10:31.425985688 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-rio.new/ghc-rio.changes 2018-07-24 17:21:41.575246790 +0200 @@ -1,0 +2,21 @@ +Fri Jul 13 14:32:15 UTC 2018 - [email protected] + +- Update rio to version 0.1.4.0. + ## 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 + * Allow dynamic reloading of `logMinLevel` and `logVerboseFormat` for the `LogOptions` record + * Add `foldMapM` + * Add `headMaybe`, `lastMaybe`, `tailMaybe`, `initMaybe`, `maximumMaybe`, `minimumMaybe`, + `maximumByMaybe`, `minimumByMaybe` functions to `RIO.List` module (issue #82) + * Move non partial functions `scanr1` and `scanl1` from `RIO.List.Partial` to `RIO.List` (issue #82) + * Add `SimpleApp` and `runSimpleApp` + * Add `asIO` + +------------------------------------------------------------------- @@ -4 +25 @@ -- Adding initial version version 0.1.2.0. +- Add rio at version 0.1.2.0. Old: ---- rio-0.1.2.0.tar.gz New: ---- rio-0.1.4.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-rio.spec ++++++ --- /var/tmp/diff_new_pack.cwAFKS/_old 2018-07-24 17:21:43.327249034 +0200 +++ /var/tmp/diff_new_pack.cwAFKS/_new 2018-07-24 17:21:43.331249039 +0200 @@ -19,7 +19,7 @@ %global pkg_name rio %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.2.0 +Version: 0.1.4.0 Release: 0 Summary: A standard library for Haskell License: MIT ++++++ rio-0.1.2.0.tar.gz -> rio-0.1.4.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/ChangeLog.md new/rio-0.1.4.0/ChangeLog.md --- old/rio-0.1.2.0/ChangeLog.md 2018-04-23 14:42:57.000000000 +0200 +++ new/rio-0.1.4.0/ChangeLog.md 2018-07-06 05:20:13.000000000 +0200 @@ -1,4 +1,22 @@ # 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 +* Allow dynamic reloading of `logMinLevel` and `logVerboseFormat` for the `LogOptions` record +* Add `foldMapM` +* Add `headMaybe`, `lastMaybe`, `tailMaybe`, `initMaybe`, `maximumMaybe`, `minimumMaybe`, + `maximumByMaybe`, `minimumByMaybe` functions to `RIO.List` module (issue #82) +* Move non partial functions `scanr1` and `scanl1` from `RIO.List.Partial` to `RIO.List` (issue #82) +* Add `SimpleApp` and `runSimpleApp` +* Add `asIO` + ## 0.1.2.0 * Allow setting usage of code location in the log output diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/rio.cabal new/rio-0.1.4.0/rio.cabal --- old/rio-0.1.2.0/rio.cabal 2018-04-29 17:01:55.000000000 +0200 +++ new/rio-0.1.4.0/rio.cabal 2018-07-06 05:13:57.000000000 +0200 @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: ceb8120bf0a35f85bf8e2dc1e5fe5cb70fabef54290d42e7051d631841b690ee +-- hash: 11d51864811c17133c8f1aecfbec3086de7f37c755fad2fb3e2c54ed8b85f817 name: rio -version: 0.1.2.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 @@ -44,11 +44,13 @@ RIO.Map RIO.Map.Partial RIO.Map.Unchecked + RIO.Prelude.Simple RIO.Process RIO.Seq RIO.Set RIO.Set.Partial RIO.Set.Unchecked + RIO.State RIO.Text RIO.Text.Lazy RIO.Text.Lazy.Partial @@ -66,6 +68,7 @@ RIO.Vector.Unboxed.Partial RIO.Vector.Unboxed.Unsafe RIO.Vector.Unsafe + RIO.Writer other-modules: RIO.Prelude.Display RIO.Prelude.Extra @@ -114,7 +117,10 @@ other-modules: RIO.ListSpec RIO.LoggerSpec + RIO.Prelude.ExtraSpec RIO.Prelude.IOSpec + RIO.Prelude.RIOSpec + RIO.Prelude.SimpleSpec RIO.PreludeSpec RIO.TextSpec Paths_rio diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/List/Partial.hs new/rio-0.1.4.0/src/RIO/List/Partial.hs --- old/rio-0.1.2.0/src/RIO/List/Partial.hs 2018-04-12 07:41:10.000000000 +0200 +++ new/rio-0.1.4.0/src/RIO/List/Partial.hs 2018-06-19 17:29:26.000000000 +0200 @@ -20,6 +20,9 @@ -- * Building lists -- ** Scans + -- + -- These functions are not partial, they are being exported here for legacy + -- reasons, they may be removed from this module on a future major release , Data.List.scanl1 , Data.List.scanr1 @@ -28,4 +31,3 @@ ) where import qualified Data.List - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/List.hs new/rio-0.1.4.0/src/RIO/List.hs --- old/rio-0.1.2.0/src/RIO/List.hs 2018-04-12 07:41:11.000000000 +0200 +++ new/rio-0.1.4.0/src/RIO/List.hs 2018-06-19 17:29:26.000000000 +0200 @@ -8,6 +8,10 @@ , Data.List.uncons , Data.List.null , Data.List.length + , headMaybe + , lastMaybe + , tailMaybe + , initMaybe -- * List transformations , Data.List.map @@ -36,6 +40,10 @@ , Data.List.all , Data.List.sum , Data.List.product + , maximumMaybe + , minimumMaybe + , maximumByMaybe + , minimumByMaybe -- * Building lists @@ -43,6 +51,8 @@ , Data.List.scanl , Data.List.scanl' , Data.List.scanr + , Data.List.scanl1 + , Data.List.scanr1 -- ** Accumulating maps , Data.List.mapAccumL @@ -233,3 +243,40 @@ -- @since 0.1.0.0 linesCR :: String -> [String] linesCR = map (dropSuffix "\r") . lines + +safeListCall :: Foldable t => (t a -> b) -> t a -> Maybe b +safeListCall f xs + | Data.List.null xs = Nothing + | otherwise = Just $ f xs + +-- | @since 0.1.3.0 +headMaybe :: [a] -> Maybe a +headMaybe = safeListCall Data.List.head + +-- | @since 0.1.3.0 +lastMaybe :: [a] -> Maybe a +lastMaybe = safeListCall Data.List.last + +-- | @since 0.1.3.0 +tailMaybe :: [a] -> Maybe [a] +tailMaybe = safeListCall Data.List.tail + +-- | @since 0.1.3.0 +initMaybe :: [a] -> Maybe [a] +initMaybe = safeListCall Data.List.init + +-- | @since 0.1.3.0 +maximumMaybe :: (Ord a, Foldable t) => t a -> Maybe a +maximumMaybe = safeListCall Data.List.maximum + +-- | @since 0.1.3.0 +minimumMaybe :: (Ord a, Foldable t) => t a -> Maybe a +minimumMaybe = safeListCall Data.List.minimum + +-- | @since 0.1.3.0 +maximumByMaybe :: (Ord a, Foldable t) => (a -> a -> Ordering) -> t a -> Maybe a +maximumByMaybe f = safeListCall (Data.List.maximumBy f) + +-- | @since 0.1.3.0 +minimumByMaybe :: (Ord a, Foldable t) => (a -> a -> Ordering) -> t a -> Maybe a +minimumByMaybe f = safeListCall (Data.List.minimumBy f) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Prelude/Extra.hs new/rio-0.1.4.0/src/RIO/Prelude/Extra.hs --- old/rio-0.1.2.0/src/RIO/Prelude/Extra.hs 2018-03-18 09:09:39.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO/Prelude/Extra.hs 2018-06-19 17:29:26.000000000 +0200 @@ -6,13 +6,16 @@ , mapMaybeM , forMaybeA , forMaybeM + , foldMapM , nubOrd , whenM , unlessM + , asIO ) where import qualified Data.Set as Set import Data.Monoid (First (..)) +import Data.Foldable (foldlM) import RIO.Prelude.Reexports -- | Apply a function to a 'Left' constructor @@ -40,6 +43,26 @@ forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b] forMaybeM = flip mapMaybeM +-- | Extend 'foldMap' to allow side effects. +-- +-- Internally, this is implemented using a strict left fold. This is used for +-- performance reasons. It also necessitates that this function has a @Monad@ +-- constraint and not just an @Applicative@ constraint. For more information, +-- see +-- <https://github.com/commercialhaskell/rio/pull/99#issuecomment-394179757>. +-- +-- @since 0.1.3.0 +foldMapM + :: (Monad m, Monoid w, Foldable t) + => (a -> m w) + -> t a + -> m w +foldMapM f = foldlM + (\acc a -> do + w <- f a + return $! mappend acc w) + mempty + -- | Strip out duplicates nubOrd :: Ord a => [a] -> [a] nubOrd = @@ -61,3 +84,10 @@ unlessM boolM action = do x <- boolM if x then return () else action + +-- | Helper function to force an action to run in 'IO'. Especially +-- useful for overly general contexts, like hspec tests. +-- +-- @since 0.1.3.0 +asIO :: IO a -> IO a +asIO = id diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Prelude/Logger.hs new/rio-0.1.4.0/src/RIO/Prelude/Logger.hs --- old/rio-0.1.2.0/src/RIO/Prelude/Logger.hs 2018-04-23 14:42:57.000000000 +0200 +++ new/rio-0.1.4.0/src/RIO/Prelude/Logger.hs 2018-06-19 17:29:26.000000000 +0200 @@ -9,13 +9,16 @@ , logOther -- * Running with logging , withLogFunc + , newLogFunc , LogFunc , HasLogFunc (..) , logOptionsHandle -- ** Log options , LogOptions , setLogMinLevel + , setLogMinLevelIO , setLogVerboseFormat + , setLogVerboseFormatIO , setLogTerminal , setLogUseTime , setLogUseColor @@ -274,8 +277,8 @@ logOptionsMemory = do ref <- newIORef mempty let options = LogOptions - { logMinLevel = LevelInfo - , logVerboseFormat = False + { logMinLevel = return LevelInfo + , logVerboseFormat = return False , logTerminal = True , logUseTime = False , logUseColor = False @@ -299,8 +302,8 @@ useUtf8 <- canUseUtf8 handle' unicode <- if useUtf8 then return True else getCanUseUnicode return LogOptions - { logMinLevel = if verbose then LevelDebug else LevelInfo - , logVerboseFormat = verbose + { logMinLevel = return $ if verbose then LevelDebug else LevelInfo + , logVerboseFormat = return verbose , logTerminal = terminal , logUseTime = verbose , logUseColor = verbose && terminal @@ -331,6 +334,34 @@ return (str == str') test `catchIO` \_ -> return False + +-- | Given a 'LogOptions' value, returns both a new 'LogFunc' and a sub-routine that +-- disposes it. +-- +-- Intended for use if you want to deal with the teardown of 'LogFunc' yourself, +-- otherwise prefer the 'withLogFunc' function instead. +-- +-- @since 0.1.3.0 +newLogFunc :: (MonadIO n, MonadIO m) => LogOptions -> n (LogFunc, m ()) +newLogFunc options = + if logTerminal options then do + var <- newMVar mempty + return (LogFunc + { unLogFunc = stickyImpl var options (simpleLogFunc options) + , lfOptions = Just options + } + , do state <- takeMVar var + unless (B.null state) (liftIO $ logSend options "\n") + ) + else + return (LogFunc + { unLogFunc = \cs src level str -> + simpleLogFunc options cs src (noSticky level) str + , lfOptions = Just options + } + , return () + ) + -- | Given a 'LogOptions' value, run the given function with the -- specified 'LogFunc'. A common way to use this function is: -- @@ -351,23 +382,10 @@ -- @since 0.0.0.0 withLogFunc :: MonadUnliftIO m => LogOptions -> (LogFunc -> m a) -> m a withLogFunc options inner = withRunInIO $ \run -> do - if logTerminal options - then bracket - (newMVar mempty) - (\var -> do - state <- takeMVar var - unless (B.null state) (logSend options "\n")) - (\var -> run $ inner $ LogFunc - { unLogFunc = stickyImpl var options (simpleLogFunc options) - , lfOptions = Just options - } - ) - else - run $ inner $ LogFunc - { unLogFunc = \cs src level str -> - simpleLogFunc options cs src (noSticky level) str - , lfOptions = Just options - } + bracket (newLogFunc options) + snd + (run . inner . fst) + -- | Replace Unicode characters with non-Unicode equivalents replaceUnicode :: Char -> Char @@ -385,8 +403,8 @@ -- -- @since 0.0.0.0 data LogOptions = LogOptions - { logMinLevel :: !LogLevel - , logVerboseFormat :: !Bool + { logMinLevel :: !(IO LogLevel) + , logVerboseFormat :: !(IO Bool) , logTerminal :: !Bool , logUseTime :: !Bool , logUseColor :: !Bool @@ -401,7 +419,16 @@ -- -- @since 0.0.0.0 setLogMinLevel :: LogLevel -> LogOptions -> LogOptions -setLogMinLevel level options = options { logMinLevel = level } +setLogMinLevel level options = options { logMinLevel = return level } + +-- | Refer to 'setLogMinLevel'. This modifier allows to alter the verbose format +-- value dynamically at runtime. +-- +-- Default: in verbose mode, 'LevelDebug'. Otherwise, 'LevelInfo'. +-- +-- @since 0.1.3.0 +setLogMinLevelIO :: IO LogLevel -> LogOptions -> LogOptions +setLogMinLevelIO getLevel options = options { logMinLevel = getLevel } -- | Use the verbose format for printing log messages. -- @@ -409,7 +436,17 @@ -- -- @since 0.0.0.0 setLogVerboseFormat :: Bool -> LogOptions -> LogOptions -setLogVerboseFormat v options = options { logVerboseFormat = v } +setLogVerboseFormat v options = options { logVerboseFormat = return v } + +-- | Refer to 'setLogVerboseFormat'. This modifier allows to alter the verbose +-- format value dynamically at runtime. +-- +-- Default: follows the value of the verbose flag. +-- +-- @since 0.1.3.0 +setLogVerboseFormatIO :: IO Bool -> LogOptions -> LogOptions +setLogVerboseFormatIO getVerboseLevel options = + options { logVerboseFormat = getVerboseLevel } -- | Do we treat output as a terminal. If @True@, we will enabled -- sticky logging functionality. @@ -446,12 +483,15 @@ setLogUseLoc l options = options { logUseLoc = l } simpleLogFunc :: LogOptions -> CallStack -> LogSource -> LogLevel -> Utf8Builder -> IO () -simpleLogFunc lo cs _src level msg = - when (level >= logMinLevel lo) $ do - timestamp <- getTimestamp +simpleLogFunc lo cs _src level msg = do + logLevel <- logMinLevel lo + logVerbose <- logVerboseFormat lo + + when (level >= logLevel) $ do + timestamp <- getTimestamp logVerbose logSend lo $ getUtf8Builder $ timestamp <> - getLevel <> + getLevel logVerbose <> ansi reset <> msg <> getLoc <> @@ -470,9 +510,9 @@ ansi xs | logUseColor lo = xs | otherwise = mempty - getTimestamp :: IO Utf8Builder - getTimestamp - | logVerboseFormat lo && logUseTime lo = + getTimestamp :: Bool -> IO Utf8Builder + getTimestamp logVerbose + | logVerbose && logUseTime lo = do now <- getZonedTime return $ ansi setBlack <> fromString (formatTime' now) <> ": " | otherwise = return mempty @@ -480,9 +520,9 @@ formatTime' = take timestampLength . formatTime defaultTimeLocale "%F %T.%q" - getLevel :: Utf8Builder - getLevel - | logVerboseFormat lo = + getLevel :: Bool -> Utf8Builder + getLevel logVerbose + | logVerbose = case level of LevelDebug -> ansi setGreen <> "[debug] " LevelInfo -> ansi setBlue <> "[info] " @@ -536,6 +576,8 @@ repeating ' ' <> repeating backSpaceChar) + logLevel <- logMinLevel lo + case level of LevelOther "sticky-done" -> do clear @@ -547,7 +589,7 @@ logSend lo (byteString bs <> flush) return bs _ - | level >= logMinLevel lo -> do + | level >= logLevel -> do clear logFunc loc src level msgOrig unless (B.null sticky) $ logSend lo (byteString sticky <> flush) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Prelude/RIO.hs new/rio-0.1.4.0/src/RIO/Prelude/RIO.hs --- old/rio-0.1.2.0/src/RIO/Prelude/RIO.hs 2018-03-18 09:09:39.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO/Prelude/RIO.hs 2018-07-06 05:21:05.000000000 +0200 @@ -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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Prelude/Reexports.hs new/rio-0.1.4.0/src/RIO/Prelude/Reexports.hs --- old/rio-0.1.2.0/src/RIO/Prelude/Reexports.hs 2018-04-04 10:53:59.000000000 +0200 +++ new/rio-0.1.4.0/src/RIO/Prelude/Reexports.hs 2018-07-06 05:13:29.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Prelude/Simple.hs new/rio-0.1.4.0/src/RIO/Prelude/Simple.hs --- old/rio-0.1.2.0/src/RIO/Prelude/Simple.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO/Prelude/Simple.hs 2018-06-19 17:29:26.000000000 +0200 @@ -0,0 +1,54 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | Provide a @SimpleApp@ datatype, for providing a basic @App@-like +-- environment with common functionality built in. This is intended to +-- make it easier to, e.g., use rio's logging and process code from +-- within short scripts. +-- +-- @since 0.1.3.0 +module RIO.Prelude.Simple + ( SimpleApp + , runSimpleApp + ) where + +import RIO.Prelude.Reexports +import RIO.Prelude.Logger +import RIO.Prelude.Lens +import RIO.Prelude.RIO +import RIO.Process +import System.Environment (lookupEnv) + +-- | A simple, non-customizable environment type for @RIO@, which +-- provides common functionality. If it's insufficient for your needs, +-- define your own, custom @App@ data type. +-- +-- @since 0.1.3.0 +data SimpleApp = SimpleApp + { saLogFunc :: !LogFunc + , saProcessContext :: !ProcessContext + } +instance HasLogFunc SimpleApp where + logFuncL = lens saLogFunc (\x y -> x { saLogFunc = y }) +instance HasProcessContext SimpleApp where + processContextL = lens saProcessContext (\x y -> x { saProcessContext = y }) + +-- | Run with a default configured @SimpleApp@, consisting of: +-- +-- * Logging to stderr +-- +-- * If the @RIO_VERBOSE@ environment variable is set, turns on +-- verbose logging +-- +-- * Default process context +-- +-- @since 0.1.3.0 +runSimpleApp :: MonadIO m => RIO SimpleApp a -> m a +runSimpleApp m = liftIO $ do + verbose <- isJust <$> lookupEnv "RIO_VERBOSE" + lo <- logOptionsHandle stderr verbose + pc <- mkDefaultProcessContext + withLogFunc lo $ \lf -> + let simpleApp = SimpleApp + { saLogFunc = lf + , saProcessContext = pc + } + in runRIO simpleApp m diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Process.hs new/rio-0.1.4.0/src/RIO/Process.hs --- old/rio-0.1.2.0/src/RIO/Process.hs 2018-04-04 10:51:26.000000000 +0200 +++ new/rio-0.1.4.0/src/RIO/Process.hs 2018-06-19 17:29:05.000000000 +0200 @@ -123,7 +123,11 @@ , P.unsafeProcessHandle ) where -import RIO +import RIO.Prelude.Display +import RIO.Prelude.Reexports +import RIO.Prelude.Logger +import RIO.Prelude.RIO +import RIO.Prelude.Lens import qualified Data.Map as Map import qualified Data.Text as T import qualified System.Directory as D diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/State.hs new/rio-0.1.4.0/src/RIO/State.hs --- old/rio-0.1.2.0/src/RIO/State.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO/State.hs 2018-07-06 05:21:35.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO/Writer.hs new/rio-0.1.4.0/src/RIO/Writer.hs --- old/rio-0.1.2.0/src/RIO/Writer.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO/Writer.hs 2018-07-06 05:21:46.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/src/RIO.hs new/rio-0.1.4.0/src/RIO.hs --- old/rio-0.1.2.0/src/RIO.hs 2018-03-19 17:14:01.000000000 +0100 +++ new/rio-0.1.4.0/src/RIO.hs 2018-06-19 17:29:05.000000000 +0200 @@ -10,6 +10,7 @@ , module RIO.Prelude.Text , module RIO.Prelude.Trace , module RIO.Prelude.URef + , module RIO.Prelude.Simple ) where import RIO.Prelude.Display @@ -23,3 +24,4 @@ import RIO.Prelude.Text import RIO.Prelude.Trace import RIO.Prelude.URef +import RIO.Prelude.Simple diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/test/RIO/LoggerSpec.hs new/rio-0.1.4.0/test/RIO/LoggerSpec.hs --- old/rio-0.1.2.0/test/RIO/LoggerSpec.hs 2018-03-18 09:09:39.000000000 +0100 +++ new/rio-0.1.4.0/test/RIO/LoggerSpec.hs 2018-05-27 15:09:44.000000000 +0200 @@ -24,3 +24,25 @@ logStickyDone "XYZ" builder <- readIORef ref toLazyByteString builder `shouldBe` "ABC\b\b\b \b\b\bshould appear\nABC\b\b\b \b\b\bXYZ\n" + it "setLogMinLevelIO" $ do + (ref, options) <- logOptionsMemory + logLevelRef <- newIORef LevelDebug + withLogFunc (options & setLogMinLevelIO (readIORef logLevelRef)) + $ \lf -> runRIO lf $ do + logDebug "should appear" + -- reset log min level to info + atomicModifyIORef' logLevelRef (\_ -> (LevelInfo, ())) + logDebug "should not appear" + builder <- readIORef ref + toLazyByteString builder `shouldBe` "should appear\n" + it "setLogVerboseFormatIO" $ do + (ref, options) <- logOptionsMemory + logVerboseFormatRef <- newIORef True + withLogFunc (options & setLogVerboseFormatIO (readIORef logVerboseFormatRef)) + $ \lf -> runRIO lf $ do + logInfo "verbose log" + -- reset verbose format + atomicModifyIORef' logVerboseFormatRef (\_ -> (False, ())) + logInfo "no verbose log" + builder <- readIORef ref + toLazyByteString builder `shouldBe` "[info] verbose log\nno verbose log\n" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/test/RIO/Prelude/ExtraSpec.hs new/rio-0.1.4.0/test/RIO/Prelude/ExtraSpec.hs --- old/rio-0.1.2.0/test/RIO/Prelude/ExtraSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/test/RIO/Prelude/ExtraSpec.hs 2018-06-19 17:29:26.000000000 +0200 @@ -0,0 +1,13 @@ +module RIO.Prelude.ExtraSpec (spec) where + +import RIO +import Test.Hspec + +spec :: Spec +spec = do + describe "foldMapM" $ do + it "sanity" $ do + let helper :: Applicative f => Int -> f [Int] + helper = pure . pure + res <- foldMapM helper [1..10] + res `shouldBe` [1..10] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/test/RIO/Prelude/RIOSpec.hs new/rio-0.1.4.0/test/RIO/Prelude/RIOSpec.hs --- old/rio-0.1.2.0/test/RIO/Prelude/RIOSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/test/RIO/Prelude/RIOSpec.hs 2018-07-06 05:12:54.000000000 +0200 @@ -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!" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.2.0/test/RIO/Prelude/SimpleSpec.hs new/rio-0.1.4.0/test/RIO/Prelude/SimpleSpec.hs --- old/rio-0.1.2.0/test/RIO/Prelude/SimpleSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rio-0.1.4.0/test/RIO/Prelude/SimpleSpec.hs 2018-06-19 17:29:26.000000000 +0200 @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ViewPatterns #-} +module RIO.Prelude.SimpleSpec (spec) where + +import RIO +import RIO.Process +import Test.Hspec + +spec :: Spec +spec = do + it "logging works" $ asIO $ runSimpleApp $ logDebug "logging allowed" + it "process calling works" $ asIO $ runSimpleApp $ proc "echo" ["hello"] runProcess_
