glirc 2.6 → 2.7
raw patch · 12 files changed
+294/−113 lines, 12 filesdep +regex-tdfadep +regex-tdfa-textdep −text-icu
Dependencies added: regex-tdfa, regex-tdfa-text
Dependencies removed: text-icu
Files
- ChangeLog.md +8/−0
- README.md +43/−12
- glirc.cabal +3/−2
- src/Client/Commands.hs +50/−9
- src/Client/Configuration.hs +40/−29
- src/Client/Configuration/Colors.hs +41/−8
- src/Client/Image/Message.hs +40/−13
- src/Client/Image/Palette.hs +33/−28
- src/Client/Image/UserList.hs +1/−1
- src/Client/State.hs +13/−8
- src/Client/WordCompletion.hs +8/−3
- src/Config/FromConfig.hs +14/−0
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for glirc2 +## 2.7++* Switch to regex-tdfa (easier to install on macOS than text-icu)+* Tab-complete starts with most recent nick+* Add `/reload`+* Add custom palette entry for self highlights+* Add ability to set background colors and styles in palette+ ## 2.6 * connect-cmds now use actual client commands instead of raw IRC messages. For example `msg user my message` or `join #mychannel`
README.md view
@@ -90,7 +90,9 @@ * "/path/to/extra/certificate.pem" palette:- time: [10,10,10] -- RGB values for color for timestamps+ time:+ fg: [10,10,10] -- RGB values for color for timestamps+ bg: blue nick-colors: [ cyan, magenta, green, yellow, blue , bright-cyan, bright-magenta, bright-green, bright-blue@@ -110,6 +112,7 @@ * `servers` - These settings are used to override defaults when the hostname matches * `palette` - Client color overrides * `window-names` - text - Names of windows (typically overridden on non QWERTY layouts)+* `nick-padding` - nonnegative integer - Nicks are padded until they have the specified length Settings --------@@ -139,18 +142,44 @@ Palette ------- -* `nick-colors` - List of colors - Use for nick highlights-* `time` - color - color for timestamp-* `meta` - color - color for metadata-* `sigil` - color - color for sigils-* `label` - color - color for information labels-* `latency` - color - color for latency time-* `error` - color - color for error messages-* `textbox` - color - color for textbox edges-* `window-name` - color - color for current window name-* `activity` - color - color for activity notification-* `mention` - color - color for mention notification+* `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`)+* `time` - attr - attr for timestamp+* `meta` - attr - attr for metadata+* `sigil` - attr - attr for sigils+* `label` - attr - attr for information labels+* `latency` - attr - attr for latency time+* `error` - attr - attr for error messages+* `textbox` - attr - attr for textbox edges+* `window-name` - attr - attr for current window name+* `activity` - attr - attr for activity notification+* `mention` - attr - attr for mention notification +Text Attributes+---------------++Text attributes can be specified either as a single foreground color or section of attributes.++* `<number>` - Maps to a terminal color+* `<name>` - Direct selection of standard 16 terminal colors+* `[red-number, blue-number, green-number]` - List of 3 numbers in range 0-255 map to an approximation of the RGB color.++Attributes++* `fg` - foreground color+* `bg` - background color+* `style` - single style or list of styles++Styles++* `blink`+* `bold`+* `dim`+* `standout`+* `reverse-video`+* `underline`+ Commands ======== @@ -161,6 +190,8 @@ * `/connect <name>` - Connect to the given server * `/disconnect` - Forcefully terminate connection to the current server * `/reconnect` - Reconnect to the current server+* `/reload` - Reload the previous configuration file (not retroactive!)+* `/reload <path>` - Load a new configuration file Connection commands
glirc.cabal view
@@ -1,5 +1,5 @@ name: glirc-version: 2.6+version: 2.7 synopsis: Console IRC client description: Console IRC client license: ISC@@ -75,7 +75,8 @@ split >=0.2 && <0.3, stm >=2.4 && <2.5, text >=1.2.2 && <1.3,- text-icu >=0.7 && <0.8,+ regex-tdfa >=1.2 && <1.3,+ regex-tdfa-text >=1.0 && <1.1, time >=1.6 && <1.7, tls >=1.3.8 && <1.4, transformers >=0.5.2 && <0.6,
src/Client/Commands.hs view
@@ -18,6 +18,7 @@ , tabCompletion ) where +import Client.Configuration import Client.ConnectionState import qualified Client.EditBox as Edit import Client.Message@@ -181,6 +182,7 @@ , (["clear" ], ClientCommand cmdClear noClientTab) , (["reconnect" ], ClientCommand cmdReconnect noClientTab) , (["ignore" ], ClientCommand cmdIgnore simpleClientTab)+ , (["reload" ], ClientCommand cmdReload tabReload) , (["quote" ], NetworkCommand cmdQuote simpleNetworkTab) , (["j","join" ], NetworkCommand cmdJoin simpleNetworkTab)@@ -402,7 +404,7 @@ tabFocus isReversed st _ = commandSuccess $ fromMaybe st- $ clientTextBox (wordComplete id isReversed completions) st+ $ clientTextBox (wordComplete id isReversed [] completions) st where networks = map mkId $ HashMap.keys $ view clientNetworkMap st params = words $ uncurry take $ clientLine st@@ -687,6 +689,26 @@ updateIgnores s = foldl' updateIgnore s xs updateIgnore s x = over (contains x) not s +-- | Implementation of @/reload@+--+-- Attempt to reload the configuration file+cmdReload :: ClientCommand+cmdReload st rest =+ do let path | null rest = view (clientConfig . configConfigPath) st+ | otherwise = Just rest+ res <- loadConfiguration path+ case res of+ Left{} -> commandFailure st+ Right cfg ->+ commandSuccess $! set clientConfig cfg st++-- | Support file name tab completion when providing an alternative+-- configuration file.+--+-- /NOT IMPLEMENTED/+tabReload :: Bool {- ^ reversed -} -> ClientCommand+tabReload _ st _ = commandFailure st+ modeCommand :: [Text] -> ConnectionState -> ClientState -> IO CommandResult modeCommand modes cs st = case view clientFocus st of@@ -732,26 +754,44 @@ , let parsedModesWithParams = [ (pol,mode) | (pol,mode,arg) <- parsedModes, not (Text.null arg) ] , (pol,mode):_ <- drop (paramIndex-3) parsedModesWithParams- , let completions = computeModeCompletion pol mode channel cs+ , let (hint, completions) = computeModeCompletion pol mode channel cs st -> commandSuccess $ fromMaybe st- $ clientTextBox (wordComplete id isReversed completions) st+ $ clientTextBox (wordComplete id isReversed hint completions) st _ -> commandSuccess st where paramIndex = length $ words $ uncurry take $ clientLine st +activeNicks ::+ ClientState ->+ [Identifier]+activeNicks st =+ toListOf+ ( clientWindows . ix focus+ . winMessages . folded+ . wlBody . _IrcBody+ . folding msgActor . to userNick) st+ where+ focus = view clientFocus st+ -- | Use the *!*@host masks of users for channel lists when setting list modes -- -- Use the channel's mask list for removing modes -- -- Use the nick list otherwise-computeModeCompletion :: Bool -> Char -> Identifier -> ConnectionState -> [Identifier]-computeModeCompletion pol mode channel cs+computeModeCompletion ::+ Bool {- ^ mode polarity -} ->+ Char {- ^ mode -} ->+ Identifier {- ^ channel -} ->+ ConnectionState ->+ ClientState ->+ ([Identifier],[Identifier]) {- ^ (hint, complete) -}+computeModeCompletion pol mode channel cs st | mode `elem` view modesLists modeSettings =- if pol then usermasks else masks- | otherwise = nicks+ if pol then ([],usermasks) else ([],masks)+ | otherwise = (activeNicks st, nicks) where modeSettings = view csModeTypes cs nicks = HashMap.keys (view (csChannels . ix channel . chanUsers) cs)@@ -773,7 +813,7 @@ commandNameCompletion :: Bool -> ClientState -> Maybe ClientState commandNameCompletion isReversed st = do guard (cursorPos == n)- clientTextBox (wordComplete id isReversed possibilities) st+ clientTextBox (wordComplete id isReversed [] possibilities) st where n = length leadingPart (cursorPos, line) = clientLine st@@ -785,8 +825,9 @@ nickTabCompletion :: Bool {- ^ reversed -} -> ClientState -> ClientState nickTabCompletion isReversed st = fromMaybe st- $ clientTextBox (wordComplete (++": ") isReversed completions) st+ $ clientTextBox (wordComplete (++": ") isReversed hint completions) st where+ hint = activeNicks st completions = currentCompletionList st sendModeration :: Identifier -> [RawIrcMsg] -> ConnectionState -> IO ConnectionState
src/Client/Configuration.hs view
@@ -22,6 +22,8 @@ , configServers , configPalette , configWindowNames+ , configNickPadding+ , configConfigPath -- * Loading configuration , loadConfiguration@@ -38,13 +40,14 @@ import Config import Config.FromConfig import Control.Lens hiding (List)+import Data.Foldable (for_) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Maybe import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text-import Graphics.Vty.Attributes+import qualified Data.Vector as Vector import Irc.Identifier (Identifier, mkId) import System.Directory import System.FilePath@@ -57,7 +60,10 @@ { _configDefaults :: ServerSettings -- ^ Default connection settings , _configServers :: (HashMap Text ServerSettings) -- ^ Host-specific settings , _configPalette :: Palette- , _configWindowNames :: Text -- ^ Names of windows, used when alt-jumping+ , _configWindowNames :: Text -- ^ Names of windows, used when alt-jumping)+ , _configNickPadding :: Maybe Integer -- ^ Padding of nicks+ , _configConfigPath :: Maybe FilePath+ -- ^ manually specified configuration path, used for reloading } deriving Show @@ -140,13 +146,17 @@ Left parseError -> throwIO (ConfigurationParseFailed parseError) Right rawcfg -> return rawcfg - case runConfigParser (parseConfiguration def rawcfg) of+ case runConfigParser (parseConfiguration mbPath def rawcfg) of Left loadError -> throwIO (ConfigurationMalformed (Text.unpack loadError)) Right cfg -> return cfg -parseConfiguration :: ServerSettings -> Value -> ConfigParser Configuration-parseConfiguration def = parseSections $+parseConfiguration ::+ Maybe FilePath {- ^ optionally specified path to config -} ->+ ServerSettings {- ^ prepopulated default server settings -} ->+ Value ->+ ConfigParser Configuration+parseConfiguration _configConfigPath def = parseSections $ do _configDefaults <- fromMaybe def <$> sectionOptWith (parseServerSettings def) "defaults"@@ -160,6 +170,12 @@ _configWindowNames <- fromMaybe defaultWindowNames <$> sectionOpt "window-names" + _configNickPadding <- sectionOpt "nick-padding"+ for_ _configNickPadding (\padding ->+ when (padding < 0)+ (liftConfigParser $+ failure "nick-padding has to be a non negative number"))+ return Configuration{..} parsePalette :: Value -> ConfigParser Palette@@ -168,32 +184,31 @@ paletteHelper :: Palette -> Text -> Value -> ConfigParser Palette paletteHelper p k v = case k of- "nick-colors" -> do xs <- parseColors v+ "nick-colors" -> do xs <- Vector.fromList <$> parseList parseAttr v+ when (null xs) (failure "Empty palette") return $! set palNicks xs p - "self" -> setAttr palSelf- "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- _ -> failure "Unknown palette entry"+ "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+ _ -> failure "Unknown palette entry" where setAttr l =- do x <- parseColor v- let !attr = withForeColor defAttr x+ do !attr <- parseAttr v return $! set l attr p -parseSectionsWith :: (a -> Text -> Value -> ConfigParser a) -> a -> Value -> ConfigParser a-parseSectionsWith p start s =- case s of- Sections xs -> foldM (\x (Section k v) -> extendLoc k (p x k v)) start xs- _ -> failure "Expected sections"+ setAttrMb l =+ do !attr <- parseAttr v+ return $! set l (Just attr) p parseServers :: ServerSettings -> Value -> ConfigParser (HashMap Text ServerSettings) parseServers def v =@@ -249,10 +264,6 @@ parseBoolean (Atom "yes") = return True parseBoolean (Atom "no") = return False parseBoolean _ = failure "expected yes or no"--parseList :: (Value -> ConfigParser a) -> Value -> ConfigParser [a]-parseList p (List xs) = traverse p xs-parseList _ _ = failure "expected list" parseNum :: Num a => Value -> ConfigParser a parseNum v = fromInteger <$> parseConfig v
src/Client/Configuration/Colors.hs view
@@ -11,24 +11,57 @@ -} module Client.Configuration.Colors- ( parseColors- , parseColor+ ( parseColor+ , parseAttr ) where import Config import Config.FromConfig import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap+import Data.Foldable import Data.Ratio import Data.Text (Text)-import Data.Vector (Vector)-import qualified Data.Vector as Vector import Graphics.Vty.Attributes -parseColors :: Value -> ConfigParser (Vector Color)-parseColors (List []) = failure "Empty color palette"-parseColors (List xs) = traverse parseColor (Vector.fromList xs)-parseColors _ = failure "Expected list of colors or default"+-- | Parse a text attribute. This value should be a sections with the @fg@ and/or+-- @bg@ attributes. Otherwise it should be a color entry that will be used+-- for the foreground color. An empty sections value will result in 'defAttr'+parseAttr :: Value -> ConfigParser Attr+parseAttr (Sections xs) = parseSectionsWith parseAttrEntry defAttr (Sections xs)+parseAttr v = withForeColor defAttr <$> parseColor v++parseAttrEntry :: Attr -> Text -> Value -> ConfigParser Attr+parseAttrEntry acc k v =+ case k of+ "fg" -> parseColor' withForeColor+ "bg" -> parseColor' withBackColor+ "style" -> parseStyle'+ _ -> failure "Unknown attribute entry"+ where+ parseStyle' =+ do xs <- parseStyles v+ return $! foldl' withStyle acc xs++ parseColor' f =+ do c <- parseColor v+ return $! f acc c++parseStyles :: Value -> ConfigParser [Style]+parseStyles (List xs) = parseList parseStyle (List xs)+parseStyles v = pure <$> parseStyle v++parseStyle :: Value -> ConfigParser Style+parseStyle v =+ case v of+ Atom "blink" -> pure blink -- You're the boss...+ Atom "bold" -> pure bold+ Atom "dim" -> pure bold+ Atom "reverse-video" -> pure reverseVideo+ Atom "standout" -> pure standout+ Atom "underline" -> pure underline+ _ -> failure "expected blink, bold, dim, reverse-video, standout, underline"+ -- | Parse a color. Support formats are: --
src/Client/Image/Message.hs view
@@ -12,6 +12,7 @@ module Client.Image.Message ( MessageRendererParams(..) , RenderMode(..)+ , IdentifierColorMode(..) , defaultRenderParams , msgImage , metadataImg@@ -36,6 +37,7 @@ import Data.Hashable (hash) import qualified Data.HashSet as HashSet import Data.List+import Data.Maybe import qualified Data.Text as Text import Data.Text (Text) import qualified Data.Vector as Vector@@ -47,6 +49,7 @@ , rendNicks :: [Identifier] -- ^ nicknames to highlight , rendMyNicks :: [Identifier] -- ^ nicknames to highlight in red , rendPalette :: Palette -- ^ nick color palette+ , rendNickPadding :: Maybe Integer -- ^ nick padding } -- | Default 'MessageRenderParams' with no sigils or nicknames specified@@ -57,6 +60,7 @@ , rendNicks = [] , rendMyNicks = [] , rendPalette = defaultPalette+ , rendNickPadding = Nothing } -- | Construct a message given the time the message was received and its@@ -67,6 +71,7 @@ MessageRendererParams -> MessageBody -> Image msgImage rm when params body = horizCat [ renderTime rm (rendPalette params) when+ , char defAttr ' ' , statusMsgImage (rendStatusMsg params) , bodyImage rm params body ]@@ -80,6 +85,7 @@ , string defAttr txt ] +-- | Render the given time according to the current mode and palette. renderTime :: RenderMode -> Palette -> ZonedTime -> Image renderTime DetailedRender = datetimeImage renderTime NormalRender = timeImage@@ -114,7 +120,7 @@ timeImage :: Palette -> ZonedTime -> Image timeImage palette = string (view palTime palette)- . formatTime defaultTimeLocale "%R "+ . formatTime defaultTimeLocale "%R" -- | Render a 'ZonedTime' as full date and time user quiet attributes --@@ -124,13 +130,22 @@ datetimeImage :: Palette -> ZonedTime -> Image datetimeImage palette = string (view palTime palette)- . formatTime defaultTimeLocale "%F %T "+ . formatTime defaultTimeLocale "%F %T" -- | Level of detail to use when rendering data RenderMode = NormalRender -- ^ only render nicknames | DetailedRender -- ^ render full user info +-- | Optionally insert padding on the right of an 'Image' until it has+-- the minimum width.+rightPad :: RenderMode -> Maybe Integer -> Image -> Image+rightPad NormalRender (Just minWidth) i =+ let h = 1+ w = max 0 (fromIntegral minWidth - imageWidth i)+ in i <|> backgroundFill w h+rightPad _ _ i = i+ -- | Render a chat message given a rendering mode, the sigils of the user -- who sent the message, and a list of nicknames to highlight. ircLineImage ::@@ -154,7 +169,7 @@ string (view palSigil pal) sigils <|> coloredUserInfo pal rm myNicks old <|> string defAttr " became " <|>- coloredIdentifier pal myNicks new+ coloredIdentifier pal NormalIdentifier myNicks new Join nick _chan -> string quietAttr "join " <|>@@ -179,7 +194,7 @@ string (view palSigil pal) sigils <|> coloredUserInfo pal rm myNicks kicker <|> string defAttr " kicked " <|>- coloredIdentifier pal myNicks kickee <|>+ coloredIdentifier pal NormalIdentifier myNicks kickee <|> string defAttr ": " <|> parseIrcText reason @@ -191,14 +206,16 @@ Notice src _dst txt -> detail (string quietAttr "note ") <|> string (view palSigil pal) sigils <|>- coloredUserInfo pal rm myNicks src <|>+ rightPad rm (rendNickPadding rp)+ (coloredUserInfo pal rm myNicks src) <|> string (withForeColor defAttr red) ": " <|> parseIrcTextWithNicks pal myNicks nicks txt Privmsg src _dst txt -> detail (string quietAttr "chat ") <|> string (view palSigil pal) sigils <|>- coloredUserInfo pal rm myNicks src <|>+ rightPad rm (rendNickPadding rp)+ (coloredUserInfo pal rm myNicks src) <|> string defAttr ": " <|> parseIrcTextWithNicks pal myNicks nicks txt @@ -311,21 +328,31 @@ attr = withForeColor defAttr color +data IdentifierColorMode+ = PrivmsgIdentifier -- ^ An identifier in a PRIVMSG+ | NormalIdentifier -- ^ An identifier somewhere else -- | Render a nickname in its hash-based color. coloredIdentifier :: Palette ->+ IdentifierColorMode -> [Identifier] {- ^ my nicknames -} -> Identifier -> Image-coloredIdentifier palette myNicks ident =+coloredIdentifier palette icm myNicks ident = text' color (idText ident) where color- | ident `elem` myNicks = _palSelf palette- | otherwise = withForeColor defAttr $ v Vector.! i+ | ident `elem` myNicks =+ case icm of+ PrivmsgIdentifier -> fromMaybe+ (view palSelf palette)+ (view palSelfHighlight palette)+ NormalIdentifier -> view palSelf palette - v = _palNicks palette+ | otherwise = v Vector.! i++ v = view palNicks palette i = hash ident `mod` Vector.length v -- | Render an a full user. In normal mode only the nickname will be rendered.@@ -337,10 +364,10 @@ [Identifier] {- ^ my nicks -} -> UserInfo -> Image coloredUserInfo palette NormalRender myNicks ui =- coloredIdentifier palette myNicks (userNick ui)+ coloredIdentifier palette NormalIdentifier myNicks (userNick ui) coloredUserInfo palette DetailedRender myNicks !ui = horizCat- [ coloredIdentifier palette myNicks (userNick ui)+ [ coloredIdentifier palette NormalIdentifier myNicks (userNick ui) , aux '!' (userName ui) , aux '@' (userHost ui) ]@@ -380,7 +407,7 @@ nickSet = HashSet.fromList nicks txtParts = nickSplit txt highlight1 part- | HashSet.member partId nickSet = coloredIdentifier palette myNicks partId+ | HashSet.member partId nickSet = coloredIdentifier palette PrivmsgIdentifier myNicks partId | otherwise = text' defAttr part where partId = mkId part
src/Client/Image/Palette.hs view
@@ -14,6 +14,7 @@ Palette(..) , palNicks , palSelf+ , palSelfHighlight , palTime , palMeta , palSigil@@ -36,18 +37,19 @@ -- | Color palette used for rendering the client UI data Palette = Palette- { _palNicks :: Vector Color -- ^ colors for highlighting nicknames- , _palSelf :: Attr -- ^ color of our own nickname(s)- , _palTime :: Attr -- ^ color of message timestamps- , _palMeta :: Attr -- ^ color of coalesced metadata- , _palSigil :: Attr -- ^ color of sigils (e.g. @+)- , _palLabel :: Attr -- ^ color of information labels- , _palLatency :: Attr -- ^ color of ping latency- , _palWindowName :: Attr -- ^ color of window name- , _palError :: Attr -- ^ color of error messages- , _palTextBox :: Attr -- ^ color of textbox markers- , _palActivity :: Attr -- ^ color of window name with activity- , _palMention :: Attr -- ^ color of window name with mention+ { _palNicks :: Vector Attr -- ^ colors for highlighting nicknames+ , _palSelf :: Attr -- ^ color of our own nickname(s)+ , _palSelfHighlight :: Maybe Attr -- ^ color of our own nickname(s) in mentions+ , _palTime :: Attr -- ^ color of message timestamps+ , _palMeta :: Attr -- ^ color of coalesced metadata+ , _palSigil :: Attr -- ^ color of sigils (e.g. @+)+ , _palLabel :: Attr -- ^ color of information labels+ , _palLatency :: Attr -- ^ color of ping latency+ , _palWindowName :: Attr -- ^ color of window name+ , _palError :: Attr -- ^ color of error messages+ , _palTextBox :: Attr -- ^ color of textbox markers+ , _palActivity :: Attr -- ^ color of window name with activity+ , _palMention :: Attr -- ^ color of window name with mention } deriving Show @@ -56,23 +58,26 @@ -- | Default UI colors that look nice in my dark solarized color scheme defaultPalette :: Palette defaultPalette = Palette- { _palNicks = defaultNickColorPalette- , _palSelf = withForeColor defAttr red- , _palTime = withForeColor defAttr brightBlack- , _palMeta = withForeColor defAttr brightBlack- , _palSigil = withForeColor defAttr cyan- , _palLabel = withForeColor defAttr green- , _palLatency = withForeColor defAttr yellow- , _palWindowName = withForeColor defAttr cyan- , _palError = withForeColor defAttr red- , _palTextBox = withForeColor defAttr brightBlack- , _palActivity = withForeColor defAttr green- , _palMention = withForeColor defAttr red+ { _palNicks = defaultNickColorPalette+ , _palSelf = withForeColor defAttr red+ , _palSelfHighlight = Nothing+ , _palTime = withForeColor defAttr brightBlack+ , _palMeta = withForeColor defAttr brightBlack+ , _palSigil = withForeColor defAttr cyan+ , _palLabel = withForeColor defAttr green+ , _palLatency = withForeColor defAttr yellow+ , _palWindowName = withForeColor defAttr cyan+ , _palError = withForeColor defAttr red+ , _palTextBox = withForeColor defAttr brightBlack+ , _palActivity = withForeColor defAttr green+ , _palMention = withForeColor defAttr red } -- | Default nick highlighting colors that look nice in my dark solarized -- color scheme.-defaultNickColorPalette :: Vector Color-defaultNickColorPalette = Vector.fromList- [cyan, magenta, green, yellow, blue,- brightCyan, brightMagenta, brightGreen, brightBlue]+defaultNickColorPalette :: Vector Attr+defaultNickColorPalette+ = fmap (withForeColor defAttr)+ $ Vector.fromList+ [cyan, magenta, green, yellow, blue,+ brightCyan, brightMagenta, brightGreen, brightBlue]
src/Client/Image/UserList.hs view
@@ -51,7 +51,7 @@ renderUser (ident, sigils) = string (view palSigil pal) sigils <|>- coloredIdentifier pal myNicks ident+ coloredIdentifier pal NormalIdentifier myNicks ident gap = char defAttr ' '
src/Client/State.hs view
@@ -90,7 +90,6 @@ import Data.Monoid import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text.ICU as ICU import Data.Time import Graphics.Vty import Irc.Codes@@ -99,6 +98,9 @@ import Irc.RawIrcMsg import Irc.UserInfo import LensUtils+import Text.Regex.TDFA+import Text.Regex.TDFA.String (compile)+import Text.Regex.TDFA.Text () -- RegexLike Regex Text orphan import Network.Connection -- | Textual name of a network connection@@ -236,6 +238,7 @@ , rendNicks = channelUserList network channel' st , rendMyNicks = myNicks , rendPalette = palette+ , rendNickPadding = view (clientConfig . configNickPadding) st } palette = view (clientConfig . configPalette) st@@ -462,14 +465,14 @@ clientMatcher :: ClientState -> Text -> Bool clientMatcher st = case break (==' ') (clientFirstLine st) of- ("/grep" ,_:reStr) -> go [] reStr- ("/grepi",_:reStr) -> go [ICU.CaseInsensitive] reStr+ ("/grep" ,_:reStr) -> go True reStr+ ("/grepi",_:reStr) -> go False reStr _ -> const True where- go opts reStr- | not (null reStr)- , Right r <- ICU.regex' opts (Text.pack reStr) = isJust . ICU.find r- | otherwise = const True+ go sensitive reStr =+ case compile defaultCompOpt{caseSensitive=sensitive} defaultExecOpt reStr of+ Left{} -> const True+ Right r -> match r :: Text -> Bool -- | Remove a network connection and unlink it from the network map. -- This operation assumes that the networkconnection exists and should@@ -490,7 +493,9 @@ addConnection :: Text -> ClientState -> IO ClientState addConnection network st = do let defSettings = (view (clientConfig . configDefaults) st)- { _ssName = Just network }+ { _ssName = Just network+ , _ssHostName = Text.unpack network+ } settings = fromMaybe defSettings $ preview (clientConfig . configServers . ix network) st
src/Client/WordCompletion.hs view
@@ -13,6 +13,7 @@ ) where import Irc.Identifier+import Control.Applicative import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Set as Set@@ -29,13 +30,16 @@ -- when auto-completing a nick and including a trailing colon. -- -- The @reversed@ parameter indicates that tab-completion should return the--- previous entry.+-- previous entry. When starting a fresh tab completion the priority completions+-- will be considered in order before resorting to the set of possible+-- completions. wordComplete :: (String -> String) {- ^ leading update operation -} -> Bool {- ^ reversed -} ->+ [Identifier] {- ^ priority completions -} -> [Identifier] {- ^ possible completions -} -> Edit.EditBox -> Maybe Edit.EditBox-wordComplete leadingCase isReversed vals box =+wordComplete leadingCase isReversed hint vals box = do let current = currentWord box guard (not (null current)) let cur = mkId (Text.pack current)@@ -49,7 +53,8 @@ pat = mkId (Text.pack patternStr) _ ->- do next <- tabSearch isReversed cur cur vals+ do next <- find (idPrefix cur) hint <|>+ tabSearch isReversed cur cur vals Just $ set Edit.tabSeed (Just current) $ replaceWith leadingCase (idString next) box
src/Config/FromConfig.hs view
@@ -21,6 +21,9 @@ , extendLoc , FromConfig(parseConfig) + -- * Parser wrappers+ , parseList+ -- * Section parsing , SectionParser , parseSections@@ -28,6 +31,7 @@ , sectionOpt , sectionOptWith , liftConfigParser+ , parseSectionsWith ) where import Config@@ -161,3 +165,13 @@ floatingToRatio :: Integral a => Integer -> Integer -> Ratio a floatingToRatio c e = fromIntegral c * 10 ^^ e++parseSectionsWith :: (a -> Text -> Value -> ConfigParser a) -> a -> Value -> ConfigParser a+parseSectionsWith p start s =+ case s of+ Sections xs -> foldM (\x (Section k v) -> extendLoc k (p x k v)) start xs+ _ -> failure "Expected sections"++parseList :: (Value -> ConfigParser a) -> Value -> ConfigParser [a]+parseList p (List xs) = traverse p xs+parseList _ _ = failure "expected list"