glirc 2.14 → 2.15

raw patch · 40 files changed

+1477/−944 lines, 40 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +51/−25
• exec/Main.hs +4/−4
• glirc.cabal +13/−9
• src/Client/CommandArguments.hs +0/−111
• src/Client/Commands.hs +32/−19
• src/Client/Commands/Arguments.hs +12/−0
• src/Client/Commands/Exec.hs +15/−3
• src/Client/Commands/Interpolation.hs +42/−1
• src/Client/Commands/Recognizer.hs +127/−0
• src/Client/Commands/WordCompletion.hs +12/−12
• src/Client/Configuration.hs +21/−32
• src/Client/EventLoop.hs +32/−5
• src/Client/Image.hs +2/−125
• src/Client/Image/ChannelInfo.hs +0/−81
• src/Client/Image/Help.hs +0/−75
• src/Client/Image/MaskList.hs +0/−83
• src/Client/Image/Message.hs +2/−5
• src/Client/Image/Palette.hs +11/−2
• src/Client/Image/PaletteView.hs +0/−61
• src/Client/Image/StatusLine.hs +27/−17
• src/Client/Image/Textbox.hs +40/−18
• src/Client/Image/UserList.hs +0/−128
• src/Client/Image/Windows.hs +0/−75
• src/Client/Network/Async.hs +21/−13
• src/Client/Options.hs +117/−0
• src/Client/State.hs +38/−18
• src/Client/State/EditBox.hs +1/−0
• src/Client/State/EditBox/Content.hs +17/−1
• src/Client/State/Focus.hs +1/−9
• src/Client/State/Window.hs +17/−12
• src/Client/View.hs +46/−0
• src/Client/View/ChannelInfo.hs +80/−0
• src/Client/View/Help.hs +100/−0
• src/Client/View/MaskList.hs +82/−0
• src/Client/View/Mentions.hs +109/−0
• src/Client/View/Messages.hs +134/−0
• src/Client/View/Palette.hs +61/−0
• src/Client/View/UserList.hs +127/−0
• src/Client/View/Windows.hs +72/−0

@@ -1,5 +1,16 @@ # Revision history for glirc2 +## 2.15++* Add `/mentions`+* 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 `C-t` to swap characters+* Add `ESC` to return to messages window+ ## 2.14  * Add `/help`

@@ -195,7 +195,7 @@  * `nick-colors` - List of attr - Use for nick highlights * `self` - attr - attr of our own nickname(s) outside of mentions-* `self-highlight` - attr - attr of our own nickname(s) in mentions (defaults to `self`)+* `self-highlight` - attr - attr of our own nickname(s) in mentions * `time` - attr - attr for timestamp * `meta` - attr - attr for metadata * `sigil` - attr - attr for sigils@@ -207,7 +207,8 @@ * `activity` - attr - attr for activity notification * `mention` - attr - attr for mention notification * `command` - attr - attr for recognized command-* `command-ready` - attr - attr for command with successful parse+* `command-prefix` - attr - attr for prefix of known command+* `command-ready` - attr - attr for recognized command with arguments filled * `command-placeholder` - attr - attr for command argument placeholder  Text Attributes@@ -247,6 +248,8 @@ * `/reconnect` - Reconnect to the current server * `/reload [path]` - Load a new configuration file (optional path) * `/windows` - List all open windows+* `/palette` - Show the client palette+* `/mentions` - Show all the highlighted lines across all windows * `/extension <extension name> <params...>` - Send the given params to the named extension * `/exec [-n network] [-c channel] <command> <arguments...>` - Execute a command, If no network or channel are provided send output to client window, if network and channel are provided send output as messages, if network is provided send output as raw IRC messages. * `/url [n]` - Execute url-opener on the nth URL in the current window (defaults to first)@@ -322,35 +325,57 @@ Keyboard Shortcuts ================== -* `^N` next channel-* `^P` previous channel+Note that these keybindings are using *Emacs* syntax. `C-a` means "hold+control and press A". `M-a` means "hold meta key and press A". On most+modern keyboards the *Meta* key is labeled *Alt* or *Option*.++Window navigation++* `C-n` next channel+* `C-p` previous channel * `M-#` jump to window - `1234567890qwertyuiop!@#$%^&*()QWERTYUIOP`-* `M-A` jump to activity-* `M-S` jump to previous window-* `^A` beginning of line-* `^E` end of line-* `^K` delete to end-* `^U` delete to beginning-* `^D` delete at cursor-* `^W` delete word backwards-* `^Y` paste from yank buffer-* `M-F` forward word-* `M-B` backward word-* `M-BACKSPACE` delete word backwards-* `M-D` delete word forwards-* `TAB` nickname completion+* `M-a` jump to activity+* `M-s` jump to previous window+* `ESC` return to messages view (from userlist, masklist, help, etc)++Editing++* `C-a` beginning of line+* `C-e` end of line+* `C-k` delete to end+* `C-u` delete to beginning+* `C-d` delete at cursor+* `C-w` delete word backwards+* `C-y` paste from yank buffer+* `C-t` swap characters at cursor+* `M-f` forward word+* `M-b` backward word+* `M-Backspace` delete word backwards+* `M-d` delete word forwards+* `M-Enter` insert newline++* `Tab` nickname completion++Client settings+ * `F2` toggle detailed view * `F3` toggle detailed activity bar+* `F4` toggle metadata visibility++Scrolling+ * `Page Up` scroll up * `Page Down` scroll down-* `^B` bold-* `^C` color-* `^V` reverse video-* `^_` underline-* `^]` italic-* `^O` reset formatting-* `M-Enter` insert newline +Formatting++* `C-b` bold+* `C-c` color+* `C-v` reverse video+* `C-_` underline+* `C-]` italic+* `C-o` reset formatting+ Macros ====== @@ -361,6 +386,7 @@ -------------  * `name` - text - name of macro+* `arguments` - text - space separated list of argument names (suffix name with `?` when optional) * `commands` - list of text - commands to send after expansion  Macro Expansions

@@ -17,21 +17,21 @@ import System.Exit import System.IO -import Client.CommandArguments import Client.Configuration import Client.EventLoop+import Client.Options import Client.State import Client.State.Focus  -- | Main action for IRC client main :: IO () main =-  do args <- getCommandArguments-     cfg  <- loadConfiguration' (view cmdArgConfigFile args)+  do opts <- getOptions+     cfg  <- loadConfiguration' (view optConfigFile opts)      runInUnboundThread $        withClientState cfg $        clientStartExtensions >=>-       addInitialNetworks (view cmdArgInitialNetworks args) >=>+       addInitialNetworks (view optInitialNetworks opts) >=>        eventLoop  -- | Load configuration and handle errors along the way.

@@ -1,5 +1,5 @@ name:                glirc-version:             2.14+version:             2.15 synopsis:            Console IRC client description:         Console IRC client license:             ISC@@ -49,14 +49,14 @@   default-language:    Haskell2010   build-tools:         hsc2hs -  exposed-modules:     Client.CommandArguments-                       Client.CApi+  exposed-modules:     Client.CApi                        Client.CApi.Exports                        Client.CApi.Types                        Client.Commands                        Client.Commands.Arguments                        Client.Commands.Exec                        Client.Commands.Interpolation+                       Client.Commands.Recognizer                        Client.Commands.WordCompletion                        Client.Configuration                        Client.Configuration.Colors@@ -68,20 +68,15 @@                        Client.Hooks                        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-                       Client.Image.Windows                        Client.Message                        Client.Network.Async                        Client.Network.Connect+                       Client.Options                        Client.State                        Client.State.Channel                        Client.State.EditBox@@ -89,6 +84,15 @@                        Client.State.Focus                        Client.State.Network                        Client.State.Window+                       Client.View+                       Client.View.ChannelInfo+                       Client.View.Help+                       Client.View.MaskList+                       Client.View.Mentions+                       Client.View.Messages+                       Client.View.Palette+                       Client.View.UserList+                       Client.View.Windows                        Config.FromConfig    other-modules:       LensUtils

@@ -1,111 +0,0 @@-{-# Language TemplateHaskell #-}-{-|-Module      : Client.CommandArguments-Description : Processing of command-line arguments-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module process command-line arguments provided when-launching the client.---}-module Client.CommandArguments-  (-  -- * Command-line argument type-    CommandArguments(..)--  -- * Lenses-  , cmdArgConfigFile-  , cmdArgInitialNetworks--  -- * Argument loader-  , getCommandArguments-  ) where--import           Control.Lens-import           Data.Foldable-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Version-import           Development.GitRev (gitHash, gitDirty)-import           System.Console.GetOpt-import           System.Environment-import           System.Exit-import           System.IO-import           Paths_glirc (version)---- | Command-line arguments-data CommandArguments = CommandArguments-  { _cmdArgConfigFile      :: Maybe FilePath -- ^ configuration file path-  , _cmdArgInitialNetworks :: [Text]         -- ^ initial networks-  , _cmdArgShowHelp        :: Bool           -- ^ show help message-  , _cmdArgShowVersion     :: Bool           -- ^ show version message-  }--makeLenses ''CommandArguments---- | Default values for arguments-defaultCommandArguments :: CommandArguments-defaultCommandArguments = CommandArguments-  { _cmdArgConfigFile      = Nothing-  , _cmdArgInitialNetworks = []-  , _cmdArgShowHelp        = False-  , _cmdArgShowVersion     = False-  }---- | Option descriptions-options :: [OptDescr (CommandArguments -> CommandArguments)]-options =-  [ Option "c" ["config"]  (ReqArg (set cmdArgConfigFile . Just) "PATH")-    "Configuration file path"-  , Option "h" ["help"]    (NoArg (set cmdArgShowHelp True))-    "Show help"-  , Option "v" ["version"] (NoArg (set cmdArgShowVersion True))-    "Show version"-  ]---- | Load command line arguments. This action will terminate early--- in the case of the version flag, help flag, or an error.-getCommandArguments :: IO CommandArguments-getCommandArguments =-  do args <- getArgs-     case getOpt Permute options args of-       (flags, networks, [])-         | view cmdArgShowHelp    cmdArgs -> putStr helpTxt    >> exitSuccess-         | view cmdArgShowVersion cmdArgs -> putStr versionTxt >> exitSuccess-         | otherwise                      -> return cmdArgs-         where-           cmdArgs = assembleCommandArguments flags networks-       (_, _, errors) ->-         do traverse_ (hPutStr stderr) errors-            hPutStrLn stderr "Run 'glirc2 --help' to see a list of available command line options."-            exitFailure--assembleCommandArguments :: [CommandArguments -> CommandArguments] -> [String] -> CommandArguments-assembleCommandArguments flags networks =-  let flagArgs = foldl' (\acc f -> f acc) defaultCommandArguments flags-  in flagArgs { _cmdArgInitialNetworks = Text.pack <$> networks }--helpTxt :: String-helpTxt = usageInfo "glirc2 [FLAGS] INITIAL_NETWORKS..." options--versionTxt :: String-versionTxt = unlines-  [ "glirc-" ++ showVersion version ++ gitHashTxt ++ gitDirtyTxt-  , "Copyright 2016 Eric Mertens"-  ]---- | Returns @"-SOMEHASH"@ when in a git repository, @""@ otherwise.-gitHashTxt :: String-gitHashTxt-  | hashTxt == "UNKNOWN" = ""-  | otherwise            = '-':hashTxt-  where-    hashTxt = $gitHash---- | Returns @"-dirty"@ when in a dirty git repository, @""@ otherwise.-gitDirtyTxt :: String-gitDirtyTxt-  | $gitDirty = "-dirty"-  | otherwise = ""

@@ -28,6 +28,7 @@ import           Client.Commands.Arguments import           Client.Commands.Exec import           Client.Commands.Interpolation+import           Client.Commands.Recognizer import           Client.Commands.WordCompletion import           Client.Configuration import           Client.Configuration.ServerSettings@@ -42,9 +43,7 @@ import           Control.Exception (displayException, try) import           Control.Lens import           Control.Monad-import           Data.Char import           Data.Foldable-import           Data.HashMap.Strict (HashMap) import           Data.HashSet (HashSet) import           Data.List.NonEmpty (NonEmpty((:|))) import           Data.List.Split@@ -130,13 +129,14 @@ executeUserCommand :: Maybe Text -> String -> ClientState -> IO CommandResult executeUserCommand discoTime command st = do   let key = Text.takeWhile (/=' ') tcmd+      rest = dropWhile (==' ') . dropWhile (/=' ') $ command -  case preview (clientConfig . configMacros . ix key) st of-    Nothing     -> executeCommand Nothing command st-    Just cmdExs ->-      case traverse resolveMacro cmdExs of+  case views (clientConfig . configMacros) (recognize key) st of+    Exact (Macro (MacroSpec spec) cmdExs) ->+      case parseArguments spec rest *> traverse resolveMacro cmdExs of         Nothing   -> commandFailureMsg "Macro expansions failed" st         Just cmds -> process cmds st+    _ ->  executeCommand Nothing command st   where     resolveMacro = resolveMacroExpansions (commandExpansion discoTime st) expandInt @@ -220,14 +220,9 @@               Nothing -> commandFailure st               Just arg -> exec st arg   in-  case HashMap.lookup cmdTxt commands of--    Nothing ->-      case tabCompleteReversed of-        Nothing         -> commandFailureMsg "Unknown command" st-        Just isReversed -> nickTabCompletion isReversed st+  case recognize cmdTxt commands of -    Just (Command argSpec _docs impl) ->+    Exact (Command argSpec _docs impl) ->       case impl of         ClientCommand exec tab ->           finish argSpec exec tab@@ -251,6 +246,11 @@               finish argSpec (exec channelId cs) (\x -> tab x channelId cs)           | otherwise -> commandFailureMsg "This command requires an active chat window" st +    _ -> case tabCompleteReversed of+           Just isReversed -> nickTabCompletion isReversed st+           Nothing         -> commandFailureMsg "Unknown command" st++ -- | 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 ]@@ -258,8 +258,8 @@  -- | Map of built-in client commands to their implementations, tab completion -- logic, and argument structures.-commands :: HashMap Text Command-commands = HashMap.fromList (expandAliases commandsList)+commands :: Recognizer Command+commands = fromCommands (expandAliases commandsList)  commandsList :: [(NonEmpty Text,Command)] commandsList =@@ -330,6 +330,11 @@       "Show a list of all client message windows.\n"     $ ClientCommand cmdWindows noClientTab     )+  , ( pure "mentions"+    , Command NoArg+      "Show a list of all message that were highlighted as important.\n"+    $ ClientCommand cmdMentions noClientTab+    )   , ( pure "palette"     , Command NoArg       "Show the current palette settings and a color chart to help pick new colors.\n"@@ -347,6 +352,10 @@       \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\+      \\^Barguments\^B is divided on spaces into words before being processed\+      \ by getopt. Use Haskell string literal syntax to create arguments with\+      \ escaped characters and spaces inside.\n\       \\n"     $ ClientCommand cmdExec simpleClientTab     )@@ -802,6 +811,10 @@ cmdWindows :: ClientCommand () cmdWindows st _ = commandSuccess (changeSubfocus FocusWindows st) +-- | Implementation of @/mentions@ command. Set subfocus to Windows.+cmdMentions :: ClientCommand ()+cmdMentions st _ = commandSuccess (changeSubfocus FocusMentions st)+ -- | Implementation of @/palette@ command. Set subfocus to Windows. cmdPalette :: ClientCommand () cmdPalette st _ = commandSuccess (changeSubfocus FocusPalette st)@@ -998,7 +1011,7 @@   ChannelCommand String tabTopic _ channelId cs st rest -  | all isSpace rest+  | all (==' ') rest   , Just topic <- preview (csChannels . ix channelId . chanTopic) cs =      do let textBox = set Edit.line (Edit.endLine $ "/topic " ++ Text.unpack topic)         commandSuccess (over clientTextBox textBox st)@@ -1258,10 +1271,10 @@   where     n = length leadingPart     (cursorPos, line) = clientLine st-    leadingPart = takeWhile (not . isSpace) line+    leadingPart = takeWhile (/=' ') line     possibilities = Text.cons '/' <$> commandNames-    commandNames = HashMap.keys commands-                ++ HashMap.keys (view (clientConfig . configMacros) st)+    commandNames = keys commands+                ++ keys (view (clientConfig . configMacros) st)  -- | Complete the nickname at the current cursor position using the -- userlist for the currently focused channel (if any)

@@ -35,6 +35,18 @@   -- | No arguments   NoArg        :: ArgumentSpec () +instance Show (ArgumentSpec s) where+  showsPrec p spec =+    case spec of+      ReqTokenArg s rest -> showParen (p >= 11)+                          $ showString "ReqTokenArg "+                          . showsPrec 11 s . showChar ' ' . showsPrec 11 rest+      OptTokenArg s rest -> showParen (p >= 11)+                          $ showString "OptTokenArg "+                          . showsPrec 11 s . showChar ' ' . showsPrec 11 rest+      RemainingArg s     -> showParen (p >= 11)+                          $ showString "RemainingArg " . showsPrec 11 s+      NoArg              -> showString "NoArg"  -- | Parse the given input string using an argument specification. -- The arguments should start with a space but might have more.

@@ -26,6 +26,7 @@  import           Control.Exception import           Control.Lens+import           Data.List import           System.Console.GetOpt import           System.Process @@ -78,13 +79,11 @@  -- | Parse the arguments to @/exec@ looking for various flags -- and the command and its arguments.------ TODO: support quoted strings parseExecCmd ::   String                  {- ^ exec arguments          -} ->   Either [String] ExecCmd {- ^ error or parsed command -} parseExecCmd str =-  case getOpt RequireOrder options (words str) of+  case getOpt RequireOrder options (powerWords str) of     (_, [] , errs) -> Left ("No command specified":errs)     (fs, cmd:args, []) -> Right                         $ foldl (\x f -> f x) ?? fs@@ -105,3 +104,16 @@      return $ case res of        Left er -> Left [show (er :: IOError)]        Right x -> Right (lines x)++-- | Power words is similar to 'words' except that when it encounters+-- a word formatted as a Haskell 'String' literal it parses it as+-- such. Only space is used as a delimiter.+powerWords :: String -> [String]+powerWords = unfoldr (splitWord . dropWhile isSp)+  where+    isSp x = x == ' '++    splitWord xs+      | null xs         = Nothing+      | [x] <- reads xs = Just x+      | otherwise       = Just (break isSp xs)

@@ -1,4 +1,4 @@-{-# Language OverloadedStrings #-}+{-# Language OverloadedStrings, GADTs #-}  {-| Module      : Client.Commands.Interpolation@@ -15,6 +15,10 @@   ( ExpansionChunk(..)   , parseExpansion   , resolveMacroExpansions+  , Macro(..)+  , MacroSpec(..)+  , parseMacroSpecs+  , noMacroArguments   ) where  import           Control.Applicative@@ -23,6 +27,8 @@ import qualified Data.Text as Text import           Data.Text (Text) +import           Client.Commands.Arguments+ -- | Parsed chunk of an expandable command data ExpansionChunk   -- | regular text@@ -34,6 +40,41 @@   -- | bracketed variable with default @${x|lit}@   | DefaultChunk ExpansionChunk Text   deriving Show++data Macro+  = Macro+  { macroSpec :: MacroSpec+  , macroCommands :: [[ExpansionChunk]]+  } deriving Show++data MacroSpec where+  MacroSpec :: ArgumentSpec s -> MacroSpec++instance Show MacroSpec where+  showsPrec p (MacroSpec as)+    = showParen (p >= 11)+    $ showString "MacroSpec " . showsPrec 11 as++-- | Specification used when unspecified, no arguments.+noMacroArguments :: MacroSpec+noMacroArguments = MacroSpec NoArg++parseMacroSpecs :: Text -> Maybe MacroSpec+parseMacroSpecs txt =+  case parseOnly (macroSpecs <* endOfInput) txt of+    Left{}     -> Nothing+    Right spec -> Just spec++macroSpecs :: Parser MacroSpec+macroSpecs =+  cons <$> P.takeWhile1 isAlpha+       <*> optional (char '?')+       <*  P.skipSpace+       <*> macroSpecs+    <|> pure (MacroSpec NoArg)+ where+ cons desc (Just _) (MacroSpec rest) = MacroSpec (OptTokenArg (Text.unpack desc) rest)+ cons desc Nothing  (MacroSpec rest) = MacroSpec (ReqTokenArg (Text.unpack desc) rest)  -- | Parse a 'Text' searching for the expansions as specified in -- 'ExpansionChunk'. @$$@ is used to escape a single @$@.

@@ -0,0 +1,127 @@+{-# Language OverloadedStrings, DeriveFunctor #-}++{-|+Module      : Client.Commands.Recognizer+Description : Trie for recognizing commands+Copyright   : (c) Dan Doel, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module implements a trie for recognizing valid commands. This+allows entered strings to be classified as either a valid command+(with an associated value), the prefix of a valid command, or invalid.+-}++module Client.Commands.Recognizer+  ( Recognizer+  , recognize+  , Recognition(..)+  , fromCommands+  , addCommand+  , keys+  ) where++import Control.Monad+import Control.Applicative hiding (empty)++import           Data.HashMap.Strict (lookup,insertWith,HashMap,empty,unionWith,fromList,toList)+import           Data.Monoid+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Maybe++import Prelude hiding (all,lookup)++-- | A map from 'Text' values to 'a' values that is capable of yielding more+-- detailed information when looking up keys that are not actually in the map.+data Recognizer a+  = Branch !Text !(Maybe a) !(HashMap Char (Recognizer a))+  deriving (Show, Functor)++instance Monoid (Recognizer a) where+  mempty = Branch "" Nothing empty+  mappend = both++-- | Possible results of recognizing text.+data Recognition a+  = Exact a       -- ^ text matched exactly, yielding the given value+  | Prefix [Text] -- ^ text would be recognized if joined to the given suffixes+  | Invalid       -- ^ text could not possibly be recognized+  deriving (Show, Functor)++-- | Match common prefixes of two strings in a more convenient form than+-- available from 'Data.Text'+splitCommon :: Text -> Text -> (Text, Text, Text)+splitCommon l r = fromMaybe ("", l, r) $ Text.commonPrefixes l r++-- | Attempt to recognize a string, yielding a 'Recognition' result.+recognize :: Text -> Recognizer a -> Recognition a+recognize tx (Branch pf contained children)+  = case splitCommon pf tx of+      (_, pfsfx, txsfx) -> case Text.uncons txsfx of+        Nothing+          | Text.null pfsfx+          , Just a <- contained -> Exact a+          | otherwise -> Prefix $ keys (Branch pfsfx contained children)+        Just (c, txrest)+          | Text.null pfsfx+          , Just rec <- lookup c children+          -> recognize txrest rec+        _ -> Invalid++-- | Create a singleton 'Recognizer' associating the given 'Text' and value.+single :: Text -> a -> Recognizer a+single tx v = Branch tx (Just $! v) empty++-- | Union two 'Recognizers'. The stored values in the result are biased to the+-- left if there is key overlap.+both :: Recognizer a -> Recognizer a -> Recognizer a+both l@(Branch pfl conl chil) r@(Branch pfr conr chir)+  | Text.null pfl && null conl && null chil = r+  | Text.null pfr && null conr && null chir = l+  | otherwise+  = case splitCommon pfl pfr of+      (common, lsfx, rsfx) -> Branch common contained children+        where+        contained = (guard (Text.null lsfx) *> conl)+                <|> (guard (Text.null rsfx) *> conr)+        children = case (Text.uncons lsfx, Text.uncons rsfx) of+          (Nothing, Nothing)+            -> unionWith both chil chir+          (Just (l',lest), Nothing)+            -> insertWith (flip both) l' (Branch lest conl chil) chir+          (Nothing, Just (r',rest))+            -> insertWith both r' (Branch rest conr chir) chil+          (Just (l',lest), Just (r',rest))+            -> fromList [ (l', Branch lest conl chil)+                        , (r', Branch rest conr chir)+                        ]++-- | Union an arbitrary number of 'Recognizers' as with 'both'.+all :: [Recognizer a] -> Recognizer a+all [] = mempty+all [r] = r+all rs = all $ pair rs+ where+ pair (l:r:rest) = both l r : pair rest+ pair rest       = rest++-- | Create a 'Recognizer' from an association list. If a key appears twice, the+-- earliest associated value will be used.+fromCommands :: [(Text, a)] -> Recognizer a+fromCommands = all . map (uncurry single)++-- | Add a key-value pair to a 'Recognizer'. This will override the value+-- already present if one exists.+addCommand :: Text -> a -> Recognizer a -> Recognizer a+addCommand tx v = both $ single tx v++-- | Compute all strings that will be recognized by a 'Recognizer'.+keys :: Recognizer a -> [Text]+keys (Branch pf contained children)+  = maybeToList (pf <$ contained)+  ++ (mappend pf <$> childKeys children)++-- | Auxiliary function for 'keys'.+childKeys :: HashMap Char (Recognizer a) -> [Text]+childKeys children = toList children >>= \(c,rec) -> Text.cons c <$> keys rec

@@ -101,20 +101,20 @@   toString = Text.unpack  -tabSearch :: Prefix a => Bool -> a -> a -> [a] -> Maybe a+tabSearch ::+  Prefix a =>+  Bool {- ^ reversed        -} ->+  a    {- ^ search prefix   -} ->+  a    {- ^ previous result -} ->+  [a]  {- ^ posibilities    -} ->+  Maybe a tabSearch isReversed pat cur vals-  | Just next <- advanceFun cur valSet-  , isPrefix pat next-  = Just next--  | isReversed = find (isPrefix pat) (Set.toDescList valSet)--  | otherwise  = do x <- Set.lookupGE pat valSet-                    guard (isPrefix pat x)-                    Just x+  | Set.null valSet                    = Nothing+  | Just next <- advanceFun cur valSet = Just next+  | isReversed                         = Just $! Set.findMax valSet+  | otherwise                          = Just $! Set.findMin valSet   where-    valSet = Set.fromList vals+    valSet = Set.fromList (filter (isPrefix pat) vals)      advanceFun | isReversed = Set.lookupLT                | otherwise  = Set.lookupGT-

@@ -44,6 +44,7 @@ import           Client.Configuration.Colors import           Client.Configuration.ServerSettings import           Client.Commands.Interpolation+import           Client.Commands.Recognizer import           Control.Exception import           Control.Monad import           Config@@ -78,7 +79,7 @@   , _configNickPadding      :: Maybe Integer -- ^ Padding of nicks   , _configConfigPath       :: Maybe FilePath         -- ^ manually specified configuration path, used for reloading-  , _configMacros           :: HashMap Text [[ExpansionChunk]] -- ^ command macros+  , _configMacros           :: Recognizer Macro -- ^ command macros   , _configExtensions       :: [FilePath] -- ^ paths to shared library   , _configUrlOpener        :: Maybe FilePath -- ^ paths to url opening executable   , _configIgnores          :: HashSet Identifier -- ^ initial ignore list@@ -197,7 +198,7 @@      _configWindowNames <- fromMaybe defaultWindowNames                     <$> sectionOpt "window-names" -     _configMacros <- fromMaybe HashMap.empty+     _configMacros <- fromMaybe mempty                     <$> sectionOptWith parseMacroMap "macros"       _configExtensions <- fromMaybe []@@ -231,31 +232,10 @@     "nick-colors" -> do xs <- Vector.fromList <$> parseList parseAttr v                         when (null xs) (failure "Empty palette")                         return $! set palNicks xs p--    "self"              -> setAttr palSelf-    "self-highlight"    -> setAttrMb palSelfHighlight-    "time"              -> setAttr palTime-    "meta"              -> setAttr palMeta-    "sigil"             -> setAttr palSigil-    "label"             -> setAttr palLabel-    "latency"           -> setAttr palLatency-    "error"             -> setAttr palError-    "textbox"           -> setAttr palTextBox-    "window-name"       -> setAttr palWindowName-    "activity"          -> setAttr palActivity-    "mention"           -> setAttr palMention-    "command"           -> setAttr palCommand-    "command-ready"     -> setAttr palCommandReady-    "command-placeholder" -> setAttr palCommandPlaceholder-    _                   -> failure "Unknown palette entry"-  where-    setAttr l =-      do !attr <- parseAttr v-         return $! set l attr p--    setAttrMb l =-      do !attr <- parseAttr v-         return $! set l (Just attr) p+    _ | Just (Lens l) <- lookup k paletteMap ->+          do !attr <- parseAttr v+             return $! set l attr p+    _ -> failure "Unknown palette entry"  parseServers :: ServerSettings -> Value -> ConfigParser (HashMap Text ServerSettings) parseServers def v =@@ -317,7 +297,7 @@  parseUseTls :: Value -> ConfigParser UseTls parseUseTls (Atom "yes")          = return UseTls-parseUseTls (Atom "yes-insecure") = return UseInsecure+parseUseTls (Atom "yes-insecure") = return UseInsecureTls parseUseTls (Atom "no")           = return UseInsecure parseUseTls _                     = failure "expected yes, yes-insecure, or no" @@ -338,14 +318,23 @@   | otherwise = do home <- getHomeDirectory                    return (home </> path) -parseMacroMap :: Value -> ConfigParser (HashMap Text [[ExpansionChunk]])-parseMacroMap v = HashMap.fromList <$> parseList parseMacro v+parseMacroMap :: Value -> ConfigParser (Recognizer Macro)+parseMacroMap v = fromCommands <$> parseList parseMacro v -parseMacro :: Value -> ConfigParser (Text, [[ExpansionChunk]])+parseMacro :: Value -> ConfigParser (Text, Macro) parseMacro = parseSections $   do name     <- sectionReq "name"+     spec     <- fromMaybe noMacroArguments+             <$> sectionOptWith parseMacroArguments "arguments"      commands <- sectionReqWith (parseList parseMacroCommand) "commands"-     return (name, commands)+     return (name, Macro spec commands)++parseMacroArguments :: Value -> ConfigParser MacroSpec+parseMacroArguments v =+  do txt <- parseConfig v+     case parseMacroSpecs txt of+       Nothing -> failure "bad macro argument specs"+       Just ex -> return ex  parseMacroCommand :: Value -> ConfigParser [ExpansionChunk] parseMacroCommand v =

@@ -18,7 +18,6 @@ import           Client.CApi import           Client.Commands import           Client.Commands.Interpolation-import           Client.Configuration import           Client.Configuration.ServerSettings import           Client.EventLoop.Errors (exceptionToLines) import           Client.Hook@@ -28,6 +27,7 @@ import           Client.Network.Async import           Client.State import qualified Client.State.EditBox     as Edit+import           Client.State.Focus import           Client.State.Network import           Control.Concurrent.STM import           Control.Exception@@ -50,6 +50,7 @@ import           Irc.Codes import           Irc.Message import           Irc.RawIrcMsg+import           LensUtils import           Network.Connection  reconnectAttempts :: Int@@ -115,6 +116,7 @@          case networkEvent of            NetworkLine  network time line -> doNetworkLine network time line st            NetworkError network time ex   -> doNetworkError network time ex st+           NetworkOpen  network time      -> doNetworkOpen  network time st            NetworkClose network time      -> doNetworkClose network time st  -- | Sound the terminal bell assuming that the @BEL@ control code@@ -122,10 +124,29 @@ beep :: Vty -> IO () beep = ringTerminalBell . outputIface +-- | Respond to a network connection successfully connecting.+doNetworkOpen ::+  NetworkId   {- ^ network id   -} ->+  ZonedTime   {- ^ event time   -} ->+  ClientState {- ^ client state -} ->+  IO ()+doNetworkOpen networkId time st =+  case view (clientConnections . at networkId) st of+    Nothing -> error "doNetworkOpen: Network missing"+    Just cs ->+      let msg = ClientMessage+                  { _msgTime    = time+                  , _msgNetwork = view csNetwork cs+                  , _msgBody    = NormalBody "connection opened"+                  }+      in eventLoop $ recordNetworkMessage msg+                   $ overStrict (clientConnections . ix networkId . csLastReceived)+                                (\old -> old `seq` Just $! zonedTimeToUTC time) st+ -- | Respond to a network connection closing normally. doNetworkClose ::-  NetworkId {- ^ finished network -} ->-  ZonedTime {- ^ current time     -} ->+  NetworkId {- ^ network id -} ->+  ZonedTime {- ^ event time -} ->   ClientState -> IO () doNetworkClose networkId time st =   let (cs,st') = removeNetwork networkId st@@ -355,6 +376,7 @@         KChar 'u' -> changeEditor Edit.killHome         KChar 'k' -> changeEditor Edit.killEnd         KChar 'y' -> changeEditor Edit.yank+        KChar 't' -> changeContent Edit.toggle         KChar 'w' -> changeEditor (Edit.killWordBackward True)         KChar 'b' -> changeEditor (Edit.insert '\^B')         KChar 'c' -> changeEditor (Edit.insert '\^C')@@ -376,13 +398,14 @@         KChar 'f' -> changeContent Edit.rightWord         KChar 'a' -> eventLoop (jumpToActivity st)         KChar 's' -> eventLoop (returnFocus st)-        KChar c   | let names = view (clientConfig . configWindowNames) st-                  , Just i <- Text.findIndex (==c) names ->+        KChar c   | let names = clientWindowNames st+                  , Just i <- elemIndex c names ->                             eventLoop (jumpFocus i st)         _ -> eventLoop st      [] -> -- no modifier       case key of+        KEsc       -> eventLoop (changeSubfocus FocusMessages st)         KBS        -> changeContent Edit.backspace         KDel       -> changeContent Edit.delete         KLeft      -> changeContent Edit.left@@ -399,8 +422,12 @@         KChar '\t' -> doCommandResult False =<< tabCompletion False st          KChar c    -> changeEditor (Edit.insert c)++        -- toggles         KFun 2     -> eventLoop (over clientDetailView  not st)         KFun 3     -> eventLoop (over clientActivityBar not st)+        KFun 4     -> eventLoop (over clientShowMetadata not st)+         _          -> eventLoop st      _ -> eventLoop st -- unsupported modifier

@@ -11,26 +11,13 @@ -} module Client.Image (clientPicture) where -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-import           Client.Image.Windows-import           Client.Message import           Client.State-import           Client.State.Focus-import           Client.State.Network-import           Client.State.Window+import           Client.View import           Control.Lens import           Graphics.Vty (Background(..), Picture(..), Cursor(..)) import           Graphics.Vty.Image-import           Irc.Identifier (Identifier)  -- | Generate a 'Picture' for the current client state. The resulting -- client state is updated for render specific information like scrolling.@@ -53,46 +40,10 @@     (pos, tbImg) = textboxImage st'     img = mp <-> statusLineImage st' <-> tbImg -messagePaneImages :: ClientState -> [Image]-messagePaneImages !st =-  case (view clientFocus st, view clientSubfocus st) of-    (ChannelFocus network channel, FocusInfo) ->-      channelInfoImages network channel st-    (ChannelFocus network channel, FocusUsers)-      | view clientDetailView st -> userInfoImages network channel st-      | otherwise                -> userListImages network channel st-    (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-  where-    matcher = clientMatcher st--    focusedMessages-        = filter (views wlText matcher)-        $ view (clientWindows . ix (view clientFocus st) . winMessages) st--    windowLineProcessor-      | view clientDetailView st = map (view wlFullImage)-      | otherwise                = windowLinesToImages st . filter (not . isNoisy)--    isNoisy msg =-      case view wlBody msg of-        IrcBody irc -> squelchIrcMsg irc-        _           -> False- messagePane :: ClientState -> (Image, ClientState) messagePane st = (img, st')   where-    images = messagePaneImages st+    images = viewLines st     vimg   = assemble emptyImage images     vimg1  = cropBottom h vimg     img    = pad 0 (h - imageHeight vimg1) 0 0 vimg1@@ -114,80 +65,6 @@      h      = view clientHeight st - reservedLines     w      = view clientWidth st--windowLinesToImages :: ClientState -> [WindowLine] -> [Image]-windowLinesToImages st wwls =-  case gatherMetadataLines st wwls of-    ([], [])   -> []-    ([], w:ws) -> view wlImage w : windowLinesToImages st ws-    ((img,who,mbnext):mds, wls) ->-         startMetadata img mbnext who mds palette-       : windowLinesToImages st wls-  where-    palette = view (clientConfig . configPalette) st----------------------------------------------------------------------------type MetadataState =-  Identifier                            {- ^ current nick -} ->-  [(Image,Identifier,Maybe Identifier)] {- ^ metadata     -} ->-  Palette                               {- ^ palette      -} ->-  Image--startMetadata ::-  Image            {- ^ metadata image           -} ->-  Maybe Identifier {- ^ possible nick transition -} ->-  MetadataState-startMetadata img mbnext who mds palette =-        quietIdentifier palette who-    <|> img-    <|> transitionMetadata mbnext who mds palette--transitionMetadata ::-  Maybe Identifier {- ^ possible nick transition -} ->-  MetadataState-transitionMetadata mbwho who mds palette =-  case mbwho of-    Nothing   -> continueMetadata who  mds palette-    Just who' -> quietIdentifier palette who'-             <|> continueMetadata who' mds palette--continueMetadata :: MetadataState-continueMetadata _ [] _ = emptyImage-continueMetadata who1 ((img, who2, mbwho3):mds) palette-  | who1 == who2 = img-               <|> transitionMetadata mbwho3 who2 mds palette-  | otherwise    = char defAttr ' '-               <|> startMetadata img mbwho3 who2 mds palette----------------------------------------------------------------------------gatherMetadataLines ::-  ClientState ->-  [WindowLine] ->-  ( [(Image, Identifier, Maybe Identifier)] , [ WindowLine ] )-  -- ^ metadata entries are reversed-gatherMetadataLines st = go []-  where-    go acc (w:ws)-      | Just (img,who,mbnext) <- metadataWindowLine st w =-          go ((img,who,mbnext) : acc) ws--    go acc ws = (acc,ws)----- | Classify window lines for metadata coalesence-metadataWindowLine ::-  ClientState ->-  WindowLine ->-  Maybe (Image, Identifier, Maybe Identifier)-        {- ^ Image, incoming identifier, outgoing identifier if changed -}-metadataWindowLine st wl =-  case view wlBody wl of-    IrcBody irc-      | Just who <- ircIgnorable irc st -> Just (ignoreImage, who, Nothing)-      | otherwise                       -> metadataImg irc-    _                                   -> Nothing  lineWrap :: Int -> Image -> Image lineWrap w img

@@ -1,81 +0,0 @@-{-# Language OverloadedStrings #-}-{-# Language BangPatterns #-}--{-|-Module      : Client.Image.ChannelInfo-Description : Channel information renderer-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module implements a renderer for the window that shows-channel metadata.---}-module Client.Image.ChannelInfo-  ( channelInfoImages-  ) where--import           Client.Configuration-import           Client.Image.Message-import           Client.Image.MircFormatting-import           Client.Image.Palette-import           Client.State-import           Client.State.Channel-import           Client.State.Network-import           Control.Lens-import           Data.HashSet (HashSet)-import           Data.Text (Text)-import           Data.Time-import           Graphics.Vty.Image-import           Irc.Identifier---- | Render the lines used in a channel mask list-channelInfoImages ::-  Text        {- ^ network -} ->-  Identifier  {- ^ channel -} ->-  ClientState -> [Image]-channelInfoImages network channelId st--  | Just cs      <- preview (clientConnection network) st-  , Just channel <- preview (csChannels . ix channelId) cs-  = channelInfoImages' pal (clientHighlights cs st) channel--  | otherwise = [text' (view palError pal) "No channel information"]-  where-    pal = view (clientConfig . configPalette) st--channelInfoImages' :: Palette -> HashSet Identifier -> ChannelState -> [Image]-channelInfoImages' pal myNicks !channel-    = topicLine-    : provenanceLines-   ++ creationLines-   ++ urlLines--  where-    label = text' (view palLabel pal)--    topicLine = label "Topic: " <|> parseIrcText (view chanTopic channel)---    utcTimeImage = string defAttr . formatTime defaultTimeLocale "%F %T"--    provenanceLines =-        case view chanTopicProvenance channel of-          Nothing -> []-          Just !prov ->-            [ label "Topic set by: " <|>-                coloredUserInfo pal DetailedRender myNicks (view topicAuthor prov)-            , label "Topic set on: " <|> utcTimeImage (view topicTime prov)-            ]--    creationLines =-        case view chanCreation channel of-          Nothing   -> []-          Just time -> [label "Created on: " <|> utcTimeImage time]--    urlLines =-        case view chanUrl channel of-          Nothing -> []-          Just url -> [ label "Channel URL: " <|> parseIrcText url ]-

@@ -1,75 +0,0 @@-{-|-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

@@ -1,83 +0,0 @@-{-# Language OverloadedStrings #-}-{-|-Module      : Client.Image.MaskList-Description : Line renderers for channel mask list view-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module renders the lines used in the channel mask list. A mask list-can show channel bans, quiets, invites, and exceptions.--}-module Client.Image.MaskList-  ( maskListImages-  ) where--import           Client.Configuration-import           Client.Image.Palette-import           Client.State-import           Client.State.Channel-import           Client.State.Network-import           Control.Lens-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import           Data.List-import           Data.Ord-import           Data.Text (Text)-import           Data.Time-import           Graphics.Vty.Image-import           Irc.Identifier---- | Render the lines used in a channel mask list-maskListImages ::-  Char        {- ^ Mask mode -} ->-  Text        {- ^ network   -} ->-  Identifier  {- ^ channel   -} ->-  ClientState -> [Image]-maskListImages mode network channel st =-  case mbEntries of-    Nothing      -> [text' (view palError pal) "Mask list not loaded"]-    Just entries -> maskListImages' entries st--  where-    pal = view (clientConfig . configPalette) st-    mbEntries = preview-                ( clientConnection network-                . csChannels . ix channel-                . chanLists . ix mode-                ) st--maskListImages' :: HashMap Text MaskListEntry -> ClientState -> [Image]-maskListImages' entries st = countImage : images-  where-    pal = view (clientConfig . configPalette) st--    countImage = text' (view palLabel pal) "Masks (visible/total): " <|>-                 string defAttr (show (length entryList)) <|>-                 char (view palLabel pal) '/' <|>-                 string defAttr (show (HashMap.size entries))--    matcher = clientMatcher st--    matcher' (mask,entry) = matcher mask || matcher (view maskListSetter entry)--    entryList = sortBy (flip (comparing (view (_2 . maskListTime))))-              $ filter matcher'-              $ HashMap.toList entries--    renderWhen = formatTime defaultTimeLocale " %F %T"--    (masks, whoWhens) = unzip entryList-    maskImages       = text' defAttr <$> masks-    maskColumnWidth  = maximum (imageWidth <$> maskImages) + 1-    paddedMaskImages = resizeWidth maskColumnWidth <$> maskImages-    width            = max 1 (view clientWidth st)--    images = [ cropLine $ mask <|>-                          text' defAttr who <|>-                          string defAttr (renderWhen when)-             | (mask, MaskListEntry who when) <- zip paddedMaskImages whoWhens ]--    cropLine img-      | imageWidth img > width = cropRight width img-      | otherwise              = img

@@ -31,7 +31,6 @@ import           Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import           Data.List-import           Data.Maybe import           Data.Text (Text) import qualified Data.Text as Text import           Data.Time@@ -53,7 +52,7 @@   , rendNickPadding :: Maybe Integer -- ^ nick padding   } --- | Default 'MessageRenderParams' with no sigils or nicknames specified+-- | Default 'MessageRendererParams' with no sigils or nicknames specified defaultRenderParams :: MessageRendererParams defaultRenderParams = MessageRendererParams   { rendStatusMsg   = ""@@ -368,9 +367,7 @@     color       | ident `HashSet.member` myNicks =           case icm of-            PrivmsgIdentifier -> fromMaybe-                                   (view palSelf palette)-                                   (view palSelfHighlight palette)+            PrivmsgIdentifier -> view palSelfHighlight palette             NormalIdentifier  -> view palSelf palette        | otherwise = v Vector.! i

@@ -30,6 +30,8 @@   , palCommand   , palCommandReady   , palCommandPlaceholder+  , palCommandPrefix+  , palCommandError    , paletteMap @@ -46,7 +48,7 @@ data Palette = Palette   { _palNicks         :: Vector Attr -- ^ highlighting nicknames   , _palSelf          :: Attr -- ^ own nickname(s)-  , _palSelfHighlight :: Maybe Attr -- ^ own nickname(s) in mentions+  , _palSelfHighlight :: Attr -- ^ own nickname(s) in mentions   , _palTime          :: Attr -- ^ message timestamps   , _palMeta          :: Attr -- ^ coalesced metadata   , _palSigil         :: Attr -- ^ sigils (e.g. @+)@@ -59,6 +61,8 @@   , _palMention       :: Attr -- ^ window name with mention   , _palCommand       :: Attr -- ^ known command   , _palCommandReady  :: Attr -- ^ known command with complete arguments+  , _palCommandPrefix :: Attr -- ^ prefix of known command+  , _palCommandError  :: Attr -- ^ unknown command   , _palCommandPlaceholder :: Attr -- ^ command argument placeholder   }   deriving Show@@ -70,7 +74,7 @@ defaultPalette = Palette   { _palNicks                   = defaultNickColorPalette   , _palSelf                    = withForeColor defAttr red-  , _palSelfHighlight           = Nothing+  , _palSelfHighlight           = withForeColor defAttr red   , _palTime                    = withForeColor defAttr brightBlack   , _palMeta                    = withForeColor defAttr brightBlack   , _palSigil                   = withForeColor defAttr cyan@@ -83,6 +87,8 @@   , _palMention                 = withForeColor defAttr red   , _palCommand                 = withForeColor defAttr yellow   , _palCommandReady            = withForeColor defAttr green+  , _palCommandPrefix           = withForeColor defAttr blue+  , _palCommandError            = withForeColor defAttr red   , _palCommandPlaceholder      = withStyle defAttr reverseVideo   } @@ -97,6 +103,7 @@ paletteMap :: [(Text, ReifiedLens' Palette Attr)] paletteMap =   [ ("self"             , Lens palSelf)+  , ("self-highlight"   , Lens palSelfHighlight)   , ("time"             , Lens palTime)   , ("meta"             , Lens palMeta)   , ("sigil"            , Lens palSigil)@@ -110,4 +117,6 @@   , ("command"          , Lens palCommand)   , ("command-ready"    , Lens palCommandReady)   , ("command-placeholder", Lens palCommandPlaceholder)+  , ("command-prefix"   , Lens palCommandPrefix)+  , ("command-error"    , Lens palCommandError)   ]

@@ -1,61 +0,0 @@-{-|-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-    ]-  ]

@@ -14,7 +14,6 @@   ( statusLineImage   ) where -import           Client.Configuration import           Client.Image.Palette import           Client.State import           Client.State.Channel@@ -23,6 +22,7 @@ import           Client.State.Window import           Control.Lens import qualified Data.Map.Strict as Map+import           Data.Maybe import           Data.Text (Text) import qualified Data.Text as Text import           Graphics.Vty.Image@@ -42,6 +42,7 @@       , focusImage st       , activitySummary       , detailImage st+      , nometaImage st       , scrollImage st       , latencyImage st       ]@@ -56,7 +57,8 @@       , string defAttr ")"       ]   where-    attr = view (clientConfig . configPalette . palLabel) st+    pal  = clientPalette st+    attr = view palLabel pal  latencyImage :: ClientState -> Image latencyImage st@@ -76,7 +78,7 @@           | otherwise = emptyImage   | otherwise = emptyImage   where-    pal = view (clientConfig . configPalette) st+    pal = clientPalette st  infoBubble :: Image -> Image infoBubble img = string defAttr "─(" <|> img <|> string defAttr ")"@@ -86,8 +88,17 @@   | view clientDetailView st = infoBubble (string attr "detail")   | otherwise = emptyImage   where-    attr = view (clientConfig . configPalette . palLabel) st+    pal  = clientPalette st+    attr = view palLabel pal +nometaImage :: ClientState -> Image+nometaImage st+  | view clientShowMetadata st = emptyImage+  | otherwise = infoBubble (string attr "nometa")+  where+    pal  = clientPalette st+    attr = view palLabel pal+ activityImages :: ClientState -> (Image, Image) activityImages st = (summary, activityBar)   where@@ -121,7 +132,7 @@                     string defAttr "]" <|> rest       where         n   = view winUnread w-        pal = view (clientConfig . configPalette) st+        pal = clientPalette st         attr | view winMention w = view palMention pal              | otherwise         = view palActivity pal         focusText =@@ -130,16 +141,15 @@             NetworkFocus net    -> net             ChannelFocus _ chan -> idText chan -    windows     = views clientWindows Map.elems st-    windowNames = view (clientConfig . configWindowNames) st-    winNames    = Text.unpack windowNames ++ repeat '?'+    windows  = views clientWindows Map.elems st+    winNames = clientWindowNames st ++ 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+        pal = clientPalette st         attr | view winMention w = view palMention pal              | otherwise         = view palActivity pal @@ -151,7 +161,7 @@     ChannelFocus network chan -> nickPart network (Just chan)     Unfocused                 -> emptyImage   where-    pal = view (clientConfig . configPalette) st+    pal = clientPalette st     nickPart network mbChan =       case preview (clientConnection network) st of         Nothing -> emptyImage@@ -176,14 +186,13 @@       , renderedFocus       ] -    pal = view (clientConfig . configPalette) st-    focus = view clientFocus st-    windowNames = view (clientConfig . configWindowNames) st+    pal         = clientPalette st+    focus       = view clientFocus st+    windowNames = clientWindowNames st -    windowName =-      case Map.lookupIndex focus (view clientWindows st) of-        Just i | i < Text.length windowNames -> Text.index windowNames i-        _ -> '?'+    windowName = fromMaybe '?'+               $ do i <- Map.lookupIndex focus (view clientWindows st)+                    preview (ix i) windowNames      subfocusName =       case view clientSubfocus st of@@ -191,6 +200,7 @@         FocusWindows  -> Just $ string (view palLabel pal) "windows"         FocusInfo     -> Just $ string (view palLabel pal) "info"         FocusUsers    -> Just $ string (view palLabel pal) "users"+        FocusMentions -> Just $ string (view palLabel pal) "mentions"         FocusPalette  -> Just $ string (view palLabel pal) "palette"         FocusHelp mb  -> Just $ string (view palLabel pal) "help" <|>                                 foldMap (\cmd -> char defAttr ':' <|>

@@ -18,6 +18,8 @@ import           Client.Configuration import           Client.Commands import           Client.Commands.Arguments+import           Client.Commands.Interpolation+import           Client.Commands.Recognizer import           Client.Image.Arguments import           Client.Image.MircFormatting import           Client.Image.Palette@@ -26,6 +28,7 @@ import           Control.Lens import           Data.Char import           Data.List+import           Data.Monoid import qualified Data.Text as Text import           Graphics.Vty.Image @@ -37,13 +40,12 @@   = (pos, croppedImage)   where   width = view clientWidth st+  macros = views (clientConfig . configMacros) (fmap macroSpec) st   (txt, content) =-     views (clientTextBox . Edit.content) (renderContent pal) st+     views (clientTextBox . Edit.content) (renderContent macros pal) st    pos = min (width-1) leftOfCurWidth -  pal = view (clientConfig . configPalette) st-   lineImage = beginning <|> content <|> ending    leftOfCurWidth = myWcswidth ('^':txt)@@ -52,7 +54,8 @@     | leftOfCurWidth < width = lineImage     | otherwise = cropLeft width (cropRight (leftOfCurWidth+1) lineImage) -  attr      = view (clientConfig . configPalette . palTextBox) st+  pal       = clientPalette st+  attr      = view palTextBox pal   beginning = char attr '^'   ending    = char attr '$' @@ -60,10 +63,11 @@ -- corresponding to the rendered image which can be used for computing -- the logical cursor position of the cropped version of the text box. renderContent ::+  Recognizer MacroSpec {- ^ macro completions                     -} ->   Palette         {- ^ palette                               -} ->   Edit.Content    {- ^ content                               -} ->   (String, Image) {- ^ plain text rendering, image rendering -}-renderContent pal c = (txt, wholeImg)+renderContent macros pal c = (txt, wholeImg)   where   as  = reverse (view Edit.above c)   bs  = view Edit.below c@@ -78,7 +82,7 @@   wholeImg = horizCat            $ intersperse (plainText "\n")            $ map renderOtherLine as-          ++ renderLine pal curTxt+          ++ renderLine macros pal curTxt            : map renderOtherLine bs  @@ -101,17 +105,35 @@  -- | Render the active text box line using command highlighting and -- placeholders, and WYSIWYG mIRC formatting control characters.-renderLine :: Palette -> String -> Image+renderLine :: Recognizer MacroSpec -> Palette -> String -> Image+renderLine macros pal ('/':xs)+  = char defAttr '/' <|> string attr cmd <|> continue rest+ where+ specAttr spec =+   case parseArguments spec rest of+     Nothing -> view palCommand      pal+     Just{}  -> view palCommandReady pal -renderLine pal ('/':xs)-  | (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-            Just{}  -> view palCommandReady pal-  = char defAttr '/' <|>-    string attr cmd <|>-    argumentsImage pal spec rest+ (cmd, rest) = break isSpace xs+ allCommands = (Left <$> macros) <> (Right <$> commands)+ (attr, continue)+   = case recognize (Text.pack cmd) allCommands of+       Exact (Right (Command spec _ _)) ->+         ( specAttr spec+         , argumentsImage pal spec+         )+       Exact (Left (MacroSpec spec)) ->+         ( specAttr spec+         , argumentsImage pal spec+         )+       Prefix _ ->+         ( view palCommandPrefix pal+         , renderOtherLine+         )+       Invalid ->+         ( view palCommandError pal+         , renderOtherLine+         ) -renderLine _ xs = parseIrcTextExplicit (Text.pack xs)+renderLine _ _ xs = parseIrcTextExplicit (Text.pack xs)+

@@ -1,128 +0,0 @@-{-# Language OverloadedStrings #-}-{-|-Module      : Client.Image.UserList-Description : Line renderers for channel user list view-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module renders the lines used in the channel user list.--}-module Client.Image.UserList-  ( userListImages-  , userInfoImages-  ) where--import           Client.Configuration-import           Client.Image.Message-import           Client.Image.Palette-import           Client.State-import           Client.State.Channel-import           Client.State.Network-import           Control.Lens-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Map.Strict as Map-import           Data.List-import           Data.Ord-import           Data.Text (Text)-import qualified Data.Text as Text-import           Graphics.Vty.Image-import           Irc.Identifier-import           Irc.UserInfo---- | 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 -} ->-  ClientState                 ->-  [Image]-userListImages network channel st =-  case preview (clientConnection network) st of-    Just cs -> userListImages' cs channel st-    Nothing -> [text' (view palError pal) "No connection"]-  where-    pal = view (clientConfig . configPalette) st--userListImages' :: NetworkState -> Identifier -> ClientState -> [Image]-userListImages' cs channel st =-    [countImage, horizCat (intersperse gap (map renderUser usersList))]-  where-    countImage = text' (view palLabel pal) "Users:" <|>-                 sigilCountImage--    matcher = clientMatcher st--    myNicks = clientHighlights cs st--    renderUser (ident, sigils) =-      string (view palSigil pal) sigils <|>-      coloredIdentifier pal NormalIdentifier myNicks ident--    gap = char defAttr ' '--    matcher' (ident,sigils) = matcher (Text.pack sigils `Text.append` idText ident)--    usersList = sortBy (comparing fst)-              $ filter matcher'-              $ HashMap.toList usersHashMap--    sigilCounts = Map.fromListWith (+)-                    [ (take 1 sigil, 1::Int) | (_,sigil) <- usersList ]--    sigilCountImage = horizCat-      [ string (view palSigil pal) (' ':sigil) <|>-        string defAttr (show n)-      | (sigil,n) <- Map.toList sigilCounts-      ]--    pal = view (clientConfig . configPalette) st--    usersHashMap =-      view (csChannels . ix channel . chanUsers) cs---- | 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 -} ->-  ClientState                 ->-  [Image]-userInfoImages network channel st =-  case preview (clientConnection network) st of-    Just cs -> userInfoImages' cs channel st-    Nothing -> [text' (view palError pal) "No connection"]-  where-    pal = view (clientConfig . configPalette) st--userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image]-userInfoImages' cs channel st = renderEntry <$> usersList-  where-    matcher = clientMatcher st--    myNicks = clientHighlights cs st--    pal = view (clientConfig . configPalette) st--    renderEntry (info, sigils) =-      string (view palSigil pal) sigils <|>-      coloredUserInfo pal DetailedRender myNicks info--    matcher' (info,sigils) =-      matcher (Text.pack sigils `Text.append` renderUserInfo info)--    userInfos = view csUsers cs--    toInfo nick =-      case view (at nick) userInfos of-        Just (UserAndHost n h) -> UserInfo nick n h-        Nothing                -> UserInfo nick "" ""--    usersList = sortBy (flip (comparing (userNick . fst)))-              $ filter matcher'-              $ map (over _1 toInfo)-              $ HashMap.toList usersHashMap--    usersHashMap = view (csChannels . ix channel . chanUsers) cs

@@ -1,75 +0,0 @@-{-|-Module      : Client.Image.Windows-Description : View of the list of open windows-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module implements the rendering of the client window list.---}-module Client.Image.Windows-  ( windowsImages-  ) where--import           Client.Configuration-import           Client.Image.Palette-import           Client.State-import           Client.State.Focus-import           Client.State.Window-import           Control.Lens-import           Data.List-import qualified Data.Map as Map-import qualified Data.Text as Text-import           Graphics.Vty.Image-import           Irc.Identifier---- | Draw the image lines associated with the @/windows@ command.-windowsImages :: ClientState -> [Image]-windowsImages st-  = reverse-  $ createColumns-  $ zipWith (renderWindowColumns pal) names windows-  where-    cfg     = view clientConfig st-    windows = views clientWindows Map.toAscList st--    pal     = view configPalette cfg-    names   = views configWindowNames Text.unpack cfg ++ repeat '?'--renderWindowColumns :: Palette -> Char -> (Focus, Window) -> [Image]-renderWindowColumns pal name (focus, win) =-  [ char (view palWindowName pal) name-  , renderedFocus pal focus-  , renderedWindowInfo pal win-  ]--createColumns :: [[Image]] -> [Image]-createColumns xs = map makeRow xs-  where-    columnWidths = maximum . map imageWidth <$> transpose xs-    makeRow = horizCat-            . intersperse (char defAttr ' ')-            . zipWith resizeWidth columnWidths--renderedFocus :: Palette -> Focus -> Image-renderedFocus pal focus =-  case focus of-    Unfocused ->-      char (view palError pal) '*'-    NetworkFocus network ->-      text' (view palLabel pal) network-    ChannelFocus network channel ->-      text' (view palLabel pal) network <|>-      char defAttr ':' <|>-      text' (view palLabel pal) (idText channel)--renderedWindowInfo :: Palette -> Window -> Image-renderedWindowInfo pal win =-  string (view newMsgAttrLens pal) (views winUnread show win) <|>-  char defAttr '/' <|>-  string (view palActivity pal) (views winTotal show win)-  where-    newMsgAttrLens-      | view winMention win = palMention-      | otherwise           = palActivity

@@ -62,12 +62,14 @@ -- are annotated with a network ID matching that given when the connection -- was created as well as the time at which the message was recieved. data NetworkEvent-  = NetworkLine  !NetworkId !ZonedTime !ByteString-    -- ^ Event for a new recieved line (newline removed)+  -- | Event for successful connection to host+  = NetworkOpen  !NetworkId !ZonedTime+  -- | Event for a new recieved line (newline removed)+  | NetworkLine  !NetworkId !ZonedTime !ByteString+  -- | Final message indicating the network connection failed   | NetworkError !NetworkId !ZonedTime !SomeException-    -- ^ Final message indicating the network connection failed+  -- | Final message indicating the network connection finished   | NetworkClose !NetworkId !ZonedTime-    -- ^ Final message indicating the network connection finished  instance Show NetworkConnection where   showsPrec p _ = showParen (p > 10)@@ -142,19 +144,25 @@   TQueue NetworkEvent ->   TQueue ByteString ->   IO ()-startConnection network cxt settings onInput outQueue =+startConnection network cxt settings inQueue outQueue =   do rate <- newRateLimit                (view ssFloodPenalty settings)                (view ssFloodThreshold settings)      withConnection cxt settings $ \h ->-       withAsync (sendLoop h outQueue rate)      $ \sender ->-       withAsync (receiveLoop network h onInput) $ \receiver ->-         do res <- waitEitherCatch sender receiver-            case res of-              Left  Right{}  -> fail "PANIC: sendLoop returned"-              Right Right{}  -> return ()-              Left  (Left e) -> throwIO e-              Right (Left e) -> throwIO e+       do reportNetworkOpen network inQueue+          withAsync (sendLoop h outQueue rate) $ \sender ->+            withAsync (receiveLoop network h inQueue) $ \receiver ->+              do res <- waitEitherCatch sender receiver+                 case res of+                   Left  Right{}  -> fail "PANIC: sendLoop returned"+                   Right Right{}  -> return ()+                   Left  (Left e) -> throwIO e+                   Right (Left e) -> throwIO e++reportNetworkOpen :: NetworkId -> TQueue NetworkEvent -> IO ()+reportNetworkOpen network inQueue =+  do now <- getZonedTime+     atomically (writeTQueue inQueue (NetworkOpen network now))  sendLoop :: Connection -> TQueue ByteString -> RateLimit -> IO () sendLoop h outQueue rate =

@@ -0,0 +1,117 @@+{-# Language TemplateHaskell, MultiWayIf #-}+{-|+Module      : Client.Options+Description : Processing of command-line options+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module process command-line options provided when launching the client.++-}+module Client.Options+  (+  -- * Command-line options+    Options(..)++  -- * Lenses+  , optConfigFile+  , optInitialNetworks++  -- * Options loader+  , getOptions+  ) where++import           Control.Lens+import           Data.Foldable+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Version+import           Development.GitRev (gitHash, gitDirty)+import           System.Console.GetOpt+import           System.Environment+import           System.Exit+import           System.IO+import           Paths_glirc (version)++-- | Command-line options+data Options = Options+  { _optConfigFile      :: Maybe FilePath -- ^ configuration file path+  , _optInitialNetworks :: [Text]         -- ^ initial networks+  , _optShowHelp        :: Bool           -- ^ show help message+  , _optShowVersion     :: Bool           -- ^ show version message+  }++makeLenses ''Options++-- | Default values for 'Options'+defaultOptions :: Options+defaultOptions = Options+  { _optConfigFile      = Nothing+  , _optInitialNetworks = []+  , _optShowHelp        = False+  , _optShowVersion     = False+  }++-- | Option descriptions+options :: [OptDescr (Options -> Options)]+options =+  [ Option "c" ["config"]  (ReqArg (set optConfigFile . Just) "PATH")+    "Configuration file path"+  , Option "h" ["help"]    (NoArg (set optShowHelp True))+    "Show help"+  , Option "v" ["version"] (NoArg (set optShowVersion True))+    "Show version"+  ]++optOrder :: ArgOrder (Options -> Options)+optOrder = ReturnInOrder (\x -> optInitialNetworks <>~ [Text.pack x])++-- | Load command line options. This action will terminate early+-- in the case of the version flag, help flag, or an error.+getOptions :: IO Options+getOptions =+  do (flags, _, errors) <- getOpt optOrder options <$> getArgs++     let opts = foldl' (\acc f -> f acc) defaultOptions flags++         bullet x = "• " ++ x++         reportErrors =+           do hPutStrLn stderr "Errors processing command-line options:"+              traverse_ (hPutStr stderr) (map bullet errors)+              hPutStrLn stderr tryHelpTxt++     if | view optShowHelp    opts -> putStr helpTxt    >> exitSuccess+        | view optShowVersion opts -> putStr versionTxt >> exitSuccess+        | null errors              -> return opts+        | otherwise                -> reportErrors      >> exitFailure++helpTxt :: String+helpTxt = usageInfo "glirc2 [FLAGS] INITIAL_NETWORKS..." options++tryHelpTxt :: String+tryHelpTxt =+  "Run 'glirc2 --help' to see a list of available command line options."++versionTxt :: String+versionTxt = unlines+  [ "glirc-" ++ showVersion version ++ gitHashTxt ++ gitDirtyTxt+  , "Copyright 2016 Eric Mertens"+  ]++-- git version information ---------------------------------------------++-- | Returns @"-SOMEHASH"@ when in a git repository, @""@ otherwise.+gitHashTxt :: String+gitHashTxt+  | hashTxt == "UNKNOWN" = ""+  | otherwise            = '-':hashTxt+  where+    hashTxt = $gitHash++-- | Returns @"-dirty"@ when in a dirty git repository, @""@ otherwise.+gitDirtyTxt :: String+gitDirtyTxt+  | $gitDirty = "-dirty"+  | otherwise = ""

@@ -29,6 +29,7 @@   , clientScroll   , clientDetailView   , clientActivityBar+  , clientShowMetadata   , clientSubfocus   , clientNextConnectionId   , clientNetworkMap@@ -56,6 +57,8 @@   , clientTick   , applyMessageToClientState   , clientHighlights+  , clientWindowNames+  , clientPalette    -- * Add messages to buffers   , recordChannelMessage@@ -85,6 +88,7 @@ import           Client.Configuration import           Client.Configuration.ServerSettings import           Client.Image.Message+import           Client.Image.Palette import           Client.Message import           Client.Network.Async import           Client.State.Channel@@ -139,14 +143,18 @@   , _clientEvents            :: !(TQueue NetworkEvent)    -- ^ incoming network event queue   , _clientNetworkMap        :: !(HashMap Text NetworkId) -- ^ network name to connection ID +  , _clientConfig            :: !Configuration            -- ^ client configuration+   , _clientVty               :: !Vty                      -- ^ VTY handle   , _clientTextBox           :: !Edit.EditBox             -- ^ primary text box   , _clientWidth             :: !Int                      -- ^ current terminal width   , _clientHeight            :: !Int                      -- ^ current terminal height-  , _clientConfig            :: !Configuration            -- ^ client configuration+   , _clientScroll            :: !Int                      -- ^ buffer scroll lines   , _clientDetailView        :: !Bool                     -- ^ use detailed rendering mode   , _clientActivityBar       :: !Bool                     -- ^ visible activity bar+  , _clientShowMetadata      :: !Bool                     -- ^ visible activity bar+   , _clientBell              :: !Bool                     -- ^ sound a bell next draw    , _clientIgnores           :: !(HashSet Identifier)     -- ^ ignored nicknames@@ -218,6 +226,7 @@         , _clientConfig            = cfg         , _clientScroll            = 0         , _clientDetailView        = False+        , _clientShowMetadata      = True         , _clientActivityBar       = view configActivityBar cfg         , _clientNextConnectionId  = 0         , _clientBell              = False@@ -257,17 +266,17 @@   ClientMessage ->   ClientState -> ClientState recordChannelMessage network channel msg st =-  recordWindowLine focus importance wl st+  recordWindowLine focus wl st   where     focus      = ChannelFocus network channel'-    wl         = toWindowLine rendParams msg+    wl         = toWindowLine rendParams importance msg      rendParams = MessageRendererParams       { rendStatusMsg   = statusModes       , rendUserSigils  = computeMsgLineSigils network channel' msg st       , rendNicks       = HashSet.fromList (channelUserList network channel' st)       , rendMyNicks     = highlights-      , rendPalette     = view (clientConfig . configPalette) st+      , rendPalette     = clientPalette st       , rendNickPadding = view (clientConfig . configNickPadding) st       } @@ -364,11 +373,11 @@     TargetUser user   ->       foldl' (\st' chan -> overStrict                              (clientWindows . ix (ChannelFocus network chan))-                             (addToWindow WLBoring wl) st')+                             (addToWindow wl) st')            st chans       where         cfg   = view clientConfig st-        wl    = toWindowLine' cfg msg+        wl    = toWindowLine' cfg WLBoring msg         chans = user               : case preview (clientConnection network . csChannels) st of                   Nothing -> []@@ -401,39 +410,40 @@  -- | Record a message on a network window recordNetworkMessage :: ClientMessage -> ClientState -> ClientState-recordNetworkMessage msg st = recordWindowLine focus importance wl st+recordNetworkMessage msg st = recordWindowLine focus wl st   where     network    = view msgNetwork msg     focus      | Text.null network = Unfocused                | otherwise         = NetworkFocus (view msgNetwork msg)     importance = msgImportance msg st-    wl         = toWindowLine' cfg msg+    wl         = toWindowLine' cfg importance msg      cfg        = view clientConfig st  -- | Record window line at the given focus creating the window if necessary recordWindowLine ::   Focus ->-  WindowLineImportance ->   WindowLine ->   ClientState -> ClientState-recordWindowLine focus importance wl =+recordWindowLine focus wl =   over (clientWindows . at focus)-       (\w -> Just $! addToWindow importance wl (fromMaybe emptyWindow w))+       (\w -> Just $! addToWindow wl (fromMaybe emptyWindow w)) -toWindowLine :: MessageRendererParams -> ClientMessage -> WindowLine-toWindowLine params msg = WindowLine-  { _wlBody      = view msgBody msg-  , _wlText      = msgText (view msgBody msg)-  , _wlImage     = mkImage NormalRender-  , _wlFullImage = mkImage DetailedRender+toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine+toWindowLine params importance msg = WindowLine+  { _wlBody       = view msgBody msg+  , _wlText       = msgText (view msgBody msg)+  , _wlImage      = mkImage NormalRender+  , _wlFullImage  = mkImage DetailedRender+  , _wlImportance = importance+  , _wlTimestamp  = zonedTimeToUTC (view msgTime msg)   }   where     mkImage mode =       force (msgImage mode (view msgTime msg) params (view msgBody msg))  -- | 'toWindowLine' but with mostly defaulted parameters.-toWindowLine' :: Configuration -> ClientMessage -> WindowLine+toWindowLine' :: Configuration -> WindowLineImportance -> ClientMessage -> WindowLine toWindowLine' config =   toWindowLine defaultRenderParams     { rendPalette     = view configPalette     config@@ -755,3 +765,13 @@   case preview (clientConnection network) st of     Just cs -> clientHighlights cs st     Nothing -> view (clientConfig . configExtraHighlights) st++-- | Produce the list of window names configured for the client.+clientWindowNames ::+  ClientState ->+  [Char]+clientWindowNames = views (clientConfig . configWindowNames) Text.unpack++-- | Produce the list of window names configured for the client.+clientPalette :: ClientState -> Palette+clientPalette = view (clientConfig . configPalette)

@@ -43,6 +43,7 @@   , killWordBackward   , killWordForward   , yank+  , toggle   , left   , right   , leftWord

@@ -1,4 +1,4 @@-{-# Language TemplateHaskell #-}+{-# Language TemplateHaskell, BangPatterns #-} {-| Module      : Client.State.EditBox.Content Description : Multiline text container with cursor@@ -42,6 +42,7 @@   , insertPastedString   , insertString   , insertChar+  , toggle   ) where  import           Control.Lens hiding (below)@@ -253,3 +254,18 @@          $! over below (view text c :)           $ set above as           $ set line (endLine a) c++toggle :: Content -> Content+toggle !c+  | p < 1     = c+  | n < 2     = c+  | n == p    = over text (swapAt (p-2)) c+  | otherwise = set pos (p+1)+              $ over text (swapAt (p-1)) c+  where+    p = view pos c+    n = views text length c++    swapAt 0 (x:y:z) = y:x:z+    swapAt i (x:xs)  = x:swapAt (i-1) xs+    swapAt _ _       = error "toggle: PANIC! Invalid argument"

@@ -24,13 +24,6 @@   , _ChannelFocus   , _NetworkFocus   , _Unfocused--  -- * Subfocus Prisms-  , _FocusMessages-  , _FocusInfo-  , _FocusUsers-  , _FocusMasks-  , _FocusWindows   ) where  import           Control.Lens@@ -55,10 +48,9 @@   | FocusMasks !Char -- ^ Show channel mask list for given mode   | FocusWindows     -- ^ Show client windows   | FocusPalette     -- ^ Show current palette+  | FocusMentions    -- ^ Show all mentions   | FocusHelp (Maybe Text) -- ^ Show help window with optional command   deriving (Eq,Show)--makePrisms ''Subfocus  -- | Unfocused first, followed by focuses sorted by network. -- Within the same network the network focus comes first and

@@ -26,6 +26,8 @@   , wlText   , wlImage   , wlFullImage+  , wlImportance+  , wlTimestamp    -- * Window line importance   , WindowLineImportance(..)@@ -39,14 +41,17 @@ import           Client.Message import           Control.Lens import           Data.Text (Text)+import           Data.Time (UTCTime) import           Graphics.Vty.Image (Image)  -- | A single message to be displayed in a window data WindowLine = WindowLine-  { _wlBody      :: !MessageBody -- ^ Original Haskell value-  , _wlText      :: {-# UNPACK #-} !Text -- ^ Searchable text form-  , _wlImage     :: !Image       -- ^ Normal rendered image-  , _wlFullImage :: !Image       -- ^ Detailed rendered image+  { _wlBody       :: !MessageBody -- ^ Original Haskell value+  , _wlText       :: {-# UNPACK #-} !Text -- ^ Searchable text form+  , _wlImage      :: !Image       -- ^ Normal rendered image+  , _wlFullImage  :: !Image       -- ^ Detailed rendered image+  , _wlImportance :: !WindowLineImportance -- ^ Importance of message+  , _wlTimestamp  :: {-# UNPACK #-} !UTCTime   }  -- | A 'Window' tracks all of the messages and metadata for a particular@@ -79,14 +84,14 @@  -- | Adds a given line to a window as the newest message. Window's -- unread count will be updated according to the given importance.-addToWindow :: WindowLineImportance -> WindowLine -> Window -> Window-addToWindow importance !msg !win = Window-    { _winMessages = msg : _winMessages win-    , _winTotal    = _winTotal win + 1-    , _winUnread   = _winUnread win-                   + (if importance == WLBoring then 0 else 1)-    , _winMention  = _winMention win-                  || importance == WLImportant+addToWindow :: WindowLine -> Window -> Window+addToWindow !msg !win = Window+    { _winMessages = msg : view winMessages win+    , _winTotal    = view winTotal win + 1+    , _winUnread   = view winUnread win+                   + (if view wlImportance msg == WLBoring then 0 else 1)+    , _winMention  = view winMention win+                  || view wlImportance msg == WLImportant     }  -- | Update the window clearing the unread count and important flag.

@@ -0,0 +1,46 @@+{-# Language BangPatterns #-}+{-|+Module      : Client.View+Description : View selection module+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module selects the correct view based on the current state.++-}+module Client.View+  ( viewLines+  ) where++import           Client.State+import           Client.State.Focus+import           Client.View.ChannelInfo+import           Client.View.Help+import           Client.View.MaskList+import           Client.View.Mentions+import           Client.View.Messages+import           Client.View.Palette+import           Client.View.UserList+import           Client.View.Windows+import           Control.Lens+import           Graphics.Vty.Image++viewLines :: ClientState -> [Image]+viewLines !st =+  case (view clientFocus st, view clientSubfocus st) of+    (ChannelFocus network channel, FocusInfo) ->+      channelInfoImages network channel st+    (ChannelFocus network channel, FocusUsers)+      | view clientDetailView st -> userInfoImages network channel st+      | otherwise                -> userListImages network channel st+    (ChannelFocus network channel, FocusMasks mode) ->+      maskListImages mode network channel st+    (_, FocusWindows) -> windowsImages st+    (_, FocusMentions) -> mentionsViewLines st+    (_, FocusPalette) -> paletteViewLines pal+    (_, FocusHelp mb) -> helpImageLines mb pal++    _ -> chatMessageImages st+  where+    pal = clientPalette st

@@ -0,0 +1,80 @@+{-# Language OverloadedStrings #-}+{-# Language BangPatterns #-}++{-|+Module      : Client.View.ChannelInfo+Description : Channel information renderer+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module implements a renderer for the window that shows+channel metadata.++-}+module Client.View.ChannelInfo+  ( channelInfoImages+  ) where++import           Client.Image.Message+import           Client.Image.MircFormatting+import           Client.Image.Palette+import           Client.State+import           Client.State.Channel+import           Client.State.Network+import           Control.Lens+import           Data.HashSet (HashSet)+import           Data.Text (Text)+import           Data.Time+import           Graphics.Vty.Image+import           Irc.Identifier++-- | Render the lines used in a channel mask list+channelInfoImages ::+  Text        {- ^ network -} ->+  Identifier  {- ^ channel -} ->+  ClientState -> [Image]+channelInfoImages network channelId st++  | Just cs      <- preview (clientConnection network) st+  , Just channel <- preview (csChannels . ix channelId) cs+  = channelInfoImages' pal (clientHighlights cs st) channel++  | otherwise = [text' (view palError pal) "No channel information"]+  where+    pal = clientPalette st++channelInfoImages' :: Palette -> HashSet Identifier -> ChannelState -> [Image]+channelInfoImages' pal myNicks !channel+    = topicLine+    : provenanceLines+   ++ creationLines+   ++ urlLines++  where+    label = text' (view palLabel pal)++    topicLine = label "Topic: " <|> parseIrcText (view chanTopic channel)+++    utcTimeImage = string defAttr . formatTime defaultTimeLocale "%F %T"++    provenanceLines =+        case view chanTopicProvenance channel of+          Nothing -> []+          Just !prov ->+            [ label "Topic set by: " <|>+                coloredUserInfo pal DetailedRender myNicks (view topicAuthor prov)+            , label "Topic set on: " <|> utcTimeImage (view topicTime prov)+            ]++    creationLines =+        case view chanCreation channel of+          Nothing   -> []+          Just time -> [label "Created on: " <|> utcTimeImage time]++    urlLines =+        case view chanUrl channel of+          Nothing -> []+          Just url -> [ label "Channel URL: " <|> parseIrcText url ]+

@@ -0,0 +1,100 @@+{-# Language OverloadedStrings #-}++{-|+Module      : Client.View.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.View.Help+  ( helpImageLines+  ) where++import           Client.Commands+import           Client.Commands.Arguments+import           Client.Image.Arguments+import           Client.Image.MircFormatting+import           Client.Image.Palette+import           Client.Commands.Recognizer+import           Control.Lens+import           Data.List.NonEmpty (NonEmpty((:|)))+import           Data.Monoid ((<>))+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]    {- ^ help lines            -}+helpImageLines mbCmd pal =+  case mbCmd of+    Nothing  -> listAllCommands pal+    Just cmd -> commandHelpLines cmd pal++-- | Generate detailed help lines for the command with the given name.+commandHelpLines ::+  Text    {- ^ command name -} ->+  Palette {- ^ palette      -} ->+  [Image] {- ^ lines        -}+commandHelpLines cmdName pal =+  case recognize cmdName commands of+    Invalid -> [string (view palError pal) "Unknown command, try /help"]+    Prefix sfxs ->+      [string (view palError pal) $ "Unknown command, did you mean: " ++ suggestions]+      where+      suggestions = Text.unpack $ Text.intercalate " " ((cmdName <>) <$> sfxs)+    Exact (Command args doc impl) ->+      reverse $ commandSummary pal (pure cmdName) args+              : emptyImage+              : explainContext impl+              : emptyImage+              : map parseIrcText docs+      where+        docs = Text.lines doc++-- | Generate an explanation of the context where the given command+-- implementation will be valid.+explainContext ::+  CommandImpl a {- ^ command implementation -} ->+  Image         {- ^ help line              -}+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)++-- | Generate the lines for the help window showing all commands.+listAllCommands ::+  Palette {- ^ palette    -} ->+  [Image] {- ^ help lines -}+listAllCommands pal =+  reverse+    [ commandSummary pal name args+    | (name, Command args _ _) <- commandsList ]++-- | Generate the help line for the given command and its+-- specification for use in the list of commands.+commandSummary ::+  Palette        {- ^ palette                  -} ->+  NonEmpty Text  {- ^ command name and aliases -} ->+  ArgumentSpec a {- ^ argument specification   -} ->+  Image          {- ^ summary help line        -}+commandSummary pal (cmd :| _) args  =+  char defAttr '/' <|>+  text' (view palCommand pal) cmd <|>+  argumentsImage pal' args ""++  where+    pal' = set palCommandPlaceholder defAttr pal

@@ -0,0 +1,82 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Client.View.MaskList+Description : Line renderers for channel mask list view+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module renders the lines used in the channel mask list. A mask list+can show channel bans, quiets, invites, and exceptions.+-}+module Client.View.MaskList+  ( maskListImages+  ) where++import           Client.Image.Palette+import           Client.State+import           Client.State.Channel+import           Client.State.Network+import           Control.Lens+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import           Data.List+import           Data.Ord+import           Data.Text (Text)+import           Data.Time+import           Graphics.Vty.Image+import           Irc.Identifier++-- | Render the lines used in a channel mask list+maskListImages ::+  Char        {- ^ Mask mode -} ->+  Text        {- ^ network   -} ->+  Identifier  {- ^ channel   -} ->+  ClientState -> [Image]+maskListImages mode network channel st =+  case mbEntries of+    Nothing      -> [text' (view palError pal) "Mask list not loaded"]+    Just entries -> maskListImages' entries st++  where+    pal = clientPalette st+    mbEntries = preview+                ( clientConnection network+                . csChannels . ix channel+                . chanLists . ix mode+                ) st++maskListImages' :: HashMap Text MaskListEntry -> ClientState -> [Image]+maskListImages' entries st = countImage : images+  where+    pal = clientPalette st++    countImage = text' (view palLabel pal) "Masks (visible/total): " <|>+                 string defAttr (show (length entryList)) <|>+                 char (view palLabel pal) '/' <|>+                 string defAttr (show (HashMap.size entries))++    matcher = clientMatcher st++    matcher' (mask,entry) = matcher mask || matcher (view maskListSetter entry)++    entryList = sortBy (flip (comparing (view (_2 . maskListTime))))+              $ filter matcher'+              $ HashMap.toList entries++    renderWhen = formatTime defaultTimeLocale " %F %T"++    (masks, whoWhens) = unzip entryList+    maskImages       = text' defAttr <$> masks+    maskColumnWidth  = maximum (imageWidth <$> maskImages) + 1+    paddedMaskImages = resizeWidth maskColumnWidth <$> maskImages+    width            = max 1 (view clientWidth st)++    images = [ cropLine $ mask <|>+                          text' defAttr who <|>+                          string defAttr (renderWhen when)+             | (mask, MaskListEntry who when) <- zip paddedMaskImages whoWhens ]++    cropLine img+      | imageWidth img > width = cropRight width img+      | otherwise              = img

@@ -0,0 +1,109 @@+{-# Language BangPatterns #-}+{-|+Module      : Client.View.Mentions+Description : Mentions view+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module provides the lines that have been highlighted+across the client in sorted order.++-}+module Client.View.Mentions+  ( mentionsViewLines+  ) where++import           Client.Image.Palette+import           Client.State+import           Client.State.Focus+import           Client.State.Window+import qualified Data.Map as Map+import           Control.Lens+import           Data.Text (Text)+import           Data.Time (UTCTime)+import           Irc.Identifier (idText)+import           Graphics.Vty.Image++-- | Generate the list of message lines marked important ordered by+-- time. Each run of lines from the same channel will be grouped+-- together. Messages are headed by their window, network, and channel.+mentionsViewLines :: ClientState -> [Image]+mentionsViewLines st = addMarkers pal entries++  where+    pal = clientPalette st++    names = clientWindowNames st ++ repeat '?'++    detail = view clientDetailView st++    entries = merge+              [windowEntries detail n net (idText chan) v+              | (n,(ChannelFocus net chan, v))+                <- names `zip` Map.toList (view clientWindows st) ]++data MentionLine = MentionLine+  { mlTimestamp  :: UTCTime+  , mlWindowName :: Char+  , mlNetwork    :: Text+  , mlChannel    :: Text+  , mlImage      :: Image+  }++addMarkers ::+  Palette       {- ^ palette                           -} ->+  [MentionLine] {- ^ list of mentions in time order    -} ->+  [Image]       {- ^ mention images and channel labels -}+addMarkers _ [] = []+addMarkers !pal (!ml : xs) =+  mlImage ml : map mlImage same ++ windowMarker : addMarkers pal rest+  where+    isSame ml' = mlWindowName ml == mlWindowName ml'+              && mlNetwork    ml == mlNetwork    ml'+              && mlChannel    ml == mlChannel    ml'++    (same,rest) = span isSame xs++    windowMarker = char (view palWindowName pal) (mlWindowName ml) <|>+                   char defAttr ':' <|>+                   text' (view palLabel pal) (mlNetwork ml) <|>+                   char defAttr ':' <|>+                   text' (view palLabel pal) (mlChannel ml)++windowEntries ::+  Bool   {- ^ detailed view -} ->+  Char   {- ^ window name   -} ->+  Text   {- ^ network name  -} ->+  Text   {- ^ channel name  -} ->+  Window {- ^ window        -} ->+  [MentionLine]+windowEntries !detailed name net chan w =+  [ MentionLine+      { mlTimestamp  = view wlTimestamp l+      , mlWindowName = name+      , mlNetwork    = net+      , mlChannel    = chan+      , mlImage      = if detailed then view wlFullImage l else view wlImage l+      }+  | l <- view winMessages w+  , WLImportant == view wlImportance l+  ]++-- | Merge a list of sorted lists of mention lines into a single sorted list+-- in descending order.+merge :: [[MentionLine]] -> [MentionLine]+merge []  = []+merge [x] = x+merge xss = merge (merge2s xss)++merge2s :: [[MentionLine]] -> [[MentionLine]]+merge2s (x:y:z) = merge2 x y : merge2s z+merge2s xs      = xs++merge2 :: [MentionLine] -> [MentionLine] -> [MentionLine]+merge2 [] ys = ys+merge2 xs [] = xs+merge2 xxs@(x:xs) yys@(y:ys)+  | mlTimestamp x >= mlTimestamp y = x : merge2 xs yys+  | otherwise                      = y : merge2 xxs ys

@@ -0,0 +1,134 @@+{-|+Module      : Client.View.Messages+Description : Chat message view+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module returns the chat messages for the currently focused+window in message view and gathers metadata entries into single+lines.++-}+module Client.View.Messages+  ( chatMessageImages+  ) where++import           Client.Image.Palette+import           Client.Image.Message+import           Client.State+import           Client.State.Network+import           Client.State.Window+import           Client.Message+import           Control.Lens+import           Irc.Identifier+import           Graphics.Vty.Image++chatMessageImages :: ClientState -> [Image]+chatMessageImages st = windowLineProcessor focusedMessages+  where+    matcher = clientMatcher st++    focusedMessages+        = filter (views wlText matcher)+        $ view (clientWindows . ix (view clientFocus st) . winMessages) st++    windowLineProcessor++      | view clientDetailView st =+          if view clientShowMetadata st+            then map (view wlFullImage)+            else detailedImagesWithoutMetadata st++      | otherwise = windowLinesToImages st . filter (not . isNoisy)++    isNoisy msg =+      case view wlBody msg of+        IrcBody irc -> squelchIrcMsg irc+        _           -> False++detailedImagesWithoutMetadata :: ClientState -> [WindowLine] -> [Image]+detailedImagesWithoutMetadata st wwls =+  case gatherMetadataLines st wwls of+    ([], [])   -> []+    ([], w:ws) -> view wlFullImage w : detailedImagesWithoutMetadata st ws+    (_:_, wls) -> detailedImagesWithoutMetadata st wls++windowLinesToImages :: ClientState -> [WindowLine] -> [Image]+windowLinesToImages st wwls =+  case gatherMetadataLines st wwls of+    ([], [])   -> []+    ([], w:ws) -> view wlImage w : windowLinesToImages st ws+    ((img,who,mbnext):mds, wls)++      | view clientShowMetadata st ->+         startMetadata img mbnext who mds palette+       : windowLinesToImages st wls++      | otherwise -> windowLinesToImages st wls+  where+    palette = clientPalette st++------------------------------------------------------------------------++type MetadataState =+  Identifier                            {- ^ current nick -} ->+  [(Image,Identifier,Maybe Identifier)] {- ^ metadata     -} ->+  Palette                               {- ^ palette      -} ->+  Image++startMetadata ::+  Image            {- ^ metadata image           -} ->+  Maybe Identifier {- ^ possible nick transition -} ->+  MetadataState+startMetadata img mbnext who mds palette =+        quietIdentifier palette who+    <|> img+    <|> transitionMetadata mbnext who mds palette++transitionMetadata ::+  Maybe Identifier {- ^ possible nick transition -} ->+  MetadataState+transitionMetadata mbwho who mds palette =+  case mbwho of+    Nothing   -> continueMetadata who  mds palette+    Just who' -> quietIdentifier palette who'+             <|> continueMetadata who' mds palette++continueMetadata :: MetadataState+continueMetadata _ [] _ = emptyImage+continueMetadata who1 ((img, who2, mbwho3):mds) palette+  | who1 == who2 = img+               <|> transitionMetadata mbwho3 who2 mds palette+  | otherwise    = char defAttr ' '+               <|> startMetadata img mbwho3 who2 mds palette++------------------------------------------------------------------------++gatherMetadataLines ::+  ClientState ->+  [WindowLine] ->+  ( [(Image, Identifier, Maybe Identifier)] , [ WindowLine ] )+  -- ^ metadata entries are reversed+gatherMetadataLines st = go []+  where+    go acc (w:ws)+      | Just (img,who,mbnext) <- metadataWindowLine st w =+          go ((img,who,mbnext) : acc) ws++    go acc ws = (acc,ws)+++-- | Classify window lines for metadata coalesence+metadataWindowLine ::+  ClientState ->+  WindowLine ->+  Maybe (Image, Identifier, Maybe Identifier)+        {- ^ Image, incoming identifier, outgoing identifier if changed -}+metadataWindowLine st wl =+  case view wlBody wl of+    IrcBody irc+      | Just who <- ircIgnorable irc st -> Just (ignoreImage, who, Nothing)+      | otherwise                       -> metadataImg irc+    _                                   -> Nothing+

@@ -0,0 +1,61 @@+{-|+Module      : Client.View.Palette+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.View.Palette+  ( 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+    ]+  ]

@@ -0,0 +1,127 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Client.View.UserList+Description : Line renderers for channel user list view+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module renders the lines used in the channel user list.+-}+module Client.View.UserList+  ( userListImages+  , userInfoImages+  ) where++import           Client.Image.Message+import           Client.Image.Palette+import           Client.State+import           Client.State.Channel+import           Client.State.Network+import           Control.Lens+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map.Strict as Map+import           Data.List+import           Data.Ord+import           Data.Text (Text)+import qualified Data.Text as Text+import           Graphics.Vty.Image+import           Irc.Identifier+import           Irc.UserInfo++-- | 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 -} ->+  ClientState                 ->+  [Image]+userListImages network channel st =+  case preview (clientConnection network) st of+    Just cs -> userListImages' cs channel st+    Nothing -> [text' (view palError pal) "No connection"]+  where+    pal = clientPalette st++userListImages' :: NetworkState -> Identifier -> ClientState -> [Image]+userListImages' cs channel st =+    [countImage, horizCat (intersperse gap (map renderUser usersList))]+  where+    countImage = text' (view palLabel pal) "Users:" <|>+                 sigilCountImage++    matcher = clientMatcher st++    myNicks = clientHighlights cs st++    renderUser (ident, sigils) =+      string (view palSigil pal) sigils <|>+      coloredIdentifier pal NormalIdentifier myNicks ident++    gap = char defAttr ' '++    matcher' (ident,sigils) = matcher (Text.pack sigils `Text.append` idText ident)++    usersList = sortBy (comparing fst)+              $ filter matcher'+              $ HashMap.toList usersHashMap++    sigilCounts = Map.fromListWith (+)+                    [ (take 1 sigil, 1::Int) | (_,sigil) <- usersList ]++    sigilCountImage = horizCat+      [ string (view palSigil pal) (' ':sigil) <|>+        string defAttr (show n)+      | (sigil,n) <- Map.toList sigilCounts+      ]++    pal = clientPalette st++    usersHashMap =+      view (csChannels . ix channel . chanUsers) cs++-- | 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 -} ->+  ClientState                 ->+  [Image]+userInfoImages network channel st =+  case preview (clientConnection network) st of+    Just cs -> userInfoImages' cs channel st+    Nothing -> [text' (view palError pal) "No connection"]+  where+    pal = clientPalette st++userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image]+userInfoImages' cs channel st = renderEntry <$> usersList+  where+    matcher = clientMatcher st++    myNicks = clientHighlights cs st++    pal = clientPalette st++    renderEntry (info, sigils) =+      string (view palSigil pal) sigils <|>+      coloredUserInfo pal DetailedRender myNicks info++    matcher' (info,sigils) =+      matcher (Text.pack sigils `Text.append` renderUserInfo info)++    userInfos = view csUsers cs++    toInfo nick =+      case view (at nick) userInfos of+        Just (UserAndHost n h) -> UserInfo nick n h+        Nothing                -> UserInfo nick "" ""++    usersList = sortBy (flip (comparing (userNick . fst)))+              $ filter matcher'+              $ map (over _1 toInfo)+              $ HashMap.toList usersHashMap++    usersHashMap = view (csChannels . ix channel . chanUsers) cs

@@ -0,0 +1,72 @@+{-|+Module      : Client.View.Windows+Description : View of the list of open windows+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module implements the rendering of the client window list.++-}+module Client.View.Windows+  ( windowsImages+  ) where++import           Client.Image.Palette+import           Client.State+import           Client.State.Focus+import           Client.State.Window+import           Control.Lens+import           Data.List+import qualified Data.Map as Map+import           Graphics.Vty.Image+import           Irc.Identifier++-- | Draw the image lines associated with the @/windows@ command.+windowsImages :: ClientState -> [Image]+windowsImages st+  = reverse+  $ createColumns+  $ zipWith (renderWindowColumns pal) names windows+  where+    windows = views clientWindows Map.toAscList st++    pal     = clientPalette st+    names   = clientWindowNames st ++ repeat '?'++renderWindowColumns :: Palette -> Char -> (Focus, Window) -> [Image]+renderWindowColumns pal name (focus, win) =+  [ char (view palWindowName pal) name+  , renderedFocus pal focus+  , renderedWindowInfo pal win+  ]++createColumns :: [[Image]] -> [Image]+createColumns xs = map makeRow xs+  where+    columnWidths = maximum . map imageWidth <$> transpose xs+    makeRow = horizCat+            . intersperse (char defAttr ' ')+            . zipWith resizeWidth columnWidths++renderedFocus :: Palette -> Focus -> Image+renderedFocus pal focus =+  case focus of+    Unfocused ->+      char (view palError pal) '*'+    NetworkFocus network ->+      text' (view palLabel pal) network+    ChannelFocus network channel ->+      text' (view palLabel pal) network <|>+      char defAttr ':' <|>+      text' (view palLabel pal) (idText channel)++renderedWindowInfo :: Palette -> Window -> Image+renderedWindowInfo pal win =+  string (view newMsgAttrLens pal) (views winUnread show win) <|>+  char defAttr '/' <|>+  string (view palActivity pal) (views winTotal show win)+  where+    newMsgAttrLens+      | view winMention win = palMention+      | otherwise           = palActivity