glirc 2.27 → 2.28

raw patch · 30 files changed

+583/−284 lines, 30 filesdep ~irc-coredep ~networkdep ~vtyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: irc-core, network, vty

API changes (from Hackage documentation)

Files

• ChangeLog.md +38/−26
• exec/Exports.hs +5/−1
• exec/Main.hs +6/−6
• exec/linux_exported_symbols.txt +3/−0
• exec/macos_exported_symbols.txt +3/−0
• glirc.cabal +9/−7
• include/glirc-api.h +9/−6
• src/Client/CApi.hs +15/−4
• src/Client/CApi/Exports.hs +176/−58
• src/Client/CApi/Types.hsc +54/−23
• src/Client/Commands.hs +6/−7
• src/Client/Commands/Arguments/Renderer.hs +0/−1
• src/Client/Commands/Interpolation.hs +24/−13
• src/Client/Commands/Recognizer.hs +0/−1
• src/Client/Configuration.hs +73/−8
• src/Client/Configuration/Macros.hs +3/−3
• src/Client/EventLoop/Actions.hs +0/−1
• src/Client/Hook.hs +4/−3
• src/Client/Hook/Znc/Buffextras.hs +4/−11
• src/Client/Image/Message.hs +24/−10
• src/Client/Image/MircFormatting.hs +0/−1
• src/Client/Message.hs +1/−1
• src/Client/State.hs +2/−2
• src/Client/State/Focus.hs +0/−1
• src/Client/State/Network.hs +95/−27
• src/Client/View/Palette.hs +9/−3
• src/Client/View/RtsStats.hs +3/−4
• src/Client/View/UserList.hs +8/−7
• src/RtsStats.hs +8/−48
• src/StrictUnit.hs +1/−1

@@ -1,15 +1,27 @@ # Revision history for glirc2 +## 2.28+* Add formatting reference to `/palette`+* Make RTLD flags configurable when loading an extension+* Update client's internal hostname on `RPL_HOSTHIDDEN`+* Support IRCv3.2 `server-time` extension over ZNC-specific one+* Lots of work on the Lua extension code and documentation+* Added `glirc_user_account` and `glirc_user_channel_modes`+  extension API entrypoints.+* Added support for `account-notify` and `extended-join`+* Added configurable "arguments" to the C extensions+ ## 2.27 * Requires GHC 8.4 * Show channel topic in channel on join * Fix socket leak when failing to load TLS certificates * Add delay when indicating sent ping to reduce noise+* Add support for italics in formatting  ## 2.26 * Updates for GHC 8.4.1 * Added `/toggle-show-ping` and `show-ping` configuration setting-  to toggle visibility of the ping roundtrip times.+  to toggle visibility of the ping round-trip times.  ## 2.25 * `/ignore` can list ignores and supports full wildcard masks@@ -30,9 +42,9 @@   for the home directory works for resolving paths relative   to $HOME. Absolute paths are unmodified. -* Support network:#channel in /query+* Support `network:#channel` in `/query` -* Add an optional OTR extension. See the otr-extension/ directory+* Add an optional OTR extension. See the `otr-extension/` directory   and the wiki for more information.  * Extended the C API with `glirc_inject_chat` and `chat_entrypoint`@@ -46,7 +58,7 @@  ## 2.22 -* Added dynanic indentation of wrapped lines. Lines now+* Added dynamic indentation of wrapped lines. Lines now   wrap to where the message portion of the line started.   This removes `indent-wrapped-lines` configuration setting * Added pervasive word-boundary oriented line wrapping@@ -59,21 +71,21 @@ * Memory savings by packing message timestamp information, and   using the "detailed" image for regular expression matching. * Added `/rtsstats` command for inspecting the GHC RTS statistics-* Added many minor IRC query commands: admin, info, map, rules-  motd, version, lusers, kill, knock, list.+* Added many minor IRC query commands: `admin`, `info`, `map`, `rules`+  `motd`, `version`, `lusers`, `kill`, `knock`, `list`.  ## 2.21.1 -* Support for latest config-schema+* Support for latest `config-schema` * Adapt extension API to help support stub Rust extension  ## 2.21 -* Make metadata toggle (F4) a window-level setting instead of client level+* Make metadata toggle `F4` a window-level setting instead of client level * Add configuration option to hide metadata by default `hide-metadata` * Make keymap configurable under `key-bindings`, add `/keymap` command-* Add transient error message view, press ESC to clear-* Implement two-column split window mode: `/toggle-layout` and F5+* Add transient error message view, press `ESC` to clear+* Implement two-column split window mode: `/toggle-layout` and `F5` * Implement word-boundary based line wrapping  ## 2.20.6@@ -138,10 +150,10 @@ ## 2.17  * Add `reconnect-attempts` setting-* Add peristence for `/grep` and `/grepi`+* Add persistence for `/grep` and `/grepi` * Add filter argument to `/windows` * Better tab completion for `/channel` and `/focus`-* Isolate and number urls in view with `/url`+* Isolate and number URLs in view with `/url` * Map `M-Left` and `M-Right` to backward word and forward word  ## 2.16@@ -154,8 +166,8 @@ * Add macro argument declarations * Add indication when a command is still a prefix or not of a valid command * Support quoted strings arguments to /exec-* Add F4 to toggle visibility of metadata lines-* tls-insecure setting was incorrectly behaving like normal insecure+* Add `F4` to toggle visibility of metadata lines+* `tls-insecure` setting was incorrectly behaving like normal insecure * Add `C-t` to swap characters * Add `ESC` to return to messages window @@ -163,11 +175,11 @@  * Add `/help` * Add `/palette`-* Add F3 to toggle activity detail bar+* Add `F3` to toggle activity detail bar  ## 2.13 -* Add disconnect expansion, support expansions in connect-cmds+* Add disconnect expansion, support expansions in `connect-cmds` * Add default expansion syntax `${var|default}` * Add support for multiple nicknames to try on connect * Add `ignores` section to configuration@@ -184,7 +196,7 @@  * Add `M-S` to jump to previously focused window * Add `extra-highlights` section-* Tab complete servernames in `/connect`+* Tab complete server names in `/connect` * Add `/windows` command for listing active windows * Add `glirc_clear_window` C API procedure * Allow `process_message` callback to drop messages@@ -194,7 +206,7 @@  ## 2.10 -* Fixes for multiline editing+* Fixes for multi-line editing * Multiple, sequential kills all fill the same yank buffer  ## 2.9@@ -207,12 +219,12 @@ ## 2.8  * Support `vty-5.8`-* Implement inital support for macros+* Implement initial support for macros * Support `znc.in/self-message`  ## 2.7 -* Switch to regex-tdfa (easier to install on macOS than text-icu)+* Switch to `regex-tdfa` (easier to install on MacOS than `text-icu`) * Tab-complete starts with most recent nick * Add `/reload` * Add custom palette entry for self highlights@@ -220,17 +232,17 @@  ## 2.6 -* connect-cmds now use actual client commands instead of raw IRC messages. For example `msg user my message` or `join #mychannel`-* Multiple lines can be held in the textbox at once. Pasting mutiple lines insert those lines into the textbox rather than sending them immediately.+* `connect-cmds` now use actual client commands instead of raw IRC messages. For example `msg user my message` or `join #mychannel`+* Multiple lines can be held in the textbox at once. Pasting multiple lines insert those lines into the textbox rather than sending them immediately. * Added `M-d` and `M-Enter` key bindings * Added `name` field to server configuration-* Extract irc-core library again+* Extract `irc-core` library again * Configurable self color  ## 2.5 -* Add facilities for hooks that can alter the irc message stream.-* Implement a hook that handles the znc buffextras plugin.+* Add facilities for hooks that can alter the IRC message stream.+* Implement a hook that handles the ZNC `buffextras` plugin. * Implement configurable nick color highlight palette. * Resolve relative paths starting at the home directory. * Significantly configurable UI colors@@ -246,7 +258,7 @@  * Add commands `/znc` * Add initial support for ZNC's playback module and `/znc-playback` command-* Don't consider message seen when in masklist, userlist, or channelinfo windows+* Don't consider message seen when in `masklist`, `userlist`, or `channelinfo` windows * Add terminal bell on command error  ## 2.2

@@ -6,6 +6,7 @@ Maintainer  : emertens@gmail.com  Entry point into glirc2 from the C API+ -} module Exports () where @@ -19,12 +20,15 @@ foreign export ccall glirc_list_networks      :: Glirc_list_networks foreign export ccall glirc_identifier_cmp     :: Glirc_identifier_cmp foreign export ccall glirc_is_channel         :: Glirc_is_channel-foreign export ccall glirc_is_logged_on       :: Glirc_is_channel+foreign export ccall glirc_is_logged_on       :: Glirc_is_logged_on foreign export ccall glirc_list_channels      :: Glirc_list_channels foreign export ccall glirc_list_channel_users :: Glirc_list_channel_users foreign export ccall glirc_my_nick            :: Glirc_my_nick+foreign export ccall glirc_user_account       :: Glirc_user_account+foreign export ccall glirc_user_channel_modes :: Glirc_user_channel_modes foreign export ccall glirc_mark_seen          :: Glirc_mark_seen foreign export ccall glirc_clear_window       :: Glirc_clear_window foreign export ccall glirc_free_string        :: Glirc_free_string foreign export ccall glirc_free_strings       :: Glirc_free_strings foreign export ccall glirc_current_focus      :: Glirc_current_focus+foreign export ccall glirc_resolve_path       :: Glirc_resolve_path

@@ -30,8 +30,8 @@ main =   do opts <- getOptions      let mbPath = view optConfigFile opts-     cfg  <- loadConfiguration' mbPath-     withClientState mbPath cfg $ \st0 ->+     (path,cfg) <- loadConfiguration' mbPath+     withClientState path cfg $ \st0 ->        withVty $ \vty ->          do st1 <- clientStartExtensions    st0             st2 <- initialNetworkLogic opts st1@@ -46,11 +46,11 @@       | otherwise              = view optInitialNetworks opts ++ clientAutoconnects st  -- | Load configuration and handle errors along the way.-loadConfiguration' :: Maybe FilePath -> IO Configuration-loadConfiguration' path =-  do cfgRes <- loadConfiguration path+loadConfiguration' :: Maybe FilePath -> IO (FilePath, Configuration)+loadConfiguration' mbPath =+  do cfgRes <- loadConfiguration mbPath      case cfgRes of-       Right cfg -> return cfg+       Right x -> return x        Left (ConfigurationReadFailed e) ->          report "Failed to open configuration:" e        Left (ConfigurationParseFailed p e) ->

@@ -7,11 +7,14 @@ glirc_list_channels; glirc_list_channel_users; glirc_my_nick;+glirc_user_account;+glirc_user_channel_modes; glirc_mark_seen; glirc_is_channel; glirc_is_logged_on; glirc_clear_window; glirc_current_focus;+glirc_resolve_path; glirc_free_string; glirc_free_strings; };

@@ -6,10 +6,13 @@ _glirc_list_channels _glirc_list_channel_users _glirc_my_nick+_glirc_user_account+_glirc_user_channel_modes _glirc_mark_seen _glirc_is_channel _glirc_is_logged_on _glirc_clear_window _glirc_current_focus+_glirc_resolve_path _glirc_free_string _glirc_free_strings

@@ -1,5 +1,6 @@+cabal-version:       2.2 name:                glirc-version:             2.27+version:             2.28 synopsis:            Console IRC client description:         Console IRC client                      .@@ -13,19 +14,17 @@ maintainer:          emertens@gmail.com copyright:           2016,2017 Eric Mertens category:            Network-build-type:          Custom extra-source-files:  ChangeLog.md README.md                      exec/linux_exported_symbols.txt                      exec/macos_exported_symbols.txt-cabal-version:       >=1.23 homepage:            https://github.com/glguy/irc-core bug-reports:         https://github.com/glguy/irc-core/issues-tested-with:         GHC==8.0.2+tested-with:         GHC==8.4.3  custom-setup   setup-depends: base     >=4.11 && <4.12,                  filepath >=1.4  && <1.5,-                 Cabal    >=1.24 && <2.3+                 Cabal    >=2.2  && <2.3,  source-repository head   type: git@@ -124,6 +123,9 @@                        Paths_glirc                        Build_glirc +  autogen-modules:     Paths_glirc+                       Build_glirc+   build-depends:       base                 >=4.11   && <4.12,                        HsOpenSSL            >=0.11   && <0.12,                        async                >=2.1    && <2.3,@@ -139,7 +141,7 @@                        gitrev               >=1.2    && <1.4,                        hashable             >=1.2.4  && <1.3,                        hookup               >=0.2.2  && <0.3,-                       irc-core             >=2.3    && <2.4,+                       irc-core             >=2.5    && <2.6,                        kan-extensions       >=5.0    && <5.3,                        lens                 >=4.14   && <4.18,                        network              >=2.6.2  && <2.8,@@ -155,7 +157,7 @@                        unix                 >=2.7    && <2.8,                        unordered-containers >=0.2.7  && <0.3,                        vector               >=0.11   && <0.13,-                       vty                  >=5.23.1 && <5.24+                       vty                  >=5.23.1 && <5.24,  test-suite test   type:                exitcode-stdio-1.0

@@ -43,7 +43,7 @@         struct glirc_string command; }; -typedef void *start_type         (struct glirc *G, const char *path);+typedef void *start_type         (struct glirc *G, const char *path, const struct glirc_string *args, size_t args_len); typedef void stop_type           (struct glirc *G, void *S); typedef enum process_result process_message_type(struct glirc *G, void *S, const struct glirc_message *); typedef enum process_result process_chat_type(struct glirc *G, void *S, const struct glirc_chat *);@@ -67,17 +67,20 @@                 const char* tgt, size_t tgtLen,                 const char* msg, size_t msgLen); char ** glirc_list_networks(struct glirc *G);-char ** glirc_list_channels(struct glirc *G, struct glirc_string network);-char ** glirc_list_channel_users(struct glirc *G, struct glirc_string network, struct glirc_string channel);+char ** glirc_list_channels(struct glirc *G, const char *net, size_t netlen);+char ** glirc_list_channel_users(struct glirc *G, const char *net, size_t net_len, const char *chan, size_t chan_len); void glirc_current_focus(struct glirc *G, char **net, size_t *netlen, char **tgt , size_t *tgtlen); char * glirc_my_nick(struct glirc *G, const char *net, size_t netlen);-void glirc_mark_seen(struct glirc *G, struct glirc_string network, struct glirc_string channel);-void glirc_clear_window(struct glirc *G, struct glirc_string network, struct glirc_string channel);-int glirc_identifier_cmp(struct glirc_string s, struct glirc_string t);+char * glirc_user_account(struct glirc *G, const char *net, size_t netlen, const char *nick, size_t nicklen);+char * glirc_user_channel_modes(struct glirc *G, const char *net, size_t netlen, const char *chan, size_t chanlen, const char *nick, size_t nicklen);+void glirc_mark_seen(struct glirc *G, const char *net, size_t net_len, const char *chan, size_t chan_len);+void glirc_clear_window(struct glirc *G, const char *net, size_t net_len, const char *chan, size_t chan_len);+int glirc_identifier_cmp(const char *s, size_t s_len, const char *t, size_t t_len); int glirc_is_channel(struct glirc *G, const char *net, size_t netlen,                                       const char *tgt, size_t tgtlen); int glirc_is_logged_on(struct glirc *G, const char *net, size_t netlen,                                         const char *tgt, size_t tgtlen);+char * glirc_resolve_path(struct glirc *G, const char *path, size_t path_len);  void glirc_free_string(char *); void glirc_free_strings(char **);

@@ -24,7 +24,11 @@   , chatExtension   ) where +import           Client.Configuration+                   (ExtensionConfiguration,+                    extensionPath, extensionRtldFlags, extensionArgs) import           Client.CApi.Types+import           Control.Lens (view) import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Codensity@@ -67,17 +71,24 @@ -- passed to any subsequent calls into the extension. activateExtension ::   Ptr () ->-  FilePath {- ^ path to extension -} ->+  ExtensionConfiguration {- ^ extension configuration -} ->   IO ActiveExtension-activateExtension stab path =-  do dl   <- dlopen path [RTLD_NOW, RTLD_LOCAL]+activateExtension stab config =+  do dl   <- dlopen (view extensionPath config)+                    (view extensionRtldFlags config)      p    <- dlsym dl extensionSymbol      fgn  <- peek (castFunPtrToPtr p)      name <- peekCString (fgnName fgn)      let f = fgnStart fgn      s  <- if nullFunPtr == f              then return nullPtr-             else withCString path (runStartExtension f stab)+             else evalNestedIO $+                  do extPath <- nest1 (withCString (view extensionPath config))+                     args <- traverse withText+                           $ view extensionArgs config+                     argsArray <- nest1 (withArray args)+                     let len = fromIntegral (length args)+                     liftIO (runStartExtension f stab extPath argsArray len)      return $! ActiveExtension        { aeFgn     = fgn        , aeDL      = dl

@@ -8,9 +8,11 @@  This module exports the C functions that extensions can used to query the state of the client.++C Extensions can include @glirc-api.h@ -} module Client.CApi.Exports- ( -- * Extension API types+ ( -- * Extension entry-points    Glirc_send_message  , glirc_send_message @@ -29,6 +31,12 @@  , Glirc_my_nick  , glirc_my_nick + , Glirc_user_account+ , glirc_user_account++ , Glirc_user_channel_modes+ , glirc_user_channel_modes+  , Glirc_identifier_cmp  , glirc_identifier_cmp @@ -55,9 +63,14 @@   , Glirc_inject_chat  , glirc_inject_chat++ , Glirc_resolve_path+ , glirc_resolve_path+  ) where  import           Client.CApi.Types+import           Client.Configuration import           Client.Message import           Client.State import           Client.State.Channel@@ -126,12 +139,14 @@  ------------------------------------------------------------------------ --- | Network, command, and parameters are used when transmitting a message.+-- | Type of 'glirc_send_message' extension entry-point type Glirc_send_message =   Ptr ()     {- ^ api token          -} ->   Ptr FgnMsg {- ^ pointer to message -} ->   IO CInt    {- ^ 0 on success       -} +-- | Entry-point into the client when an extern extension wants send an IRC+-- command to a connected server. glirc_send_message :: Glirc_send_message glirc_send_message token msgPtr =   do mvar    <- derefToken token@@ -147,14 +162,17 @@  ------------------------------------------------------------------------ --- | Print a message or error to the client window+-- | Type of 'glirc_print' extension entry-point type Glirc_print =-  Ptr ()  {- ^ api token         -} ->+  Ptr ()      {- ^ api token         -} ->   MessageCode {- ^ enum message_code -} ->-  CString {- ^ message           -} ->-  CSize   {- ^ message length    -} ->-  IO CInt {- ^ 0 on success      -}+  CString     {- ^ message           -} ->+  CSize       {- ^ message length    -} ->+  IO CInt     {- ^ 0 on success      -} +-- | Entry-point for extensions to append a message to the client buffer.+-- The @message_code@ can be used to render the message normally or to+-- cause the client to draw attention to the message as an error. glirc_print :: Glirc_print glirc_print stab code msgPtr msgLen =   do mvar <- derefToken stab@@ -175,7 +193,7 @@  ------------------------------------------------------------------------ --- | Print a message or error to the client window+-- | Type of 'glirc_inject_chat' extension entry-point. type Glirc_inject_chat =   Ptr ()  {- ^ api token         -} ->   CString {- ^ network           -} ->@@ -188,6 +206,10 @@   CSize   {- ^ message length    -} ->   IO CInt {- ^ 0 on success      -} +-- | Add a message to a chat window as if it was received+-- directly from the IRC server. This is useful when implementing+-- extensions that intercept incoming chat messages and transform+-- them before showing the user. glirc_inject_chat :: Glirc_inject_chat glirc_inject_chat stab netPtr netLen srcPtr srcLen tgtPtr tgtLen msgPtr msgLen =   do mvar <- derefToken stab@@ -209,12 +231,15 @@  ------------------------------------------------------------------------ --- | The resulting strings and array of strings are malloc'd and the--- caller must free them. NULL returned on failure.+-- | Type of 'glirc_list_networks' extension entry-point type Glirc_list_networks =   Ptr ()           {- ^ api token                                        -} ->   IO (Ptr CString) {- ^ null terminated array of null terminated strings -} +-- | This extension entry-point allocates a list of all the identifiers for+-- the active networks on the client. @NULL@ returned on failure.+-- The caller is responsible for freeing successful result with+-- @glirc_free_strings@. glirc_list_networks :: Glirc_list_networks glirc_list_networks stab =   do mvar <- derefToken stab@@ -225,10 +250,7 @@  ------------------------------------------------------------------------ --- | Case insensitive comparison suitable for use on channels and nicknames.--- Returns -1 if the first identifier is less than the second--- Returns 0 if the first identifier is equal to the second--- Returns 1 if the first identifier is greater than the second+-- | Type of 'glirc_identifier_cmp' extension entry-point type Glirc_identifier_cmp =   CString {- ^ identifier 1     -} ->   CSize   {- ^ identifier 1 len -} ->@@ -236,6 +258,10 @@   CSize   {- ^ identifier 2 len -} ->   IO CInt +-- | Case insensitive comparison suitable for use on channels and nicknames.+-- Returns -1 if the first identifier is less than the second+-- Returns 0 if the first identifier is equal to the second+-- Returns 1 if the first identifier is greater than the second glirc_identifier_cmp :: Glirc_identifier_cmp glirc_identifier_cmp p1 n1 p2 n2 =   do txt1 <- peekFgnStringLen (FgnStringLen p1 n1)@@ -247,14 +273,16 @@  ------------------------------------------------------------------------ --- | The resulting strings and array of strings are malloc'd and the--- caller must free them. NULL returned on failure.+-- | Type of 'glirc_list_channels' extension entry-point type Glirc_list_channels =   Ptr ()  {- ^ api token   -} ->   CString {- ^ network     -} ->   CSize   {- ^ network len -} ->   IO (Ptr CString) {- ^ null terminated array of null terminated strings -} +-- | Generate a list of connected channels for the network identified in+-- the arguments. @NULL@ returned on failure. Caller is responsible for+-- freeing successful result with @glirc_free_strings@. glirc_list_channels :: Glirc_list_channels glirc_list_channels stab networkPtr networkLen =   do mvar <- derefToken stab@@ -268,8 +296,7 @@  ------------------------------------------------------------------------ --- | The resulting strings and array of strings are malloc'd and the--- caller must free them.  NULL returned on failure.+-- | Type of 'glirc_list_channel_users' extension entry-point type Glirc_list_channel_users =   Ptr ()  {- ^ api token   -} ->   CString {- ^ network     -} ->@@ -278,6 +305,10 @@   CSize   {- ^ channel len -} ->   IO (Ptr CString) {- ^ null terminated array of null terminated strings -} +-- | Generate a list of IRC nicknames currently connected to the identified+-- channel on the identified network. @NULL@ returned on failure.+-- Caller is responsible for freeing successful result with+-- @glirc_free_strings@. glirc_list_channel_users :: Glirc_list_channel_users glirc_list_channel_users stab networkPtr networkLen channelPtr channelLen =   do mvar <- derefToken stab@@ -296,14 +327,17 @@  ------------------------------------------------------------------------ --- | The resulting string is malloc'd and the caller must free it.--- NULL returned on failure.+-- | Type of 'glirc_my_nick' extension entry-point type Glirc_my_nick =   Ptr ()  {- ^ api token           -} ->   CString {- ^ network name        -} ->   CSize   {- ^ network name length -} ->   IO CString +-- | Return the IRC nickname associated with the active network+-- connection identified in the arguments. @NULL@ returned on failure.+-- Caller is responsible for freeing successful result with+-- @glirc_free_string@. glirc_my_nick :: Glirc_my_nick glirc_my_nick stab networkPtr networkLen =   do mvar <- derefToken stab@@ -316,9 +350,66 @@  ------------------------------------------------------------------------ --- | Mark a window as being seen clearing the new message counter.--- To clear the client window send an empty network name.--- To clear a network window send an empty channel name.+-- | Type of 'glirc_user_account' extension entry-point+type Glirc_user_account =+  Ptr ()  {- ^ api token           -} ->+  CString {- ^ network name        -} ->+  CSize   {- ^ network name length -} ->+  CString {- ^ nickname            -} ->+  CSize   {- ^ nickname length     -} ->+  IO CString++-- | Return the services account name associated with a nickname on+-- a server as tracked by the client. Caller is responsible for freeing+-- successful result with @glirc_free_string@. If no account is+-- known, @NULL@ is returned.+glirc_user_account :: Glirc_user_account+glirc_user_account stab networkPtr networkLen nickPtr nickLen =+  do mvar    <- derefToken stab+     st      <- readMVar mvar+     network <- peekFgnStringLen (FgnStringLen networkPtr networkLen)+     nick    <- peekFgnStringLen (FgnStringLen nickPtr    nickLen   )+     let mb = preview ( clientConnection network+                      . csUsers . ix (mkId nick)+                      . uhAccount . filtered (not . Text.null)) st+     case mb of+       Just acct -> newCString (Text.unpack acct)+       _         -> return nullPtr++------------------------------------------------------------------------++-- | Type of 'glirc_user_account' extension entry-point+type Glirc_user_channel_modes =+  Ptr ()  {- ^ api token           -} ->+  CString {- ^ network name        -} ->+  CSize   {- ^ network name length -} ->+  CString {- ^ channel             -} ->+  CSize   {- ^ channel length      -} ->+  CString {- ^ nickname            -} ->+  CSize   {- ^ nickname length     -} ->+  IO CString++-- | Return the sigils associated with a nickname on a particular channel.+-- Caller is responsible for freeing successful result with+-- @glirc_free_string@. If user is on channel without any sigils an empty+-- string is returned. If user is not on channel @NULL@ is returned.+glirc_user_channel_modes :: Glirc_user_channel_modes+glirc_user_channel_modes stab netPtr netLen chanPtr chanLen nickPtr nickLen =+  do mvar    <- derefToken stab+     st      <- readMVar mvar+     network <- peekFgnStringLen (FgnStringLen netPtr  netLen)+     chan    <- peekFgnStringLen (FgnStringLen chanPtr chanLen   )+     nick    <- peekFgnStringLen (FgnStringLen nickPtr nickLen   )+     let mb = preview ( clientConnection network+                      . csChannels . ix (mkId chan)+                      . chanUsers  . ix (mkId nick) ) st+     case mb of+       Just sigils -> newCString sigils+       Nothing     -> return nullPtr++------------------------------------------------------------------------++-- | Type of 'glirc_mark_seen' extension entry-point type Glirc_mark_seen =   Ptr ()  {- ^ api token           -} ->   CString {- ^ network name        -} ->@@ -327,6 +418,9 @@   CSize   {- ^ channel name length -} ->   IO () +-- | Mark a window as being seen, clearing the new message counter.+-- To specify the client window send an empty network name.+-- To specify a network window send an empty channel name. glirc_mark_seen :: Glirc_mark_seen glirc_mark_seen stab networkPtr networkLen channelPtr channelLen =   do network <- peekFgnStringLen (FgnStringLen networkPtr networkLen)@@ -343,9 +437,7 @@  ------------------------------------------------------------------------ --- | Mark a window as being seen clearing the new message counter.--- To clear the client window send an empty network name.--- To clear a network window send an empty channel name.+-- | Type of 'glirc_clear_window' extension entry-point type Glirc_clear_window =   Ptr ()  {- ^ api token           -} ->   CString {- ^ network name        -} ->@@ -354,6 +446,9 @@   CSize   {- ^ channel name length -} ->   IO () +-- | Clear contents of a specified window.+-- To specify the client window send an empty network name.+-- To specify a network window send an empty channel name. glirc_clear_window :: Glirc_clear_window glirc_clear_window stab networkPtr networkLen channelPtr channelLen =   do network <- peekFgnStringLen (FgnStringLen networkPtr networkLen)@@ -370,23 +465,25 @@  ------------------------------------------------------------------------ --- | Free one of the heap allocated strings found as a return value--- from the extension API. If argument is NULL, nothing happens.+-- | Type of 'glirc_free_string' extension entry-point type Glirc_free_string =   CString {- ^ glirc allocated string -} ->   IO () +-- | Free one of the heap allocated strings found as a return value+-- from the extension API. If argument is @NULL@, nothing happens. glirc_free_string :: Glirc_free_string glirc_free_string = free  ------------------------------------------------------------------------ --- | Free an array of heap allocated strings found as a return value--- from the extension API. If argument is NULL, nothing happens.+-- | Type of 'glirc_free_strings' extension entry-point type Glirc_free_strings =   Ptr CString {- ^ glirc allocated strings, null-terminated -} ->   IO () +-- | Free an array of heap allocated strings found as a return value+-- from the extension API. If argument is @NULL@, nothing happens. glirc_free_strings :: Glirc_free_strings glirc_free_strings p =   unless (p == nullPtr) $@@ -395,13 +492,7 @@  ------------------------------------------------------------------------ --- | Free an array of heap allocated strings found as a return value--- from the extension API. If argument is NULL, nothing happens.------ Free the allocated strings with @glirc_free_string@------ Strings set to NULL if there is no current network or no--- current target.+-- | Type of 'glirc_current_focus' extension entry-point type Glirc_current_focus =   Ptr ()      {- ^ api token                      -} ->   Ptr CString {- ^ newly allocated network string -} ->@@ -410,29 +501,27 @@   Ptr CSize   {- ^ target length                  -} ->   IO () +-- | Find the network and target identifier associated with the+-- currently focused window.+--+-- Free the allocated strings with @glirc_free_string@.+--+-- Strings set to @NULL@ if there is no current network or no+-- current target. glirc_current_focus :: Glirc_current_focus glirc_current_focus stab netP netL tgtP tgtL =   do mvar <- derefToken stab      st   <- readMVar mvar-     case view clientFocus st of-       Unfocused        -> do poke' netP nullPtr-                              poke' netL 0-                              poke' tgtP nullPtr-                              poke' tgtL 0--       NetworkFocus n   -> do exportText netP netL n-                              poke' tgtP nullPtr-                              poke' tgtL 0--       ChannelFocus n t -> do exportText netP netL n-                              exportText tgtP tgtL (idText t)+     let (net,tgt) = case view clientFocus st of+                       Unfocused        -> (Text.empty, Text.empty)+                       NetworkFocus n   -> (n         , Text.empty)+                       ChannelFocus n t -> (n         , idText t  )+     exportText netP netL net+     exportText tgtP tgtL tgt  ------------------------------------------------------------------------ --- | Returns @1@ when the given target on the given network is a channel--- name, otherwise returns @0@.------ If the given network is not currently active this returns @0@.+-- | Type of 'glirc_is_channel' extension entry-point type Glirc_is_channel =   Ptr ()  {- ^ api token       -} ->   CString {- ^ network name    -} ->@@ -441,6 +530,10 @@   CSize   {- ^ target length   -} ->   IO CInt {- ^ boolean         -} +-- | Returns @1@ when the given target on the given network is a channel+-- name, otherwise returns @0@.+--+-- If the given network is not currently active this returns @0@. glirc_is_channel :: Glirc_is_channel glirc_is_channel stab net netL tgt tgtL =   do mvar    <- derefToken stab@@ -454,10 +547,7 @@  ------------------------------------------------------------------------ --- | Returns @1@ when the given target on the given network shares a--- channel with the user, @0@ otherwise.------ If the given network is not currently active this returns @0@.+-- | Type of 'glirc_is_logged_on' extension entry-point type Glirc_is_logged_on =   Ptr ()  {- ^ api token       -} ->   CString {- ^ network name    -} ->@@ -466,7 +556,11 @@   CSize   {- ^ target length   -} ->   IO CInt {- ^ boolean         -} -glirc_is_logged_on :: Glirc_is_channel+-- | Returns @1@ when the given target on the given network shares a+-- channel with the user, @0@ otherwise.+--+-- If the given network is not currently active this returns @0@.+glirc_is_logged_on :: Glirc_is_logged_on glirc_is_logged_on stab net netL tgt tgtL =   do mvar    <- derefToken stab      st      <- readMVar mvar@@ -475,3 +569,27 @@       let online = has (clientConnection network . csUsers . ix (mkId target)) st      return $! if online then 1 else 0++------------------------------------------------------------------------++-- | Type of 'glirc_resolve_path' extension entry-point+type Glirc_resolve_path =+  Ptr ()     {- ^ api token     -} ->+  CString    {- ^ path          -} ->+  CSize      {- ^ path length   -} ->+  IO CString {- ^ resolved path -}++-- | Resolve the given string to an absolute path. This expands @~@ for+-- the home directory and computes paths relative to the configuration+-- file.+--+-- Free the allocated string with @glirc_free_string@.+glirc_resolve_path :: Glirc_resolve_path+glirc_resolve_path stab pathP pathL =+  do mvar    <- derefToken stab+     st      <- readMVar mvar+     path    <- peekFgnStringLen (FgnStringLen pathP pathL)++     let cfgPath = view clientConfigPath st+     cxt <- newFilePathContext cfgPath+     newCString (resolveFilePath cxt (Text.unpack path))

@@ -20,6 +20,7 @@   , StopExtension   , ProcessMessage   , ProcessCommand+  , ProcessChat    -- * Strings   , FgnStringLen(..)@@ -45,7 +46,7 @@   , MessageCode(..), normalMessage, errorMessage    -- * process message results-  , MessageResult(..), passMessage, dropMessage+  , ProcessResult(..), passMessage, dropMessage    -- * Marshaling helpers   , withText0@@ -56,72 +57,95 @@ import           Control.Monad import           Data.Text (Text) import qualified Data.Text.Foreign as Text+import           Data.Word import           Foreign.C import           Foreign.Marshal.Array import           Foreign.Ptr import           Foreign.Storable  -- | Tag for describing the kind of message to display in the client--- as used in `glirc_print`.+-- as used in `glirc_print`. See 'normalMessage' and 'errorMessage'. -- -- @enum message_code;@-newtype MessageCode = MessageCode CInt deriving Eq-#enum MessageCode, MessageCode, NORMAL_MESSAGE, ERROR_MESSAGE+newtype MessageCode = MessageCode (#type enum message_code) deriving Eq +-- | Normal client message. Unread counter increments, but no client+-- bell or error status update.+normalMessage :: MessageCode+normalMessage = MessageCode (#const NORMAL_MESSAGE)++-- | Important client message. Unread counter increments, bell rings,+-- and error status updates.+errorMessage :: MessageCode+errorMessage = MessageCode (#const ERROR_MESSAGE)+ -- | Result used to determine what to do after processing a message with -- the 'ProcessMessage' callback. ----- @enum process_result;@-newtype MessageResult = MessageResult CInt deriving Eq-#enum MessageResult, MessageResult, PASS_MESSAGE, DROP_MESSAGE+-- | @enum process_result@+newtype ProcessResult = ProcessResult (#type enum process_result) deriving Eq ---+-- | Allow the message to proceed through the client logic.+passMessage :: ProcessResult+passMessage = ProcessResult (#const PASS_MESSAGE) --- | @typedef void *start(void *glirc, const char *path);@+-- | Drop the message from further processing.+dropMessage :: ProcessResult+dropMessage = ProcessResult (#const DROP_MESSAGE)++-- | @typedef void *start(void *glirc, const char *path)@ type StartExtension =-  Ptr ()      {- ^ api token                   -} ->-  CString     {- ^ path to extension           -} ->-  IO (Ptr ()) {- ^ initialized extension state -}+  Ptr ()           {- ^ api token                   -} ->+  CString          {- ^ path to extension           -} ->+  Ptr FgnStringLen {- ^ array of arguments          -} ->+  CSize            {- ^ number of arguments         -} ->+  IO (Ptr ())      {- ^ initialized extension state -} --- | @typedef void stop(void *glirc, void *S);@+-- | @typedef void stop(void *glirc, void *S)@ type StopExtension =   Ptr () {- ^ api token       -} ->   Ptr () {- ^ extension state -} ->   IO () --- | @typedef enum process_result process_message(void *glirc, void *S, const struct glirc_message *);@+-- | @typedef enum process_result process_message(void *glirc, void *S, const struct glirc_message *)@ type ProcessMessage =   Ptr ()     {- ^ api token       -} ->   Ptr ()     {- ^ extention state -} ->   Ptr FgnMsg {- ^ message to send -} ->-  IO MessageResult+  IO ProcessResult --- | @typedef void process_command(void *glirc, void *S, const struct glirc_command *);@+-- | @typedef void process_command(void *glirc, void *S, const struct glirc_command *)@ type ProcessCommand =   Ptr ()     {- ^ api token       -} ->   Ptr ()     {- ^ extension state -} ->   Ptr FgnCmd {- ^ command         -} ->   IO () --- | @typedef void process_chat(void *glirc, void *S, const struct glirc_chat *);@+-- | @typedef void process_chat(void *glirc, void *S, const struct glirc_chat *)@ type ProcessChat =   Ptr ()      {- ^ api token       -} ->   Ptr ()      {- ^ extension state -} ->   Ptr FgnChat {- ^ chat info       -} ->-  IO MessageResult+  IO ProcessResult --- | Type of dynamic function pointer wrappers.+-- | Type of dynamic function pointer wrappers. These convert C+-- function-pointers into Haskell functions. type Dynamic a = FunPtr a -> a +-- | Dynamic import for 'StartExtension'. foreign import ccall "dynamic" runStartExtension :: Dynamic StartExtension+-- | Dynamic import for 'StopExtension'. foreign import ccall "dynamic" runStopExtension  :: Dynamic StopExtension+-- | Dynamic import for 'ProcessMessage'. foreign import ccall "dynamic" runProcessMessage :: Dynamic ProcessMessage+-- | Dynamic import for 'ProcessCommand'. foreign import ccall "dynamic" runProcessCommand :: Dynamic ProcessCommand+-- | Dynamic import for 'ProcessChat'. foreign import ccall "dynamic" runProcessChat    :: Dynamic ProcessChat  ------------------------------------------------------------------------ --- | @struct glirc_extension;@+-- | Information describing an extension's entry-points and metadata. data FgnExtension = FgnExtension   { fgnStart   :: FunPtr StartExtension -- ^ Optional startup callback   , fgnStop    :: FunPtr StopExtension  -- ^ Optional shutdown callback@@ -132,6 +156,7 @@   , fgnMajorVersion, fgnMinorVersion :: CInt -- ^ extension version   } +-- | @struct glirc_extension@ instance Storable FgnExtension where   alignment _ = #alignment struct glirc_extension   sizeOf    _ = #size      struct glirc_extension@@ -199,13 +224,15 @@  ------------------------------------------------------------------------ --- | @struct glirc_message@+-- | Chat message data containing the source network, window target,+-- and message body. data FgnChat = FgnChat   { fhNetwork    :: FgnStringLen   , fhTarget     :: FgnStringLen   , fhMessage    :: FgnStringLen   } +-- | @struct glirc_message@ instance Storable FgnChat where   alignment _ = #alignment struct glirc_chat   sizeOf    _ = #size      struct glirc_chat@@ -221,11 +248,13 @@  ------------------------------------------------------------------------ --- | @struct glirc_command@+-- | Used to pass arguments from @/extension EXT_NAME@ client command into+-- an extension. data FgnCmd = FgnCmd   { fcCommand :: FgnStringLen   } +-- | @struct glirc_command@ instance Storable FgnCmd where   alignment _ = #alignment struct glirc_command   sizeOf    _ = #size      struct glirc_command@@ -236,9 +265,11 @@  ------------------------------------------------------------------------ --- | @struct glirc_string@+-- | Pointer to UTF-8 encoded string and as string length. Strings are+-- null-terminated. The null-terminator is not counted in the length. data FgnStringLen = FgnStringLen !CString !CSize +-- | @struct glirc_string@ instance Storable FgnStringLen where   alignment _ = #alignment struct glirc_string   sizeOf    _ = #size      struct glirc_string

@@ -53,7 +53,6 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import           Data.Maybe (fromMaybe)-import           Data.Monoid ((<>)) import           Data.Text (Text) import qualified Data.Text as Text import           Data.Time@@ -1835,8 +1834,8 @@ computeBanUserInfo :: Identifier -> NetworkState    -> UserInfo computeBanUserInfo who cs =   case view (csUser who) cs of-    Nothing                   -> UserInfo who "*" "*"-    Just (UserAndHost _ host) -> UserInfo "*" "*" host+    Nothing                     -> UserInfo who "*" "*"+    Just (UserAndHost _ host _) -> UserInfo "*" "*" host  cmdRemove :: ChannelCommand (String, String) cmdRemove channelId cs st (who,reason) =@@ -1968,14 +1967,14 @@ -- Attempt to reload the configuration file cmdReload :: ClientCommand (Maybe String) cmdReload st mbPath =-  do let path   = mbPath <|> view clientConfigPath st+  do let path = mbPath <|> Just (view clientConfigPath st)      res <- loadConfiguration path      case res of        Left e -> commandFailureMsg (describeProblem e) st-       Right cfg ->+       Right (path',cfg) ->          do st1 <- clientStartExtensions                  $ set clientConfig cfg-                 $ set clientConfigPath mbPath st+                 $ set clientConfigPath path' st             commandSuccess st1    where@@ -2146,7 +2145,7 @@     usermasks =       [ mkId ("*!*@" <> host)         | nick <- HashMap.keys (view (csChannels . ix channel . chanUsers) cs)-        , UserAndHost _ host <- toListOf (csUsers . ix nick) cs+        , UserAndHost _ host _ <- toListOf (csUsers . ix nick) cs         ]  -- | Predicate for mode commands that can be performed without ops

@@ -19,7 +19,6 @@ import           Control.Lens import           Control.Monad.Trans.State import           Data.Functor.Compose-import           Data.Semigroup ((<>)) import qualified Data.Text as Text import           Graphics.Vty (wcswidth) import           Graphics.Vty.Attributes

@@ -10,6 +10,13 @@ This module is able to parse commands with inline variables and then to evaluate those variables to produce a complete command that varies by the current context.++Variables are built from 1 or more letters.++Optional arguments are suffixed with a @?@++Remaining text arguments are suffixed with a @*@+ -} module Client.Commands.Interpolation   ( ExpansionChunk(..)@@ -66,16 +73,19 @@  macroSpecs :: Parser MacroSpec macroSpecs =-  cons <$> P.takeWhile1 isAlpha-       <*> optional (char '?')-       <*  P.skipSpace-       <*> macroSpecs-    <|> pure (MacroSpec (pure []))+  do var <- P.takeWhile1 isAlpha+     mode <- optional (True <$ char '?' <|> False <$ char '*')+     P.skipSpace+     case mode of+       Nothing    -> addReq var <$> macroSpecs+       Just True  -> addOpt var <$> macroSpecs+       Just False -> MacroSpec (pure <$> remainingArg (Text.unpack var)) <$ P.endOfInput+  <|> noMacroArguments <$ P.endOfInput   where     add1 desc = liftA2 (:) (simpleToken (Text.unpack desc)) -    cons desc (Just _) (MacroSpec rest) = MacroSpec (fromMaybe [] <$> optionalArg (add1 desc rest))-    cons desc Nothing  (MacroSpec rest) = MacroSpec (add1 desc rest)+    addOpt var (MacroSpec rest) = MacroSpec (fromMaybe [] <$> optionalArg (add1 var rest))+    addReq var (MacroSpec rest) = MacroSpec (add1 var rest)  -- | Parse a 'Text' searching for the expansions as specified in -- 'ExpansionChunk'. @$$@ is used to escape a single @$@.@@ -111,13 +121,14 @@ -- the two expansion functions. If the expansion of any chunk -- fails the whole expansion fails. resolveMacroExpansions ::-  (Text    -> Maybe Text) {- ^ variable resolution       -} ->-  (Integer -> Maybe Text) {- ^ argument index resolution -} ->-  [ExpansionChunk]        {- ^ chunks                    -} ->-  Maybe Text              {- ^ concatenated, expanded chunks -}+  Alternative f =>+  (Text    -> f Text) {- ^ variable resolution           -} ->+  (Integer -> f Text) {- ^ argument index resolution     -} ->+  [ExpansionChunk]    {- ^ chunks                        -} ->+  f Text              {- ^ concatenated, expanded chunks -} resolveMacroExpansions var arg xs = Text.concat <$> traverse resolve1 xs   where-    resolve1 (LiteralChunk lit) = Just lit+    resolve1 (LiteralChunk lit) = pure lit     resolve1 (VariableChunk v)  = var v     resolve1 (IntegerChunk i)   = arg i-    resolve1 (DefaultChunk p d) = resolve1 p <|> Just d+    resolve1 (DefaultChunk p d) = resolve1 p <|> pure d

@@ -25,7 +25,6 @@ import Control.Applicative hiding (empty)  import           Data.HashMap.Strict (lookup,insertWith,HashMap,empty,unionWith,fromList,toList)-import           Data.Semigroup import           Data.Text (Text) import qualified Data.Text as Text import           Data.Maybe

@@ -21,6 +21,7 @@   , ConfigurationFailure(..)   , LayoutMode(..)   , PaddingMode(..)+  , ExtensionConfiguration(..)    -- * Lenses   , configDefaults@@ -41,6 +42,10 @@   , configShowPing   , configJumpModifier +  , extensionPath+  , extensionRtldFlags+  , extensionArgs+   -- * Loading configuration   , loadConfiguration @@ -49,6 +54,11 @@    -- * Specification   , configurationSpec++  -- * FilePath resolution+  , FilePathContext+  , newFilePathContext+  , resolveFilePath   ) where  import           Client.Commands.Interpolation@@ -70,7 +80,7 @@ import qualified Data.HashSet                        as HashSet import qualified Data.List.NonEmpty                  as NonEmpty import           Data.Maybe-import           Data.Monoid                         (Endo(..), (<>))+import           Data.Monoid                         (Endo(..)) import           Data.Text                           (Text) import qualified Data.Text                           as Text import qualified Data.Text.IO                        as Text@@ -80,6 +90,7 @@ import           System.Directory import           System.FilePath import           System.IO.Error+import           System.Posix.DynamicLinker          (RTLDFlags(..))  -- | Top-level client configuration information. When connecting to a -- server configuration from '_configServers' is used where possible,@@ -92,7 +103,7 @@   , _configExtraHighlights :: HashSet Identifier -- ^ Extra highlight nicks/terms   , _configNickPadding     :: PaddingMode -- ^ Padding of nicks in messages   , _configMacros          :: Recognizer Macro -- ^ command macros-  , _configExtensions      :: [FilePath] -- ^ paths to shared library+  , _configExtensions      :: [ExtensionConfiguration] -- ^ extensions to load   , _configUrlOpener       :: Maybe FilePath -- ^ paths to url opening executable   , _configIgnores         :: [Text] -- ^ initial ignore mask list   , _configActivityBar     :: Bool -- ^ initially visibility of the activity bar@@ -119,7 +130,6 @@   | TwoColumn   deriving Show -makeLenses ''Configuration  -- | Failure cases when loading a configuration file. data ConfigurationFailure@@ -137,6 +147,18 @@ -- | default instance instance Exception ConfigurationFailure +-- | Configuration information for run-time loaded dynamic+-- library extensions.+data ExtensionConfiguration = ExtensionConfiguration+  { _extensionPath      :: FilePath -- ^ path to shared object+  , _extensionRtldFlags :: [RTLDFlags] -- ^ dynamic linker flags+  , _extensionArgs      :: [Text] -- ^ arguments to the extension on startup+  }+  deriving Show++makeLenses ''Configuration+makeLenses ''ExtensionConfiguration+ -- | The default client behavior for naming windows is to use the first two -- rows of a QWERTY keyboard followed by the first two rows combined with -- SHIFT.@@ -197,9 +219,12 @@   -- | Load the configuration file defaulting to @~/.glirc/config@.+--+-- Given configuration path is optional and actual path used will+-- be returns on success loadConfiguration ::   Maybe FilePath {- ^ path to configuration file -} ->-  IO (Either ConfigurationFailure Configuration)+  IO (Either ConfigurationFailure (FilePath, Configuration)) loadConfiguration mbPath = try $   do (path,txt) <- readConfigurationFile mbPath      def  <- loadDefaultServerSettings@@ -215,7 +240,9 @@                 $ Text.unpack                 $ Text.unlines                 $ map explainLoadError (toList es)-       Right cfg -> resolvePaths path (cfg def)+       Right cfg ->+         do cfg' <- resolvePaths path (cfg def)+            return (path, cfg')   -- | Generate a human-readable explanation of an error arising from@@ -249,7 +276,7 @@                                 . over (ssTlsServerCert . mapped) res                                 . over (ssSaslEcdsaFile . mapped) res                                 . over (ssLogDir        . mapped) res-     return $! over (configExtensions . mapped) res+     return $! over (configExtensions . mapped . extensionPath) res              . over (configServers    . mapped) resolveServerFilePaths              $ cfg @@ -272,8 +299,8 @@                                "Modifier used to jump to a window by name. Defaults to `meta`."      _configMacros          <- sec' mempty "macros" macroMapSpec                                "Programmable macro commands"-     _configExtensions      <- sec' [] "extensions" (listSpec stringSpec)-                               "Filenames of extension libraries to load at startup"+     _configExtensions      <- sec' [] "extensions" (listSpec extensionSpec)+                               "extension libraries to load at startup"      _configUrlOpener       <- optSection' "url-opener" stringSpec                                "External command used by /url command"      _configExtraHighlights <- sec' mempty "extra-highlights" identifierSetSpec@@ -402,6 +429,44 @@              "Colors used to highlight nicknames"            : [ optSection' lbl (set l <$> attrSpec) "" | (lbl, Lens l) <- paletteMap ] +extensionSpec :: ValueSpecs ExtensionConfiguration+extensionSpec = simpleExtensionSpec <!> fullExtensionSpec++-- | Default dynamic linker flags: @RTLD_LOCAL@ and @RTLD_NOW@+defaultRtldFlags :: [RTLDFlags]+defaultRtldFlags = [RTLD_LOCAL, RTLD_NOW]++-- | Given only a filepath build an extension configuration that+-- loads the extension using the 'defaultRtldFlags' and no arguments.+simpleExtensionSpec :: ValueSpecs ExtensionConfiguration+simpleExtensionSpec =+  do _extensionPath <- stringSpec+     pure ExtensionConfiguration+       { _extensionRtldFlags = defaultRtldFlags+       , _extensionArgs      = []+       , .. }++-- | Full extension configuration allows the RTLD flags to be manually+-- specified. This can be useful if the extension defines symbols that+-- need to be visible to libraries that the extension is linked against.+fullExtensionSpec :: ValueSpecs ExtensionConfiguration+fullExtensionSpec =+  sectionsSpec "extension" $+  do _extensionPath      <- reqSection' "path"       stringSpec+                            "Path to shared object"+     _extensionRtldFlags <- fromMaybe defaultRtldFlags <$>+                            optSection' "rtld-flags" (listSpec rtldFlagSpec)+                            "Runtime dynamic linker flags"+     _extensionArgs      <- fromMaybe [] <$> optSection "args"+                            "Extension-specific configuration arguments"+     pure ExtensionConfiguration {..}++rtldFlagSpec :: ValueSpecs RTLDFlags+rtldFlagSpec = namedSpec "rtld-flag"+             $ RTLD_LOCAL  <$ atomSpec "local"+           <!> RTLD_GLOBAL <$ atomSpec "global"+           <!> RTLD_NOW    <$ atomSpec "now"+           <!> RTLD_LAZY   <$ atomSpec "lazy"  buildServerMap ::   ServerSettings {- ^ defaults -} ->

@@ -28,11 +28,11 @@   do name     <- reqSection "name" ""      spec     <- fromMaybe noMacroArguments              <$> optSection' "arguments" macroArgumentsSpec ""-     commands <- reqSection' "commands" (listSpec macroCommandSpec) ""+     commands <- reqSection' "commands" (oneOrList macroCommandSpec) ""      return (name, Macro spec commands)  macroArgumentsSpec :: ValueSpecs MacroSpec-macroArgumentsSpec = customSpec "macro arguments" valuesSpec parseMacroSpecs+macroArgumentsSpec = customSpec "macro-arguments" valuesSpec parseMacroSpecs  macroCommandSpec :: ValueSpecs [ExpansionChunk]-macroCommandSpec = customSpec "macro command" valuesSpec parseExpansion+macroCommandSpec = customSpec "macro-command" valuesSpec parseExpansion

@@ -34,7 +34,6 @@ import qualified Data.Map as Map import           Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap-import           Data.Semigroup ((<>)) import           Data.Text (Text) import qualified Data.Text as Text import           Text.Read

@@ -31,10 +31,11 @@ -- handle a message ('PassMessage'), filter out a message ('OmitMessage'), -- or change a message into an arbitrary other message ('RemapMessage'). data MessageResult-  = PassMessage-  | OmitMessage-  | RemapMessage IrcMsg+  = PassMessage -- ^ continue processing+  | OmitMessage -- ^ stop processing and drop message+  | RemapMessage IrcMsg -- ^ stop processing and return new message +-- 'PassMessage' is an identity element instance Semigroup MessageResult where   PassMessage <> r = r   l           <> _ = l

@@ -17,7 +17,6 @@   ( buffextrasHook   ) where -import           Control.Monad import           Data.Attoparsec.Text as P import           Data.Text as Text hiding (head) @@ -51,12 +50,12 @@ prefixedParser chan = do     pfx <- prefixParser     choice-      [ Join pfx chan <$ skipToken "joined"-      , Quit pfx . filterEmpty <$ skipToken "quit with message:" <*> parseReason-      , Part pfx chan . filterEmpty <$ skipToken "parted with message:" <*> parseReason+      [ Join pfx chan "" <$ skipToken "joined"+      , Quit pfx . filterEmpty <$ skipToken "quit:" <*> P.takeText+      , Part pfx chan . filterEmpty <$ skipToken "parted:" <*> P.takeText       , Nick pfx . mkId <$ skipToken "is now known as" <*> simpleTokenParser       , Mode pfx chan <$ skipToken "set mode:" <*> allTokens-      , Kick pfx chan <$ skipToken "kicked" <*> parseId <* skipToken "Reason:" <*> parseReason+      , Kick pfx chan <$ skipToken "kicked" <*> parseId <* skipToken "with reason:" <*> P.takeText       , Topic pfx chan <$ skipToken "changed the topic to:" <*> P.takeText       ] @@ -73,9 +72,3 @@ filterEmpty txt   | Text.null txt = Nothing   | otherwise     = Just txt--parseReason :: Parser Text-parseReason =-  do txt <- char '[' *> P.takeText-     guard (not (Text.null txt) && Text.last txt == ']')-     return (Text.init txt)

@@ -149,8 +149,8 @@   case body of     IrcBody irc | NormalRender   <- rm -> ircLineImage     params irc                 | DetailedRender <- rm -> fullIrcLineImage params irc-    ErrorBody  txt                     -> text' defAttr (cleanText txt)-    NormalBody txt                     -> text' defAttr (cleanText txt)+    ErrorBody  txt                     -> parseIrcText txt+    NormalBody txt                     -> parseIrcText txt  -- | Render a 'ZonedTime' as time using quiet attributes --@@ -257,7 +257,9 @@     BatchStart{}   -> mempty     BatchEnd{}     -> mempty +    Account user _ -> who user <> " account:" + -- | Render a chat message given a rendering mode, the sigils of the user -- who sent the message, and a list of nicknames to highlight. ircLineImage ::@@ -297,6 +299,8 @@     Cap _ args        -> separatedParams args     Mode _ _ params   -> ircWords params +    Account _ acct -> if Text.null acct then "*" else text' defAttr (cleanText acct)+ -- | Render a chat message given a rendering mode, the sigils of the user -- who sent the message, and a list of nicknames to highlight. fullIrcLineImage ::@@ -320,9 +324,12 @@       " is now known as " <>       coloredIdentifier pal NormalIdentifier myNicks new -    Join nick _chan ->+    Join nick _chan acct ->       string quietAttr "join " <>-      coloredUserInfo pal rm myNicks nick+      coloredUserInfo pal rm myNicks nick <>+      if Text.null acct+        then mempty+        else " " <> text' quietAttr (cleanText acct)      Part nick _chan mbreason ->       string quietAttr "part " <>@@ -417,16 +424,23 @@     BatchStart{}   -> "BATCH +"     BatchEnd{}     -> "BATCH -" +    Account src acct ->+      string quietAttr "acct " <>+      who src <> ": " <>+      if Text.null acct then "*" else text' defAttr (cleanText acct) + renderCapCmd :: CapCmd -> Text renderCapCmd cmd =   case cmd of-    CapLs   -> "caps available"-    CapList -> "caps active"-    CapAck  -> "caps acknowledged"-    CapNak  -> "caps rejected"-    CapEnd  -> "caps finished" -- server shouldn't send this-    CapReq  -> "caps requested" -- server shouldn't send this+    CapLs   -> "caps-available"+    CapList -> "caps-active"+    CapAck  -> "caps-acknowledged"+    CapNak  -> "caps-rejected"+    CapEnd  -> "caps-finished" -- server shouldn't send this+    CapReq  -> "caps-requested" -- server shouldn't send this+    CapNew  -> "caps-offered"+    CapDel  -> "caps-withdrawn"  separatorImage :: Image' separatorImage = char (withForeColor defAttr blue) '·'

@@ -25,7 +25,6 @@ import           Data.Bits import           Data.Char import           Data.Maybe-import           Data.Semigroup ((<>)) import           Data.Text (Text) import           Graphics.Vty.Attributes 

@@ -83,7 +83,7 @@ ircSummary :: IrcMsg -> IrcSummary ircSummary msg =   case msg of-    Join who _      -> JoinSummary (userNick who)+    Join who _ _    -> JoinSummary (userNick who)     Part who _ _    -> PartSummary (userNick who)     Quit who _      -> QuitSummary (userNick who)     Nick who who'   -> NickSummary (userNick who) who'

@@ -169,7 +169,7 @@   , _clientNetworkMap        :: !(HashMap Text NetworkId) -- ^ network name to connection ID    , _clientConfig            :: !Configuration            -- ^ client configuration-  , _clientConfigPath        :: !(Maybe FilePath)         -- ^ client configuration file path+  , _clientConfigPath        :: !FilePath                 -- ^ client configuration file path    , _clientTextBox           :: !Edit.EditBox             -- ^ primary text box   , _clientTextBoxOffset     :: !Int                      -- ^ size to crop from left of text box@@ -240,7 +240,7 @@ clientLine = views (clientTextBox . Edit.line) (\(Edit.Line n t) -> (n, t))  -- | Construct an initial 'ClientState' using default values.-withClientState :: Maybe FilePath -> Configuration -> (ClientState -> IO a) -> IO a+withClientState :: FilePath -> Configuration -> (ClientState -> IO a) -> IO a withClientState cfgPath cfg k =    withExtensionState $ \exts ->

@@ -28,7 +28,6 @@   ) where  import           Control.Lens-import           Data.Monoid ((<>)) import           Data.Text (Text) import           Irc.Identifier 

@@ -48,6 +48,9 @@    -- * User information   , UserAndHost(..)+  , uhUser+  , uhHost+  , uhAccount    -- * Cross-message state   , Transaction(..)@@ -140,9 +143,11 @@   deriving Show  -- | Pair of username and hostname. Empty strings represent missing information.-data UserAndHost =-  UserAndHost {-# UNPACK #-} !Text {-# UNPACK #-} !Text-  -- ^ username hostname+data UserAndHost = UserAndHost+  { _uhUser    :: {-# UNPACK #-}!Text -- ^ username+  , _uhHost    :: {-# UNPACK #-}!Text -- ^ hostname+  , _uhAccount :: {-# UNPACK #-}!Text -- ^ services account+  }   deriving Show  -- | Status of the ping timer@@ -164,9 +169,11 @@   | NamesTransaction [Text]   | BanTransaction [(Text,MaskListEntry)]   | WhoTransaction [UserInfo]+  | CapTransaction   deriving Show  makeLenses ''NetworkState+makeLenses ''UserAndHost makePrisms ''Transaction makePrisms ''PingStatus makePrisms ''TimedAction@@ -189,12 +196,26 @@   where     transmit = send (view csSocket cs) . renderRawIrcMsg +    actionPrefix = "\^AACTION "+    actionSuffix = "\^A"++    -- Special case for splitting a single CTCP ACTION into+    -- multiple actions+    multiline cmd tgt txt+      | Just txt1 <- Text.stripPrefix actionPrefix txt+      , Just txt2 <- Text.stripSuffix actionSuffix txt1 =+      let txtChunks     = utf8ChunksOf maxContentLen txt2+          maxContentLen = computeMaxMessageLength (view csUserInfo cs) tgt+                        - Text.length actionPrefix - Text.length actionSuffix+      in for_ txtChunks $ \txtChunk ->+           transmit $ rawIrcMsg cmd [tgt, actionPrefix <> txtChunk <> actionSuffix]++    -- Normal case     multiline cmd tgt txt =-      for_ txtChunks $ \txtChunk ->-        transmit $ rawIrcMsg cmd [tgt, txtChunk]-      where-        txtChunks = utf8ChunksOf maxContentLen txt-        maxContentLen = computeMaxMessageLength (view csUserInfo cs) tgt+      let txtChunks     = utf8ChunksOf maxContentLen txt+          maxContentLen = computeMaxMessageLength (view csUserInfo cs) tgt+      in for_ txtChunks $ \txtChunk ->+           transmit $ rawIrcMsg cmd [tgt, txtChunk]  -- This is an approximation for splitting the text. It doesn't -- understand combining characters. A correct implementation@@ -238,7 +259,7 @@   , _csSocket       = sock   , _csChannelTypes = defaultChannelTypes   , _csModeTypes    = defaultModeTypes-  , _csTransaction  = NoTransaction+  , _csTransaction  = CapTransaction   , _csModes        = ""   , _csStatusMsg    = ""   , _csSettings     = settings@@ -276,12 +297,16 @@   case msg of     Ping args -> ([ircPong args], cs)     Pong _    -> noReply $ doPong msgWhen cs-    Join user chan ->+    Join user chan acct ->            noReply-         $ recordUser user+         $ recordUser user acct          $ overChannel chan (joinChannel (userNick user))          $ createOnJoin user chan cs +    Account user acct ->+           noReply+         $ recordUser user acct cs+     Quit user _reason ->            noReply          $ forgetUser (userNick user)@@ -298,10 +323,18 @@          $ overChannels (nickChange (userNick oldNick) newNick) cs      Reply RPL_WELCOME (me:_) -> doWelcome msgWhen (mkId me) cs-    Reply RPL_SASLSUCCESS _ -> ([ircCapEnd], cs)-    Reply RPL_SASLFAIL _ -> ([ircCapEnd], cs)+    Reply RPL_SASLSUCCESS _ -> endCapTransaction cs+    Reply RPL_SASLFAIL _ -> endCapTransaction cs     Reply ERR_NICKNAMEINUSE (_:badnick:_)       | PingConnecting{} <- view csPingStatus cs -> doBadNick badnick cs+    Reply RPL_HOSTHIDDEN (_:host:_) ->+        noReply (set (csUserInfo . uiHost) host cs)++    -- /who <#channel> %tuhna,616+    Reply RPL_WHOSPCRPL [_me,"616",user,host,nick,acct] ->+       let acct' = if acct == "0" then "" else acct+       in noReply (recordUser (UserInfo (mkId nick) user host) acct' cs)+     Reply code args        -> noReply (doRpl code msgWhen args cs)     Cap cmd params         -> doCap cmd params cs     Authenticate param     -> doAuthenticate param cs@@ -336,6 +369,7 @@   . set csNick me   . set csNextPingTime (Just $! addUTCTime 30 (zonedTimeToUTC msgWhen))   . set csPingStatus PingNone+  . set csTransaction NoTransaction -- wipe out CapTransaction if it was active  -- | Handle 'ERR_NICKNAMEINUSE' errors when connecting. doBadNick ::@@ -540,6 +574,7 @@     RPL_UMODEIS         -> True     RPL_WHOREPLY        -> True     RPL_ENDOFWHO        -> True+    RPL_WHOSPCRPL       -> True     RPL_TOPICWHOTIME    -> True     RPL_CREATIONTIME    -> True     RPL_CHANNEL_URL     -> True@@ -631,11 +666,24 @@       | otherwise         = mode:modes     applyOne modes (False, mode, _) = delete mode modes -supportedCaps :: NetworkState -> [Text]-supportedCaps cs =-  sasl ++ ["multi-prefix", "batch", "znc.in/playback",-           "server-time", "znc.in/self-message"]+selectCaps ::+  NetworkState {- ^ network state  -} ->+  [Text]       {- ^ server caps    -} ->+  [Text]       {- ^ caps to enable -}+selectCaps cs offered = supported `intersect` offered   where+    supported =+      sasl ++ serverTime +++      ["multi-prefix", "batch", "znc.in/playback", "znc.in/self-message"+      , "cap-notify", "extended-join", "account-notify" ]++    -- logic for using IRCv3.2 server-time if available and falling back+    -- to ZNC's specific extension otherwise.+    serverTime+      | "server-time"            `elem` offered = ["server-time"]+      | "znc.in/server-time-iso" `elem` offered = ["znc.in/server-time-iso"]+      | otherwise                               = []+     ss = view csSettings cs     sasl = ["sasl" | isJust (view ssSaslUsername ss)                    , isJust (view ssSaslPassword ss) ||@@ -669,25 +717,41 @@ doCap cmd args cs =   case (cmd,args) of     (CapLs,[capsTxt])-      | null reqCaps -> ([ircCapEnd], cs)+      | null reqCaps -> endCapTransaction cs       | otherwise -> ([ircCapReq reqCaps], cs)       where         caps = Text.words capsTxt-        reqCaps = intersect (supportedCaps cs) caps+        reqCaps = selectCaps cs caps +    (CapNew,[capsTxt])+      | null reqCaps -> ([], cs)+      | otherwise -> ([ircCapReq reqCaps], cs)+      where+        caps = Text.words capsTxt+        reqCaps = selectCaps cs caps++    (CapDel,_) -> ([],cs)+     (CapAck,[capsTxt])       | "sasl" `elem` caps ->           if isJust (view ssSaslEcdsaFile ss)-            then ([ircAuthenticate Ecdsa.authenticationMode], set csAuthenticationState AS_EcdsaStarted cs)+            then ( [ircAuthenticate Ecdsa.authenticationMode]+                 , set csAuthenticationState AS_EcdsaStarted cs)           else if isJust (view ssSaslUsername ss)-            then ([ircAuthenticate plainAuthenticationMode], set csAuthenticationState AS_PlainStarted cs)-          else ([ircCapEnd], cs)+            then ( [ircAuthenticate plainAuthenticationMode]+                 , set csAuthenticationState AS_PlainStarted cs)+          else endCapTransaction cs       where         ss   = view csSettings cs         caps = Text.words capsTxt -    _ -> ([ircCapEnd], cs)+    _ -> endCapTransaction cs +endCapTransaction :: NetworkState -> ([RawIrcMsg], NetworkState)+endCapTransaction cs =+  case view csTransaction cs of+    CapTransaction -> ([ircCapEnd], set csTransaction NoTransaction cs)+    _              -> ([], cs)  initialMessages :: NetworkState -> [RawIrcMsg] initialMessages cs@@ -800,11 +864,11 @@ csUser :: Functor f => Identifier -> LensLike' f NetworkState (Maybe UserAndHost) csUser i = csUsers . at i -recordUser :: UserInfo -> NetworkState -> NetworkState-recordUser (UserInfo nick user host)+recordUser :: UserInfo -> Text -> NetworkState -> NetworkState+recordUser (UserInfo nick user host) acct   | Text.null user || Text.null host = id   | otherwise = set (csUsers . at nick)-                    (Just (UserAndHost user host))+                    (Just $! UserAndHost user host acct)  forgetUser :: Identifier -> NetworkState -> NetworkState forgetUser = over csUsers . sans@@ -838,7 +902,11 @@       | not (Text.null user)       , not (Text.null host)       , HashSet.member nick channelUsers =-              HashMap.insert nick (UserAndHost user host) users+            HashMap.alter+                (\mb -> case mb of+                          Nothing                     -> Just $! UserAndHost user host ""+                          Just (UserAndHost _ _ acct) -> Just $! UserAndHost user host acct+                ) nick users       | otherwise = users  -- | Compute the earliest timed action for a connection, if any

@@ -42,17 +42,23 @@ paletteViewLines :: Palette -> [Image'] paletteViewLines pal = reverse $ -  [ "Current client palette"+  [ "Current client palette:"   , ""   , columns (paletteEntries pal)   , "" -  , "Current client palette nick highlight colors"+  , "Current client palette nick highlight colors:"   , ""   , columns (nickHighlights pal)   , "" -  , "Chat formatting colors: ^C[foreground[,background]]"+  , "Chat formatting modes:"+  , ""+  , "   C-b  C-_       C-]    C-v     C-o"+  , parseIrcText "   \^Bbold\^B \^_underline\^_ \^]italic\^] \^Vreverse\^V reset"+  , ""++  , "Chat formatting colors: C-c[foreground[,background]]"   , ""   , columns ("   " : map decimalImage [0..15])   , columns mircColors

@@ -1,4 +1,4 @@-{-# Language CPP, OverloadedStrings #-}+{-# Language OverloadedStrings #-} {-| Module      : Client.View.RtsStats Description : View current GHC RTS statistics@@ -6,8 +6,7 @@ License     : ISC Maintainer  : emertens@gmail.com -Lines for the @/rtsstats@ command. This module depends-on GHC 8.2.1 API.+Lines for the @/rtsstats@ command.  -} @@ -26,7 +25,7 @@ rtsStatsLines Nothing pal = [text' (view palError pal) "Statistics not available"] rtsStatsLines (Just stats) pal   | null entries = [text' (view palError pal) "Statistics empty"]-  | otherwise    = zipWith (\v l -> padV wv v <> " " <> l) valueImages labelImages +  | otherwise    = zipWith (\v l -> padV wv v <> " " <> l) valueImages labelImages   where     entries     = statsToEntries stats     labelImages = map (text' (view palLabel pal) . fst) entries

@@ -114,21 +114,22 @@      pal = clientPalette st -    renderEntry (info, sigils) =+    renderEntry ((info, acct), sigils) =       string (view palSigil pal) sigils <>-      coloredUserInfo pal DetailedRender myNicks info+      coloredUserInfo pal DetailedRender myNicks info <>+      " " <> text' (view palMeta pal) (cleanText acct) -    matcher' (info,sigils) =-      matcher (LText.fromChunks [Text.pack sigils, renderUserInfo info])+    matcher' ((info, acct),sigils) =+      matcher (LText.fromChunks [Text.pack sigils, renderUserInfo info, " ", acct])      userInfos = view csUsers cs      toInfo nick =       case view (at nick) userInfos of-        Just (UserAndHost n h) -> UserInfo nick n h-        Nothing                -> UserInfo nick "" ""+        Just (UserAndHost n h a) -> (UserInfo nick n h, a)+        Nothing                  -> (UserInfo nick "" "", "") -    usersList = sortBy (flip (comparing (userNick . fst)))+    usersList = sortBy (flip (comparing (userNick . fst . fst)))               $ filter matcher'               $ map (over _1 toInfo)               $ HashMap.toList usersHashMap

@@ -1,8 +1,8 @@-{-# Language OverloadedStrings, CPP #-}+{-# Language OverloadedStrings #-}  {-| Module      : RtsStats-Description : Compatibility layer for GHC RTS statistics across versions+Description : Human readable interface to GHC RTS statistics Copyright   : (c) Eric Mertens, 2017 License     : ISC Maintainer  : emertens@gmail.com@@ -15,12 +15,12 @@   , statsToEntries   ) where -import           Data.Int-import           Data.List (intercalate)+import           Data.Int        (Int64)+import           Data.List       (intercalate) import           Data.List.Split (chunksOf)-import           Data.Text (Text)+import           Data.Text       (Text) import qualified Data.Text as Text-import           Data.Word+import           Data.Word       (Word32, Word64) import           GHC.Stats  class    Render a      where render :: a -> Text@@ -37,8 +37,6 @@ addCommas :: String -> String addCommas = reverse . intercalate "," . chunksOf 3 . reverse -#if MIN_VERSION_base(4,10,0)- newtype Stats = Stats RTSStats  getStats :: IO (Maybe Stats)@@ -48,7 +46,8 @@                 else pure Nothing  statsToEntries :: Stats -> [(Text, Text)]-statsToEntries (Stats rts) = seq rgc+statsToEntries (Stats rts) =+  let rgc = gc rts in seq rgc   [ ("GCs"                                 , render $ gcs                             rts)   , ("Major GCs"                           , render $ major_gcs                       rts)   , ("Allocated bytes"                     , render $ allocated_bytes                 rts)@@ -84,42 +83,3 @@   , ("Elapsed ns"                          , render $ gcdetails_elapsed_ns            rgc)   , ("==[Last GC]=="                       , ""                                          )   ]-  where-    rgc = gc rts--#else--statsToEntries :: Stats -> [(Text, Text)]-statsToEntries (Stats rts) = seq rts-  [ ("Allocated bytes"            , render $ bytesAllocated         rts)-  , ("GCs"                        , render $ numGcs                 rts)-  , ("Major GCs"                  , render $ numByteUsageSamples    rts)-  , ("Cumulative allocated bytes" , render $ maxBytesUsed           rts)-  , ("Cumulative live bytes"      , render $ cumulativeBytesUsed    rts)-  , ("Cumulative copied  bytes"   , render $ bytesCopied            rts)-  , ("Max slop bytes"             , render $ maxBytesSlop           rts)-  , ("Maximum allocated megabytes", render $ peakMegabytesAllocated rts)-  , ("Mutator CPU seconds"        , render $ mutatorCpuSeconds      rts)-  , ("Mutator elapsed seconds"    , render $ mutatorWallSeconds     rts)-  , ("GC CPU seconds"             , render $ gcCpuSeconds           rts)-  , ("GC elapsed seconds"         , render $ gcWallSeconds          rts)-  , ("CPU seconds"                , render $ cpuSeconds             rts)-  , ("Elapsed seconds"            , render $ wallSeconds            rts)-  , ("Total bytes copied"         , render $ parTotBytesCopied      rts)-  , ("Max parallel bytes copied"  , render $ parMaxBytesCopied      rts)-  , ("==[Totals]=="               , ""                                 )-  , (""                           , ""                                 )-  , ("(last) Live bytes"          , render $ currentBytesUsed       rts)-  , ("(last) Slop bytes"          , render $ currentBytesSlop       rts)-  , ("==[Last GC]=="              , ""                                 )-  ]--newtype Stats = Stats GCStats--getStats :: IO (Maybe Stats)-getStats =-  do enabled <- getGCStatsEnabled-     if enabled then Just . Stats <$> getGCStats-                else pure Nothing--#endif

@@ -15,7 +15,7 @@   ( StrictUnit(..)   ) where -import           Data.Semigroup+import           Data.Semigroup (stimes, stimesIdempotent)  -- | Unit data type with a strict 'Semigroup' and 'Monoid' instances. data StrictUnit = StrictUnit