diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,35 @@ +irc-fun-client 0.1.1.0 -- 2015-09-10 +==================================== + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Basic channel logger API +* Efficient and scalable time getter +* Channel member tracker + +Bug fixes: + +* (None) + +Dependency changes: + +* Add dependency: auto-update +* Add dependency: fast-logger +* Add dependency: time +* Add dependency: time-units +* Add dependency: unordered-containers + + + + + irc-fun-client 0.1.0.0 -- 2015-08-09 ==================================== diff --git a/irc-fun-client.cabal b/irc-fun-client.cabal --- a/irc-fun-client.cabal +++ b/irc-fun-client.cabal @@ -1,5 +1,5 @@ name: irc-fun-client -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Another library for writing IRC clients. description: This is an IRC client library that uses @irc-fun-messages@ library package @@ -24,14 +24,22 @@ library exposed-modules: Network.IRC.Fun.Client + , Network.IRC.Fun.Client.ChannelLogger , Network.IRC.Fun.Client.Commands , Network.IRC.Fun.Client.Events , Network.IRC.Fun.Client.IO + , Network.IRC.Fun.Client.NickTracker + , Network.IRC.Fun.Client.Time , Network.IRC.Fun.Client.Util -- other-modules: -- other-extensions: - build-depends: base >=4.7 && <5 + build-depends: auto-update + , base >=4.7 && <5 , irc-fun-messages - , network >=2.3 + , fast-logger >=2.4.1 + , network >=2.3 + , time >=1.5 + , time-units >=1 + , unordered-containers >=0.2.5 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Network/IRC/Fun/Client.hs b/src/Network/IRC/Fun/Client.hs --- a/src/Network/IRC/Fun/Client.hs +++ b/src/Network/IRC/Fun/Client.hs @@ -20,6 +20,11 @@ -- * "Commands": Provides functions for sending IRC commands to the server. -- * "Events": Provides an Event type and functions for receiving IRC events. -- These events are an abstraction on top of IRC messages. +-- * "ChannelLogger": Provides a system for logging IRC channel activity into a +-- file. +-- * "Time": Provides an efficient scalable way to get the current time, and a +-- formatted time string for use in the logger. +-- * "NickTracker": Provides functions for tracking channels and their members -- * "Util": Miscellaneous helper functions which could be useful to clients -- -- If you're writing an IRC client, here is a suggestion for how to begin: @@ -32,14 +37,20 @@ -- need to receive IRC messages directly, use functions from the "IO" -- module. module Network.IRC.Fun.Client - ( module Network.IRC.Fun.Client.Commands - , module Network.IRC.Fun.Client.Events - , module Network.IRC.Fun.Client.IO - , module Network.IRC.Fun.Client.Util + ( module ChannelLogger + , module Commands + , module Events + , module IO + , module NickTracker + , module Util + , module Time ) where -import Network.IRC.Fun.Client.Commands -import Network.IRC.Fun.Client.Events -import Network.IRC.Fun.Client.IO -import Network.IRC.Fun.Client.Util +import qualified Network.IRC.Fun.Client.ChannelLogger as ChannelLogger +import qualified Network.IRC.Fun.Client.Commands as Commands +import qualified Network.IRC.Fun.Client.Events as Events +import qualified Network.IRC.Fun.Client.IO as IO +import qualified Network.IRC.Fun.Client.NickTracker as NickTracker +import qualified Network.IRC.Fun.Client.Util as Util +import qualified Network.IRC.Fun.Client.Time as Time diff --git a/src/Network/IRC/Fun/Client/ChannelLogger.hs b/src/Network/IRC/Fun/Client/ChannelLogger.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Client/ChannelLogger.hs @@ -0,0 +1,116 @@ +{- This file is part of irc-fun-client. + - + - Written in 2015 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +{-# LANGUAGE OverloadedStrings #-} + +module Network.IRC.Fun.Client.ChannelLogger + ( Logger () + , ChanLogEvent (..) + , LogEvent (..) + , logFilePath + , newLogger + , removeLogger + , logEvent + , fromClientEvent + ) +where + +import Control.Monad (liftM) +import Data.Monoid ((<>)) +import Network.IRC.Fun.Client.Events (Event (..)) +import Network.IRC.Fun.Messages.TypeAliases (NickName, ChannelName) +import System.Log.FastLogger + +data Logger = Logger + { loggerSet :: LoggerSet + , loggerGetTime :: IO String + } + +data ChanLogEvent + = EnterChan NickName + | LeaveChan NickName + | MessageChan NickName String + | RenameInChan NickName NickName + deriving Show + +data LogEvent + = Enter NickName ChannelName + | Leave NickName ChannelName + | LeaveAll NickName + | Message NickName ChannelName String + | Rename NickName NickName + deriving Show + +-- | Utility for constructing a log file path. +logFilePath :: FilePath -- ^ Directory in which to place log files. Relative + -- to the program's working directory, or absolute. + -> String -- ^ Server label, e.g. @\"freenode\"@ + -> ChannelName -- ^ IRC channel name, e.g. @\"#freepost\"@ + -> FilePath +logFilePath dir server chan = dir ++ "/" ++ server ++ "." ++ chan ++ ".irc" + +-- | Create a logger for a given IRC channel. +newLogger :: IO String -- ^ Action which returns a formatted time string. You + -- can use "Network.IRC.Fun.Client.Time" to create such + -- an action. + -> FilePath -- ^ Path of the log file + -> IO Logger +newLogger getTime path = do + lset <- newFileLoggerSet defaultBufSize path + return $ Logger + { loggerSet = lset + , loggerGetTime = getTime + } + +-- | Flush buffers and release resources. +-- +-- When the logger is paused for a long period of time (i.e. not momentarily - +-- e.g. by a user disabling channel logging via UI), you can use this to +-- release resources. Later, when logging is needed again, create a fresh new +-- logger. +-- +-- If your client joins many channels but log few of them, you can save +-- resources by keeping open loggers only for the few logged channels. +removeLogger :: Logger -> IO () +removeLogger logger = rmLoggerSet $ loggerSet logger + +formatEvent :: ChanLogEvent -> LogStr +formatEvent e = case e of + EnterChan nick -> "|-->| " <> toLogStr nick <> " has joined" + LeaveChan nick -> "|<--| " <> toLogStr nick <> " has left" + MessageChan nick msg -> "<" <> toLogStr nick <> "> " <> toLogStr msg + RenameInChan old new -> "|---| " <> toLogStr old <> " is now known as " + <> toLogStr new + +formatLine :: IO String -> ChanLogEvent -> IO LogStr +formatLine getTime event = do + t <- getTime + return $ toLogStr t <> " " <> formatEvent event + +-- | Write a log message corresponding to a given event. +logEvent :: Logger -> ChanLogEvent -> IO () +logEvent logger event = do + line <- formatLine (loggerGetTime logger) event + pushLogStrLn (loggerSet logger) line + +-- | If an IRC client event can be logged, return a matching log event and the +-- channel in which the event has occured. +fromClientEvent :: Event -> Maybe LogEvent +fromClientEvent event = case event of + Join chan nick -> Just $ Enter nick chan + Part chan nick _reason -> Just $ Leave nick chan + Quit nick _reason -> Just $ LeaveAll nick + ChannelMessage chan nick msg _notice -> Just $ Message nick chan msg + _ -> Nothing diff --git a/src/Network/IRC/Fun/Client/NickTracker.hs b/src/Network/IRC/Fun/Client/NickTracker.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Client/NickTracker.hs @@ -0,0 +1,126 @@ +{- This file is part of irc-fun-client. + - + - Written in 2015 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | Using the tools provided here, you can track which users are members of +-- which channels. This functionality has a veriety of uses, e.g. displaying +-- user lists in client UI and logging/displaying quit messages in the correct +-- channel logs/buffers. +module Network.IRC.Fun.Client.NickTracker + ( ChannelTracker (..) + , NetworkTracker (..) + , isMemberOf + , isInChannel + , presence + , newChannel + , newNetwork + , addMember + , addToChannel + , addChannel + , removeMember + , removeFromChannel + , removeFromNetwork + , removeChannel + , removeChannels + ) +where + +import qualified Data.HashMap.Lazy as M +import qualified Data.HashSet as S +import Network.IRC.Fun.Messages.TypeAliases + +newtype ChannelTracker = ChannelTracker (S.HashSet NickName) + +newtype NetworkTracker = NetworkTracker (M.HashMap ChannelName ChannelTracker) + +-- | Check whether a nickname is present in a channel. +isMemberOf :: NickName -> ChannelTracker -> Bool +nick `isMemberOf` (ChannelTracker nicks) = nick `S.member` nicks + +-- | Check whether a nickname is present in a channel. +isInChannel :: NickName -> ChannelName -> NetworkTracker -> Bool +isInChannel nick chan (NetworkTracker cts) = + case M.lookup chan cts of + Nothing -> False + Just ct -> nick `isMemberOf` ct + +applySnd :: (b -> c) -> (a, b) -> (a, c) +applySnd f (x, y) = (x, f y) + +-- | Check in which channels a nickname is present. +presence :: NickName -> NetworkTracker -> [ChannelName] +presence nick (NetworkTracker cts) = + [ chan | (chan, True) <- map (applySnd (nick `isMemberOf`)) $ M.toList cts] + +-- | Record a channel with the given present nicknames. +newChannel :: [NickName] -> ChannelTracker +newChannel nicks = ChannelTracker $ S.fromList nicks + +-- | Create new tracker. +newNetwork :: NetworkTracker +newNetwork = NetworkTracker $ M.empty + +-- | Record a nickname being present in a channel. +addMember :: NickName -> ChannelTracker -> ChannelTracker +addMember nick (ChannelTracker nicks) = ChannelTracker $ S.insert nick nicks + +-- | Record a nickname being present in a channel. +addToChannel :: ChannelName -> NickName -> NetworkTracker -> NetworkTracker +addToChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts + where + f chans = + case M.lookup chan chans of + Nothing -> + let ct = ChannelTracker $ S.singleton nick + in M.insert chan ct chans + Just (ChannelTracker nicks) -> + let ct = ChannelTracker $ S.insert nick nicks + in M.insert chan ct chans + +-- | Record a channel with the given present nicknames. +addChannel :: ChannelName -> [NickName] -> NetworkTracker -> NetworkTracker +addChannel chan nicks (NetworkTracker cts) = NetworkTracker $ f cts + where + f = M.insert chan $ newChannel nicks + +-- | Record a channel not having a given nickname anymore. +removeMember :: NickName -> ChannelTracker -> ChannelTracker +removeMember nick (ChannelTracker nicks) = ChannelTracker $ S.delete nick nicks + +-- | Record a channel not having a given nickname anymore. +removeFromChannel :: ChannelName + -> NickName + -> NetworkTracker + -> NetworkTracker +removeFromChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts + where + f chans = M.adjust (removeMember nick) chan chans + +-- | Record a nickname not being present in any channel anymore. +removeFromNetwork :: NickName -> NetworkTracker -> NetworkTracker +removeFromNetwork nick (NetworkTracker cts) = NetworkTracker $ f cts + where + f = M.map (removeMember nick) + +-- | Remove a channel from the tracker. +removeChannel :: ChannelName -> NetworkTracker -> NetworkTracker +removeChannel chan (NetworkTracker cts) = NetworkTracker $ f cts + where + f = M.delete chan + +-- | Remove channels from the tracker. +removeChannels :: [ChannelName] -> NetworkTracker -> NetworkTracker +removeChannels chans (NetworkTracker cts) = NetworkTracker $ f cts + where + f ts = ts `M.difference` M.fromList (zip chans (repeat ())) diff --git a/src/Network/IRC/Fun/Client/Time.hs b/src/Network/IRC/Fun/Client/Time.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Client/Time.hs @@ -0,0 +1,46 @@ +{- This file is part of irc-fun-client. + - + - Written in 2015 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | Get the current UTC time and formatted time strings, using auto-update to +-- run the actual action periodically and by demand. In other words, these +-- functions can safely be used at high frequency. +-- +-- Intended use: Create a single getter in the main thread and pass as needed +-- to other threads for their own use. +module Network.IRC.Fun.Client.Time + ( currentTimeGetter + ) +where + +import Control.AutoUpdate +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import Data.Time.Units (Second, toMicroseconds) + +format = formatTime defaultTimeLocale "%F %T" + +action = do + t <- getCurrentTime + return (t, format t) + +settings = defaultUpdateSettings + { updateFreq = fromInteger $ toMicroseconds (1 :: Second) + , updateAction = action + } + +-- | Make a getter which returns the current time, and a formatted time string +-- for use in IRC logs. +currentTimeGetter :: IO (IO (UTCTime, String)) +currentTimeGetter = mkAutoUpdate settings