Z-IO 0.6.2.0 → 0.6.3.0

raw patch · 16 files changed

+324/−259 lines, 16 filesdep −microlensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: microlens

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Z-IO.cabal +2/−2
• Z/IO/Environment.hs +1/−0
• Z/IO/FileSystem/FilePath.hsc +11/−3
• Z/IO/LowResTimer.hs +1/−1
• Z/IO/Network/DNS.hsc +1/−1
• Z/IO/Network/SocketAddr.hsc +1/−1
• Z/IO/Network/UDP.hs +9/−1
• Z/IO/Process.hsc +1/−0
• Z/IO/StdStream.hs +19/−11
• Z/IO/StdStream/Ansi.hs +1/−1
• Z/IO/Time.hs +1/−1
• Z/IO/UV/Errno.hsc +1/−1
• Z/IO/UV/FFI.hsc +2/−235
• Z/IO/UV/FFI_Env.hsc +266/−0
• Z/IO/UV/Win.hs +1/−1

@@ -1,5 +1,11 @@ # Revision history for Z-IO +## 0.6.3.0  -- 2020-02-20++* Split `Z.IO.UV.FFI` to `Z.IO.UV.FFI` and `Z.IO.UV.FFI_Env`, to make the module buildable when memory is constrained. +* Make functions works on TTY in `Z.IO.StdStream` correctly ignore redirected streams.+* Move `pathSeparator` to `pathSeparators`, now `pathSeparator` return the default path separator.+ ## 0.6.2.0  -- 2020-02-18  * Hide `Logger` constructor from `Z.IO.Logger`, remove implementation details such as `defaultTSCache`, `pushLogIORef`, `flushLogIORef`, add `loggerFormatter` to `LoggerConfig`.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-IO-version:            0.6.2.0+version:            0.6.3.0 synopsis:           Simple and high performance IO toolkit for Haskell description:   Simple and high performance IO toolkit for Haskell, including@@ -110,6 +110,7 @@     Z.IO.Time     Z.IO.UV.Errno     Z.IO.UV.FFI+    Z.IO.UV.FFI_Env     Z.IO.UV.Manager     Z.IO.UV.UVStream   other-modules:@@ -125,7 +126,6 @@     , unix-time             >=0.4.7 && <=0.5     , unordered-containers  ^>=0.2     , Z-Data                ^>=0.6-    , microlens    default-language:   Haskell2010   default-extensions:

@@ -43,6 +43,7 @@ import Z.IO.UV.Manager import Foreign.Storable import Z.IO.UV.FFI+import Z.IO.UV.FFI_Env  -- | Computation 'getArgs' returns a list of the program's command -- line arguments (including the program path).

@@ -31,7 +31,8 @@   , PathStyle(..)   , pathStyle   , getPathStyle, setPathStyle-  , pathSeparator, searchPathSeparator, extensionSeparator+  , pathSeparator, pathSeparators+  , searchPathSeparator, extensionSeparator   -- * Search path   , getSearchPath  ) where@@ -109,9 +110,16 @@ setPathStyle :: PathStyle -> IO () setPathStyle = cwk_path_set_style . pathStyleToEnum_ --- | Get the character that separates directories. -pathSeparator :: IO [Word8]+-- | Get the default character that separates directories. +pathSeparator :: IO Word8 pathSeparator = do+    s <- getPathStyle+    case s of UnixStyle -> return (#const SLASH)+              _         -> return (#const BACKSLASH)++-- | Get characters that separates directories. +pathSeparators :: IO [Word8]+pathSeparators = do     s <- getPathStyle     case s of UnixStyle -> return [(#const SLASH)]               _         -> return [(#const SLASH), (#const BACKSLASH)]

@@ -51,7 +51,7 @@ import           System.IO.Unsafe import           Z.Data.PrimRef.PrimIORef import           Z.IO.Exception-import           Z.IO.UV.FFI    (uv_hrtime)+import           Z.IO.UV.FFI_Env    (uv_hrtime)  -- queueSize :: Int

@@ -3,7 +3,7 @@ Description : DNS and reverse DNS Copyright   : (c) Winterland, 2018 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable 

@@ -3,7 +3,7 @@ Description : TCP\/UDP socket address API Copyright   : (c) Winterland, 2018 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable 

@@ -159,7 +159,15 @@             throwUVIfMinus_ (uv_udp_getsockname hdl paddr plen)  -- | Wrapper for a connected 'UDP'.-newtype ConnectedUDP = ConnectedUDP UDP deriving Show+newtype ConnectedUDP = ConnectedUDP UDP++instance Show ConnectedUDP where show = T.toString+instance T.Print ConnectedUDP where+    toUTF8BuilderP _ (ConnectedUDP (UDP hdl slot uvm _ _)) = do+        "ConnectedUDP{udpHandle="    >> T.toUTF8Builder hdl+        ",udpSlot="         >> T.toUTF8Builder slot+        ",udpManager="      >> T.toUTF8Builder uvm+        T.char7 '}'  -- | Associate the UDP handle to a remote address and port, -- so every message sent by this handle is automatically sent to that destination

@@ -79,6 +79,7 @@ import Z.IO.Network.IPC import Z.IO.Resource import Z.IO.UV.FFI+import Z.IO.UV.FFI_Env import Z.IO.UV.Manager import Z.IO.UV.UVStream 

@@ -38,8 +38,8 @@ module Z.IO.StdStream   ( -- * Standard input & output streams     StdStream-  , isStdStreamTTY   , getStdStreamFD+  , isStdStreamTTY   , setStdinTTYMode   , getStdoutWinSize   , stdin, stdout, stderr@@ -87,6 +87,7 @@ instance Show StdStream where show = T.toString  instance T.Print StdStream where+    {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP p (StdStream istty ptr slot uvm) = T.parenWhen (p > 10) $ do         if istty         then "StdStream(TTY) "@@ -100,10 +101,13 @@         "StdFile "         T.toUTF8Builder fd ++-- | Is this standard stream connected to a TTY device? isStdStreamTTY :: StdStream -> Bool isStdStreamTTY (StdStream istty _ _ _) = istty isStdStreamTTY _                       = False +-- | Get the standard stream's OS file descriptor. getStdStreamFD :: StdStream -> IO FD getStdStreamFD (StdStream _ hdl _ _) = throwUVIfMinus (hs_uv_fileno hdl) getStdStreamFD (StdFile fd) = return fd@@ -165,33 +169,37 @@  -- | The global stdout stream. ----- | If you want to write logs, don't use 'stdout' directly, use 'Z.IO.Logger' instead.+-- If you want a buffered device, consider use the 'stdoutBuf' first.+-- If you want to write logs, don't use 'stdout' directly, use 'Z.IO.Logger' instead. stdout :: StdStream {-# NOINLINE stdout #-} stdout = unsafePerformIO (makeStdStream 1)  -- | The global stderr stream. --+-- If you want a buffered device, consider use the 'stderrBuf' first. -- | If you want to write logs, don't use 'stderr' directly, use 'Z.IO.Logger' instead. stderr :: StdStream {-# NOINLINE stderr #-} stderr = unsafePerformIO (makeStdStream 2)  -- |  A global buffered stdin stream protected by 'MVar'.+--+-- If you want a buffered device, consider use the 'stdinBuf' first. stdinBuf :: MVar BufferedInput {-# NOINLINE stdinBuf #-} stdinBuf = unsafePerformIO (newBufferedInput stdin >>= newMVar) --- |  A global buffered stdout stream protected by 'MVar'.+-- | A global buffered stdout stream protected by 'MVar'. ----- | If you want to write logs, don't use 'stdoutBuf' directly, use 'Z.IO.Logger' instead.+-- If you want to write logs, don't use 'stdoutBuf' directly, use 'Z.IO.Logger' instead. stdoutBuf :: MVar BufferedOutput {-# NOINLINE stdoutBuf #-} stdoutBuf = unsafePerformIO (newBufferedOutput stdout >>= newMVar) --- |  A global buffered stderr stream protected by 'MVar'.+-- | A global buffered stderr stream protected by 'MVar'. ----- | If you want to write logs, don't use 'stderrBuf' directly, use 'Z.IO.Logger' instead.+-- If you want to write logs, don't use 'stderrBuf' directly, use 'Z.IO.Logger' instead. stderrBuf :: MVar BufferedOutput {-# NOINLINE stderrBuf #-} stderrBuf = unsafePerformIO (newBufferedOutput stderr >>= newMVar)@@ -228,18 +236,19 @@                     throwUVIfMinus_ (uv_pipe_open hdl fd)                     return (StdStream False hdl slot uvm) --- | Change terminal's mode if stdin is connected to a terminal.+-- | Change terminal's mode if stdin is connected to a terminal,+-- do nothing if stdout is not connected to TTY. setStdinTTYMode :: TTYMode -> IO () setStdinTTYMode mode = case stdin of-    StdStream _ hdl _ uvm ->+    StdStream True hdl _ uvm ->         withUVManager' uvm . throwUVIfMinus_ $ uv_tty_set_mode hdl mode     _ -> return ()  -- | Get terminal's output window size in (width, height) format,--- return (-1, -1) if stdout is a file.+-- return (-1, -1) if stdout is not connected to TTY. getStdoutWinSize :: HasCallStack => IO (CInt, CInt) getStdoutWinSize = case stdout of-    StdStream _ hdl _ uvm ->+    StdStream True hdl _ uvm ->         withUVManager' uvm $ do             (w, (h, ())) <- allocPrimUnsafe $ \ w ->                 allocPrimUnsafe $ \ h -> throwUVIfMinus_ $ uv_tty_get_winsize hdl w h@@ -268,4 +277,3 @@     case line of Just line' -> return line'                  Nothing    -> throwIO (ResourceVanished                     (IOEInfo "ECLOSED" "stdin is closed" callStack))-

@@ -3,7 +3,7 @@ Description : Ansi control code sequences Copyright   : (c) Winterland, 2017-2020 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable 

@@ -29,7 +29,7 @@ import Foreign.C.Types import Z.Foreign import Z.Data.CBytes-import Z.IO.UV.FFI+import Z.IO.UV.FFI_Env import Z.IO.Exception import System.IO.Unsafe (unsafePerformIO) 

@@ -3,7 +3,7 @@ Description : Errno provided by libuv Copyright   : (c) Winterland, 2017-2018 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable 

@@ -3,17 +3,16 @@ Description : libuv operations Copyright   : (c) Winterland, 2017-2018 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable -INTERNAL MODULE, provides all libuv side operations.+INTERNAL MODULE, provides all libuv side operations(env related is moved to FFI_ENV).  -}  module Z.IO.UV.FFI where -import           Control.Monad import           Data.Bits import           Data.Int import           Data.Word@@ -27,7 +26,6 @@ import           Z.Data.JSON         (JSON) import           Z.Data.CBytes as CBytes import           Z.Foreign-import           Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack) import           Z.IO.Network.SocketAddr    (SocketAddr) import           System.Posix.Types (CSsize (..)) import           GHC.Generics@@ -885,237 +883,6 @@ pattern UV_FILE = #const UV_FILE  foreign import ccall unsafe uv_guess_handle :: FD -> IO UVHandleType--foreign import ccall unsafe uv_resident_set_memory :: MBA## CSize -> IO CInt-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-    { tv_sec  :: {-# UNPACK #-} !CLong-    , tv_usec :: {-# UNPACK #-} !CLong-    }   deriving (Show, Read, Eq, Ord, Generic)-        deriving anyclass (Print, JSON)---- | Data type for resource usage results.------ Members marked with (X) are unsupported on Windows.--- See <https://man7.org/linux/man-pages/man2/getrusage.2.html getrusage(2)> for supported fields on Unix-data ResUsage = ResUsage-    { ru_utime    :: {-# UNPACK #-} !TimeVal   -- ^  user CPU time used, in microseconds-    , ru_stime    :: {-# UNPACK #-} !TimeVal   -- ^  system CPU time used, in microseconds-    , ru_maxrss   :: {-# UNPACK #-} !Word64    -- ^  maximum resident set size-    , ru_ixrss    :: {-# UNPACK #-} !Word64    -- ^  integral shared memory size (X)-    , ru_idrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared data size (X)-    , ru_isrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared stack size (X)-    , ru_minflt   :: {-# UNPACK #-} !Word64    -- ^  page reclaims (soft page faults) (X)-    , ru_majflt   :: {-# UNPACK #-} !Word64    -- ^  page faults (hard page faults)-    , ru_nswap    :: {-# UNPACK #-} !Word64    -- ^  swaps (X)-    , ru_inblock  :: {-# UNPACK #-} !Word64    -- ^  block input operations-    , ru_oublock  :: {-# UNPACK #-} !Word64    -- ^  block output operations-    , ru_msgsnd   :: {-# UNPACK #-} !Word64    -- ^  IPC messages sent (X)-    , ru_msgrcv   :: {-# UNPACK #-} !Word64    -- ^  IPC messages received (X)-    , ru_nsignals :: {-# UNPACK #-} !Word64    -- ^  signals received (X)-    , ru_nvcsw    :: {-# UNPACK #-} !Word64    -- ^  voluntary context switches (X)-    , ru_nivcsw   :: {-# UNPACK #-} !Word64    -- ^  involuntary context switches (X)-    }   deriving (Show, Read, Eq, Ord, Generic)-        deriving anyclass (Print, JSON)--sizeOfResUsage :: Int-sizeOfResUsage = #size uv_rusage_t--peekResUsage :: MBA## a -> IO ResUsage-peekResUsage mba = do-    utime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_utime )-    utime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_utime) + sizeOf (undefined :: CLong))-    stime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_stime )-    stime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_stime) + sizeOf (undefined :: CLong))-    maxrss   <- peekMBA mba (#offset  uv_rusage_t, ru_maxrss  )-    ixrss    <- peekMBA mba (#offset  uv_rusage_t, ru_ixrss   )-    idrss    <- peekMBA mba (#offset  uv_rusage_t, ru_idrss   )-    isrss    <- peekMBA mba (#offset  uv_rusage_t, ru_isrss   )-    minflt   <- peekMBA mba (#offset  uv_rusage_t, ru_minflt  )-    majflt   <- peekMBA mba (#offset  uv_rusage_t, ru_majflt  )-    nswap    <- peekMBA mba (#offset  uv_rusage_t, ru_nswap   )-    inblock  <- peekMBA mba (#offset  uv_rusage_t, ru_inblock )-    oublock  <- peekMBA mba (#offset  uv_rusage_t, ru_oublock )-    msgsnd   <- peekMBA mba (#offset  uv_rusage_t, ru_msgsnd  )-    msgrcv   <- peekMBA mba (#offset  uv_rusage_t, ru_msgrcv  )-    nsignals <- peekMBA mba (#offset  uv_rusage_t, ru_nsignals)-    nvcsw    <- peekMBA mba (#offset  uv_rusage_t, ru_nvcsw   )-    nivcsw   <- peekMBA mba (#offset  uv_rusage_t, ru_nivcsw  )-    return (ResUsage (TimeVal utime_sec utime_usec) (TimeVal stime_sec stime_usec)-                    maxrss ixrss idrss isrss minflt majflt nswap inblock-                    oublock msgsnd msgrcv nsignals nvcsw nivcsw)--foreign import ccall unsafe uv_os_getpid :: IO PID-foreign import ccall unsafe uv_os_getppid :: IO PID-foreign import ccall unsafe uv_os_getpriority :: PID -> MBA## CInt -> IO CInt-foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt--newtype PID = PID CInt-    deriving (Eq, Ord, Show, Read, Generic)-    deriving newtype (Storable, Prim, Unaligned, JSON)-    deriving anyclass Print--type Priority = CInt-pattern PRIORITY_LOW          :: Priority-pattern PRIORITY_BELOW_NORMAL :: Priority-pattern PRIORITY_NORMAL       :: Priority-pattern PRIORITY_ABOVE_NORMAL :: Priority-pattern PRIORITY_HIGH         :: Priority-pattern PRIORITY_HIGHEST      :: Priority-pattern PRIORITY_LOW           = #const UV_PRIORITY_LOW-pattern PRIORITY_BELOW_NORMAL  = #const UV_PRIORITY_BELOW_NORMAL-pattern PRIORITY_NORMAL        = #const UV_PRIORITY_NORMAL-pattern PRIORITY_ABOVE_NORMAL  = #const UV_PRIORITY_ABOVE_NORMAL-pattern PRIORITY_HIGH          = #const UV_PRIORITY_HIGH-pattern PRIORITY_HIGHEST       = #const UV_PRIORITY_HIGHEST--foreign import ccall unsafe uv_hrtime :: IO Word64--foreign import ccall unsafe uv_os_environ :: MBA## (Ptr a) -> MBA## CInt -> IO CInt-foreign import ccall unsafe uv_os_free_environ :: Ptr a -> CInt -> IO ()-foreign import ccall unsafe uv_os_getenv :: BA## Word8 -> MBA## Word8 -> MBA## CSize -> IO CInt-foreign import ccall unsafe uv_os_setenv :: BA## Word8 -> BA## Word8 -> IO CInt-foreign import ccall unsafe uv_os_unsetenv :: BA## Word8 -> IO CInt--pattern UV_MAXHOSTNAMESIZE :: CSize-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-    , os_version :: CBytes-    , os_machine :: CBytes-    }   deriving (Eq, Ord, Show, Read, Generic)-        deriving anyclass (Print, JSON)--getOSName :: HasCallStack => IO OSName-getOSName = do-    (MutableByteArray mba##) <- newByteArray (#size uv_utsname_t)-    throwUVIfMinus_ (uv_os_uname mba##)-    sn <- peekMBACBytes mba## (#offset uv_utsname_t, sysname)-    re <- peekMBACBytes mba## (#offset uv_utsname_t, release)-    ve <- peekMBACBytes mba## (#offset uv_utsname_t, version)-    ma <- peekMBACBytes mba##  (#offset uv_utsname_t, machine)-    return (OSName sn re ve ma)--foreign import ccall unsafe uv_os_uname :: MBA## OSName -> IO CInt--foreign import ccall unsafe hs_uv_random :: MBA## Word8 -> CSize -> CInt -> IO CInt-foreign import ccall unsafe hs_uv_random_threaded :: Ptr Word8 -> CSize -> CInt -> Ptr UVLoop -> IO UVSlotUnsafe---- | Data type for password file information.-data PassWD = PassWD-    { passwd_username :: CBytes-    , passwd_uid :: UID-    , passwd_gid :: GID-    , passwd_shell :: CBytes-    , passwd_homedir :: CBytes-    }   deriving (Eq, Ord, Show, Read, Generic)-        deriving anyclass (Print, JSON)--foreign import ccall unsafe uv_os_get_passwd :: MBA## PassWD -> IO CInt-foreign import ccall unsafe uv_os_free_passwd :: MBA## PassWD -> IO ()---- | Gets a subset of the password file entry for the current effective uid (not the real uid).------ The populated data includes the username, euid, gid, shell, and home directory.--- On non-Windows systems, all data comes from getpwuid_r(3).--- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty.-getPassWD :: HasCallStack => IO PassWD-getPassWD =  bracket-    (do mpa@(MutableByteArray mba##) <- newByteArray (#size uv_passwd_t)-        throwUVIfMinus_ (uv_os_get_passwd mba##)-        return mpa)-    (\ (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)-        shell <- fromCString =<< peekMBA mba## (#offset uv_passwd_t, shell)-        homedir <- fromCString =<< peekMBA mba## (#offset uv_passwd_t, homedir)-        return (PassWD username uid gid shell homedir))--foreign import ccall unsafe uv_cwd :: MBA## Word8 -> MBA## CSize -> IO CInt-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, Read, Generic)-        deriving anyclass (Print, JSON)---- | Gets information about the CPUs on the system.-getCPUInfo :: HasCallStack => 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)---- | Alternative data type for storing times.--- typedef struct { int64_t tv_sec; int32_t tv_usec; } uv_timeval64_t;-data TimeVal64 = TimeVal64-    { tv64_sec  :: {-# UNPACK #-} !Int64-    , tv64_usec :: {-# UNPACK #-} !Int32-    }   deriving (Show, Read, Eq, Ord, Generic)-        deriving anyclass (Print, JSON)--foreign import ccall unsafe uv_gettimeofday :: MBA## TimeVal64 -> IO CInt---- | Cross-platform implementation of <https://man7.org/linux/man-pages/man2/gettimeofday.2.html gettimeofday(2)>.--- The timezone argument to gettimeofday() is not supported, as it is considered obsolete.-getTimeOfDay :: HasCallStack => IO TimeVal64-getTimeOfDay = do-    (MutableByteArray mba##) <- newByteArray (#size uv_timeval64_t)-    throwUVIfMinus_ (uv_gettimeofday mba##)-    s <- peekMBA mba## (#offset uv_timeval64_t, tv_sec)-    us <- peekMBA mba## (#offset uv_timeval64_t, tv_usec)-    return (TimeVal64 s us)  -------------------------------------------------------------------------------- -- fs event

@@ -0,0 +1,266 @@+{-|+Module      : Z.IO.UV.FFI_Env+Description : libuv operations+Copyright   : (c) Winterland, 2020+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++INTERNAL MODULE, split from "Z.IO.UV.FFI" to make it buildable under constrained memory.++-}++module Z.IO.UV.FFI_Env where++import           Control.Monad+import           Data.Int+import           Data.Word+import           Data.Primitive.Types   (Prim)+import           Foreign.C.Types+import           Foreign.Ptr+import           Foreign.Storable+import           Z.Data.Array.Unaligned+import           Z.Data.Text.Print   (Print(..))+import           Z.Data.JSON         (JSON)+import           Z.Data.CBytes as CBytes+import           Z.Foreign+import           Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack)+import           GHC.Generics+import           Z.IO.UV.FFI++#include "hs_uv.h"+#if HAVE_UNISTD_H+#include <unistd.h>+#endif++foreign import ccall unsafe uv_resident_set_memory :: MBA## CSize -> IO CInt+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+    { tv_sec  :: {-# UNPACK #-} !CLong+    , tv_usec :: {-# UNPACK #-} !CLong+    }   deriving (Show, Read, Eq, Ord, Generic)+        deriving anyclass (Print, JSON)++-- | Data type for resource usage results.+--+-- Members marked with (X) are unsupported on Windows.+-- See <https://man7.org/linux/man-pages/man2/getrusage.2.html getrusage(2)> for supported fields on Unix+data ResUsage = ResUsage+    { ru_utime    :: {-# UNPACK #-} !TimeVal   -- ^  user CPU time used, in microseconds+    , ru_stime    :: {-# UNPACK #-} !TimeVal   -- ^  system CPU time used, in microseconds+    , ru_maxrss   :: {-# UNPACK #-} !Word64    -- ^  maximum resident set size+    , ru_ixrss    :: {-# UNPACK #-} !Word64    -- ^  integral shared memory size (X)+    , ru_idrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared data size (X)+    , ru_isrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared stack size (X)+    , ru_minflt   :: {-# UNPACK #-} !Word64    -- ^  page reclaims (soft page faults) (X)+    , ru_majflt   :: {-# UNPACK #-} !Word64    -- ^  page faults (hard page faults)+    , ru_nswap    :: {-# UNPACK #-} !Word64    -- ^  swaps (X)+    , ru_inblock  :: {-# UNPACK #-} !Word64    -- ^  block input operations+    , ru_oublock  :: {-# UNPACK #-} !Word64    -- ^  block output operations+    , ru_msgsnd   :: {-# UNPACK #-} !Word64    -- ^  IPC messages sent (X)+    , ru_msgrcv   :: {-# UNPACK #-} !Word64    -- ^  IPC messages received (X)+    , ru_nsignals :: {-# UNPACK #-} !Word64    -- ^  signals received (X)+    , ru_nvcsw    :: {-# UNPACK #-} !Word64    -- ^  voluntary context switches (X)+    , ru_nivcsw   :: {-# UNPACK #-} !Word64    -- ^  involuntary context switches (X)+    }   deriving (Show, Read, Eq, Ord, Generic)+        deriving anyclass (Print, JSON)++sizeOfResUsage :: Int+sizeOfResUsage = #size uv_rusage_t++peekResUsage :: MBA## a -> IO ResUsage+peekResUsage mba = do+    utime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_utime )+    utime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_utime) + sizeOf (undefined :: CLong))+    stime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_stime )+    stime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_stime) + sizeOf (undefined :: CLong))+    maxrss   <- peekMBA mba (#offset  uv_rusage_t, ru_maxrss  )+    ixrss    <- peekMBA mba (#offset  uv_rusage_t, ru_ixrss   )+    idrss    <- peekMBA mba (#offset  uv_rusage_t, ru_idrss   )+    isrss    <- peekMBA mba (#offset  uv_rusage_t, ru_isrss   )+    minflt   <- peekMBA mba (#offset  uv_rusage_t, ru_minflt  )+    majflt   <- peekMBA mba (#offset  uv_rusage_t, ru_majflt  )+    nswap    <- peekMBA mba (#offset  uv_rusage_t, ru_nswap   )+    inblock  <- peekMBA mba (#offset  uv_rusage_t, ru_inblock )+    oublock  <- peekMBA mba (#offset  uv_rusage_t, ru_oublock )+    msgsnd   <- peekMBA mba (#offset  uv_rusage_t, ru_msgsnd  )+    msgrcv   <- peekMBA mba (#offset  uv_rusage_t, ru_msgrcv  )+    nsignals <- peekMBA mba (#offset  uv_rusage_t, ru_nsignals)+    nvcsw    <- peekMBA mba (#offset  uv_rusage_t, ru_nvcsw   )+    nivcsw   <- peekMBA mba (#offset  uv_rusage_t, ru_nivcsw  )+    return (ResUsage (TimeVal utime_sec utime_usec) (TimeVal stime_sec stime_usec)+                    maxrss ixrss idrss isrss minflt majflt nswap inblock+                    oublock msgsnd msgrcv nsignals nvcsw nivcsw)++foreign import ccall unsafe uv_os_getpid :: IO PID+foreign import ccall unsafe uv_os_getppid :: IO PID+foreign import ccall unsafe uv_os_getpriority :: PID -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt++newtype PID = PID CInt+    deriving (Eq, Ord, Show, Read, Generic)+    deriving newtype (Storable, Prim, Unaligned, JSON)+    deriving anyclass Print++type Priority = CInt+pattern PRIORITY_LOW          :: Priority+pattern PRIORITY_BELOW_NORMAL :: Priority+pattern PRIORITY_NORMAL       :: Priority+pattern PRIORITY_ABOVE_NORMAL :: Priority+pattern PRIORITY_HIGH         :: Priority+pattern PRIORITY_HIGHEST      :: Priority+pattern PRIORITY_LOW           = #const UV_PRIORITY_LOW+pattern PRIORITY_BELOW_NORMAL  = #const UV_PRIORITY_BELOW_NORMAL+pattern PRIORITY_NORMAL        = #const UV_PRIORITY_NORMAL+pattern PRIORITY_ABOVE_NORMAL  = #const UV_PRIORITY_ABOVE_NORMAL+pattern PRIORITY_HIGH          = #const UV_PRIORITY_HIGH+pattern PRIORITY_HIGHEST       = #const UV_PRIORITY_HIGHEST++foreign import ccall unsafe uv_hrtime :: IO Word64++foreign import ccall unsafe uv_os_environ :: MBA## (Ptr a) -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_os_free_environ :: Ptr a -> CInt -> IO ()+foreign import ccall unsafe uv_os_getenv :: BA## Word8 -> MBA## Word8 -> MBA## CSize -> IO CInt+foreign import ccall unsafe uv_os_setenv :: BA## Word8 -> BA## Word8 -> IO CInt+foreign import ccall unsafe uv_os_unsetenv :: BA## Word8 -> IO CInt++pattern UV_MAXHOSTNAMESIZE :: CSize+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+    , os_version :: CBytes+    , os_machine :: CBytes+    }   deriving (Eq, Ord, Show, Read, Generic)+        deriving anyclass (Print, JSON)++getOSName :: HasCallStack => IO OSName+getOSName = do+    (MutableByteArray mba##) <- newByteArray (#size uv_utsname_t)+    throwUVIfMinus_ (uv_os_uname mba##)+    sn <- peekMBACBytes mba## (#offset uv_utsname_t, sysname)+    re <- peekMBACBytes mba## (#offset uv_utsname_t, release)+    ve <- peekMBACBytes mba## (#offset uv_utsname_t, version)+    ma <- peekMBACBytes mba##  (#offset uv_utsname_t, machine)+    return (OSName sn re ve ma)++foreign import ccall unsafe uv_os_uname :: MBA## OSName -> IO CInt++foreign import ccall unsafe hs_uv_random :: MBA## Word8 -> CSize -> CInt -> IO CInt+foreign import ccall unsafe hs_uv_random_threaded :: Ptr Word8 -> CSize -> CInt -> Ptr UVLoop -> IO UVSlotUnsafe++-- | Data type for password file information.+data PassWD = PassWD+    { passwd_username :: CBytes+    , passwd_uid :: UID+    , passwd_gid :: GID+    , passwd_shell :: CBytes+    , passwd_homedir :: CBytes+    }   deriving (Eq, Ord, Show, Read, Generic)+        deriving anyclass (Print, JSON)++foreign import ccall unsafe uv_os_get_passwd :: MBA## PassWD -> IO CInt+foreign import ccall unsafe uv_os_free_passwd :: MBA## PassWD -> IO ()++-- | Gets a subset of the password file entry for the current effective uid (not the real uid).+--+-- The populated data includes the username, euid, gid, shell, and home directory.+-- On non-Windows systems, all data comes from getpwuid_r(3).+-- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty.+getPassWD :: HasCallStack => IO PassWD+getPassWD =  bracket+    (do mpa@(MutableByteArray mba##) <- newByteArray (#size uv_passwd_t)+        throwUVIfMinus_ (uv_os_get_passwd mba##)+        return mpa)+    (\ (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)+        shell <- fromCString =<< peekMBA mba## (#offset uv_passwd_t, shell)+        homedir <- fromCString =<< peekMBA mba## (#offset uv_passwd_t, homedir)+        return (PassWD username uid gid shell homedir))++foreign import ccall unsafe uv_cwd :: MBA## Word8 -> MBA## CSize -> IO CInt+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, Read, Generic)+        deriving anyclass (Print, JSON)++-- | Gets information about the CPUs on the system.+getCPUInfo :: HasCallStack => 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)++-- | Alternative data type for storing times.+-- typedef struct { int64_t tv_sec; int32_t tv_usec; } uv_timeval64_t;+data TimeVal64 = TimeVal64+    { tv64_sec  :: {-# UNPACK #-} !Int64+    , tv64_usec :: {-# UNPACK #-} !Int32+    }   deriving (Show, Read, Eq, Ord, Generic)+        deriving anyclass (Print, JSON)++foreign import ccall unsafe uv_gettimeofday :: MBA## TimeVal64 -> IO CInt++-- | Cross-platform implementation of <https://man7.org/linux/man-pages/man2/gettimeofday.2.html gettimeofday(2)>.+-- The timezone argument to gettimeofday() is not supported, as it is considered obsolete.+getTimeOfDay :: HasCallStack => IO TimeVal64+getTimeOfDay = do+    (MutableByteArray mba##) <- newByteArray (#size uv_timeval64_t)+    throwUVIfMinus_ (uv_gettimeofday mba##)+    s <- peekMBA mba## (#offset uv_timeval64_t, tv_sec)+    us <- peekMBA mba## (#offset uv_timeval64_t, tv_usec)+    return (TimeVal64 s us)

@@ -3,7 +3,7 @@ Description : Special code on windows Copyright   : (c) Winterland, 2017-2018 License     : BSD-Maintainer  : drkoster@qq.com+Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable -}