packages feed

Z-IO 0.1.6.1 → 0.1.7.0

raw patch · 10 files changed

+290/−105 lines, 10 filesdep ~Z-DataPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Z-Data

API changes (from Hackage documentation)

- Z.IO.Logger: [loggerShowDebug] :: LoggerConfig -> Bool
- Z.IO.Logger: flushLog :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [Bytes] -> IO ()
- Z.IO.Logger: warn :: HasCallStack => Builder () -> IO ()
- Z.IO.Logger: warnTo :: HasCallStack => Logger -> Builder () -> IO ()
+ Z.IO.Environment: CPUInfo :: CBytes -> CInt -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> CPUInfo
+ Z.IO.Environment: TimeVal :: {-# UNPACK #-} !CLong -> {-# UNPACK #-} !CLong -> TimeVal
+ Z.IO.Environment: [cpu_model] :: CPUInfo -> CBytes
+ Z.IO.Environment: [cpu_speed] :: CPUInfo -> CInt
+ Z.IO.Environment: [cpu_times_idle] :: CPUInfo -> Word64
+ Z.IO.Environment: [cpu_times_irq] :: CPUInfo -> Word64
+ Z.IO.Environment: [cpu_times_nice] :: CPUInfo -> Word64
+ Z.IO.Environment: [cpu_times_sys] :: CPUInfo -> Word64
+ Z.IO.Environment: [cpu_times_user] :: CPUInfo -> Word64
+ Z.IO.Environment: [tv_sec] :: TimeVal -> {-# UNPACK #-} !CLong
+ Z.IO.Environment: [tv_usec] :: TimeVal -> {-# UNPACK #-} !CLong
+ Z.IO.Environment: data CPUInfo
+ Z.IO.Environment: data TimeVal
+ Z.IO.Environment: getCPUInfo :: IO [CPUInfo]
+ Z.IO.Environment: getConstrainedMem :: IO Word64
+ Z.IO.Environment: getFreeMem :: IO Word64
+ Z.IO.Environment: getLoadAvg :: IO (Double, Double, Double)
+ Z.IO.Environment: getTotalMem :: IO Word64
+ Z.IO.Logger: [loggerConfigLevel] :: LoggerConfig -> {-# UNPACK #-} !Level
+ Z.IO.Logger: [loggerLevel] :: Logger -> {-# UNPACK #-} !Level
+ Z.IO.Logger: critical :: HasCallStack => Builder () -> IO ()
+ Z.IO.Logger: defaultLevelFmt :: Level -> Builder ()
+ Z.IO.Logger: flushLogIORef :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [Bytes] -> IO ()
+ Z.IO.Logger: pattern CRITICAL :: Level
+ Z.IO.Logger: pattern DEBUG :: Level
+ Z.IO.Logger: pattern FATAL :: Level
+ Z.IO.Logger: pattern INFO :: Level
+ Z.IO.Logger: pattern NOTSET :: Level
+ Z.IO.Logger: pattern WARNING :: Level
+ Z.IO.Logger: pushLogIORef :: IORef [Bytes] -> Int -> Builder () -> IO ()
+ Z.IO.Logger: warning :: HasCallStack => Builder () -> IO ()
+ Z.IO.Logger: warningTo :: HasCallStack => Logger -> Builder () -> IO ()
+ Z.IO.Resource: withResourceInPool :: (MonadMask m, MonadIO m, HasCallStack) => Pool a -> (a -> m b) -> m b
+ Z.IO.StdStream: printLineStd :: (HasCallStack, ShowT a) => a -> IO ()
+ Z.IO.Time: iso8061DateFormat :: TimeFormat
+ Z.IO.UV.FFI: CPUInfo :: CBytes -> CInt -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> CPUInfo
+ Z.IO.UV.FFI: [cpu_model] :: CPUInfo -> CBytes
+ Z.IO.UV.FFI: [cpu_speed] :: CPUInfo -> CInt
+ Z.IO.UV.FFI: [cpu_times_idle] :: CPUInfo -> Word64
+ Z.IO.UV.FFI: [cpu_times_irq] :: CPUInfo -> Word64
+ Z.IO.UV.FFI: [cpu_times_nice] :: CPUInfo -> Word64
+ Z.IO.UV.FFI: [cpu_times_sys] :: CPUInfo -> Word64
+ Z.IO.UV.FFI: [cpu_times_user] :: CPUInfo -> Word64
+ Z.IO.UV.FFI: data CPUInfo
+ Z.IO.UV.FFI: getCPUInfo :: IO [CPUInfo]
+ Z.IO.UV.FFI: getLoadAvg :: IO (Double, Double, Double)
+ Z.IO.UV.FFI: instance GHC.Classes.Eq Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance GHC.Classes.Ord Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance GHC.Generics.Generic Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance GHC.Show.Show Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance Z.Data.JSON.Base.EncodeJSON Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance Z.Data.JSON.Base.FromValue Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance Z.Data.JSON.Base.ToValue Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: instance Z.Data.Text.ShowT.ShowT Z.IO.UV.FFI.CPUInfo
+ Z.IO.UV.FFI: peekCPUInfoOff :: Ptr CPUInfo -> Int -> IO CPUInfo
+ Z.IO.UV.FFI: uv_cpu_info :: MBA# (Ptr CPUInfo) -> MBA# CInt -> IO CInt
+ Z.IO.UV.FFI: uv_free_cpu_info :: Ptr CPUInfo -> CInt -> IO ()
+ Z.IO.UV.FFI: uv_get_constrained_memory :: IO Word64
+ Z.IO.UV.FFI: uv_get_free_memory :: IO Word64
+ Z.IO.UV.FFI: uv_get_total_memory :: IO Word64
+ Z.IO.UV.FFI: uv_loadavg :: MBA# (Double, Double, Double) -> IO ()
- Z.IO.Logger: Logger :: (Builder () -> IO ()) -> IO () -> IO () -> IO (Builder ()) -> LogFormatter -> Logger
+ Z.IO.Logger: Logger :: (Builder () -> IO ()) -> IO () -> IO () -> IO (Builder ()) -> LogFormatter -> {-# UNPACK #-} !Level -> Logger
- Z.IO.Logger: LoggerConfig :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> Bool -> LoggerConfig
+ Z.IO.Logger: LoggerConfig :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Level -> LoggerConfig
- Z.IO.Logger: coloredFmt :: Bool -> LogFormatter
+ Z.IO.Logger: coloredFmt :: LogFormatter
- Z.IO.Logger: defaultFmt :: Bool -> LogFormatter
+ Z.IO.Logger: defaultFmt :: LogFormatter
- Z.IO.Logger: type Level = CBytes
+ Z.IO.Logger: type Level = Int
- Z.IO.StdStream: printStd :: HasCallStack => ShowT a => a -> IO ()
+ Z.IO.StdStream: printStd :: (HasCallStack, ShowT a) => a -> IO ()

Files

ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for Z-IO +## 0.1.7.0  -- 2020-10-24++* Add `iso8016DateFormat`, change logger's default time format to include time zone.+* Rename `warn` to `warning`, change `Level` to `Int` type alias in `Z.IO.Logger`, add `critical`.+* Export `TimeVal` from `Z.IO.Environment`.+* Add `getCPUInfo`, `getLoadAvg`, `getXXXMem` to `Z.IO.Environment`.+ ## 0.1.6.1  -- 2020-10-17  * Export `ResUsage` from `Z.IO.Environment`.
Z-IO.cabal view
@@ -1,6 +1,6 @@ cabal-version:              2.4 name:                       Z-IO-version:                    0.1.6.1+version:                    0.1.7.0 synopsis:                   Simple and high performance IO toolkit for Haskell description:                Simple and high performance IO toolkit for Haskell, including                             file system, network, ipc and more!@@ -115,7 +115,7 @@                             Z.Compression.Zlib      build-depends:          base                    >= 4.12 && < 5.0-                          , Z-Data                  >= 0.1.7.2 && < 0.1.8+                          , Z-Data                  >= 0.1.7.2 && < 0.1.9                           , primitive               >= 0.7.1 && < 0.7.2                           , exceptions              == 0.10.*                           , time                    >= 1.8 && < 2.0
Z/IO/Environment.hs view
@@ -19,7 +19,8 @@   , setEnv, unsetEnv     -- * other environment infos   , getCWD, chDir, getHomeDir, getTempDir-  , getResUsage, ResUsage(..)+  , getRandom, getRandomT+  , getResUsage, ResUsage(..), TimeVal(..)   , getResidentSetMemory   , getUpTime   , getHighResolutionTime@@ -28,7 +29,9 @@   , getHostname   , getOSName, OSName(..)   , getPassWD, PassWD(..), UID, GID-  , getRandom, getRandomT+  , getCPUInfo, CPUInfo(..)+  , getLoadAvg+  , getFreeMem, getTotalMem, getConstrainedMem   ) where  import Control.Monad@@ -240,6 +243,22 @@             _ -> do                 throwUVIfMinus_ (return r)                 return v++-- | Gets the amount of free memory available in the system, as reported by the kernel (in bytes).+getFreeMem :: IO Word64+getFreeMem = uv_get_free_memory++-- | Gets the total amount of physical memory in the system (in bytes).+getTotalMem :: IO Word64+getTotalMem = uv_get_total_memory++-- | Gets the amount of memory available to the process (in bytes) based on limits imposed by the OS.+--+-- If there is no such constraint, or the constraint is unknown, 0 is returned.+-- Note that it is not unusual for this value to be less than or greater than 'getTotalMem'.+-- Note This function currently only returns a non-zero value on Linux, based on cgroups if it is present.+getConstrainedMem :: IO Word64+getConstrainedMem = uv_get_constrained_memory  -------------------------------------------------------------------------------- 
Z/IO/Exception.hs view
@@ -69,6 +69,7 @@   , HasCallStack   , CallStack   , callStack+  , module Z.IO.UV.Errno   ) where  import Control.Exception hiding (IOException)
Z/IO/FileSystem/FilePath.hsc view
@@ -374,7 +374,7 @@ -- | Joins multiple paths together. -- -- This function generates a new path by joining multiple paths together.--- It will remove double separators, and unlike 'getAbsolute',+-- It will remove double separators, and unlike 'absolute', -- it permits the use of multiple relative paths to combine. concat :: [CBytes] -> IO CBytes concat ps = do
Z/IO/Logger.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ {-| Module      : Z.IO.Logger Description : High performance logger@@ -17,7 +19,10 @@     * Each logging thread only need perform a CAS to prepend log 'V.Bytes' into a list, which reduces contention.     * Each log call is atomic, Logging order is preserved under concurrent settings. -Flushing is automatic and throttled for 'debug', 'info', 'warn' to boost performance, but a 'fatal' log will always flush logger's buffer.  This could lead to a problem that if main thread exits too early logs may missed, to add a flushing when program exits, use 'withDefaultLogger' like:+Flushing is automatic and throttled for 'debug', 'info', 'warning' to boost+performance, but a 'fatal' and 'critical' log will always flush logger's buffer.+This could lead to a problem that if main thread exits too early logs may missed,+to add a flushing when program exits, use 'withDefaultLogger' like:  @ import Z.IO.Logger@@ -44,37 +49,47 @@     -- * logging functions   , debug   , info-  , warn+  , warning   , fatal+  , critical   , otherLevel-  , Level     -- * logging functions with specific logger   , debugTo   , infoTo-  , warnTo+  , warningTo   , fatalTo   , otherLevelTo-    -- * Helper to write new logger+    -- * Helpers to write new logger   , defaultTSCache   , defaultFmtCallStack+  , defaultLevelFmt   , LogFormatter, defaultFmt, coloredFmt-  , flushLog+  , pushLogIORef, flushLogIORef+    -- * Constants+    -- ** Level+  , Level+  , pattern DEBUG+  , pattern INFO+  , pattern WARNING+  , pattern FATAL+  , pattern CRITICAL+  , pattern NOTSET   ) where -import Control.Monad-import Z.Data.Vector.Base as V-import Z.IO.LowResTimer-import Z.IO.StdStream-import Z.IO.StdStream.Ansi  (color, AnsiColor(..))-import Z.IO.Buffered-import System.IO.Unsafe (unsafePerformIO)-import Z.IO.Exception-import Z.IO.Time-import Data.IORef-import Control.Concurrent.MVar-import GHC.Stack-import qualified Z.Data.Builder as B-import qualified Z.Data.CBytes as CB+import           Control.Concurrent.MVar+import           Control.Monad+import           Data.IORef+import           GHC.Stack+import           System.IO.Unsafe        (unsafePerformIO)+import qualified Z.Data.Builder          as B+import qualified Z.Data.CBytes           as CB+import           Z.Data.Vector.Base      as V+import           Z.IO.Buffered+import           Z.IO.Exception+import           Z.IO.LowResTimer+import           Z.IO.StdStream+import           Z.IO.StdStream.Ansi     (AnsiColor (..), color)+import           Z.IO.Time  type LogFormatter = B.Builder ()            -- ^ data\/time string                   -> Level                  -- ^ log level@@ -82,29 +97,40 @@                   -> CallStack              -- ^ call stack trace                   -> B.Builder () +-- | Extensible logger type. data Logger = Logger-    { loggerPushBuilder     :: B.Builder () -> IO () -- ^ push log into buffer-    , flushLogger           :: IO ()                -- ^ flush logger's buffer to output device-    , flushLoggerThrottled  :: IO ()                -- ^ throttled flush, e.g. use 'throttleTrailing_' from "Z.IO.LowResTimer"-    , loggerTSCache         :: IO (B.Builder ())    -- ^ A IO action return a formatted date\/time string-    , loggerFmt             :: LogFormatter+    { loggerPushBuilder    :: B.Builder () -> IO ()+    -- ^ Push log into buffer+    , flushLogger          :: IO ()+    -- ^ Flush logger's buffer to output device+    , flushLoggerThrottled :: IO ()+    -- ^ Throttled flush, e.g. use 'throttleTrailing_' from "Z.IO.LowResTimer"+    , loggerTSCache        :: IO (B.Builder ())+    -- ^ An IO action return a formatted date\/time string+    , loggerFmt            :: LogFormatter+    -- ^ Output logs if level is equal or higher than this value.+    , loggerLevel          :: {-# UNPACK #-} !Level     } +-- | Logger config type used in this module. data LoggerConfig = LoggerConfig-    { loggerMinFlushInterval :: {-# UNPACK #-} !Int -- ^ Minimal flush interval, see Notes on 'debug'-    , loggerLineBufSize      :: {-# UNPACK #-} !Int -- ^ Buffer size to build each log line-    , loggerShowDebug        :: Bool                -- ^ Set to 'False' to filter debug logs+    { loggerMinFlushInterval :: {-# UNPACK #-} !Int+    -- ^ Minimal flush interval, see Notes on 'debug'+    , loggerLineBufSize      :: {-# UNPACK #-} !Int+    -- ^ Buffer size to build each log line+    , loggerConfigLevel      :: {-# UNPACK #-} !Level+    -- ^ Config log's filter level     }  -- | A default logger config with -- -- * 0.1s minimal flush interval -- * line buffer size 240 bytes--- * show debug True+-- * show everything by default defaultLoggerConfig :: LoggerConfig-defaultLoggerConfig = LoggerConfig 1 240 True+defaultLoggerConfig = LoggerConfig 1 240 NOTSET --- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@+-- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@('iso8061DateFormat'). -- -- The timestamp will updated in 0.1s granularity to ensure a seconds level precision. defaultTSCache :: IO (B.Builder ())@@ -112,23 +138,7 @@ defaultTSCache = unsafePerformIO $ do     throttle 1 $ do         t <- getSystemTime-        CB.toBuilder <$> formatSystemTime simpleDateFormat t---- | Use this function to implement a simple 'IORef' based concurrent logger.------ @--- bList <- newIORef []--- let flush = flushLog buffered bList--- ..--- return $ Logger (pushLog bList) flush ...--- @----flushLog :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [V.Bytes] -> IO ()-flushLog oLock bList =-    withMVar oLock $ \ o -> do-        bss <- atomicModifyIORef' bList (\ bss -> ([], bss))-        forM_ (reverse bss) (writeBuffer o)-        flushBuffer o+        CB.toBuilder <$> formatSystemTime iso8061DateFormat t  -- | Make a new simple logger. --@@ -137,40 +147,59 @@           -> MVar (BufferedOutput o)           -> IO Logger newLogger LoggerConfig{..} oLock = do-    bList <- newIORef []-    let flush = flushLog oLock bList+    logsRef <- newIORef []+    let flush = flushLogIORef oLock logsRef     throttledFlush <- throttleTrailing_ loggerMinFlushInterval flush-    return $ Logger (pushLog bList) flush throttledFlush defaultTSCache-        (defaultFmt loggerShowDebug)-  where-    pushLog bList b = do-        let !bs = B.buildBytesWith loggerLineBufSize b-        atomicModifyIORef' bList (\ bss -> (bs:bss, ()))+    return $ Logger (pushLogIORef logsRef loggerLineBufSize)+                    flush throttledFlush defaultTSCache defaultFmt+                    loggerConfigLevel --- | Make a new colored logger connected to stderr.+-- | Make a new colored logger(connected to stderr). -- -- This logger will output colorized log if stderr is connected to TTY. newColoredLogger :: LoggerConfig -> IO Logger newColoredLogger LoggerConfig{..} = do-    bList <- newIORef []-    let flush = flushLog stderrBuf bList+    logsRef <- newIORef []+    let flush = flushLogIORef stderrBuf logsRef     throttledFlush <- throttleTrailing_ loggerMinFlushInterval flush-    return $ Logger (pushLog bList) flush throttledFlush defaultTSCache-        (if isStdStreamTTY stderr then coloredFmt loggerShowDebug-                                  else defaultFmt loggerShowDebug)+    return $ Logger (pushLogIORef logsRef loggerLineBufSize)+                    flush throttledFlush defaultTSCache+                    (if isStdStreamTTY stderr then coloredFmt+                                              else defaultFmt)+                    loggerConfigLevel -  where-    pushLog bList b = do-        let !bs = B.buildBytesWith loggerLineBufSize b-        atomicModifyIORef' bList (\ bss -> (bs:bss, ()))+-- | Use 'pushLogIORef' and 'pushLogIORef' to implement a simple 'IORef' based concurrent logger.+--+-- @+-- logsRef <- newIORef []+-- let push = pushLogIORef logsRef lineBufSize+--     flush = flushLogIORef stderrBuf logsRef+--     throttledFlush <- throttleTrailing_ flushInterval flush+-- ..+-- return $ Logger push flush throttledFlush ...+-- @+--+pushLogIORef :: IORef [V.Bytes]     -- ^ logs stored in a list, new log will be CASed into it.+             -> Int                 -- ^ buffer size to build each log+             -> B.Builder ()        -- ^ formatted log+             -> IO ()+pushLogIORef logsRef loggerLineBufSize b = do+    let !bs = B.buildBytesWith loggerLineBufSize b+    unless (V.null bs) $ atomicModifyIORef' logsRef (\ bss -> (bs:bss, ())) +flushLogIORef :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [V.Bytes] -> IO ()+flushLogIORef oLock logsRef =+    withMVar oLock $ \ o -> do+        bss <- atomicModifyIORef' logsRef (\ bss -> ([], bss))+        forM_ (reverse bss) (writeBuffer o)+        flushBuffer o+ -- | A default log formatter -- -- @ [DEBUG][2020-10-09T07:44:14UTC][<interactive>:7:1]This a debug message\\n@-defaultFmt :: Bool  -- ^ show DEGUG?-           -> LogFormatter-defaultFmt showdebug ts level content cstack = when (showdebug || level /= "DEBUG") $ do-    B.square (CB.toBuilder level)+defaultFmt :: LogFormatter+defaultFmt ts level content cstack = do+    B.square (defaultLevelFmt level)     B.square ts     B.square $ defaultFmtCallStack cstack     content@@ -178,16 +207,16 @@  -- | A default colored log formatter ----- DEBUG level is 'Cyan', WARN level is 'Yellow', FATAL level is 'Red'.-coloredFmt :: Bool  -- ^ show DEBUG?-           -> LogFormatter-coloredFmt showdebug ts level content cstack = when (showdebug || level /= "DEBUG") $ do-    let blevel = CB.toBuilder level+-- DEBUG level is 'Cyan', WARNING level is 'Yellow', FATAL and CRITICAL level are 'Red'.+coloredFmt :: LogFormatter+coloredFmt ts level content cstack = do+    let blevel = defaultLevelFmt level     B.square (case level of-        "DEBUG" -> color Cyan blevel-        "WARN"  -> color Yellow blevel-        "FATAL" -> color Red blevel-        _       -> blevel)+        DEBUG    -> color Cyan blevel+        WARNING  -> color Yellow blevel+        FATAL    -> color Red blevel+        CRITICAL -> color Red blevel+        _        -> blevel)     B.square ts     B.square $ defaultFmtCallStack cstack     content@@ -228,20 +257,76 @@  -------------------------------------------------------------------------------- -type Level = CB.CBytes+-- | Logging Levels+--+-- We following the Python logging levels, for details,+-- see: <https://docs.python.org/3/howto/logging.html#logging-levels>+--+-- +----------+---------------++-- | Level    | Numeric value |+-- +----------+---------------++-- | CRITICAL | 50            |+-- +----------+---------------++-- | FATAL    | 40            |+-- +----------+---------------++-- | WARNING  | 30            |+-- +----------+---------------++-- | INFO     | 20            |+-- +----------+---------------++-- | DEBUG    | 10            |+-- +----------+---------------++-- | NOTSET   | 0             |+-- +----------+---------------++--+type Level = Int +pattern CRITICAL :: Level+pattern CRITICAL = 50++pattern FATAL :: Level+pattern FATAL = 40++pattern WARNING :: Level+pattern WARNING = 30++pattern INFO :: Level+pattern INFO = 20++pattern DEBUG :: Level+pattern DEBUG = 10++pattern NOTSET :: Level+pattern NOTSET = 0++-- | Format 'DEBUG' to 'DEBUG', etc.+--+-- Level other than built-in ones, are formatted in decimal numeric format, i.e.+-- @defaultLevelFmt 60 == "LEVEL60"@+defaultLevelFmt :: Level -> B.Builder ()+defaultLevelFmt level = case level of+    CRITICAL -> "CRITICAL"+    FATAL    -> "FATAL"+    WARNING  -> "WARNING"+    INFO     -> "INFO"+    DEBUG    -> "DEBUG"+    NOTSET   -> "NOTSET"+    level'   -> "LEVEL" >> B.int level'+ debug :: HasCallStack => B.Builder () -> IO ()-debug = otherLevel_ "DEBUG" False callStack+debug = otherLevel_ DEBUG False callStack  info :: HasCallStack => B.Builder () -> IO ()-info = otherLevel_ "INFO" False callStack+info = otherLevel_ INFO False callStack -warn :: HasCallStack => B.Builder () -> IO ()-warn = otherLevel_ "WARN" False callStack+warning :: HasCallStack => B.Builder () -> IO ()+warning = otherLevel_ WARNING False callStack  fatal :: HasCallStack => B.Builder () -> IO ()-fatal = otherLevel_ "FATAL" True callStack+fatal = otherLevel_ FATAL True callStack +critical :: HasCallStack => B.Builder () -> IO ()+critical = otherLevel_ CRITICAL True callStack+ otherLevel :: HasCallStack            => Level             -- ^ log level            -> Bool              -- ^ flush immediately?@@ -257,16 +342,16 @@ --------------------------------------------------------------------------------  debugTo :: HasCallStack => Logger -> B.Builder () -> IO ()-debugTo = otherLevelTo_ "DEBUG" False callStack+debugTo = otherLevelTo_ DEBUG False callStack  infoTo :: HasCallStack => Logger -> B.Builder () -> IO ()-infoTo = otherLevelTo_ "INFO" False callStack+infoTo = otherLevelTo_ INFO False callStack -warnTo :: HasCallStack => Logger -> B.Builder () -> IO ()-warnTo = otherLevelTo_ "WARN" False callStack+warningTo :: HasCallStack => Logger -> B.Builder () -> IO ()+warningTo = otherLevelTo_ WARNING False callStack  fatalTo :: HasCallStack => Logger -> B.Builder () -> IO ()-fatalTo = otherLevelTo_ "FATAL" True callStack+fatalTo = otherLevelTo_ FATAL True callStack  otherLevelTo :: HasCallStack              => Logger@@ -278,7 +363,7 @@     otherLevelTo_ level flushNow callStack logger  otherLevelTo_ :: Level -> Bool -> CallStack -> Logger -> B.Builder () -> IO ()-otherLevelTo_ level flushNow cstack logger bu = do+otherLevelTo_ level flushNow cstack logger bu = when (level >= loggerLevel logger) $ do     ts <- loggerTSCache logger     (loggerPushBuilder logger) $ (loggerFmt logger) ts level bu cstack     if flushNow
Z/IO/Resource.hs view
@@ -27,6 +27,7 @@   , PoolState(..)   , initPool   , initInPool+  , withResourceInPool   , poolStat, poolInUse ) where @@ -43,7 +44,7 @@ -- | A 'Resource' is an 'IO' action which acquires some resource of type a and -- also returns a finalizer of type IO () that releases the resource. ----- The only safe way to use a 'Resource' is 'withResource' and 'withResource\'',+-- The only safe way to use a 'Resource' is 'withResource' and 'withResource'', -- You should not use the 'acquire' field directly, unless you want to implement your own -- resource management. In the later case, you should 'mask_' 'acquire' since -- some resource initializations may assume async exceptions are masked.@@ -288,3 +289,11 @@         | life > 1  = age es deadNum     dead     (Entry a (life-1):living)         | otherwise = age es (deadNum+1) (a:dead) living     age _ !deadNum dead living = (deadNum, dead, living)++-- | Open resource inside a given resource pool and do some computation.+--+withResourceInPool :: (MonadCatch.MonadMask m, MonadIO m, HasCallStack)+                   => Pool a -> (a -> m b) -> m b+withResourceInPool pool = withResource res+  where+    res = initInPool pool
Z/IO/StdStream.hs view
@@ -45,8 +45,9 @@   , stdin, stdout, stderr   , stdinBuf, stdoutBuf, stderrBuf     -- * utils-  , printStd   , readLineStd+  , printStd+  , printLineStd   , putStd   , putLineStd     -- * re-export@@ -208,7 +209,7 @@ --------------------------------------------------------------------------------  -- | Print a 'ShowT' and flush to stdout.-printStd :: HasCallStack => ShowT a => a -> IO ()+printStd :: (HasCallStack, ShowT a) => a -> IO () printStd s = putStd (toBuilder s)  -- | Print a 'Builder' and flush to stdout.@@ -216,6 +217,10 @@ putStd b = withMVar stdoutBuf $ \ o -> do     writeBuilder o b     flushBuffer o++-- | Print a 'ShowT' and flush to stdout, with a linefeed.+printLineStd :: (HasCallStack, ShowT a) => a -> IO ()+printLineStd s = putLineStd (toBuilder s)  -- | Print a 'Builder' and flush to stdout, with a linefeed. putLineStd :: HasCallStack => Builder a -> IO ()
Z/IO/Time.hs view
@@ -20,7 +20,7 @@     -- * Formatting   , formatSystemTime, formatSystemTimeGMT     -- * Format-  , TimeFormat, simpleDateFormat, webDateFormat, mailDateFormat+  , TimeFormat, simpleDateFormat, iso8061DateFormat, webDateFormat, mailDateFormat   ) where  import Data.Time.Clock.System@@ -40,6 +40,13 @@ -- This should be used with 'formatSystemTime' and 'parseSystemTime'. simpleDateFormat :: TimeFormat simpleDateFormat = "%Y-%m-%d %H:%M:%S"++-- | Simple format @2020-10-16T03:15:29@.+--+-- The value is \"%Y-%m-%dT%H:%M:%S%z\".+-- This should be used with 'formatSystemTime' and 'parseSystemTime'.+iso8061DateFormat :: TimeFormat+iso8061DateFormat = "%Y-%m-%dT%H:%M:%S%z"  -- | Format for web (RFC 2616). --
Z/IO/UV/FFI.hsc view
@@ -13,6 +13,7 @@  module Z.IO.UV.FFI where +import           Control.Monad import           Data.Bits import           Data.Int import           Data.Word@@ -22,7 +23,6 @@ import           Foreign.Ptr import           Foreign.Storable import           Z.Data.Array.Unaligned-import qualified Z.Data.Array  as A  import           Z.Data.Text.ShowT   (ShowT(..)) import           Z.Data.JSON         (EncodeJSON, ToValue, FromValue) import           Z.Data.CBytes as CBytes@@ -852,6 +852,10 @@ foreign import ccall unsafe uv_uptime :: MBA## Double -> IO CInt foreign import ccall unsafe uv_getrusage :: MBA## a -> IO CInt +foreign import ccall unsafe uv_get_free_memory :: IO Word64+foreign import ccall unsafe uv_get_total_memory :: IO Word64+foreign import ccall unsafe uv_get_constrained_memory :: IO Word64+ -- | Data type for storing times. -- typedef struct { long tv_sec; long tv_usec; } uv_timeval_t; data TimeVal = TimeVal @@ -947,6 +951,7 @@ pattern UV_MAXHOSTNAMESIZE = #const UV_MAXHOSTNAMESIZE foreign import ccall unsafe uv_os_gethostname :: MBA## Word8 -> MBA## CSize -> IO CInt +-- | Data type for operating system name and version information. data OSName = OSName     { os_sysname :: CBytes     , os_release :: CBytes@@ -957,7 +962,7 @@  getOSName :: IO OSName getOSName = do-    (A.MutablePrimArray mba## :: A.MutablePrimArray A.RealWorld Word8) <- A.newArr (#size uv_utsname_t)+    (MutableByteArray mba##) <- newByteArray (#size uv_utsname_t)     throwUVIfMinus_ (uv_os_uname mba##)     sn <- peekMBA mba## (#offset uv_utsname_t, sysname)     re <- peekMBA mba## (#offset uv_utsname_t, release)@@ -990,11 +995,11 @@ -- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty. getPassWD :: IO PassWD getPassWD =  bracket-    (do mpa@(A.MutablePrimArray mba## :: A.MutablePrimArray A.RealWorld Word8) <- A.newArr (#size uv_passwd_t)+    (do mpa@(MutableByteArray mba##) <- newByteArray (#size uv_passwd_t)         throwUVIfMinus_ (uv_os_get_passwd mba##)         return mpa)-    (\ (A.MutablePrimArray mba##) -> uv_os_free_passwd mba##)-    (\ (A.MutablePrimArray mba##) -> do+    (\ (MutableByteArray mba##) -> uv_os_free_passwd mba##)+    (\ (MutableByteArray mba##) -> do         username <- fromCString =<< peekMBA mba## (#offset uv_passwd_t, username)         uid <- fromIntegral <$> (peekMBA mba## (#offset uv_passwd_t, uid) :: IO CLong)         gid <- fromIntegral <$> (peekMBA mba## (#offset uv_passwd_t, gid) :: IO CLong)@@ -1006,3 +1011,50 @@ foreign import ccall unsafe uv_chdir :: BA## Word8 -> IO CInt foreign import ccall unsafe uv_os_homedir :: MBA## Word8 -> MBA## CSize -> IO CInt foreign import ccall unsafe uv_os_tmpdir :: MBA## Word8 -> MBA## CSize -> IO CInt++foreign import ccall unsafe uv_cpu_info      :: MBA## (Ptr CPUInfo) -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_free_cpu_info :: Ptr CPUInfo -> CInt -> IO ()++-- | Data type for CPU information.+data CPUInfo = CPUInfo+    { cpu_model :: CBytes+    , cpu_speed :: CInt+    , cpu_times_user :: Word64  -- ^ milliseconds +    , cpu_times_nice :: Word64  -- ^ milliseconds+    , cpu_times_sys  :: Word64  -- ^ milliseconds +    , cpu_times_idle :: Word64  -- ^ milliseconds  +    , cpu_times_irq  :: Word64  -- ^ milliseconds+    }   deriving (Eq, Ord, Show, Generic)+        deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)++-- | Gets information about the CPUs on the system.+getCPUInfo :: IO [CPUInfo]+getCPUInfo = bracket+    (do (p, (len, _)) <-  allocPrimUnsafe $ \ pp -> +            allocPrimUnsafe $ \ plen -> +                throwUVIfMinus_ (uv_cpu_info pp plen)+        return (p, len))+    (\ (p, len) -> uv_free_cpu_info p len)+    (\ (p, len) -> forM [0..fromIntegral len-1] (peekCPUInfoOff p))++peekCPUInfoOff :: Ptr CPUInfo -> Int -> IO CPUInfo+peekCPUInfoOff p off = do+    let p' = p `plusPtr` (off * (#size uv_cpu_info_t))+    model <- fromCString =<< (#peek uv_cpu_info_t, model) p'+    speed <- (#peek uv_cpu_info_t, speed) p'+    user <- (#peek uv_cpu_info_t, cpu_times.user) p'+    nice <- (#peek uv_cpu_info_t, cpu_times.nice) p'+    sys <- (#peek uv_cpu_info_t, cpu_times.sys) p'+    idle <- (#peek uv_cpu_info_t, cpu_times.idle) p'+    irq <- (#peek uv_cpu_info_t, cpu_times.irq) p'+    return (CPUInfo model speed user nice sys idle irq)++foreign import ccall unsafe uv_loadavg :: MBA## (Double, Double, Double) -> IO ()++-- | Gets the load average. See: <https://en.wikipedia.org/wiki/Load_(computing)>+getLoadAvg :: IO (Double, Double, Double)+getLoadAvg = do+    (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg +    return ( indexPrimArray arr 0+           , indexPrimArray arr 1+           , indexPrimArray arr 2)