irc-core 1.0 → 1.1
raw patch · 7 files changed
+86/−61 lines, 7 filesdep ~attoparsecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: attoparsec
API changes (from Hackage documentation)
+ Irc.Cmd: pingCmd :: ByteString -> ByteString
Files
- CHANGELOG.md +8/−0
- driver/ClientState.hs +8/−2
- driver/Views/Channel.hs +50/−54
- driver/Views/ChannelInfo.hs +3/−1
- irc-core.cabal +3/−3
- src/Irc/Cmd.hs +13/−0
- src/Irc/Format.hs +1/−1
CHANGELOG.md view
@@ -1,3 +1,11 @@+1.1+---+* Better support for Freenode's trailing spaces+* More compact metadata representation+* Ignored messages no longer count toward unread number+* Updated version bounds on lens and attoparsec+* Channel info has user count+ 1.0 --- * Initial hackage release
driver/ClientState.hs view
@@ -231,12 +231,18 @@ where conn = view (clientServer0 . ccConnection) st + isIgnored nick = view (clientIgnores . contains nick) st+ aux = case views mesgType isRelevant message of Nothing -> over mlMessages (cons (message,error "unused colored message"))- Just txt -> over mlNewMessages (+1)- . over mlMentioned (|| mention txt || private)+ Just txt -> updateMessageCount . over mlMessages (cons (message,coloredImage)) where+ updateMessageCount+ | isIgnored (views mesgSender userNick message) = id+ | otherwise = over mlNewMessages (+1)+ . over mlMentioned (|| mention txt || private)+ !coloredImage | Text.any isControl txt = cleanText txt | otherwise = force -- avoid holding on to old channel lists
driver/Views/Channel.hs view
@@ -6,7 +6,7 @@ import Control.Lens import Data.Monoid import Data.Foldable (toList)-import Data.List (stripPrefix)+import Data.List (stripPrefix, intersperse) import Data.Text (Text) import Data.Time (TimeZone, UTCTime, formatTime, utcToZonedTime) import Graphics.Vty.Image@@ -115,7 +115,7 @@ renderOne ((msg,colored):msgs) = case mbImg of Just img -> (timestamp <|> img) : renderOne msgs- Nothing -> renderMeta emptyImage ((msg,colored):msgs)+ Nothing -> renderMeta ((msg,colored):msgs) where timestamp@@ -213,59 +213,27 @@ | view clientMetaView st = [x] | otherwise = [] - renderMeta img [] = filterMeta (cropRight width img)- renderMeta img ((msg,colored):msgs) =- let who = views mesgSender userNick msg- visible = not (view (contains who) ignores)- metaAttr = withForeColor defAttr brightBlack- in case view mesgType msg of- CtcpReqMsgType{} ->- renderMeta- (img <|>- char (withForeColor defAttr brightBlue) 'C' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- JoinMsgType ->- renderMeta- (img <|>- char (withForeColor defAttr green) '+' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- PartMsgType{} ->- renderMeta- (img <|>- char (withForeColor defAttr red) '-' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- QuitMsgType{} ->- renderMeta- (img <|>- char (withForeColor defAttr red) 'x' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- NickMsgType who' ->- renderMeta- (img <|>- identImg metaAttr who <|>- char (withForeColor defAttr yellow) '-' <|>- identImg metaAttr who' <|>- char defAttr ' ') msgs- KnockMsgType ->- renderMeta- (img <|>- char (withForeColor defAttr yellow) 'K' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- _ | not visible ->- renderMeta- (img <|>- char (withForeColor defAttr brightBlack) 'I' <|>- identImg metaAttr who <|>- char defAttr ' ') msgs- | otherwise ->- filterMeta (cropRight width img)- ++ renderOne ((msg,colored):msgs)+ renderMeta msgs = filterMeta (cropRight width img)+ ++ renderOne rest+ where+ (mds,rest) = splitWith (processMeta . fst) msgs+ mds1 = mergeMetadatas mds+ img = horizCat (intersperse gap (map renderCompressed mds1))+ gap = char defAttr ' ' + processMeta msg =+ case view mesgType msg of+ CtcpReqMsgType{} -> Just $ SimpleMetadata (char (withForeColor defAttr brightBlue) 'C') who+ JoinMsgType -> Just $ SimpleMetadata (char (withForeColor defAttr green) '+') who+ PartMsgType{} -> Just $ SimpleMetadata (char (withForeColor defAttr red) '-') who+ QuitMsgType{} -> Just $ SimpleMetadata (char (withForeColor defAttr red) 'x') who+ KnockMsgType -> Just $ SimpleMetadata (char (withForeColor defAttr yellow) 'K') who+ NickMsgType who' -> Just $ NickChange who who'+ _ | not visible -> Just $ SimpleMetadata (char (withForeColor defAttr yellow) 'I') who+ | otherwise -> Nothing+ where+ who = views mesgSender userNick msg+ visible = not (view (contains who) ignores) conn = view (clientServer0 . ccConnection) st @@ -275,7 +243,21 @@ string (withForeColor defAttr blue) [ prefix | (mode,prefix) <- prefixes, mode `elem` modes] +data CompressedMetadata+ = SimpleMetadata Image Identifier+ | NickChange Identifier Identifier +renderCompressed :: CompressedMetadata -> Image+renderCompressed md =+ case md of+ SimpleMetadata img who -> img <|> identImg metaAttr who+ NickChange who who' ->+ identImg metaAttr who <|>+ char (withForeColor defAttr yellow) '-' <|>+ identImg metaAttr who'+ where+ metaAttr = withForeColor defAttr brightBlack+ statusMsgImage :: String -> Image statusMsgImage status | null status = emptyImage@@ -349,3 +331,17 @@ ErrTargUmodeG -> "Message ignored by +g mode" ErrNoPrivs priv -> "Oper privilege required: " <> asUtf8 priv ErrMlockRestricted m ms -> "Mode '" <> Text.singleton m <> "' in locked set \"" <> asUtf8 ms <> "\""++splitWith :: (a -> Maybe b) -> [a] -> ([b],[a])+splitWith f [] = ([],[])+splitWith f (x:xs) =+ case f x of+ Nothing -> ([],x:xs)+ Just y -> case splitWith f xs of+ (ys,xs') -> (y:ys, xs')++mergeMetadatas :: [CompressedMetadata] -> [CompressedMetadata]+mergeMetadatas (SimpleMetadata img1 who1 : SimpleMetadata img2 who2 : xs)+ | who1 == who2 = mergeMetadatas (SimpleMetadata (img1 <|> img2) who1 : xs)+mergeMetadatas (x:xs) = x : mergeMetadatas xs+mergeMetadatas [] = []
driver/Views/ChannelInfo.hs view
@@ -68,7 +68,9 @@ usersLines = return $ horizCat- $ string (withForeColor defAttr green) "Users:"+ $ string (withForeColor defAttr green) "Users ("+ : string defAttr (show (Map.size (view chanUsers channel)))+ : string (withForeColor defAttr green) "):" : [ char defAttr ' ' <|> modePrefix modes <|> identImg defAttr nick
irc-core.cabal view
@@ -1,5 +1,5 @@ name: irc-core-version: 1.0+version: 1.1 homepage: https://github.com/glguy/irc-core bug-reports: https://github.com/glguy/irc-core/issues license: BSD3@@ -91,7 +91,7 @@ build-depends: base >= 4.7.0.2 && < 4.9, array >= 0.5 && < 0.6,- attoparsec >= 0.12.1.2 && < 0.13,+ attoparsec >= 0.12.1.2 && < 0.14, bytestring >= 0.10 && < 0.11, base64-bytestring>= 1.0.0.1 && < 1.1, containers >= 0.5 && < 0.6,@@ -144,7 +144,7 @@ deepseq >= 1.3.0.2 && < 1.5, directory >= 1.2.1.0 && < 1.3, filepath >= 1.3.0.2 && < 1.5,- lens >= 4.7 && < 4.9,+ lens >= 4.7 && < 4.10, network >= 2.6.0.2 && < 2.7, old-locale >= 1.0.0.6 && < 1.1, split >= 0.2.2 && < 0.3,
src/Irc/Cmd.hs view
@@ -27,6 +27,7 @@ , whowasCmd , whoCmd , pongCmd+ , pingCmd , capLsCmd , capReqCmd , capEndCmd@@ -175,6 +176,18 @@ userCmd user realname = renderRawIrcMsg outgoingMsg { msgCommand = "USER" , msgParams = [user,"0","*",realname]+ }++-- | Construct a PING command. This is used to respond to the PING+-- command to keep a connection alive.+--+-- @PONG token@+pingCmd ::+ ByteString {- ^ token -} ->+ ByteString+pingCmd token = renderRawIrcMsg outgoingMsg+ { msgCommand = "PING"+ , msgParams = [token] } -- | Construct a PONG command. This is used to respond to the PING
src/Irc/Format.hs view
@@ -142,7 +142,7 @@ -- allows for up to 15 parameters. paramsParser :: Int -> Parser [ByteString] paramsParser n =- do _ <- optional (char ' ') -- Freenode requires this exception+ do _ <- skipMany (char ' ') -- Freenode requires this exception endOfInput $> [] <|> more where more