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 +7/−0
- Z-IO.cabal +2/−2
- Z/IO/Environment.hs +21/−2
- Z/IO/Exception.hs +1/−0
- Z/IO/FileSystem/FilePath.hsc +1/−1
- Z/IO/Logger.hs +176/−91
- Z/IO/Resource.hs +10/−1
- Z/IO/StdStream.hs +7/−2
- Z/IO/Time.hs +8/−1
- Z/IO/UV/FFI.hsc +57/−5
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)