Hello community, here is the log from the commit of package ghc-rio for openSUSE:Factory checked in at 2020-01-29 13:13:12 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-rio (Old) and /work/SRC/openSUSE:Factory/.ghc-rio.new.26092 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-rio" Wed Jan 29 13:13:12 2020 rev:12 rq:766988 version:0.1.13.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-rio/ghc-rio.changes 2019-12-27 13:57:04.332765682 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-rio.new.26092/ghc-rio.changes 2020-01-29 13:13:42.282026407 +0100 @@ -1,0 +2,11 @@ +Sat Jan 18 10:34:21 UTC 2020 - [email protected] + +- Update rio to version 0.1.13.0. + ## 0.1.13.0 + + * Add `withLazyFileUtf8` + * Add `mapRIO` + * Add generic logger + * Add `exeExtensions` and improve `findExecutable` on Windows [#205](https://github.com/commercialhaskell/rio/issues/205) + +------------------------------------------------------------------- Old: ---- rio-0.1.12.0.tar.gz New: ---- rio-0.1.13.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-rio.spec ++++++ --- /var/tmp/diff_new_pack.lCmxcB/_old 2020-01-29 13:13:56.014033427 +0100 +++ /var/tmp/diff_new_pack.lCmxcB/_new 2020-01-29 13:13:56.014033427 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-rio # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name rio %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.12.0 +Version: 0.1.13.0 Release: 0 Summary: A standard library for Haskell License: MIT ++++++ rio-0.1.12.0.tar.gz -> rio-0.1.13.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/ChangeLog.md new/rio-0.1.13.0/ChangeLog.md --- old/rio-0.1.12.0/ChangeLog.md 2019-08-26 15:03:09.000000000 +0200 +++ new/rio-0.1.13.0/ChangeLog.md 2020-01-17 06:27:44.000000000 +0100 @@ -1,5 +1,12 @@ # Changelog for rio +## 0.1.13.0 + +* Add `withLazyFileUtf8` +* Add `mapRIO` +* Add generic logger +* Add `exeExtensions` and improve `findExecutable` on Windows [#205](https://github.com/commercialhaskell/rio/issues/205) + ## 0.1.12.0 * Add `logFormat` and `setLogFormat` for `LogOptions`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/rio.cabal new/rio-0.1.13.0/rio.cabal --- old/rio-0.1.12.0/rio.cabal 2019-08-26 15:04:07.000000000 +0200 +++ new/rio-0.1.13.0/rio.cabal 2020-01-17 06:22:49.000000000 +0100 @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 7dc639bd135a48a7ddeeaf2a43e7de51ccc95f000475f44c042aaa133defb453 +-- hash: 8e4af889359b601656dfdc5de6e99c1ae5312558aa4768684771e5a0fb8e6a8e name: rio -version: 0.1.12.0 +version: 0.1.13.0 synopsis: A standard library for Haskell description: See README and Haddocks at <https://www.stackage.org/package/rio> category: Control diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/src/RIO/Prelude/IO.hs new/rio-0.1.13.0/src/RIO/Prelude/IO.hs --- old/rio-0.1.12.0/src/RIO/Prelude/IO.hs 2018-12-06 09:29:44.000000000 +0100 +++ new/rio-0.1.13.0/src/RIO/Prelude/IO.hs 2020-01-17 06:22:33.000000000 +0100 @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module RIO.Prelude.IO ( withLazyFile + , withLazyFileUtf8 , readFileBinary , writeFileBinary , readFileUtf8 @@ -12,6 +13,8 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL import qualified Data.Text.IO as T import System.IO (hSetEncoding, utf8) @@ -22,6 +25,13 @@ withLazyFile :: MonadUnliftIO m => FilePath -> (BL.ByteString -> m a) -> m a withLazyFile fp inner = withBinaryFile fp ReadMode $ inner <=< liftIO . BL.hGetContents +-- | Lazily read a file in UTF8 encoding. +-- +-- @since 0.1.13 +withLazyFileUtf8 :: MonadUnliftIO m => FilePath -> (TL.Text -> m a) -> m a +withLazyFileUtf8 fp inner = withFile fp ReadMode $ \h -> + inner =<< liftIO (hSetEncoding h utf8 >> TL.hGetContents h) + -- | Write a file in UTF8 encoding -- -- This function will use OS-specific line ending handling. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/src/RIO/Prelude/Logger.hs new/rio-0.1.13.0/src/RIO/Prelude/Logger.hs --- old/rio-0.1.12.0/src/RIO/Prelude/Logger.hs 2019-08-26 15:03:09.000000000 +0200 +++ new/rio-0.1.13.0/src/RIO/Prelude/Logger.hs 2020-01-17 06:25:42.000000000 +0100 @@ -1,3 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -50,6 +54,17 @@ , noLogging -- ** Accessors , logFuncUseColorL + -- * Type-generic logger + -- $type-generic-intro + , glog + , GLogFunc + , gLogFuncClassic + , mkGLogFunc + , contramapMaybeGLogFunc + , contramapGLogFunc + , HasGLogFunc(..) + , HasLogLevel(..) + , HasLogSource(..) ) where import RIO.Prelude.Reexports hiding ((<>)) @@ -73,6 +88,10 @@ import GHC.Foreign (peekCString, withCString) import Data.Semigroup (Semigroup (..)) +#if MIN_VERSION_base(4,12,0) +import Data.Functor.Contravariant +#endif + -- | The log level of a message. -- -- @since 0.0.0.0 @@ -506,7 +525,7 @@ -- -- Default: `id` -- --- @since 0.1.12.0 +-- @since 0.1.13.0 setLogFormat :: (Utf8Builder -> Utf8Builder) -> LogOptions -> LogOptions setLogFormat f options = options { logFormat = f } @@ -659,3 +678,190 @@ -- @since 0.1.5.0 noLogging :: (HasLogFunc env, MonadReader env m) => m a -> m a noLogging = local (set logFuncL mempty) + +-------------------------------------------------------------------------------- +-- +-- $type-generic-intro +-- +-- When logging takes on a more semantic meaning and the logs need to +-- be digested, acted upon, translated or serialized upstream (to +-- e.g. a JSON logging server), we have 'GLogFunc' (as in "generic log +-- function"), and is accessed via 'HasGLogFunc'. +-- +-- There is only one function to log in this system: the 'glog' +-- function, which can log any message. You determine the log levels +-- or severity of messages when needed. +-- +-- Using 'RIO.Prelude.mapRIO' and 'contramapGLogFunc' (or +-- 'contramapMaybeGLogFunc'), you can build hierarchies of loggers. +-- +-- Example: +-- +-- @ +-- import RIO +-- +-- data DatabaseMsg = Connected String | Query String | Disconnected deriving Show +-- data WebMsg = Request String | Error String | DatabaseMsg DatabaseMsg deriving Show +-- data AppMsg = InitMsg String | WebMsg WebMsg deriving Show +-- +-- main :: IO () +-- main = +-- runRIO +-- (mkGLogFunc (\stack msg -> print msg)) +-- (do glog (InitMsg "Ready to go!") +-- runWeb +-- (do glog (Request "/foo") +-- runDB (do glog (Connected "127.0.0.1") +-- glog (Query "SELECT 1")) +-- glog (Error "Oh noes!"))) +-- +-- runDB :: RIO (GLogFunc DatabaseMsg) () -> RIO (GLogFunc WebMsg) () +-- runDB = mapRIO (contramapGLogFunc DatabaseMsg) +-- +-- runWeb :: RIO (GLogFunc WebMsg) () -> RIO (GLogFunc AppMsg) () +-- runWeb = mapRIO (contramapGLogFunc WebMsg) +-- @ +-- +-- If we instead decided that we only wanted to log database queries, +-- and not bother the upstream with connect/disconnect messages, we +-- could simplify the constructor to @DatabaseQuery String@: +-- +-- @ +-- data WebMsg = Request String | Error String | DatabaseQuery String deriving Show +-- @ +-- +-- And then @runDB@ could use 'contramapMaybeGLogFunc' to parse only queries: +-- +-- @ +-- runDB = +-- mapRIO +-- (contramapMaybeGLogFunc +-- (\msg -> +-- case msg of +-- Query string -> pure (DatabaseQuery string) +-- _ -> Nothing)) +-- @ +-- +-- This way, upstream only has to care about queries and not +-- connect/disconnect constructors. + +-- | An app is capable of generic logging if it implements this. +-- +-- @since 0.1.13.0 +class HasGLogFunc env where + type GMsg env + gLogFuncL :: Lens' env (GLogFunc (GMsg env)) + +-- | Quick way to run a RIO that only has a logger in its environment. +-- +-- @since 0.1.13.0 +instance HasGLogFunc (GLogFunc msg) where + type GMsg (GLogFunc msg) = msg + gLogFuncL = id + +-- | A generic logger of some type @msg@. +-- +-- Your 'GLocFunc' can re-use the existing classical logging framework +-- of RIO, and/or implement additional transforms, +-- filters. Alternatively, you may log to a JSON source in a database, +-- or anywhere else as needed. You can decide how to log levels or +-- severities based on the constructors in your type. You will +-- normally determine this in your main app entry point. +-- +-- @since 0.1.13.0 +newtype GLogFunc msg = GLogFunc (CallStack -> msg -> IO ()) + +#if MIN_VERSION_base(4,12,0) +-- https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Functor-Contravariant.html + +-- | Use this instance to wrap sub-loggers via 'RIO.mapRIO'. +-- +-- The 'Contravariant' class is available in base 4.12.0. +-- +-- @since 0.1.13.0 +instance Contravariant GLogFunc where + contramap = contramapGLogFunc + {-# INLINABLE contramap #-} +#endif + +-- | Perform both sets of actions per log entry. +-- +-- @since 0.1.13.0 +instance Semigroup (GLogFunc msg) where + GLogFunc f <> GLogFunc g = GLogFunc (\a b -> f a b *> g a b) + +-- | 'mempty' peforms no logging. +-- +-- @since 0.1.13.0 +instance Monoid (GLogFunc msg) where + mempty = mkGLogFunc $ \_ _ -> return () + mappend = (<>) + +-- | A vesion of 'contramapMaybeGLogFunc' which supports filering. +-- +-- @since 0.1.13.0 +contramapMaybeGLogFunc :: (a -> Maybe b) -> GLogFunc b -> GLogFunc a +contramapMaybeGLogFunc f (GLogFunc io) = + GLogFunc (\stack msg -> maybe (pure ()) (io stack) (f msg)) +{-# INLINABLE contramapMaybeGLogFunc #-} + +-- | A contramap. Use this to wrap sub-loggers via 'RIO.mapRIO'. +-- +-- If you are on base > 4.12.0, you can just use 'contramap'. +-- +-- @since 0.1.13.0 +contramapGLogFunc :: (a -> b) -> GLogFunc b -> GLogFunc a +contramapGLogFunc f (GLogFunc io) = GLogFunc (\stack msg -> io stack (f msg)) +{-# INLINABLE contramapGLogFunc #-} + +-- | Make a custom generic logger. With this you could, for example, +-- write to a database or a log digestion service. For example: +-- +-- > mkGLogFunc (\stack msg -> send (Data.Aeson.encode (JsonLog stack msg))) +-- +-- @since 0.1.13.0 +mkGLogFunc :: (CallStack -> msg -> IO ()) -> GLogFunc msg +mkGLogFunc = GLogFunc + +-- | Log a value generically. +-- +-- @since 0.1.13.0 +glog :: + (MonadIO m, HasCallStack, HasGLogFunc env, MonadReader env m) + => GMsg env + -> m () +glog t = do + GLogFunc gLogFunc <- view gLogFuncL + liftIO (gLogFunc callStack t) +{-# INLINABLE glog #-} + +-------------------------------------------------------------------------------- +-- Integration with classical logger framework + +-- | Level, if any, of your logs. If unknown, use 'LogOther'. Use for +-- your generic log data types that want to sit inside the classic log +-- framework. +-- +-- @since 0.1.13.0 +class HasLogLevel msg where + getLogLevel :: msg -> LogLevel + +-- | Source of a log. This can be whatever you want. Use for your +-- generic log data types that want to sit inside the classic log +-- framework. +-- +-- @since 0.1.13.0 +class HasLogSource msg where + getLogSource :: msg -> LogSource + +-- | Make a 'GLogFunc' via classic 'LogFunc'. Use this if you'd like +-- to log your generic data type via the classic RIO terminal logger. +-- +-- @since 0.1.13.0 +gLogFuncClassic :: + (HasLogLevel msg, HasLogSource msg, Display msg) => LogFunc -> GLogFunc msg +gLogFuncClassic (LogFunc {unLogFunc = io}) = + mkGLogFunc + (\theCallStack msg -> + liftIO + (io theCallStack (getLogSource msg) (getLogLevel msg) (display msg))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/src/RIO/Prelude/RIO.hs new/rio-0.1.13.0/src/RIO/Prelude/RIO.hs --- old/rio-0.1.12.0/src/RIO/Prelude/RIO.hs 2019-04-11 09:22:33.000000000 +0200 +++ new/rio-0.1.13.0/src/RIO/Prelude/RIO.hs 2020-01-17 06:24:28.000000000 +0100 @@ -8,6 +8,7 @@ ( RIO (..) , runRIO , liftRIO + , mapRIO -- SomeRef for Writer/State interfaces , SomeRef , HasStateRef (..) @@ -58,6 +59,14 @@ env <- ask runRIO env rio +-- | Lift one RIO env to another. +-- +-- @since 0.1.13.0 +mapRIO :: (outer -> inner) -> RIO inner a -> RIO outer a +mapRIO f m = do + outer <- ask + runRIO (f outer) m + instance MonadUnliftIO (RIO env) where askUnliftIO = RIO $ ReaderT $ \r -> withUnliftIO $ \u -> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/src/RIO/Process.hs new/rio-0.1.13.0/src/RIO/Process.hs --- old/rio-0.1.12.0/src/RIO/Process.hs 2019-06-26 07:09:32.000000000 +0200 +++ new/rio-0.1.13.0/src/RIO/Process.hs 2020-01-17 06:22:33.000000000 +0100 @@ -72,6 +72,7 @@ -- * Utilities , doesExecutableExist , findExecutable + , exeExtensions , augmentPath , augmentPathMap , showProcessArgDebug @@ -225,6 +226,13 @@ EVFNotWindows #endif +-- Don't use CPP so that the Windows code path is at least type checked +-- regularly +isWindows :: Bool +isWindows = case currentEnvVarFormat of + EVFWindows -> True + EVFNotWindows -> False + -- | Override the working directory processes run in. @Nothing@ means -- the current process's working directory. -- @@ -271,10 +279,9 @@ , pcExeCache = ref , pcExeExtensions = if isWindows - then let pathext = fromMaybe - ".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC" - (Map.lookup "PATHEXT" tm) - in map T.unpack $ "" : T.splitOn ";" pathext + then let pathext = fromMaybe defaultPATHEXT + (Map.lookup "PATHEXT" tm) + in map T.unpack $ T.splitOn ";" pathext else [""] , pcWorkingDir = Nothing } @@ -283,13 +290,11 @@ tm | isWindows = Map.fromList $ map (first T.toUpper) $ Map.toList tm' | otherwise = tm' - - -- Don't use CPP so that the Windows code path is at least type checked - -- regularly - isWindows = - case currentEnvVarFormat of - EVFWindows -> True - EVFNotWindows -> False + -- Default value for PATHTEXT on Windows versions after Windows XP. (The + -- documentation of the default at + -- https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/start + -- is incomplete.) + defaultPATHEXT = ".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC" -- | Reset the executable cache. -- @@ -299,7 +304,10 @@ pc <- view processContextL atomicModifyIORef (pcExeCache pc) (const mempty) --- | Load up an 'EnvOverride' from the standard environment. +-- | Same as 'mkProcessContext' but uses the system environment (from +-- 'System.Environment.getEnvironment'). +-- +-- @since 0.0.3.0 mkDefaultProcessContext :: MonadIO m => m ProcessContext mkDefaultProcessContext = liftIO $ @@ -307,10 +315,8 @@ mkProcessContext . Map.fromList . map (T.pack *** T.pack) --- | Modify the environment variables of a 'ProcessContext'. --- --- This will keep other settings unchanged, in particular the working --- directory. +-- | Modify the environment variables of a 'ProcessContext'. This will not +-- change the working directory. -- -- Note that this requires 'MonadIO', as it will create a new 'IORef' -- for the cache. @@ -554,50 +560,89 @@ -> m Bool doesExecutableExist = liftM isRight . findExecutable --- | Find the complete path for the executable. +-- | Find the complete path for the given executable name. +-- +-- On POSIX systems, filenames that match but are not exectuables are excluded. +-- +-- On Windows systems, the executable names tried, in turn, are the supplied +-- name (only if it has an extension) and that name extended by each of the +-- 'exeExtensions'. Also, this function may behave differently from +-- 'RIO.Directory.findExecutable'. The latter excludes as executables filenames +-- without a @.bat@, @.cmd@, @.com@ or @.exe@ extension (case-insensitive). -- -- @since 0.0.3.0 findExecutable :: (MonadIO m, MonadReader env m, HasProcessContext env) - => String -- ^ Name of executable - -> m (Either ProcessException FilePath) -- ^ Full path to that executable on success -findExecutable name0 | any FP.isPathSeparator name0 = do - pc <- view processContextL - let names0 = map (name0 ++) (pcExeExtensions pc) - testNames [] = return $ Left $ ExecutableNotFoundAt name0 - testNames (name:names) = do - exists <- liftIO $ D.doesFileExist name - if exists - then do - path <- liftIO $ D.canonicalizePath name - return $ return path - else testNames names - testNames names0 + => String + -- ^ Name of executable + -> m (Either ProcessException FilePath) + -- ^ Full path to that executable on success +findExecutable name | any FP.isPathSeparator name = do + names <- addPcExeExtensions name + testFPs (pure $ Left $ ExecutableNotFoundAt name) D.canonicalizePath names findExecutable name = do - pc <- view processContextL - m <- readIORef $ pcExeCache pc - epath <- case Map.lookup name m of - Just epath -> return epath - Nothing -> do - let loop [] = return $ Left $ ExecutableNotFound name (pcPath pc) - loop (dir:dirs) = do - let fp0 = dir FP.</> name - fps0 = map (fp0 ++) (pcExeExtensions pc) - testFPs [] = loop dirs - testFPs (fp:fps) = do - exists <- D.doesFileExist fp - existsExec <- if exists then liftM D.executable $ D.getPermissions fp else return False - if existsExec - then do - fp' <- D.makeAbsolute fp - return $ return fp' - else testFPs fps - testFPs fps0 - epath <- liftIO $ loop $ pcPath pc - () <- atomicModifyIORef (pcExeCache pc) $ \m' -> - (Map.insert name epath m', ()) - return epath - return epath + pc <- view processContextL + m <- readIORef $ pcExeCache pc + case Map.lookup name m of + Just epath -> pure epath + Nothing -> do + let loop [] = pure $ Left $ ExecutableNotFound name (pcPath pc) + loop (dir:dirs) = do + fps <- addPcExeExtensions $ dir FP.</> name + testFPs (loop dirs) D.makeAbsolute fps + epath <- loop $ pcPath pc + () <- atomicModifyIORef (pcExeCache pc) $ \m' -> + (Map.insert name epath m', ()) + pure epath + +-- | A helper function to add the executable extensions of the process context +-- to a file path. On Windows, the original file path is included, if it has an +-- existing extension. +addPcExeExtensions + :: (MonadIO m, MonadReader env m, HasProcessContext env) + => FilePath -> m [FilePath] +addPcExeExtensions fp = do + pc <- view processContextL + pure $ (if isWindows && FP.hasExtension fp then (fp:) else id) + (map (fp ++) (pcExeExtensions pc)) + +-- | A helper function to test whether file paths are to an executable +testFPs + :: (MonadIO m, MonadReader env m, HasProcessContext env) + => m (Either ProcessException FilePath) + -- ^ Default if no executable exists at any file path + -> (FilePath -> IO FilePath) + -- ^ Modification to apply to a file path, if an executable exists there + -> [FilePath] + -- ^ File paths to test, in turn + -> m (Either ProcessException FilePath) +testFPs ifNone _ [] = ifNone +testFPs ifNone modify (fp:fps) = do + exists <- liftIO $ D.doesFileExist fp + existsExec <- liftIO $ if exists + then if isWindows then pure True else isExecutable + else pure False + if existsExec then liftIO $ Right <$> modify fp else testFPs ifNone modify fps + where + isExecutable = D.executable <$> D.getPermissions fp + +-- | Get the filename extensions for executable files, including the dot (if +-- any). +-- +-- On POSIX systems, this is @[""]@. +-- +-- On Windows systems, the list is determined by the value of the @PATHEXT@ +-- environment variable, if it present in the environment. If the variable is +-- absent, this is its default value on a Windows system. This function may, +-- therefore, behave differently from 'RIO.Directory.exeExtension', +-- which returns only @".exe"@. +-- +-- @since 0.1.13.0 +exeExtensions :: (MonadIO m, MonadReader env m, HasProcessContext env) + => m [String] +exeExtensions = do + pc <- view processContextL + return $ pcExeExtensions pc -- | Augment the PATH environment variable with the given extra paths. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rio-0.1.12.0/src/RIO.hs new/rio-0.1.13.0/src/RIO.hs --- old/rio-0.1.12.0/src/RIO.hs 2019-06-26 06:57:48.000000000 +0200 +++ new/rio-0.1.13.0/src/RIO.hs 2019-12-25 07:15:53.000000000 +0100 @@ -37,6 +37,7 @@ -- * @MonadIO@ and @MonadUnliftIO@ , module Control.Monad.IO.Unlift -- * Logger + -- $logging-intro , module RIO.Prelude.Logger -- * Display , module RIO.Prelude.Display @@ -115,3 +116,24 @@ import UnliftIO.Temporary import UnliftIO.Timeout import UnliftIO.Concurrent + +-------------------------------------------------------------------------------- +-- $logging-intro +-- +-- The logging system in RIO is built upon "log functions", which are +-- accessed in RIO's environment via a class like "has log +-- function". There are two provided: +-- +-- * In the common case: for logging plain text (via 'Utf8Builder') +-- efficiently, there is 'LogFunc', which can be created via +-- 'withLogFunc', and is accessed via 'HasLogFunc'. This provides +-- all the classical logging facilities: timestamped text output +-- with log levels and colors (if terminal-supported) to the +-- terminal. We log output via 'logInfo', 'logDebug', etc. +-- +-- * In the advanced case: where logging takes on a more semantic +-- meaning and the logs need to be digested, acted upon, translated +-- or serialized upstream (to e.g. a JSON logging server), we have +-- 'GLogFunc' (as in "generic log function"), and is accessed via +-- 'HasGLogFunc'. In this case, we log output via 'glog'. See the +-- Type-generic logger section for more information.
