diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for Z-IO +## 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`. +* Add `newStdLogger/newFileLogger` to make new logger easily. +* Rework `Z.IO.FileSystem.Watch`'s API, change `watchDirs` to accept a recursive param and a callback. +* Hide `Z.IO.UV.Win` module, which should not be directly used by user. +* Fix a bug when stdio is redirected to pipes: https://github.com/ZHaskell/z-io/pull/16 + ## 0.6.1.0 -- 2020-02-09 * Fix a bug in `newMagicSplitter/newLineSplitter` code. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -32,7 +32,7 @@ > > -- call getAddrInfo to perform DNS > head <$> getAddrInfo Nothing "www.bing.com" "http" -AddrInfo {addrFlags = [AI_ADDRCONFIG,AI_V4MAPPED], addrFamily = SocketFamily 2, addrSocketType = SocketType 1, addrProtocol = ProtocolNumber 6, addrAddress = 204.79.197.200:80, addrCanonName = } +AddrInfo {addrFlags = [AI_ADDRCONFIG,AI_V4MAPPED], addrFamily = SocketFamily 2, addrSocketType = SocketType 1, addrProtocol = ProtocolNumber 6, addrAddress = 204.79.197.200:80, addrCanonName = ""} > > import qualified Z.Data.Text as T > -- send a simple HTTP request diff --git a/Z-IO.cabal b/Z-IO.cabal --- a/Z-IO.cabal +++ b/Z-IO.cabal @@ -1,393 +1,425 @@ -cabal-version: 2.4 -name: Z-IO -version: 0.6.1.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! -license: BSD-3-Clause -license-file: LICENSE -author: Z.Haskell Contributors -maintainer: winterland1989@gmail.com -copyright: (c) Z.Haskell Contributors -category: Data -build-type: Simple -homepage: https://github.com/ZHaskell/Z-IO -bug-reports: https://github.com/ZHaskell/Z-IO/issues - -extra-source-files: ChangeLog.md - README.md - LICENSE - - -- shared Haskell soruce - Z/IO/FileSystem/_Shared.hs - - -- zlib C sources - third_party/zlib/crc32.h - third_party/zlib/inffast.h - third_party/zlib/inflate.h - third_party/zlib/trees.h - third_party/zlib/deflate.h - third_party/zlib/inffixed.h - third_party/zlib/inftrees.h - third_party/zlib/zutil.h - third_party/zlib/gzguts.h - - -- cwalk header - third_party/cwalk/include/cwalk.h - - -- libuv C sources - third_party/libuv/include/uv.h - third_party/libuv/include/uv/aix.h - third_party/libuv/include/uv/android-ifaddrs.h - third_party/libuv/include/uv/bsd.h - third_party/libuv/include/uv/darwin.h - third_party/libuv/include/uv/errno.h - third_party/libuv/include/uv/linux.h - third_party/libuv/include/uv/os390.h - third_party/libuv/include/uv/posix.h - third_party/libuv/include/uv/stdint-msvc2008.h - third_party/libuv/include/uv/sunos.h - third_party/libuv/include/uv/threadpool.h - third_party/libuv/include/uv/tree.h - third_party/libuv/include/uv/unix.h - third_party/libuv/include/uv/version.h - third_party/libuv/include/uv/win.h - - third_party/libuv/src/heap-inl.h - third_party/libuv/src/idna.h - third_party/libuv/src/queue.h - third_party/libuv/src/strscpy.h - third_party/libuv/src/uv-common.h - - third_party/libuv/src/win/atomicops-inl.h - third_party/libuv/src/win/fs-fd-hash-inl.h - third_party/libuv/src/win/handle-inl.h - third_party/libuv/src/win/internal.h - third_party/libuv/src/win/req-inl.h - third_party/libuv/src/win/stream-inl.h - third_party/libuv/src/win/winapi.h - third_party/libuv/src/win/winsock.h +cabal-version: 2.4 +name: Z-IO +version: 0.6.2.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! - third_party/libuv/src/unix/atomic-ops.h - third_party/libuv/src/unix/darwin-stub.h - third_party/libuv/src/unix/darwin-stub.h - third_party/libuv/src/unix/internal.h - third_party/libuv/src/unix/linux-syscalls.h - third_party/libuv/src/unix/spinlock.h - third_party/libuv/src/unix/os390-syscalls.h +license: BSD-3-Clause +license-file: LICENSE +author: Z.Haskell Contributors +maintainer: winterland1989@gmail.com +copyright: (c) Z.Haskell Contributors +category: Data +build-type: Simple +homepage: https://github.com/ZHaskell/Z-IO +bug-reports: https://github.com/ZHaskell/Z-IO/issues +extra-source-files: + ChangeLog.md + LICENSE + README.md + third_party/cwalk/include/cwalk.h + third_party/libuv/include/uv/aix.h + third_party/libuv/include/uv/android-ifaddrs.h + third_party/libuv/include/uv/bsd.h + third_party/libuv/include/uv/darwin.h + third_party/libuv/include/uv/errno.h + third_party/libuv/include/uv/linux.h + third_party/libuv/include/uv/os390.h + third_party/libuv/include/uv/posix.h + third_party/libuv/include/uv/stdint-msvc2008.h + third_party/libuv/include/uv/sunos.h + third_party/libuv/include/uv/threadpool.h + third_party/libuv/include/uv/tree.h + third_party/libuv/include/uv/unix.h + third_party/libuv/include/uv/version.h + third_party/libuv/include/uv/win.h + third_party/libuv/include/uv.h + third_party/libuv/src/heap-inl.h + third_party/libuv/src/idna.h + third_party/libuv/src/queue.h + third_party/libuv/src/strscpy.h + third_party/libuv/src/unix/atomic-ops.h + third_party/libuv/src/unix/darwin-stub.h + third_party/libuv/src/unix/internal.h + third_party/libuv/src/unix/linux-syscalls.h + third_party/libuv/src/unix/os390-syscalls.h + third_party/libuv/src/unix/spinlock.h + third_party/libuv/src/uv-common.h + third_party/libuv/src/win/atomicops-inl.h + third_party/libuv/src/win/fs-fd-hash-inl.h + third_party/libuv/src/win/handle-inl.h + third_party/libuv/src/win/internal.h + third_party/libuv/src/win/req-inl.h + third_party/libuv/src/win/stream-inl.h + third_party/libuv/src/win/winapi.h + third_party/libuv/src/win/winsock.h + third_party/zlib/crc32.h + third_party/zlib/deflate.h + third_party/zlib/gzguts.h + third_party/zlib/inffast.h + third_party/zlib/inffixed.h + third_party/zlib/inflate.h + third_party/zlib/inftrees.h + third_party/zlib/trees.h + third_party/zlib/zutil.h + Z/IO/FileSystem/_Shared.hs source-repository head - type: git - location: git://github.com/ZHaskell/Z-IO.git + type: git + location: git://github.com/ZHaskell/z-io.git -flag no-pkg-config - description: Don't use pkg-config to check for library dependences(on platforms other than linux, win and osx) - default: False - manual: True +flag demos + description: Build benchamrk/demonstration programs + default: False -library - exposed-modules: Z.IO - Z.IO.BIO - Z.IO.BIO.Zlib - Z.IO.BIO.Concurrent +flag no-pkg-config + description: + Don't use pkg-config to check for library dependences(on platforms other than linux, win and osx) - Z.IO.FileSystem - Z.IO.FileSystem.Base - Z.IO.FileSystem.Threaded - Z.IO.FileSystem.FilePath - Z.IO.FileSystem.Watch + default: False + manual: True - Z.IO.Network.SocketAddr - Z.IO.Network.DNS - Z.IO.Network.TCP - Z.IO.Network.UDP - Z.IO.Network.IPC - Z.IO.Network - Z.IO.Buffered - Z.IO.Exception - Z.IO.LowResTimer - Z.IO.Logger - Z.IO.Process - Z.IO.Resource - Z.IO.StdStream - Z.IO.StdStream.Ansi - Z.IO.Time +library + exposed-modules: + Z.IO + Z.IO.BIO + Z.IO.BIO.Concurrent + Z.IO.BIO.Zlib + Z.IO.Buffered + Z.IO.Environment + Z.IO.Exception + Z.IO.FileSystem + Z.IO.FileSystem.Base + Z.IO.FileSystem.FilePath + Z.IO.FileSystem.Threaded + Z.IO.FileSystem.Watch + Z.IO.Logger + Z.IO.LowResTimer + Z.IO.Network + Z.IO.Network.DNS + Z.IO.Network.IPC + Z.IO.Network.SocketAddr + Z.IO.Network.TCP + Z.IO.Network.UDP + Z.IO.Process + Z.IO.Resource + Z.IO.StdStream + Z.IO.StdStream.Ansi + Z.IO.Time + Z.IO.UV.Errno + Z.IO.UV.FFI + Z.IO.UV.Manager + Z.IO.UV.UVStream + other-modules: + Z.IO.UV.Win - Z.IO.UV.Errno - Z.IO.UV.FFI - Z.IO.UV.Manager - Z.IO.UV.UVStream - Z.IO.UV.Win + build-depends: + , base >=4.12 && <5.0 + , containers ^>=0.6 + , exceptions ^>=0.10 + , primitive >=0.7.1 && <0.7.2 + , stm ^>=2.5 + , time >=1.9 && <=2.0 + , unix-time >=0.4.7 && <=0.5 + , unordered-containers ^>=0.2 + , Z-Data ^>=0.6 + , microlens - Z.IO.Environment + default-language: Haskell2010 + default-extensions: + BangPatterns + BinaryLiterals + CApiFFI + CPP + ConstraintKinds + DataKinds + DefaultSignatures + DeriveAnyClass + DeriveGeneric + DerivingStrategies + ExistentialQuantification + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + KindSignatures + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + PartialTypeSignatures + PatternSynonyms + PolyKinds + QuantifiedConstraints + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeFamilyDependencies + TypeOperators + UnboxedTuples + UnliftedFFITypes + ViewPatterns - -- Z.Compression.Zlib + build-tool-depends: hsc2hs:hsc2hs -any, hspec-discover:hspec-discover -any + ghc-options: -Wall + include-dirs: include third_party/zlib third_party/cwalk/include + includes: + hs_cwalk.h + hs_uv.h + zconf.h + zlib.h - build-depends: base >= 4.12 && <5.0 - , exceptions == 0.10.* - , primitive >= 0.7.1 && < 0.7.2 - , stm == 2.5.* - , unordered-containers == 0.2.* - , containers == 0.6.* - , Z-Data == 0.6.* - , time >= 1.9 && <= 2.0 - , unix-time >= 0.4.7 && <= 0.5 + install-includes: + hs_cwalk.h + hs_uv.h + zconf.h + zlib.h - default-language: Haskell2010 - default-extensions: BangPatterns - BinaryLiterals - CApiFFI - ConstraintKinds - CPP - DerivingStrategies - DeriveGeneric - DeriveAnyClass - DefaultSignatures - DataKinds - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - KindSignatures - MagicHash - MultiParamTypeClasses - MultiWayIf - PartialTypeSignatures - PatternSynonyms - PolyKinds - QuantifiedConstraints - QuasiQuotes - OverloadedStrings - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - TemplateHaskell - TypeApplications - TypeFamilyDependencies - TypeFamilies - TypeOperators - TupleSections - UnboxedTuples - UnliftedFFITypes - ViewPatterns - build-tool-depends: hsc2hs:hsc2hs, hspec-discover:hspec-discover - ghc-options: -Wall + cc-options: -march=native -D_FILE_OFFSET_BITS=64 + c-sources: + cbits/hs_cwalk.c + cbits/hs_uv_base.c + cbits/hs_uv_dns.c + cbits/hs_uv_file.c + cbits/hs_uv_fs_event.c + cbits/hs_uv_process.c + cbits/hs_uv_stream.c + cbits/hs_uv_udp.c + cbits/hs_zlib.c + third_party/cwalk/src/cwalk.c + third_party/libuv/src/fs-poll.c + third_party/libuv/src/idna.c + third_party/libuv/src/inet.c + third_party/libuv/src/random.c + third_party/libuv/src/strscpy.c + third_party/libuv/src/threadpool.c + third_party/libuv/src/timer.c + third_party/libuv/src/uv-common.c + third_party/libuv/src/uv-data-getter-setters.c + third_party/libuv/src/version.c + third_party/zlib/adler32.c + third_party/zlib/compress.c + third_party/zlib/crc32.c + third_party/zlib/deflate.c + third_party/zlib/infback.c + third_party/zlib/inffast.c + third_party/zlib/inflate.c + third_party/zlib/inftrees.c + third_party/zlib/trees.c + third_party/zlib/uncompr.c + third_party/zlib/zutil.c - include-dirs: include - third_party/zlib - third_party/cwalk/include + -- Note: The c-sources list is taken from libuv's Makefile.mingw, needs to be + -- updated when we bump up libuv's version. + -- header files are ignored here, otherwise will confuse linker + if os(windows) + c-sources: + third_party/libuv/src/win/async.c + third_party/libuv/src/win/core.c + third_party/libuv/src/win/detect-wakeup.c + third_party/libuv/src/win/dl.c + third_party/libuv/src/win/error.c + third_party/libuv/src/win/fs-event.c + third_party/libuv/src/win/fs.c + third_party/libuv/src/win/getaddrinfo.c + third_party/libuv/src/win/getnameinfo.c + third_party/libuv/src/win/handle.c + third_party/libuv/src/win/loop-watcher.c + third_party/libuv/src/win/pipe.c + third_party/libuv/src/win/poll.c + third_party/libuv/src/win/process-stdio.c + third_party/libuv/src/win/process.c + third_party/libuv/src/win/signal.c + third_party/libuv/src/win/stream.c + third_party/libuv/src/win/tcp.c + third_party/libuv/src/win/thread.c + third_party/libuv/src/win/tty.c + third_party/libuv/src/win/udp.c + third_party/libuv/src/win/util.c + third_party/libuv/src/win/winapi.c + third_party/libuv/src/win/winsock.c - includes: hs_uv.h - zlib.h - zconf.h - hs_cwalk.h + cc-options: + -Wall -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0600 -march=native - install-includes: hs_uv.h - zlib.h - zconf.h - hs_cwalk.h + cpp-options: -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0600 + include-dirs: third_party/libuv/include third_party/libuv/src - cc-options: -march=native -D_FILE_OFFSET_BITS=64 - c-sources: cbits/hs_uv_base.c - cbits/hs_uv_dns.c - cbits/hs_uv_file.c - cbits/hs_uv_fs_event.c - cbits/hs_uv_stream.c - cbits/hs_uv_process.c - cbits/hs_uv_udp.c - cbits/hs_zlib.c - cbits/hs_cwalk.c + -- The C runtime dependencies are imposed by libuv. + extra-libraries: + psapi + Iphlpapi + userenv + Ws2_32 - third_party/cwalk/src/cwalk.c + else + if os(linux) + c-sources: + third_party/libuv/src/fs-poll.c + third_party/libuv/src/idna.c + third_party/libuv/src/inet.c + third_party/libuv/src/random.c + third_party/libuv/src/strscpy.c + third_party/libuv/src/threadpool.c + third_party/libuv/src/timer.c + third_party/libuv/src/unix/async.c + third_party/libuv/src/unix/core.c + third_party/libuv/src/unix/dl.c + third_party/libuv/src/unix/fs.c + third_party/libuv/src/unix/getaddrinfo.c + third_party/libuv/src/unix/getnameinfo.c + third_party/libuv/src/unix/linux-core.c + third_party/libuv/src/unix/linux-inotify.c + third_party/libuv/src/unix/linux-syscalls.c + third_party/libuv/src/unix/loop-watcher.c + third_party/libuv/src/unix/loop.c + third_party/libuv/src/unix/pipe.c + third_party/libuv/src/unix/poll.c + third_party/libuv/src/unix/process.c + third_party/libuv/src/unix/procfs-exepath.c + third_party/libuv/src/unix/proctitle.c + third_party/libuv/src/unix/random-devurandom.c + third_party/libuv/src/unix/random-getrandom.c + third_party/libuv/src/unix/random-sysctl-linux.c + third_party/libuv/src/unix/signal.c + third_party/libuv/src/unix/stream.c + third_party/libuv/src/unix/tcp.c + third_party/libuv/src/unix/thread.c + third_party/libuv/src/unix/tty.c + third_party/libuv/src/unix/udp.c + third_party/libuv/src/uv-common.c + third_party/libuv/src/uv-data-getter-setters.c + third_party/libuv/src/version.c - third_party/zlib/adler32.c - third_party/zlib/compress.c - third_party/zlib/crc32.c - third_party/zlib/deflate.c - third_party/zlib/infback.c - third_party/zlib/inffast.c - third_party/zlib/inflate.c - third_party/zlib/inftrees.c - third_party/zlib/trees.c - third_party/zlib/uncompr.c - third_party/zlib/zutil.c + include-dirs: + third_party/libuv/include third_party/libuv/src/unix + third_party/libuv/src - third_party/libuv/src/fs-poll.c - third_party/libuv/src/idna.c - third_party/libuv/src/inet.c - third_party/libuv/src/random.c - third_party/libuv/src/strscpy.c - third_party/libuv/src/threadpool.c - third_party/libuv/src/timer.c - third_party/libuv/src/uv-data-getter-setters.c - third_party/libuv/src/uv-common.c - third_party/libuv/src/version.c + cc-options: -Wall -march=native - -- Note: The c-sources list is taken from libuv's Makefile.mingw, needs to be - -- updated when we bump up libuv's version. - -- header files are ignored here, otherwise will confuse linker - if os(windows) + else + if os(osx) c-sources: - third_party/libuv/src/win/async.c - third_party/libuv/src/win/core.c - third_party/libuv/src/win/detect-wakeup.c - third_party/libuv/src/win/dl.c - third_party/libuv/src/win/error.c - third_party/libuv/src/win/fs-event.c - third_party/libuv/src/win/fs.c - third_party/libuv/src/win/getaddrinfo.c - third_party/libuv/src/win/getnameinfo.c - third_party/libuv/src/win/handle.c - third_party/libuv/src/win/loop-watcher.c - third_party/libuv/src/win/pipe.c - third_party/libuv/src/win/poll.c - third_party/libuv/src/win/process-stdio.c - third_party/libuv/src/win/process.c - third_party/libuv/src/win/signal.c - third_party/libuv/src/win/stream.c - third_party/libuv/src/win/tcp.c - third_party/libuv/src/win/thread.c - third_party/libuv/src/win/tty.c - third_party/libuv/src/win/udp.c - third_party/libuv/src/win/util.c - third_party/libuv/src/win/winapi.c - third_party/libuv/src/win/winsock.c + third_party/libuv/src/fs-poll.c + third_party/libuv/src/idna.c + third_party/libuv/src/inet.c + third_party/libuv/src/random.c + third_party/libuv/src/strscpy.c + third_party/libuv/src/threadpool.c + third_party/libuv/src/timer.c + third_party/libuv/src/unix/async.c + third_party/libuv/src/unix/bsd-ifaddrs.c + third_party/libuv/src/unix/core.c + third_party/libuv/src/unix/darwin-proctitle.c + third_party/libuv/src/unix/darwin.c + third_party/libuv/src/unix/dl.c + third_party/libuv/src/unix/fs.c + third_party/libuv/src/unix/fsevents.c + third_party/libuv/src/unix/getaddrinfo.c + third_party/libuv/src/unix/getnameinfo.c + third_party/libuv/src/unix/kqueue.c + third_party/libuv/src/unix/loop-watcher.c + third_party/libuv/src/unix/loop.c + third_party/libuv/src/unix/pipe.c + third_party/libuv/src/unix/poll.c + third_party/libuv/src/unix/process.c + third_party/libuv/src/unix/proctitle.c + third_party/libuv/src/unix/random-devurandom.c + third_party/libuv/src/unix/random-getentropy.c + third_party/libuv/src/unix/signal.c + third_party/libuv/src/unix/stream.c + third_party/libuv/src/unix/tcp.c + third_party/libuv/src/unix/thread.c + third_party/libuv/src/unix/tty.c + third_party/libuv/src/unix/udp.c + third_party/libuv/src/uv-common.c + third_party/libuv/src/uv-data-getter-setters.c + third_party/libuv/src/version.c - cc-options: -Wall -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0600 -march=native - cpp-options: -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0600 - include-dirs: third_party/libuv/include - third_party/libuv/src - -- The C runtime dependencies are imposed by libuv. - extra-libraries: psapi, Iphlpapi, userenv, Ws2_32 - else - if os(linux) - c-sources: third_party/libuv/src/fs-poll.c - third_party/libuv/src/idna.c - third_party/libuv/src/inet.c - third_party/libuv/src/random.c - third_party/libuv/src/strscpy.c - third_party/libuv/src/threadpool.c - third_party/libuv/src/timer.c - third_party/libuv/src/uv-data-getter-setters.c - third_party/libuv/src/uv-common.c - third_party/libuv/src/version.c + include-dirs: + third_party/libuv/include third_party/libuv/src/unix + third_party/libuv/src - third_party/libuv/src/unix/async.c - third_party/libuv/src/unix/core.c - third_party/libuv/src/unix/dl.c - third_party/libuv/src/unix/fs.c - third_party/libuv/src/unix/getaddrinfo.c - third_party/libuv/src/unix/getnameinfo.c - third_party/libuv/src/unix/loop.c - third_party/libuv/src/unix/loop-watcher.c - third_party/libuv/src/unix/pipe.c - third_party/libuv/src/unix/poll.c - third_party/libuv/src/unix/process.c - third_party/libuv/src/unix/random-devurandom.c - third_party/libuv/src/unix/signal.c - third_party/libuv/src/unix/stream.c - third_party/libuv/src/unix/tcp.c - third_party/libuv/src/unix/thread.c - third_party/libuv/src/unix/tty.c - third_party/libuv/src/unix/udp.c + cc-options: -Wall -march=native - third_party/libuv/src/unix/linux-core.c - third_party/libuv/src/unix/linux-inotify.c - third_party/libuv/src/unix/linux-syscalls.c - third_party/libuv/src/unix/procfs-exepath.c - third_party/libuv/src/unix/proctitle.c - third_party/libuv/src/unix/random-getrandom.c - third_party/libuv/src/unix/random-sysctl-linux.c + else + if flag(no-pkg-config) + extra-libraries: uv - include-dirs: third_party/libuv/include - third_party/libuv/src/unix - third_party/libuv/src - cc-options: -Wall -march=native else - if os(osx) - c-sources: third_party/libuv/src/fs-poll.c - third_party/libuv/src/idna.c - third_party/libuv/src/inet.c - third_party/libuv/src/random.c - third_party/libuv/src/strscpy.c - third_party/libuv/src/threadpool.c - third_party/libuv/src/timer.c - third_party/libuv/src/uv-data-getter-setters.c - third_party/libuv/src/uv-common.c - third_party/libuv/src/version.c + pkgconfig-depends: libuv ==1.32 || >1.32 - third_party/libuv/src/unix/async.c - third_party/libuv/src/unix/core.c - third_party/libuv/src/unix/dl.c - third_party/libuv/src/unix/fs.c - third_party/libuv/src/unix/getaddrinfo.c - third_party/libuv/src/unix/getnameinfo.c - third_party/libuv/src/unix/loop.c - third_party/libuv/src/unix/loop-watcher.c - third_party/libuv/src/unix/pipe.c - third_party/libuv/src/unix/poll.c - third_party/libuv/src/unix/process.c - third_party/libuv/src/unix/random-devurandom.c - third_party/libuv/src/unix/signal.c - third_party/libuv/src/unix/stream.c - third_party/libuv/src/unix/tcp.c - third_party/libuv/src/unix/thread.c - third_party/libuv/src/unix/tty.c - third_party/libuv/src/unix/udp.c +test-suite Z-IO-Test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test/ + build-depends: + , base + , bytestring + , hashable + , hspec >=2.5.4 + , HUnit + , primitive + , QuickCheck >=2.10 + , quickcheck-instances + , scientific + , Z-Data + , Z-IO + , zlib - third_party/libuv/src/unix/bsd-ifaddrs.c - third_party/libuv/src/unix/darwin-proctitle.c - third_party/libuv/src/unix/darwin.c - third_party/libuv/src/unix/fsevents.c - third_party/libuv/src/unix/kqueue.c - third_party/libuv/src/unix/proctitle.c - third_party/libuv/src/unix/random-getentropy.c - - include-dirs: third_party/libuv/include - third_party/libuv/src/unix - third_party/libuv/src - cc-options: -Wall -march=native + other-modules: + Z.IO.BIO.ConcurrentSpec + Z.IO.BIO.ZlibSpec + Z.IO.BIOSpec + Z.IO.FileSystem.ThreadedSpec + Z.IO.FileSystemSpec + Z.IO.LowResTimerSpec + Z.IO.Network.IPCSpec + Z.IO.Network.TCPSpec + Z.IO.Network.UDPSpec + Z.IO.ProcessSpec + Z.IO.ResourceSpec - else - if flag(no-pkg-config) - extra-libraries: uv - else - pkgconfig-depends: libuv >= 1.32 - -test-suite Z-IO-Test - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test/ - build-depends: base - , Z-IO - , Z-Data - , hspec >= 2.5.4 - , hashable - , HUnit - , QuickCheck >= 2.10 - , quickcheck-instances - , scientific - , primitive - , zlib - , bytestring + if os(linux) + other-modules: Z.IO.Network.IPCSpec - other-modules: Z.IO.BIOSpec - Z.IO.BIO.ZlibSpec - Z.IO.BIO.ConcurrentSpec - Z.IO.FileSystem.ThreadedSpec - Z.IO.FileSystemSpec - Z.IO.Network.UDPSpec - Z.IO.Network.TCPSpec - Z.IO.Network.IPCSpec - Z.IO.LowResTimerSpec - Z.IO.ProcessSpec - Z.IO.ResourceSpec + ghc-options: -threaded + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover ==2.* +benchmark z-io-gettime + type: exitcode-stdio-1.0 + main-is: GetTime.hs + hs-source-dirs: bench/ + build-depends: + , base + , criterion ^>=1.5 + , time ^>=1.9 + , Z-Data + , Z-IO - if os(linux) - other-modules: Z.IO.Network.IPCSpec + default-language: Haskell2010 - ghc-options: -threaded - default-language: Haskell2010 - build-tool-depends: hspec-discover:hspec-discover == 2.* + if !flag(demos) + buildable: False + +executable z-io-http-bench + main-is: Http.hs + hs-source-dirs: bench/ + build-depends: + , base + , Z-Data + , Z-IO + + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + + if !flag(demos) + buildable: False diff --git a/Z/IO/FileSystem/Base.hs b/Z/IO/FileSystem/Base.hs --- a/Z/IO/FileSystem/Base.hs +++ b/Z/IO/FileSystem/Base.hs @@ -233,7 +233,7 @@ initFile :: HasCallStack => CBytes -> FileFlag -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR' - -> FileMode -- ^ Sets the file mode (permission and sticky bits), + -> FileMode -- ^ Sets the file mode (permission and sticky bits), -- but only if the file was created, see 'DEFAULT_FILE_MODE'. -> Resource File initFile path flags mode = diff --git a/Z/IO/FileSystem/Watch.hs b/Z/IO/FileSystem/Watch.hs --- a/Z/IO/FileSystem/Watch.hs +++ b/Z/IO/FileSystem/Watch.hs @@ -11,30 +11,30 @@ support recursive watch(Linux's inotify). @ --- start watching threads, use returned close function to cleanup watching threads. -(close, srcf) <- watchDirs ["fold_to_be_watch"] --- dup a file event source -src <- srcf --- print event to stdout -runBIO $ src >|> sinkToIO printLineStd +-- start watching threads, cleanup watching threads automatically when finished. +withResource (initWatchDirs ["fold_to_be_watch"] True) $ \ srcf -> do + -- dup a file event source + src <- srcf + -- print event to stdout + runBIO $ src >|> sinkToIO printStd @ -} -module Z.IO.FileSystem.Watch ( - FileEvent(..) - , watchDirs - , watchDirsRecursively - ) where +module Z.IO.FileSystem.Watch + ( FileEvent(..) + , watchDirs + , initWatchDirs + ) where import Control.Concurrent import Control.Monad import Data.Bits -import Data.IORef import qualified Data.HashMap.Strict as HM +import Data.IORef import qualified Data.List as List +import Data.Primitive.PrimArray import Data.Word import GHC.Generics -import Data.Primitive.PrimArray import Z.Data.Array import Z.Data.Array.Unaligned import Z.Data.CBytes (CBytes) @@ -48,40 +48,48 @@ import Z.IO.Exception import Z.IO.FileSystem.Base import qualified Z.IO.FileSystem.FilePath as P +import Z.IO.LowResTimer +import Z.IO.Resource import Z.IO.UV.FFI import Z.IO.UV.Manager -import Z.IO.LowResTimer -- | File event with path info. data FileEvent = FileAdd CBytes | FileRemove CBytes | FileModify CBytes - deriving (Show, Read, Ord, Eq, Generic) - deriving anyclass (Print, JSON) + deriving (Show, Read, Ord, Eq, Generic) + deriving anyclass (Print, JSON) +-- | Watching a list of given directories. +watchDirs :: [CBytes] -- ^ Directories to be watched + -> Bool -- ^ recursively watch? + -> (FileEvent -> IO ()) -- ^ Callback function to handle 'FileEvent' + -> IO () +watchDirs dirs rec callback = do + withResource (initWatchDirs dirs rec) $ \ srcf -> do + src <- srcf + runBIO $ src >|> sinkToIO callback --- | Start watching a list of given directories. --- -watchDirs :: [CBytes] -> IO (IO (), IO (Source FileEvent)) -watchDirs dirs = do - forM_ dirs $ \ dir -> do +-- | Start watching a list of given directories, stream version. +initWatchDirs :: [CBytes] -- ^ watching list + -> Bool -- ^ recursively watch? + -> Resource (IO (Source FileEvent)) +initWatchDirs dirs False = do + liftIO . forM_ dirs $ \ dir -> do b <- isDir dir unless b (throwUVIfMinus_ (return UV_ENOTDIR)) watch_ 0 dirs - --- | Start watching a list of given directories recursively. --- -watchDirsRecursively :: [CBytes] -> IO (IO (), IO (Source FileEvent)) -watchDirsRecursively dirs = do +initWatchDirs dirs _ = do #if defined(linux_HOST_OS) -- inotify doesn't support recursive watch, so we manually maintain watch list - subDirs <- forM dirs (\ dir -> scandirRecursively dir (\ _ t -> return (t == DirEntDir))) + subDirs <- liftIO . forM dirs $ \ dir -> + scandirRecursively dir (\ _ t -> return (t == DirEntDir)) watch_ UV_FS_EVENT_RECURSIVE (List.concat (dirs:subDirs)) #else watch_ UV_FS_EVENT_RECURSIVE dirs #endif -- Internal function to start watching -watch_ :: CUInt -> [CBytes] -> IO (IO (), IO (Source FileEvent)) -watch_ flag dirs = do +watch_ :: CUInt -> [CBytes] -> Resource (IO (Source FileEvent)) +watch_ flag dirs = fst <$> initResource (do -- HashMap to store all watchers mRef <- newMVar HM.empty -- there's only one place to pull the sink, that is cleanUpWatcher @@ -92,7 +100,8 @@ tid <- forkIO $ watchThread mRef dir' sink modifyMVar_ mRef $ \ m -> return $! HM.insert dir' tid m) `onException` cleanUpWatcher mRef sink - return (cleanUpWatcher mRef sink, srcf) + return (srcf, (sink, mRef))) + (\ (_, (sink, mRef)) -> cleanUpWatcher mRef sink) where eventBufSiz = defaultChunkSize @@ -195,7 +204,7 @@ me' <- atomicModifyIORef' eRef $ \ me -> case me of Just e -> (Nothing, Just e) - _ -> (Nothing, Nothing) + _ -> (Nothing, Nothing) forM_ me' (push sink) me' <- atomicModifyIORef' eRef $ \ me -> diff --git a/Z/IO/Logger.hs b/Z/IO/Logger.hs --- a/Z/IO/Logger.hs +++ b/Z/IO/Logger.hs @@ -37,16 +37,20 @@ module Z.IO.Logger ( -- * A simple Logger type - Logger(..) + Logger , LoggerConfig(..) , defaultLoggerConfig + , defaultJSONLoggerConfig , setDefaultLogger , getDefaultLogger , flushDefaultLogger , withDefaultLogger + + -- * Create a new logger , newLogger - , newColoredLogger - , newJSONLogger + , newStdLogger + , newFileLogger + -- * logging functions , debug , info @@ -54,18 +58,19 @@ , fatal , critical , otherLevel + -- * logging functions with specific logger , debugTo , infoTo , warningTo , fatalTo , otherLevelTo - -- * Helpers to write new logger - , defaultTSCache + + -- * Helpers to write new log formatter + , LogFormatter, defaultFmt, defaultColoredFmt, defaultJSONFmt , defaultFmtCallStack , defaultLevelFmt - , LogFormatter, defaultFmt, defaultColoredFmt, defaultJSONFmt - , pushLogIORef, flushLogIORef + -- * Constants -- ** Level , Level @@ -79,24 +84,29 @@ import Control.Concurrent.MVar import Control.Monad +import Data.Bits ((.|.)) import Data.IORef -import Foreign.C.Types (CInt(..)) -import GHC.Conc.Sync (ThreadId(..), myThreadId) +import Foreign.C.Types (CInt (..)) +import GHC.Conc.Sync (ThreadId (..), myThreadId) import GHC.Exts (ThreadId#) import GHC.Stack import System.IO.Unsafe (unsafePerformIO) import qualified Z.Data.Builder as B -import qualified Z.Data.JSON.Builder as JB import qualified Z.Data.CBytes as CB +import qualified Z.Data.JSON.Builder as JB import Z.Data.Vector.Base as V import Z.IO.Buffered import Z.IO.Exception +import qualified Z.IO.FileSystem as ZF import Z.IO.LowResTimer +import Z.IO.Resource import Z.IO.StdStream import Z.IO.StdStream.Ansi (AnsiColor (..), color) import Z.IO.Time -type LogFormatter = B.Builder () -- ^ data\/time string +------------------------------------------------------------------------------- + +type LogFormatter = B.Builder () -- ^ data\/time string(second precision) -> Level -- ^ log level -> B.Builder () -- ^ log content -> CallStack -- ^ call stack trace @@ -127,6 +137,8 @@ -- ^ Buffer size to build each log line , loggerConfigLevel :: {-# UNPACK #-} !Level -- ^ Config log's filter level + , loggerFormatter :: LogFormatter + -- ^ Log formatter } -- | A default logger config with @@ -134,9 +146,19 @@ -- * 0.1s minimal flush interval -- * line buffer size 240 bytes -- * show everything by default +-- * 'defaultFmt' defaultLoggerConfig :: LoggerConfig -defaultLoggerConfig = LoggerConfig 1 240 NOTSET +defaultLoggerConfig = LoggerConfig 1 240 NOTSET defaultFmt +-- | A default logger config with +-- +-- * 0.5s minimal flush interval +-- * line buffer size 1000 bytes +-- * show everything by default +-- * 'defaultJSONFmt' +defaultJSONLoggerConfig :: LoggerConfig +defaultJSONLoggerConfig = LoggerConfig 5 1000 NOTSET defaultJSONFmt + -- | 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. @@ -147,22 +169,9 @@ t <- getSystemTime' CB.toBuilder <$> formatSystemTime iso8061DateFormat t --- | 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 - logsRef <- newIORef [] - let flush = flushLogIORef stderrBuf logsRef - throttledFlush <- throttleTrailing_ loggerMinFlushInterval flush - return $ Logger (pushLogIORef logsRef loggerLineBufSize) - flush throttledFlush defaultTSCache - (if isStdStreamTTY stderr then defaultColoredFmt - else defaultFmt) - loggerConfigLevel +------------------------------------------------------------------------------- --- | Make a new simple logger, see 'defaultFmt'. --- +-- | Make a new logger with given write device. newLogger :: LoggerConfig -> MVar BufferedOutput -> IO Logger @@ -171,22 +180,25 @@ let flush = flushLogIORef oLock logsRef throttledFlush <- throttleTrailing_ loggerMinFlushInterval flush return $ Logger (pushLogIORef logsRef loggerLineBufSize) - flush throttledFlush defaultTSCache defaultFmt + flush throttledFlush defaultTSCache loggerFormatter loggerConfigLevel --- | Make a new structured JSON logger, see 'defaultJSONFmt' +-- | Make a new logger write to 'stderrBuf'. +newStdLogger :: LoggerConfig -> IO Logger +newStdLogger config = newLogger config stderrBuf + +-- | Make a new file based logger with 'defaultFmt'. -- -newJSONLogger :: LoggerConfig - -> MVar BufferedOutput - -> IO Logger -newJSONLogger LoggerConfig{..} oLock = do - logsRef <- newIORef [] - let flush = flushLogIORef oLock logsRef - throttledFlush <- throttleTrailing_ loggerMinFlushInterval flush - return $ Logger (pushLogIORef logsRef loggerLineBufSize) - flush throttledFlush defaultTSCache defaultJSONFmt - loggerConfigLevel +-- The file will be opened in append mode. +newFileLogger :: LoggerConfig -> CB.CBytes -> IO Logger +newFileLogger config path = do + let res = ZF.initFile path (ZF.O_CREAT .|. ZF.O_RDWR .|. ZF.O_APPEND) ZF.DEFAULT_FILE_MODE + (file, _closeFunc) <- acquire res + oLock <- newMVar =<< newBufferedOutput file + newLogger config oLock +------------------------------------------------------------------------------- + -- | Use 'pushLogIORef' and 'pushLogIORef' to implement a simple 'IORef' based concurrent logger. -- -- @ @@ -245,7 +257,7 @@ -- | A default JSON log formatter. -- --- @{"level":"FATAL","time":"2021-02-01T15:02:19+0800","loc":":27:1","theadId":606,"content":"..."}\\n@ +-- > {"level":"FATAL","time":"2021-02-01T15:02:19+0800","loc":":27:1","theadId":606,"content":"..."}\n defaultJSONFmt :: LogFormatter defaultJSONFmt ts level content cstack (ThreadId tid#) = do B.curly $ do @@ -275,13 +287,18 @@ globalLogger :: IORef Logger {-# NOINLINE globalLogger #-} globalLogger = unsafePerformIO $ - newIORef =<< newColoredLogger defaultLoggerConfig + newIORef =<< newStdLogger defaultLoggerConfig{ + loggerFormatter = (if isStdStreamTTY stderr then defaultColoredFmt else defaultFmt) + } -- | Change the global logger. setDefaultLogger :: Logger -> IO () setDefaultLogger !logger = atomicWriteIORef globalLogger logger -- | Get the global logger. +-- +-- This is a logger connected to stderr, if stderr is connect to TTY, +-- then use 'defaultColoredFmt', otherwise use 'defaultFmt'. getDefaultLogger :: IO Logger getDefaultLogger = readIORef globalLogger 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 @@ -88,10 +88,10 @@ -- Use 'MVar' 'UDP' in multiple threads. -- data UDP = UDP - { udpHandle :: {-# UNPACK #-} !(Ptr UVHandle) - , udpSlot :: {-# UNPACK #-} !UVSlot - , udpManager :: UVManager - , udpSendBuffer :: {-# UNPACK #-} !(A.MutablePrimArray RealWorld Word8) + { _udpHandle :: {-# UNPACK #-} !(Ptr UVHandle) + , _udpSlot :: {-# UNPACK #-} !UVSlot + , _udpManager :: UVManager + , _udpSendBuffer :: {-# UNPACK #-} !(A.MutablePrimArray RealWorld Word8) , udpClosed :: {-# UNPACK #-} !(IORef Bool) } diff --git a/Z/IO/Resource.hs b/Z/IO/Resource.hs --- a/Z/IO/Resource.hs +++ b/Z/IO/Resource.hs @@ -85,7 +85,7 @@ -- This function is useful when you want to add some initialization and clean up action -- inside 'Resource' monad. -- -initResource_ :: IO () -> IO () -> Resource () +initResource_ :: IO a -> IO () -> Resource a {-# INLINE initResource_ #-} initResource_ create release = Resource $ do r <- create diff --git a/Z/IO/StdStream.hs b/Z/IO/StdStream.hs --- a/Z/IO/StdStream.hs +++ b/Z/IO/StdStream.hs @@ -79,14 +79,18 @@ -- For the same reason you shouldn't use stderr directly, use `Z.IO.Logger` module instead. data StdStream - = StdTTY {-# UNPACK #-}!(Ptr UVHandle) {-# UNPACK #-}!UVSlot UVManager -- similar to UVStream - | StdFile {-# UNPACK #-}!FD -- similar to UVFile + = StdStream Bool {-# UNPACK #-}!(Ptr UVHandle) {-# UNPACK #-}!UVSlot UVManager + -- ^ similar to UVStream, first field is is_tty + | StdFile {-# UNPACK #-}!FD + -- ^ similar to UVFile instance Show StdStream where show = T.toString instance T.Print StdStream where - toUTF8BuilderP p (StdTTY ptr slot uvm) = T.parenWhen (p > 10) $ do - "StdTTY " + toUTF8BuilderP p (StdStream istty ptr slot uvm) = T.parenWhen (p > 10) $ do + if istty + then "StdStream(TTY) " + else "StdStream " T.toUTF8Builder ptr T.char7 ' ' T.toUTF8Builder slot @@ -97,16 +101,16 @@ T.toUTF8Builder fd isStdStreamTTY :: StdStream -> Bool -isStdStreamTTY (StdTTY _ _ _) = True -isStdStreamTTY _ = False +isStdStreamTTY (StdStream istty _ _ _) = istty +isStdStreamTTY _ = False getStdStreamFD :: StdStream -> IO FD -getStdStreamFD (StdTTY hdl _ _) = throwUVIfMinus (hs_uv_fileno hdl) +getStdStreamFD (StdStream _ hdl _ _) = throwUVIfMinus (hs_uv_fileno hdl) getStdStreamFD (StdFile fd) = return fd instance Input StdStream where {-# INLINE readInput #-} - readInput (StdTTY hdl slot uvm) buf len = mask_ $ do + readInput (StdStream _ hdl slot uvm) buf len = mask_ $ do pokeBufferTable uvm slot buf len m <- getBlockMVar uvm slot _ <- tryTakeMVar m @@ -133,7 +137,7 @@ instance Output StdStream where {-# INLINE writeOutput #-} - writeOutput (StdTTY hdl _ uvm) buf len = mask_ $ do + writeOutput (StdStream _ hdl _ uvm) buf len = mask_ $ do m <- withUVManager' uvm $ do reqSlot <- getUVSlot uvm (hs_uv_write hdl buf len) m <- getBlockMVar uvm reqSlot @@ -195,21 +199,39 @@ makeStdStream :: HasCallStack => FD -> IO StdStream makeStdStream fd = do typ <- uv_guess_handle fd - if typ == UV_TTY - then mask_ $ do + if typ == UV_FILE + then return (StdFile fd) + else mask_ $ do uvm <- getUVManager withUVManager uvm $ \ loop -> do hdl <- hs_uv_handle_alloc loop slot <- getUVSlot uvm (peekUVHandleData hdl) _ <- tryTakeMVar =<< getBlockMVar uvm slot -- clear the parking spot - throwUVIfMinus_ (uv_tty_init loop hdl (fromIntegral fd)) - return (StdTTY hdl slot uvm) - else return (StdFile fd) + case typ of + UV_TTY -> do + throwUVIfMinus_ (uv_tty_init loop hdl (fromIntegral fd)) + return (StdStream True hdl slot uvm) + UV_TCP -> do + throwUVIfMinus_ (uv_tcp_init loop hdl) + throwUVIfMinus_ (uv_tcp_open hdl fd) + return (StdStream False hdl slot uvm) + UV_UDP -> + throwUVError UV_EXDEV IOEInfo{ + ioeName = "EXDEV" + , ioeDescription = "redirect to UDP is not supported" + , ioeCallStack = callStack + } + -- normally this would be UV_NAMED_PIPE, + -- but we also give UV_UNKNOWN_HANDLE a try. + _ -> do + throwUVIfMinus_ (uv_pipe_init loop hdl 0) + throwUVIfMinus_ (uv_pipe_open hdl fd) + return (StdStream False hdl slot uvm) -- | Change terminal's mode if stdin is connected to a terminal. setStdinTTYMode :: TTYMode -> IO () setStdinTTYMode mode = case stdin of - StdTTY hdl _ uvm -> + StdStream _ hdl _ uvm -> withUVManager' uvm . throwUVIfMinus_ $ uv_tty_set_mode hdl mode _ -> return () @@ -217,7 +239,7 @@ -- return (-1, -1) if stdout is a file. getStdoutWinSize :: HasCallStack => IO (CInt, CInt) getStdoutWinSize = case stdout of - StdTTY hdl _ uvm -> + StdStream _ hdl _ uvm -> withUVManager' uvm $ do (w, (h, ())) <- allocPrimUnsafe $ \ w -> allocPrimUnsafe $ \ h -> throwUVIfMinus_ $ uv_tty_get_winsize hdl w h diff --git a/Z/IO/UV/Manager.hs b/Z/IO/UV/Manager.hs --- a/Z/IO/UV/Manager.hs +++ b/Z/IO/UV/Manager.hs @@ -65,7 +65,7 @@ data UVManager = UVManager { uvmBlockTable :: {-# UNPACK #-} !(IORef (UnliftedArray (MVar Int))) - -- ^ A array to store threads blocked on async IO. + -- ^ An array to store threads blocked on async IO. , uvmLoop :: {-# UNPACK #-} !(Ptr UVLoop) -- ^ The uv loop refrerence , uvmLoopData :: {-# UNPACK #-} !(Ptr UVLoopData) diff --git a/bench/GetTime.hs b/bench/GetTime.hs new file mode 100644 --- /dev/null +++ b/bench/GetTime.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +{-| gettimeofday bench + +This benchmark confirms an unneglectable overhead in common FFI bindings: the +overhead of doing pinned allocation. + +Theoretically things will get worse under high concurrent load since pinned +allocation sometime requires lock GHC's sm. +-} +import Criterion.Main (Benchmark, bench, bgroup, defaultMain, + nfIO) + +import qualified Data.Time.Clock.System as T +import qualified Z.IO.Time as Z + +main :: IO () +main = do + defaultMain + [ bgroup "Z-IO" + [ bench "gettimeofday-z" $ nfIO Z.getSystemTime' + , bench "gettimeofday-time" $ nfIO T.getSystemTime + ] + ] diff --git a/bench/Http.hs b/bench/Http.hs new file mode 100644 --- /dev/null +++ b/bench/Http.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| HTTP benchmark test + +This program read HTTP request(without parsing), and send some respond. You can +use HTTP benchmark tools such as ab or wrk to test IO throughput, remember to +add a proper heap size to improve performance (-Hx parammeter): + +ulimit -n 10000 +http-bench +RTS -H512M +wrk -c5000 http://localhost:8888 + +-} + +module Main where + +import Control.Monad +import Foreign.ForeignPtr +import qualified Z.Data.Vector as V +import qualified Z.Foreign as FFI +import Z.IO +import Z.IO.Network + +main :: IO () +main = startTCPServer defaultTCPServerConfig $ \ uvs -> do + recvbuf <- mallocForeignPtrBytes 2048 + sendcontent' <- FFI.pinPrimVector sendcontent + catch (echo uvs recvbuf sendcontent') (\ (e::SomeException) -> return ()) + where + echo uvs recvbuf sendcontent' = loop + where + loop = do + r <- withForeignPtr recvbuf $ \ p -> do + readInput uvs p 2048 + when (r /= 0) $ do + FFI.withPrimVectorSafe sendcontent' $ writeOutput uvs + loop + + sendcontent :: V.Bytes + sendcontent = + "HTTP/1.1 200 OK\r\n\ + \Content-Type: text/html; charset=UTF-8\r\n\ + \Content-Length: 500\r\n\ + \Connection: Keep-Alive\r\n\ + \\r\n" `V.append` (V.pack $ replicate 500 48)