diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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`. diff --git a/Z-IO.cabal b/Z-IO.cabal --- a/Z-IO.cabal +++ b/Z-IO.cabal @@ -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: diff --git a/Z/IO/Environment.hs b/Z/IO/Environment.hs --- a/Z/IO/Environment.hs +++ b/Z/IO/Environment.hs @@ -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). diff --git a/Z/IO/FileSystem/FilePath.hsc b/Z/IO/FileSystem/FilePath.hsc --- a/Z/IO/FileSystem/FilePath.hsc +++ b/Z/IO/FileSystem/FilePath.hsc @@ -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)] diff --git a/Z/IO/LowResTimer.hs b/Z/IO/LowResTimer.hs --- a/Z/IO/LowResTimer.hs +++ b/Z/IO/LowResTimer.hs @@ -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 diff --git a/Z/IO/Network/DNS.hsc b/Z/IO/Network/DNS.hsc --- a/Z/IO/Network/DNS.hsc +++ b/Z/IO/Network/DNS.hsc @@ -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 diff --git a/Z/IO/Network/SocketAddr.hsc b/Z/IO/Network/SocketAddr.hsc --- a/Z/IO/Network/SocketAddr.hsc +++ b/Z/IO/Network/SocketAddr.hsc @@ -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 diff --git a/Z/IO/Network/UDP.hs b/Z/IO/Network/UDP.hs --- a/Z/IO/Network/UDP.hs +++ b/Z/IO/Network/UDP.hs @@ -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 diff --git a/Z/IO/Process.hsc b/Z/IO/Process.hsc --- a/Z/IO/Process.hsc +++ b/Z/IO/Process.hsc @@ -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 diff --git a/Z/IO/StdStream.hs b/Z/IO/StdStream.hs --- a/Z/IO/StdStream.hs +++ b/Z/IO/StdStream.hs @@ -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)) - diff --git a/Z/IO/StdStream/Ansi.hs b/Z/IO/StdStream/Ansi.hs --- a/Z/IO/StdStream/Ansi.hs +++ b/Z/IO/StdStream/Ansi.hs @@ -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 diff --git a/Z/IO/Time.hs b/Z/IO/Time.hs --- a/Z/IO/Time.hs +++ b/Z/IO/Time.hs @@ -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) diff --git a/Z/IO/UV/Errno.hsc b/Z/IO/UV/Errno.hsc --- a/Z/IO/UV/Errno.hsc +++ b/Z/IO/UV/Errno.hsc @@ -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 diff --git a/Z/IO/UV/FFI.hsc b/Z/IO/UV/FFI.hsc --- a/Z/IO/UV/FFI.hsc +++ b/Z/IO/UV/FFI.hsc @@ -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 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: -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 . --- 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 diff --git a/Z/IO/UV/FFI_Env.hsc b/Z/IO/UV/FFI_Env.hsc new file mode 100644 --- /dev/null +++ b/Z/IO/UV/FFI_Env.hsc @@ -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 +#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 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: +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 . +-- 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) diff --git a/Z/IO/UV/Win.hs b/Z/IO/UV/Win.hs --- a/Z/IO/UV/Win.hs +++ b/Z/IO/UV/Win.hs @@ -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 -}