glirc 2.13 → 2.14

raw patch · 28 files changed

+690/−142 lines, 28 filesdep ~vtyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vty

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• README.md +4/−3
• glirc.cabal +4/−2
• src/Client/CApi.hs +5/−1
• src/Client/CommandArguments.hs +2/−0
• src/Client/Commands.hs +264/−63
• src/Client/Commands/Exec.hs +42/−8
• src/Client/Commands/Interpolation.hs +7/−2
• src/Client/Commands/WordCompletion.hs +13/−1
• src/Client/Configuration.hs +17/−5
• src/Client/Configuration/Colors.hs +6/−0
• src/Client/Configuration/ServerSettings.hs +2/−0
• src/Client/EventLoop.hs +2/−1
• src/Client/Image.hs +13/−6
• src/Client/Image/Arguments.hs +3/−3
• src/Client/Image/Help.hs +75/−0
• src/Client/Image/Message.hs +8/−1
• src/Client/Image/Palette.hs +27/−10
• src/Client/Image/PaletteView.hs +61/−0
• src/Client/Image/StatusLine.hs +56/−15
• src/Client/Image/Textbox.hs +2/−2
• src/Client/Image/UserList.hs +10/−3
• src/Client/Image/Windows.hs +4/−1
• src/Client/State.hs +33/−7
• src/Client/State/EditBox/Content.hs +1/−1
• src/Client/State/Focus.hs +2/−0
• src/Client/State/Network.hs +15/−7
• src/Config/FromConfig.hs +6/−0

@@ -1,5 +1,11 @@ # Revision history for glirc2 +## 2.14++* Add `/help`+* Add `/palette`+* Add F3 to toggle activity detail bar+ ## 2.13  * Add disconnect expansion, support expansions in connect-cmds

@@ -164,6 +164,7 @@ * `extensions` - list of text - Filenames of extension to load * `url-opener` - text - Command to execute with URL parameter for `/url` e.g. gnome-open on GNOME or open on macOS * `ignores` - list of text - Initial list of nicknames to ignore+* `activity-bar` - yes or no - Initial setting for visibility of activity bar (default no)  Settings --------@@ -207,9 +208,7 @@ * `mention` - attr - attr for mention notification * `command` - attr - attr for recognized command * `command-ready` - attr - attr for command with successful parse-* `command-required` - attr - attr for required command argument placeholder-* `command-optional` - attr - attr for optional command argument placeholder-* `command-remaining` - attr - attr for remaining command text placeholder+* `command-placeholder` - attr - attr for command argument placeholder  Text Attributes ---------------@@ -240,6 +239,7 @@  Client commands +* `/help [command]` - Show in-client help * `/exit` - Terminate the client * `/quit` - Gracefully terminate connection to the current server * `/connect <name>` - Connect to the given server@@ -340,6 +340,7 @@ * `M-D` delete word forwards * `TAB` nickname completion * `F2` toggle detailed view+* `F3` toggle detailed activity bar * `Page Up` scroll up * `Page Down` scroll down * `^B` bold

@@ -1,5 +1,5 @@ name:                glirc-version:             2.13+version:             2.14 synopsis:            Console IRC client description:         Console IRC client license:             ISC@@ -69,10 +69,12 @@                        Client.Image                        Client.Image.Arguments                        Client.Image.ChannelInfo+                       Client.Image.Help                        Client.Image.MaskList                        Client.Image.Message                        Client.Image.MircFormatting                        Client.Image.Palette+                       Client.Image.PaletteView                        Client.Image.StatusLine                        Client.Image.Textbox                        Client.Image.UserList@@ -122,7 +124,7 @@                        unix                 >=2.7    && <2.8,                        unordered-containers >=0.2.7  && <0.3,                        vector               >=0.11   && <0.12,-                       vty                  >=5.10   && <5.11,+                       vty                  >=5.10   && <5.12,                        x509                 >=1.6.3  && <1.7,                        x509-store           >=1.6.1  && <1.7,                        x509-system          >=1.6.3  && <1.7

@@ -12,7 +12,10 @@ -}  module Client.CApi-  ( ActiveExtension(..)+  ( -- * Extension type+    ActiveExtension(..)++  -- * Extension callbacks   , extensionSymbol   , activateExtension   , deactivateExtension@@ -122,6 +125,7 @@             then go rest msgPtr             else return False +-- | Notify an extension of a client command with the given parameters. commandExtension ::   Ptr ()          {- ^ client state stableptr -} ->   [Text]          {- ^ parameters             -} ->

@@ -14,6 +14,8 @@   (   -- * Command-line argument type     CommandArguments(..)++  -- * Lenses   , cmdArgConfigFile   , cmdArgInitialNetworks 

@@ -19,7 +19,9 @@   , tabCompletion   -- * Commands   , Command(..)+  , CommandImpl(..)   , commands+  , commandsList   ) where  import           Client.CApi@@ -44,6 +46,7 @@ import           Data.Foldable import           Data.HashMap.Strict (HashMap) import           Data.HashSet (HashSet)+import           Data.List.NonEmpty (NonEmpty((:|))) import           Data.List.Split import qualified Data.HashMap.Strict as HashMap import           Data.Text (Text)@@ -94,8 +97,8 @@   -- | requires an active channel window   | ChannelCommand (ChannelCommand a) (Bool -> ChannelCommand String) --- | Pair of a command and it's argument specification-data Command = forall a.  Command (ArgumentSpec a) (CommandImpl a)+-- | A command is an argument specification, implementation, and documentation+data Command = forall a. Command (ArgumentSpec a) Text (CommandImpl a)  -- | Consider the text entry successful and resume the client commandSuccess :: Monad m => ClientState -> m CommandResult@@ -150,7 +153,12 @@            CommandFailure st1 -> process cs st1 -- ?            CommandQuit st1    -> return (CommandQuit st1) -commandExpansion :: Maybe Text -> ClientState -> Text -> Maybe Text+-- | Compute the replacement value for the given expansion variable.+commandExpansion ::+  Maybe Text  {- ^ disconnect time    -} ->+  ClientState {- ^ client state       -} ->+  Text        {- ^ expansion variable -} ->+  Maybe Text  {- ^ expansion value    -} commandExpansion discoTime st v =   case v of     "network" -> views clientFocus focusNetwork st@@ -219,7 +227,7 @@         Nothing         -> commandFailureMsg "Unknown command" st         Just isReversed -> nickTabCompletion isReversed st -    Just (Command argSpec impl) ->+    Just (Command argSpec _docs impl) ->       case impl of         ClientCommand exec tab ->           finish argSpec exec tab@@ -243,219 +251,397 @@               finish argSpec (exec channelId cs) (\x -> tab x channelId cs)           | otherwise -> commandFailureMsg "This command requires an active chat window" st --- Expands each alias to have its own copy of the command callbacks-expandAliases :: [([a],b)] -> [(a,b)]-expandAliases xs = [ (a,b) | (as,b) <- xs, a <- as ]+-- | Expands each alias to have its own copy of the command callbacks+expandAliases :: [(NonEmpty a,b)] -> [(a,b)]+expandAliases xs = [ (a,b) | (as,b) <- xs, a <- toList as ] ++-- | Map of built-in client commands to their implementations, tab completion+-- logic, and argument structures. commands :: HashMap Text Command-commands = HashMap.fromList-         $ expandAliases+commands = HashMap.fromList (expandAliases commandsList) +commandsList :: [(NonEmpty Text,Command)]+commandsList =   --   -- Client commands   ---  [ ( ["connect"]+  [ ( pure "connect"     , Command (ReqTokenArg "network" NoArg)+      "Connect to \^Bnetwork\^B by name.\n\+      \\n\+      \If no name is configured the hostname is the 'name'.\n"     $ ClientCommand cmdConnect tabConnect     )-  , ( ["exit"]+  , ( pure "exit"     , Command NoArg+      "Exit the client immediately.\n"     $ ClientCommand cmdExit noClientTab     )-  , ( ["focus"]+  , ( pure "focus"     , Command (ReqTokenArg "network" (OptTokenArg "channel" NoArg))+      "Change the focused window.\n\+      \\n\+      \When only \^Bnetwork\^B is specified this switches to the network status window.\n\+      \When \^Bnetwork\^B and \^Bchannel\^B are specified this switches to that chat window.\n\+      \\n\+      \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\+      \See also: /channel (aliased /c) to switch to a channel on the current network.\n"     $ ClientCommand cmdFocus tabFocus     )-  , ( ["clear"]+  , ( pure "clear"     , Command (OptTokenArg "network" (OptTokenArg "channel" NoArg))+      "Clear a window.\n\+      \\n\+      \If no arguments are provided the current window is cleared.\n\+      \If \^Bnetwork\^B is provided the that network window is cleared.\n\+      \If \^Bnetwork\^B and \^Bchannel\^B are provided that chat window is cleared.\n\+      \\n\+      \If a window is cleared and no longer active that window will be removed from the client.\n"     $ ClientCommand cmdClear noClientTab     )-  , ( ["reconnect"]+  , ( pure "reconnect"     , Command NoArg+      "Reconnect to the current network.\n"     $ ClientCommand cmdReconnect noClientTab     )-  , ( ["ignore"]+  , ( pure "ignore"     , Command (RemainingArg "nicks")+      "Toggle the soft-ignore on each of the space-delimited given nicknames.\n"     $ ClientCommand cmdIgnore simpleClientTab     )-  , ( ["reload"]+  , ( pure "reload"     , Command (OptTokenArg "filename" NoArg)+      "Reload the client configuration file.\n\+      \\n\+      \If \^Bfilename\^B is provided it will be used to reload.\n\+      \Otherwise the previously loaded configuration file will be reloaded.\n"     $ ClientCommand cmdReload tabReload     )-  , ( ["extension"]+  , ( pure "extension"     , Command (ReqTokenArg "extension" (RemainingArg "arguments"))+      "Calls the process_command callback of the given extension.\n\+      \\n\+      \\^Bextension\^B should be the name of the loaded extension.\n"     $ ClientCommand cmdExtension simpleClientTab     )-  , ( ["windows"]+  , ( pure "windows"     , Command NoArg+      "Show a list of all client message windows.\n"     $ ClientCommand cmdWindows noClientTab     )-  , ( ["exec"]+  , ( pure "palette"+    , Command NoArg+      "Show the current palette settings and a color chart to help pick new colors.\n"+    $ ClientCommand cmdPalette noClientTab+    )+  , ( pure "exec"     , Command (RemainingArg "arguments")+      "Execute a command synchnonously sending the to a configuration destination.\n\+      \\n\+      \\^Barguments\^B: [-n network] [-c channel] [-i input] command [command arguments...]\n\+      \\n\+      \When \^Binput\^B is specified it is sent to the stdin.\n\+      \\n\+      \When neither \^Bnetwork\^B nor \^Bchannel\^B are specified output goes to client window (*)\n\+      \When \^Bnetwork\^B is specified output is sent as raw IRC traffic to the network.\n\+      \When \^Bchannel\^B is specified output is sent as chat to the given channel on the current network.\n\+      \When \^Bnetwork\^B and \^Bchannel\^B are specified output is sent as chat to the given channel on the given network.\n\+      \\n"     $ ClientCommand cmdExec simpleClientTab     )-  , ( ["url"]+  , ( pure "url"     , Command (OptTokenArg "number" NoArg)+      "Open a URL seen in chat.\n\+      \\n\+      \The URL is opened using the executable configured under \^Burl-opener\^B.\n\+      \\n\+      \When this command is active in the textbox, chat messages are filtered to only show ones with URLs.\n\+      \\n\+      \When \^Bnumber\^B is omitted it defaults to \^B1\^B. The number selects the URL to open counting back from the most recent.\n"     $ ClientCommand cmdUrl noClientTab     )+  , ( pure "help"+    , Command (OptTokenArg "command" NoArg)+      "Show command documentation.\n\+      \\n\+      \When \^Bcommand\^B is omitted a list of all commands is displayed.\n\+      \When \^Bcommand\^B is specified detailed help for that command is shown.\n"+    $ ClientCommand cmdHelp tabHelp+    )    --   -- Network commands   ---  , ( ["quote"]+  , ( pure "quote"     , Command (RemainingArg "raw IRC command")+      "Send a raw IRC command.\n"     $ NetworkCommand cmdQuote  simpleNetworkTab     )-  , ( ["j","join"]+  , ( "join" :| ["j"]     , Command (ReqTokenArg "channels" (OptTokenArg "keys" NoArg))+      "Join a chat channel.\n\+      \\n\+      \\^Bchannels\^B: comma-separated list of channels\n\+      \\^Bkeys\^B: comma-separated list of keys\n"     $ NetworkCommand cmdJoin   simpleNetworkTab     )-  , ( ["c","channel"]+  , ( "channel" :| ["c"]     , Command (ReqTokenArg "channel" NoArg)+      "Change the focused window.\n\+      \\n\+      \Changes the focus to the \^Bchannel\^B chat window on the current network.\n\+      \\n\+      \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\+      \See also: /focus to switch to a channel on a different network.\n\+      \See also: /focus to switch to a channel on a different network.\n"     $ NetworkCommand cmdChannel simpleNetworkTab     )-  , ( ["mode"]+  , ( pure "mode"     , Command (RemainingArg "modes and parameters")+      "Sets IRC modes.\n\+      \\n\+      \Examples:\n\+      \Setting a ban:           /mode +b *!*@hostname\n\+      \Removing a quiet:        /mode -q *!*@hostname\n\+      \Voicing two users:       /mode +vv user1 user2\n\+      \Demoting an op to voice: /mode +v-o user1 user1\n\+      \\n\+      \When executed in a network window, mode changes are applied to your user.\n\+      \When executed in a channel window, mode changes are applied to the channel.\n\+      \\n\+      \This command has parameter sensitive tab-completion.\n"     $ NetworkCommand cmdMode   tabMode     )-  , ( ["msg"]+  , ( pure "msg"     , Command (ReqTokenArg "target" (RemainingArg "message"))+      "Send a chat message to a user or a channel.\n\+      \\n\+      \\^Btarget\^B can be a channel or nickname.\n"     $ NetworkCommand cmdMsg    simpleNetworkTab     )-  , ( ["notice"]+  , ( pure "notice"     , Command (ReqTokenArg "target" (RemainingArg "message"))+      "Send a notice message to a user or a channel. Notices are typically used by bots.\n\+      \\n\+      \\^Btarget\^B can be a channel or nickname.\n"     $ NetworkCommand cmdNotice simpleNetworkTab     )-  , ( ["ctcp"]+  , ( pure "ctcp"     , Command (ReqTokenArg "target" (ReqTokenArg "command" (RemainingArg "arguments")))+      "Send a CTCP command to a user or a channel.\n\+      \\n\+      \Examples:\n\+      \Version query:    /ctcp user1 version\n\+      \Local-time query: /ctcp user1 time\n\+      \\n\+      \\^Btarget\^B can be a channel or nickname.\n\+      \\^Bcommand\^B can be any CTCP command.\n\+      \\^Barguments\^B are specific to a particular command.\n"     $ NetworkCommand cmdCtcp simpleNetworkTab     )-  , ( ["nick"]+  , ( pure "nick"     , Command (ReqTokenArg "nick" NoArg)+      "Change your nickname.\n"     $ NetworkCommand cmdNick   simpleNetworkTab     )-  , ( ["quit"]-    , Command (RemainingArg "quit message")+  , ( pure "quit"+    , Command (RemainingArg "reason")+      "Gracefully disconnect the current network connection.\n\+      \\n\+      \\^Breason\^B: optional quit reason\n\+      \\n\+      \See also: /disconnect /exit\n"     $ NetworkCommand cmdQuit   simpleNetworkTab     )-  , ( ["disconnect"]+  , ( pure "disconnect"     , Command NoArg+      "Immediately terminate the current network connection.\n\+      \\n\+      \See also: /quit /exit\n"     $ NetworkCommand cmdDisconnect noNetworkTab     )-  , ( ["who"]+  , ( pure "who"     , Command (RemainingArg "arguments")+      "Send WHO query to server with given arguments.\n"     $ NetworkCommand cmdWho simpleNetworkTab     )-  , ( ["whois"]+  , ( pure "whois"     , Command (RemainingArg "arguments")+      "Send WHOIS query to server with given arguments.\n"     $ NetworkCommand cmdWhois simpleNetworkTab     )-  , ( ["whowas"]+  , ( pure "whowas"     , Command (RemainingArg "arguments")+      "Send WHOWAS query to server with given arguments.\n"     $ NetworkCommand cmdWhowas simpleNetworkTab     )-  , ( ["ison"]+  , ( pure "ison"     , Command (RemainingArg "arguments")+      "Send ISON query to server with given arguments.\n"     $ NetworkCommand cmdIson   simpleNetworkTab     )-  , ( ["userhost"]+  , ( pure "userhost"     , Command (RemainingArg "arguments")+      "Send USERHOST query to server with given arguments.\n"     $ NetworkCommand cmdUserhost simpleNetworkTab     )-  , ( ["away"]-    , Command (RemainingArg "arguments")+  , ( pure "away"+    , Command (RemainingArg "message")+      "Set away status.\n\+      \\n\+      \When \^Bmessage\^B is omitted away status is cleared.\n"     $ NetworkCommand cmdAway   simpleNetworkTab     )-  , ( ["links"]+  , ( pure "links"     , Command (RemainingArg "arguments")+      "Send LINKS query to server with given arguments.\n"     $ NetworkCommand cmdLinks  simpleNetworkTab     )-  , ( ["time"]+  , ( pure "time"     , Command (RemainingArg "arguments")+      "Send TIME query to server with given arguments.\n"     $ NetworkCommand cmdTime   simpleNetworkTab     )-  , ( ["stats"]+  , ( pure "stats"     , Command (RemainingArg "arguments")+      "Send STATS query to server with given arguments.\n"     $ NetworkCommand cmdStats  simpleNetworkTab     )-  , ( ["znc"]+  , ( pure "znc"     , Command (RemainingArg "arguments")+      "Send command directly to ZNC.\n\+      \\n\+      \The advantage of this over /msg is that responses are not broadcast to call clients.\n"     $ NetworkCommand cmdZnc    simpleNetworkTab     )-  , ( ["znc-playback"]-    , Command (RemainingArg "arguments")+  , ( pure "znc-playback"+    , Command (OptTokenArg "time" (OptTokenArg "date" NoArg))+      "Request playback from the ZNC 'playback' module.\n\+      \\n\+      \\^Btime\^B determines the time to playback since.\n\+      \\^Bdate\^B determines the date to playback since.\n\+      \\n\+      \When both \^Btime\^B and \^Bdate\^B are omitted, all playback is requested.\n\+      \When both \^Bdate\^B is omitted it is defaulted the most recent date in the past that makes sense.\n\+      \\n\+      \Time format: HOURS:MINUTES (example: 7:00)\n\+      \Date format: YEAR-MONTH-DAY (example: 2016-06-16)\n\+      \\n\+      \Note that the playback module is not installed in ZNC by default!\n"     $ NetworkCommand cmdZncPlayback noNetworkTab     ) -  , ( ["invite"]+  , ( pure "invite"     , Command (ReqTokenArg "nick" NoArg)+      "Invite a user to the current channel.\n"     $ ChannelCommand cmdInvite simpleChannelTab     )-  , ( ["topic"]+  , ( pure "topic"     , Command (RemainingArg "message")+      "Set the topic on the current channel.\n\+      \\n\+      \Tab-completion with no \^Bmessage\^B specified will load the current topic for editing.\n"     $ ChannelCommand cmdTopic tabTopic     )-  , ( ["kick"]+  , ( pure "kick"     , Command (ReqTokenArg "nick" (RemainingArg "reason"))+      "Kick a user from the current channel.\n\+      \\n\+      \See also: /kickban /remove\n"     $ ChannelCommand cmdKick   simpleChannelTab     )-  , ( ["kickban"]+  , ( pure "kickban"     , Command (ReqTokenArg "nick" (RemainingArg "reason"))+      "Ban and kick a user from the current channel.\n\+      \\n\+      \Users are banned by hostname match.\n\+      \See also: /kick /remove\n"     $ ChannelCommand cmdKickBan simpleChannelTab     )-  , ( ["remove"]+  , ( pure "remove"     , Command (ReqTokenArg "nick" (RemainingArg "reason"))+      "Remove a user from the current channel.\n\+      \\n\+      \Remove works like /kick except it results in a PART.\n\+      \See also: /kick /kickban\n"     $ ChannelCommand cmdRemove simpleChannelTab     )-  , ( ["part"]+  , ( pure "part"     , Command (RemainingArg "reason")+      "Part from the current channel.\n"     $ ChannelCommand cmdPart simpleChannelTab     ) -  , ( ["users"]+  , ( pure "users"     , Command NoArg+      "Show the user list for the current channel.\n\+      \\n\+      \Detailed view (F2) shows full hostmask.\n\+      \Hostmasks can be populated with /who #channel.\n"     $ ChannelCommand cmdUsers  noChannelTab     )-  , ( ["channelinfo"]+  , ( pure "channelinfo"     , Command NoArg+      "Show information about the current channel.\n"     $ ChannelCommand cmdChannelInfo noChannelTab     )-  , ( ["masks"]+  , ( pure "masks"     , Command (ReqTokenArg "mode" NoArg)+      "Show mask lists for current channel.\n\+      \\n\+      \Common \^Bmode\^B values:\n\+      \\^Bb\^B: bans\n\+      \\^Bq\^B: quiets\n\+      \\^BI\^B: invite exemptions (op view only)\n\+      \\^Be\^B: ban exemption (op view only)s\n\+      \\n\+      \To populate the mask lists for the first time use: /mode \^Bmode\^B\n"     $ ChannelCommand cmdMasks noChannelTab     ) -  , ( ["me"]+  , ( pure "me"     , Command (RemainingArg "message")+      "Send an 'action' to the current chat window.\n"     $ ChatCommand cmdMe simpleChannelTab     )-  , ( ["say"]+  , ( pure "say"     , Command (RemainingArg "message")+      "Send a message to the current chat window.\n\+      \\n\+      \This can be useful for sending a chat message with a leading '/'.\n"     $ ChatCommand cmdSay simpleChannelTab     )   ] +-- | Provides no tab completion for client commands noClientTab :: Bool -> ClientCommand String noClientTab _ st _ = commandFailure st +-- | Provides no tab completion for network commands noNetworkTab :: Bool -> NetworkCommand String noNetworkTab _ _ st _ = commandFailure st +-- | Provides no tab completion for channel commands noChannelTab :: Bool -> ChannelCommand String noChannelTab _ _ _ st _ = commandFailure st +-- | Provides nickname based tab completion for client commands simpleClientTab :: Bool -> ClientCommand String simpleClientTab isReversed st _ =   nickTabCompletion isReversed st +-- | Provides nickname based tab completion for network commands simpleNetworkTab :: Bool -> NetworkCommand String simpleNetworkTab isReversed _ st _ =   nickTabCompletion isReversed st +-- | Provides nickname based tab completion for channel commands simpleChannelTab :: Bool -> ChannelCommand String simpleChannelTab isReversed _ _ st _ =   nickTabCompletion isReversed st +-- | Implementation of @/exit@ command. cmdExit :: ClientCommand () cmdExit st _ = return (CommandQuit st) @@ -490,7 +676,8 @@             ChannelFocus network channel -> has (clientConnection network                                                 .csChannels . ix channel) st -+-- | Implementation of @/quote@. Parses arguments as a raw IRC command and+-- sends to the current network. cmdQuote :: NetworkCommand String cmdQuote cs st rest =   case parseRawIrcMsg (Text.pack rest) of@@ -615,6 +802,21 @@ cmdWindows :: ClientCommand () cmdWindows st _ = commandSuccess (changeSubfocus FocusWindows st) +-- | Implementation of @/palette@ command. Set subfocus to Windows.+cmdPalette :: ClientCommand ()+cmdPalette st _ = commandSuccess (changeSubfocus FocusPalette st)++-- | Implementation of @/help@ command. Set subfocus to Windows.+cmdHelp :: ClientCommand (Maybe (String, ()))+cmdHelp st mb = commandSuccess (changeSubfocus focus st)+  where+    focus = FocusHelp (fmap (Text.pack . fst) mb)++tabHelp :: Bool -> ClientCommand String+tabHelp isReversed st _ = simpleTabCompletion id [] commandNames isReversed st+  where+    commandNames = [ cmd | (cmd :| _, _) <- commandsList ]+ simpleTabCompletion ::   Prefix a =>   (String -> String) {- ^ leading transform -} ->@@ -701,16 +903,15 @@   do sendMsg cs (ircZnc (Text.words (Text.pack rest)))      commandSuccess st --- TODO: support time ranges-cmdZncPlayback :: NetworkCommand String-cmdZncPlayback cs st rest =-  case words rest of+cmdZncPlayback :: NetworkCommand (Maybe (String, Maybe (String, ())))+cmdZncPlayback cs st args =+  case args of      -- request everything-    [] -> success "0"+    Nothing -> success "0"      -- current date explicit time-    [timeStr]+    Just (timeStr, Nothing)        | Just tod <- parse timeFormats timeStr ->           do now <- getZonedTime              let (nowTod,t) = (zonedTimeLocalTime . localTimeTimeOfDay <<.~ tod) now@@ -721,7 +922,7 @@              successZoned (fixDay t)      -- explicit date and time-    [dateStr,timeStr]+    Just (dateStr, Just (timeStr, _))        | Just day  <- parse dateFormats dateStr        , Just tod  <- parse timeFormats timeStr ->           do tz <- getCurrentTimeZone

@@ -11,24 +11,49 @@ can show channel bans, quiets, invites, and exceptions. -} -module Client.Commands.Exec where+module Client.Commands.Exec+  ( -- * Exec command configuration+    ExecCmd(..) +  -- * Lenses+  , execOutputNetwork+  , execOutputChannel++  -- * Operations+  , parseExecCmd+  , runExecCmd+  ) where+ import           Control.Exception import           Control.Lens import           System.Console.GetOpt import           System.Process +-- | Settings for @/exec@ command.+--+-- When no network or channel are specified the output is sent to the client+-- window.+--+-- When only a network is specified the output is sent as raw IRC commands to+-- that network.+--+-- When only a channel is specified the output is sent as messages on the+-- current network to the given channel.+--+-- When the network and channel are specified the output is sent as messages+-- to the given channel on the given network. data ExecCmd = ExecCmd-  { _execOutputNetwork :: Maybe String-  , _execOutputChannel :: Maybe String-  , _execCommand       :: String-  , _execStdIn         :: String-  , _execArguments     :: [String]+  { _execOutputNetwork :: Maybe String -- ^ output network+  , _execOutputChannel :: Maybe String -- ^ output channel+  , _execCommand       :: String       -- ^ command filename+  , _execStdIn         :: String       -- ^ stdin source+  , _execArguments     :: [String]     -- ^ command arguments   }   deriving (Read,Show)  makeLenses ''ExecCmd +-- | Default values for @/exec@ to be overridden by flags. emptyExecCmd :: ExecCmd emptyExecCmd = ExecCmd   { _execOutputNetwork = Nothing@@ -51,8 +76,13 @@         "Use string as stdin"   ] +-- | Parse the arguments to @/exec@ looking for various flags+-- and the command and its arguments.+-- -- TODO: support quoted strings-parseExecCmd :: String -> Either [String] ExecCmd+parseExecCmd ::+  String                  {- ^ exec arguments          -} ->+  Either [String] ExecCmd {- ^ error or parsed command -} parseExecCmd str =   case getOpt RequireOrder options (words str) of     (_, [] , errs) -> Left ("No command specified":errs)@@ -63,7 +93,11 @@                         $ emptyExecCmd     (_,_, errs) -> Left errs -runExecCmd :: ExecCmd -> IO (Either [String] [String])+-- | Execute the requested command synchronously and return+-- the output.+runExecCmd ::+  ExecCmd                       {- ^ exec configuration          -} ->+  IO (Either [String] [String]) {- ^ error lines or output lines -} runExecCmd e =   do res <- try (readProcess (view execCommand e)                              (view execArguments e)

@@ -35,6 +35,8 @@   | DefaultChunk ExpansionChunk Text   deriving Show +-- | Parse a 'Text' searching for the expansions as specified in+-- 'ExpansionChunk'. @$$@ is used to escape a single @$@. parseExpansion :: Text -> Maybe [ExpansionChunk] parseExpansion txt =   case parseOnly (many parseChunk <* endOfInput) txt of@@ -63,11 +65,14 @@ parseVariable = IntegerChunk  <$> P.decimal             <|> VariableChunk <$> P.takeWhile1 isAlpha +-- | Attempt to expand all of the elements in the given list using+-- 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]                                          ->-  Maybe Text+  [ExpansionChunk]        {- ^ chunks                    -} ->+  Maybe Text              {- ^ concatenated, expanded chunks -} resolveMacroExpansions var arg xs = Text.concat <$> traverse resolve1 xs   where     resolve1 (LiteralChunk lit) = Just lit

@@ -9,7 +9,7 @@  -} module Client.Commands.WordCompletion-  ( Prefix+  ( Prefix(..)   , wordComplete   ) where @@ -77,8 +77,19 @@   $ take n txt  where Edit.Line n txt = view Edit.line box +-- | Class for types that are isomorphic to 'String'+-- and which can support a total order and a prefix+-- predicate.+--+-- @+-- 'Prefix.toString' ('fromString' x) == x+-- 'fromString' ('Prefix.toString' x) == x+-- 'Prefix.isPrefix' x y ==> x '<=' y+-- @ class (IsString a, Ord a) => Prefix a where+  -- | Check if the first argument is a lexicographic prefix of the second.   isPrefix :: a -> a -> Bool+  -- | Convert to a 'String'.   toString :: a -> String  instance Prefix Identifier where@@ -88,6 +99,7 @@ instance Prefix Text where   isPrefix = Text.isPrefixOf   toString = Text.unpack+  tabSearch :: Prefix a => Bool -> a -> a -> [a] -> Maybe a tabSearch isReversed pat cur vals

@@ -18,6 +18,8 @@   -- * Configuration type     Configuration(..)   , ConfigurationFailure(..)++  -- * Lenses   , configDefaults   , configServers   , configPalette@@ -29,6 +31,7 @@   , configExtraHighlights   , configUrlOpener   , configIgnores+  , configActivityBar    -- * Loading configuration   , loadConfiguration@@ -79,17 +82,26 @@   , _configExtensions       :: [FilePath] -- ^ paths to shared library   , _configUrlOpener        :: Maybe FilePath -- ^ paths to url opening executable   , _configIgnores          :: HashSet Identifier -- ^ initial ignore list+  , _configActivityBar      :: Bool -- ^ initially visibility of the activity bar   }   deriving Show  makeLenses ''Configuration +-- | Failure cases when loading a configuration file. data ConfigurationFailure-  = ConfigurationParseFailed String++  -- | Error message from reading configuration file+  = ConfigurationReadFailed String++  -- | Error message from parser or lexer+  | ConfigurationParseFailed String++  -- | Error message from loading parsed configuration   | ConfigurationMalformed String-  | ConfigurationReadFailed String   deriving Show +-- | default instance instance Exception ConfigurationFailure  defaultWindowNames :: Text@@ -201,6 +213,8 @@      _configIgnores <- maybe HashSet.empty HashSet.fromList                     <$> sectionOptWith (parseList parseIdentifier) "ignores" +     _configActivityBar <- fromMaybe False <$> sectionOpt  "activity-bar"+      for_ _configNickPadding (\padding ->        when (padding < 0)             (liftConfigParser $@@ -232,9 +246,7 @@     "mention"           -> setAttr palMention     "command"           -> setAttr palCommand     "command-ready"     -> setAttr palCommandReady-    "command-required"  -> setAttr palCommandRequired-    "command-optional"  -> setAttr palCommandOptional-    "command-remaining" -> setAttr palCommandRemaining+    "command-placeholder" -> setAttr palCommandPlaceholder     _                   -> failure "Unknown palette entry"   where     setAttr l =

@@ -72,14 +72,18 @@ parseColor v =   case v of     _ | Just i <- parseInteger v -> parseColorNumber i+     Atom a | Just c <- HashMap.lookup (atomName a) namedColors -> return c+     List [r,g,b]       | Just r' <- parseInteger r       , Just g' <- parseInteger g       , Just b' <- parseInteger b ->          parseRgb r' g' b'+     _ -> failure "Expected a color number, name, or RBG list" +-- | Match integers between 0 and 255 as Terminal colors. parseColorNumber :: Integer -> ConfigParser Color parseColorNumber i   | i < 0 = failure "Negative color not supported"@@ -87,6 +91,8 @@   | i < 256 = return (Color240 (fromInteger (i - 16)))   | otherwise = failure "Color value too high" +-- | Accepts any integer literal or floating literal which can+-- be losslessly converted to an integer. parseInteger :: Value -> Maybe Integer parseInteger v =   case v of

@@ -16,6 +16,8 @@   (   -- * Server settings type     ServerSettings(..)++  -- * Lenses   , ssNicks   , ssUser   , ssReal

@@ -399,7 +399,8 @@         KChar '\t' -> doCommandResult False =<< tabCompletion False st          KChar c    -> changeEditor (Edit.insert c)-        KFun 2     -> eventLoop (over clientDetailView not st)+        KFun 2     -> eventLoop (over clientDetailView  not st)+        KFun 3     -> eventLoop (over clientActivityBar not st)         _          -> eventLoop st      _ -> eventLoop st -- unsupported modifier

@@ -13,9 +13,11 @@  import           Client.Configuration import           Client.Image.ChannelInfo+import           Client.Image.Help import           Client.Image.MaskList import           Client.Image.Message import           Client.Image.Palette+import           Client.Image.PaletteView import           Client.Image.StatusLine import           Client.Image.Textbox import           Client.Image.UserList@@ -49,11 +51,7 @@   where     (mp, st') = messagePane st     (pos, tbImg) = textboxImage st'-    img = vertCat-            [ mp-            , statusLineImage st'-            , tbImg-            ]+    img = mp <-> statusLineImage st' <-> tbImg  messagePaneImages :: ClientState -> [Image] messagePaneImages !st =@@ -66,8 +64,12 @@     (ChannelFocus network channel, FocusMasks mode) ->       maskListImages mode network channel st     (_, FocusWindows) -> windowsImages st+    (_, FocusPalette) -> paletteViewLines pal+    (_, FocusHelp mb) -> helpImageLines mb pal      _ -> chatMessageImages st+  where+    pal = view (clientConfig . configPalette) st  chatMessageImages :: ClientState -> [Image] chatMessageImages st = windowLineProcessor focusedMessages@@ -105,7 +107,12 @@      scroll = view clientScroll st     vh     = h + scroll-    h      = view clientHeight st - 2++    reservedLines+      | view clientActivityBar st = 3+      | otherwise                 = 2++    h      = view clientHeight st - reservedLines     w      = view clientWidth st  windowLinesToImages :: ClientState -> [WindowLine] -> [Image]

@@ -53,12 +53,12 @@   case arg of     NoArg           -> emptyImage     ReqTokenArg n a -> leader-                   <|> string (view palCommandRequired pal) n+                   <|> string (view palCommandPlaceholder pal) n                    <|> mkPlaceholders pal a     OptTokenArg n a -> leader-                   <|> string (view palCommandOptional pal) n+                   <|> string (view palCommandPlaceholder pal) (n ++ "?")                    <|> mkPlaceholders pal a     RemainingArg n  -> leader-                   <|> string (view palCommandRemaining pal) n+                   <|> string (view palCommandPlaceholder pal) (n ++ "…")   where     leader = char defAttr ' '

@@ -0,0 +1,75 @@+{-|+Module      : Client.Image.Help+Description : Renderer for help lines+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module provides the rendering used for the @/help@ command.++-}+module Client.Image.Help+  ( helpImageLines+  ) where++import           Client.Image.Arguments+import           Client.Image.Palette+import           Client.Image.MircFormatting+import           Client.Commands+import           Client.Commands.Arguments+import           Control.Lens+import           Data.List.NonEmpty (NonEmpty((:|)))+import           Data.Text (Text)+import qualified Data.Text as Text+import           Graphics.Vty.Image++-- | Generate either the list of all commands and their arguments,+-- or when given a command name generate the detailed help text+-- for that command.+helpImageLines ::+  Maybe Text {- ^ optional command name -} ->+  Palette    {- ^ palette               -} ->+  [Image]    {- ^ lines                 -}+helpImageLines mbCmd pal =+  case mbCmd of+    Nothing  -> listAllCommands pal+    Just cmd -> commandHelpLines cmd pal++commandHelpLines :: Text -> Palette -> [Image]+commandHelpLines cmdName pal =+  case view (at cmdName) commands of+    Nothing -> [string (view palError pal) "Unknown command, try /help"]+    Just (Command args doc impl) ->+      reverse $ commandSummary pal (pure cmdName) args+              : emptyImage+              : explainContext impl+              : emptyImage+              : map parseIrcText docs+      where+        docs = Text.lines doc++explainContext :: CommandImpl a -> Image+explainContext impl =+  case impl of+    ClientCommand {} -> go "client command" "works everywhere"+    NetworkCommand{} -> go "network command" "works when focused on active network"+    ChannelCommand{} -> go "channel command" "works when focused on active channel"+    ChatCommand   {} -> go "chat command" "works when focused on an active channel or private message"+  where+    go x y = string (withStyle defAttr bold) x <|>+             string defAttr (": " ++ y)++listAllCommands :: Palette -> [Image]+listAllCommands pal =+  reverse+    [ commandSummary pal name args+    | (name, Command args _ _) <- commandsList ]++commandSummary :: Palette -> NonEmpty Text -> ArgumentSpec a -> Image+commandSummary pal (cmd :| _) args  =+  char defAttr '/' <|>+  text' (view palCommand pal) cmd <|>+  argumentsImage pal' args ""++  where+    pal' = set palCommandPlaceholder defAttr pal

@@ -302,7 +302,7 @@       string (view palSigil pal) sigils <|>       coloredUserInfo pal rm myNicks nick <|>       string defAttr " set mode: " <|>-      separatedParams params+      ircWords params      Authenticate{} -> string defAttr "AUTHENTICATE ***"     BatchStart{}   -> string defAttr "BATCH +"@@ -322,8 +322,15 @@ separatorImage :: Image separatorImage = char (withForeColor defAttr blue) '·' +-- | Process list of 'Text' as individual IRC formatted words+-- separated by a special separator to distinguish parameters+-- from words within parameters. separatedParams :: [Text] -> Image separatedParams = horizCat . intersperse separatorImage . map parseIrcText++-- | Process list of 'Text' as individual IRC formatted words+ircWords :: [Text] -> Image+ircWords = horizCat . intersperse (char defAttr ' ') . map parseIrcText  renderReplyCode :: RenderMode -> MessageRendererParams -> ReplyCode -> Image renderReplyCode rm rp code@(ReplyCode w) =

@@ -1,4 +1,4 @@-{-# Language TemplateHaskell, OverloadedLists #-}+{-# Language TemplateHaskell, OverloadedLists, OverloadedStrings #-} {-| Module      : Client.Image.Palette Description : Palette of colors used to render the UI@@ -12,6 +12,8 @@   (   -- * Palette type     Palette(..)++  -- * Lenses   , palNicks   , palSelf   , palSelfHighlight@@ -27,15 +29,16 @@   , palMention   , palCommand   , palCommandReady-  , palCommandRequired-  , palCommandOptional-  , palCommandRemaining+  , palCommandPlaceholder +  , paletteMap+   -- * Defaults   , defaultPalette   ) where  import           Control.Lens+import           Data.Text (Text) import           Data.Vector (Vector) import           Graphics.Vty.Attributes @@ -56,9 +59,7 @@   , _palMention       :: Attr -- ^ window name with mention   , _palCommand       :: Attr -- ^ known command   , _palCommandReady  :: Attr -- ^ known command with complete arguments-  , _palCommandRequired  :: Attr -- ^ required argument placeholder-  , _palCommandOptional  :: Attr -- ^ optional argument placeholder-  , _palCommandRemaining :: Attr -- ^ remaining command text placeholder+  , _palCommandPlaceholder :: Attr -- ^ command argument placeholder   }   deriving Show @@ -82,9 +83,7 @@   , _palMention                 = withForeColor defAttr red   , _palCommand                 = withForeColor defAttr yellow   , _palCommandReady            = withForeColor defAttr green-  , _palCommandRequired         = withStyle defAttr reverseVideo-  , _palCommandOptional         = withStyle defAttr reverseVideo-  , _palCommandRemaining        = withStyle defAttr reverseVideo+  , _palCommandPlaceholder      = withStyle defAttr reverseVideo   }  -- | Default nick highlighting colors that look nice in my dark solarized@@ -94,3 +93,21 @@   withForeColor defAttr <$>     [cyan, magenta, green, yellow, blue,      brightCyan, brightMagenta, brightGreen, brightBlue]++paletteMap :: [(Text, ReifiedLens' Palette Attr)]+paletteMap =+  [ ("self"             , Lens palSelf)+  , ("time"             , Lens palTime)+  , ("meta"             , Lens palMeta)+  , ("sigil"            , Lens palSigil)+  , ("label"            , Lens palLabel)+  , ("latency"          , Lens palLatency)+  , ("window-name"      , Lens palWindowName)+  , ("error"            , Lens palError)+  , ("textbox"          , Lens palTextBox)+  , ("activity"         , Lens palActivity)+  , ("mention"          , Lens palMention)+  , ("command"          , Lens palCommand)+  , ("command-ready"    , Lens palCommandReady)+  , ("command-placeholder", Lens palCommandPlaceholder)+  ]

@@ -0,0 +1,61 @@+{-|+Module      : Client.Image.PaletteView+Description : View current palette and to see all terminal colors+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++Lines for the @/palette@ command. This view shows all the colors of+the current palette as well as the colors available in the terminal.++-}++module Client.Image.PaletteView+  ( paletteViewLines+  ) where++import           Client.Image.Palette+import           Control.Lens+import           Data.List+import           Graphics.Vty.Image++digits :: String+digits = "0123456789ABCDEF"++digitImage :: Char -> Image+digitImage d = string defAttr [' ',d,' ']++columns :: [Image] -> Image+columns = horizCat . intersperse (char defAttr ' ')++-- | Generate lines used for @/palette@. These lines show+-- all the colors used in the current palette as well as+-- the colors available for use in palettes.+paletteViewLines :: Palette -> [Image]+paletteViewLines pal =+  [ columns+  $ digitImage digit+  : [ string (withBackColor defAttr c) "   "+    | col <- [0 .. 15]+    , let c = Color240 (row * 16 + col)+    ]+  | (digit,row) <- reverse $ take 15 $ zip (drop 1 digits) [0 ..]+  ] +++  [ columns+  $ digitImage '0'+  : [ string (withBackColor defAttr (ISOColor c)) "   "+    | c <- [0..15]+    ]++  , columns (map digitImage (' ':digits))+  , emptyImage+  , columns+    [ text' (view l pal) name+    | (name, Lens l) <- paletteMap+    ]+  , emptyImage+  , columns+    [ string attr "nicks"+    | attr <- toListOf (palNicks . folded) pal+    ]+  ]

@@ -32,13 +32,15 @@ -- | Renders the status line between messages and the textbox. statusLineImage :: ClientState -> Image statusLineImage st-  = content <|> charFill defAttr '─' fillSize 1+  = activityBar <->+    content <|> charFill defAttr '─' fillSize 1   where     fillSize = max 0 (view clientWidth st - imageWidth content)+    (activitySummary, activityBar) = activityImages st     content = horizCat       [ myNickImage st       , focusImage st-      , activityImage st+      , activitySummary       , detailImage st       , scrollImage st       , latencyImage st@@ -86,21 +88,56 @@   where     attr = view (clientConfig . configPalette . palLabel) st -activityImage :: ClientState -> Image-activityImage st-  | null indicators = emptyImage-  | otherwise       = string defAttr "─[" <|>-                      horizCat indicators <|>-                      string defAttr "]"+activityImages :: ClientState -> (Image, Image)+activityImages st = (summary, activityBar)   where-    windows = views clientWindows Map.elems st+    activityBar+      | view clientActivityBar st = activityBar' <|> activityFill+      | otherwise                 = emptyImage++    summary+      | null indicators = emptyImage+      | otherwise       = string defAttr "─[" <|>+                          horizCat indicators <|>+                          string defAttr "]"++    activityFill = charFill defAttr '─'+                        (max 0 (view clientWidth st - imageWidth activityBar'))+                        1++    activityBar' = foldr baraux emptyImage+                 $ zip winNames+                 $ Map.toList+                 $ view clientWindows st++    baraux (i,(focus,w)) rest+      | n == 0 = rest+      | otherwise = string defAttr "─[" <|>+                    char (view palWindowName pal) i <|>+                    char defAttr              ':' <|>+                    text' (view palLabel pal) focusText <|>+                    char defAttr              ':' <|>+                    string attr               (show n) <|>+                    string defAttr "]" <|> rest+      where+        n   = view winUnread w+        pal = view (clientConfig . configPalette) st+        attr | view winMention w = view palMention pal+             | otherwise         = view palActivity pal+        focusText =+          case focus of+            Unfocused           -> Text.pack "*"+            NetworkFocus net    -> net+            ChannelFocus _ chan -> idText chan++    windows     = views clientWindows Map.elems st     windowNames = view (clientConfig . configWindowNames) st-    winNames = Text.unpack windowNames ++ repeat '?'-    indicators = aux (zip winNames windows)-    aux [] = []-    aux ((i,w):ws)-      | view winUnread w == 0 = aux ws-      | otherwise = char attr i : aux ws+    winNames    = Text.unpack windowNames ++ repeat '?'++    indicators  = foldr aux [] (zip winNames windows)+    aux (i,w) rest+      | view winUnread w == 0 = rest+      | otherwise = char attr i : rest       where         pal = view (clientConfig . configPalette) st         attr | view winMention w = view palMention pal@@ -154,6 +191,10 @@         FocusWindows  -> Just $ string (view palLabel pal) "windows"         FocusInfo     -> Just $ string (view palLabel pal) "info"         FocusUsers    -> Just $ string (view palLabel pal) "users"+        FocusPalette  -> Just $ string (view palLabel pal) "palette"+        FocusHelp mb  -> Just $ string (view palLabel pal) "help" <|>+                                foldMap (\cmd -> char defAttr ':' <|>+                                            text' (view palLabel pal) cmd) mb         FocusMasks m  -> Just $ horizCat           [ string (view palLabel pal) "masks"           , char defAttr ':'

@@ -104,8 +104,8 @@ renderLine :: Palette -> String -> Image  renderLine pal ('/':xs)-  | (cmd,rest)            <- break isSpace xs-  , Just (Command spec _) <- view (at (Text.pack cmd)) commands+  | (cmd,rest)              <- break isSpace xs+  , Just (Command spec _ _) <- view (at (Text.pack cmd)) commands   , let attr =           case parseArguments spec rest of             Nothing -> view palCommand      pal

@@ -8,7 +8,10 @@  This module renders the lines used in the channel user list. -}-module Client.Image.UserList where+module Client.Image.UserList+  ( userListImages+  , userInfoImages+  ) where  import           Client.Configuration import           Client.Image.Message@@ -27,7 +30,9 @@ import           Irc.Identifier import           Irc.UserInfo --- | Render the lines used in a simple user list window.+-- | Render the lines used by the @/users@ command in normal mode.+-- These lines show the count of users having each channel mode+-- in addition to the nicknames of the users. userListImages ::   Text        {- ^ network -} ->   Identifier  {- ^ channel -} ->@@ -77,7 +82,9 @@     usersHashMap =       view (csChannels . ix channel . chanUsers) cs --- | Render lines for detailed channel user list which shows full user info.+-- | Render lines for the @/users@ command in detailed view.+-- Each user will be rendered on a separate line with username+-- and host visible when known. userInfoImages ::   Text        {- ^ network -} ->   Identifier  {- ^ channel -} ->

@@ -8,7 +8,9 @@ This module implements the rendering of the client window list.  -}-module Client.Image.Windows (windowsImages) where+module Client.Image.Windows+  ( windowsImages+  ) where  import           Client.Configuration import           Client.Image.Palette@@ -22,6 +24,7 @@ import           Graphics.Vty.Image import           Irc.Identifier +-- | Draw the image lines associated with the @/windows@ command. windowsImages :: ClientState -> [Image] windowsImages st   = reverse

@@ -14,6 +14,8 @@   (   -- * Client state type     ClientState(..)++  -- * Lenses   , clientWindows   , clientTextBox   , clientConnections@@ -26,6 +28,7 @@   , clientConfig   , clientScroll   , clientDetailView+  , clientActivityBar   , clientSubfocus   , clientNextConnectionId   , clientNetworkMap@@ -33,12 +36,12 @@   , clientConnection   , clientBell   , clientExtensions++  -- * Client operations   , withClientState-  , clientShutdown   , clientStartExtensions+  , clientShutdown   , clientPark--  -- * Client operations   , clientMatcher   , urlPattern @@ -143,6 +146,7 @@   , _clientConfig            :: !Configuration            -- ^ client configuration   , _clientScroll            :: !Int                      -- ^ buffer scroll lines   , _clientDetailView        :: !Bool                     -- ^ use detailed rendering mode+  , _clientActivityBar       :: !Bool                     -- ^ visible activity bar   , _clientBell              :: !Bool                     -- ^ sound a bell next draw    , _clientIgnores           :: !(HashSet Identifier)     -- ^ ignored nicknames@@ -214,6 +218,7 @@         , _clientConfig            = cfg         , _clientScroll            = 0         , _clientDetailView        = False+        , _clientActivityBar       = view configActivityBar cfg         , _clientNextConnectionId  = 0         , _clientBell              = False         , _clientExtensions        = exts@@ -669,7 +674,13 @@     windows = view clientWindows st     (focus,_) = Map.elemAt i windows -changeFocus :: Focus -> ClientState -> ClientState+-- | Change the window focus to the given value, reset the subfocus+-- to message view, reset the scroll, remember the previous focus+-- if it changed.+changeFocus ::+  Focus       {- ^ new focus    -} ->+  ClientState {- ^ client state -} ->+  ClientState changeFocus focus st   = set clientScroll 0   . updatePrevious@@ -682,7 +693,12 @@       | focus == oldFocus = id       | otherwise         = set clientPrevFocus oldFocus -changeSubfocus :: Subfocus -> ClientState -> ClientState+-- | Change the subfocus to the given value, preserve the focus, reset+-- the scroll.+changeSubfocus ::+  Subfocus    {- ^ new subfocus -} ->+  ClientState {- ^ client state -} ->+  ClientState changeSubfocus focus   = set clientScroll 0   . set clientSubfocus focus@@ -718,13 +734,23 @@     isForward = not isReversed     (l,r)     = Map.split (view clientFocus st) (view clientWindows st) -clientHighlights :: NetworkState -> ClientState -> HashSet Identifier+-- | Compute the set of extra identifiers that should be highlighted given+-- a particular network state.+clientHighlights ::+  NetworkState       {- ^ network state               -} ->+  ClientState        {- ^ client state                -} ->+  HashSet Identifier {- ^ extra highlight identifiers -} clientHighlights cs st =   HashSet.insert     (view csNick cs)     (view (clientConfig . configExtraHighlights) st) -clientHighlightsNetwork :: Text -> ClientState -> HashSet Identifier+-- | Compute the set of extra identifiers that should be highlighted given+-- a particular network.+clientHighlightsNetwork ::+  Text               {- ^ network                     -} ->+  ClientState        {- ^ client state                -} ->+  HashSet Identifier {- ^ extra highlight identifiers -} clientHighlightsNetwork network st =   case preview (clientConnection network) st of     Just cs -> clientHighlights cs st

@@ -66,7 +66,7 @@ endLine s = Line (length s) s  -- | Zipper-ish view of the multi-line content of an 'EditBox'.--- Lines '_above' the '_currentLine' are stored in reverse order.+-- Lines 'above' the 'currentLine' are stored in reverse order. data Content = Content   { _above       :: ![String]   , _currentLine :: !Line

@@ -54,6 +54,8 @@   | FocusUsers       -- ^ Show channel user list   | FocusMasks !Char -- ^ Show channel mask list for given mode   | FocusWindows     -- ^ Show client windows+  | FocusPalette     -- ^ Show current palette+  | FocusHelp (Maybe Text) -- ^ Show help window with optional command   deriving (Eq,Show)  makePrisms ''Subfocus

@@ -22,6 +22,7 @@     NetworkState(..)   , newNetworkState +  -- * Lenses   , csNick   , csChannels   , csSocket@@ -143,6 +144,9 @@ csNick :: Lens' NetworkState Identifier csNick = csUserInfo . uiNick +-- | Transmit a 'RawIrcMsg' on the connection associated+-- with the given network. For @PRIVMSG@ and @NOTICE@ overlong+-- commands are detected and transmitted as multiple messages. sendMsg :: NetworkState -> RawIrcMsg -> IO () sendMsg cs msg =   case (view msgCommand msg, view msgParams msg) of@@ -185,13 +189,15 @@           case Text.splitAt (charIx - startChar) currentTxt of             (a,b) -> a : search byteIx charIx b xs' +-- | Construct a new network state using the given settings and+-- default values as specified by the IRC specification. newNetworkState ::-  NetworkId ->-  Text ->-  ServerSettings ->-  NetworkConnection ->-  PingStatus ->-  NetworkState+  NetworkId         {- ^ unique network ID         -} ->+  Text              {- ^ network name              -} ->+  ServerSettings    {- ^ server settings           -} ->+  NetworkConnection {- ^ active network connection -} ->+  PingStatus        {- ^ initial ping status       -} ->+  NetworkState      {- ^ new network state         -} newNetworkState networkId network settings sock ping = NetworkState   { _csNetworkId    = networkId   , _csUserInfo     = UserInfo "*" "" ""@@ -213,7 +219,9 @@   }  -+-- | Used for updates to a 'NetworkState' that require no reply.+--+-- @noReply x = ([], x)@ noReply :: NetworkState -> ([RawIrcMsg], NetworkState) noReply x = ([], x) 

@@ -85,6 +85,12 @@   parseConfig (Text x)          = return x   parseConfig _                 = failure "expected text" +-- | Matches @yes@ as 'True' and @no@ as 'False.+instance FromConfig Bool where+  parseConfig (Atom "yes")      = return True+  parseConfig (Atom "no")       = return False+  parseConfig _                 = failure "expected yes or no"+ -- | Matches 'Number' values ignoring the base instance FromConfig Integer where   parseConfig (Number _ n)      = return n