rss2irc-1.0.3: Base.hs
{-# LANGUAGE PatternGuards, BangPatterns, DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
{- |
Types and settings.
Copyright (c) Don Stewart 2008-2009, Simon Michael 2009-2011
License: BSD3.
-}
module Base where
import Control.Concurrent.Chan (Chan)
import Control.DeepSeq (NFData)
import Control.Exception
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Time ()
import Data.Time.Clock
import Data.Typeable
import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion)
import Network.HTTP.Conduit (Manager)
import System.Console.CmdArgs
import System.IO (Handle)
import Text.Feed.Types (Item)
import Text.Printf (printf)
progname = $(packageVariable (pkgName . package))
version = $(packageVariable (pkgVersion . package))
progversion = progname ++ " " ++ version :: String
defport = 6667
defusername = progname
defrealname = progname ++ " feed announcer"
definterval = 5
defidle = 0
defmaxitems = 5
maxmessagelength = 400
-- | Maximum size of each part of our irc announcements.
-- The max announcement length will be the sum of these, plus typically 15
-- due to prettification, plus any length increase due to --replace. The
-- defaults below should keep most announcements within maxmessagelength
-- and all announcements within maxmessagelength * 2 or so.
maxtitlelength = 100
maxdesclength = 300
maxauthorlength = 50
maxdatelength = 50
maxlinklength = 200
progname, version, progversion, defusername, defrealname :: String
defport, definterval, defidle, defmaxitems, maxmessagelength, maxtitlelength,
maxdesclength, maxauthorlength, maxdatelength, maxlinklength :: Int
defopts :: Opts
defopts = Opts {
ident = defrealname &= typ "STR" &= help "set the bot's identity string (useful for contact info)"
,delay = def &= help "wait for N minutes before starting (helps avoid mass joins)"
,interval = definterval &= name "i" &= help ("polling and announcing interval in minutes (default "++(show definterval)++")")
,cache_control = def &= explicit &= name "cache-control" &= typ "STR" &= help ("set a HTTP cache-control header when polling")
,idle = defidle &= help ("announce only when channel has been idle N minutes (default "++(show defidle)++")")
,max_items = defmaxitems &= help ("announce at most N items per interval (default "++(show defmaxitems)++")")
,recent = def &= name "r" &= help "announce up to N recent items at startup (default 0)"
,ignore_ids_and_times = def &= help "ignore feed item IDs and timestamps (use for feeds with bad ones)"
,allow_duplicates = def &= help "turn off duplicate announcement protection (enabled by default)"
,use_actions = def &= help "use CTCP ACTIONs instead of normal IRC messages"
,no_title = def &= help ("don't show item title (shown by default, up to "++(show maxtitlelength)++" chars)")
,author = def &= name "a" &= help ("show author (up to "++(show maxauthorlength)++" chars)")
,description = def &= name "d" &= help ("show description (up to "++(show maxdesclength)++" chars)")
,link_ = def &= help ("show link URL (up to "++(show maxlinklength)++" chars)")
,time = def &= help ("show timestamp (up to "++(show maxdatelength)++" chars)")
,email = def &= help "show email addresses (stripped by default)"
,html = def &= help "show HTML tags and entities (stripped by default)"
,replace = def &= typ "OLD/NEW" &= help "replace OLD with NEW (regexpr patterns)"
,num_iterations = def &= name "n" &= help "exit after N iterations"
,quiet = def &= help "silence normal console output"
,debug_irc = def &= help "log irc activity"
,debug_feed = def &= help "log feed items and polling stats"
,debug_xml = def &= help "log feed content"
,feed = def &= argPos 0 &= typ "FEEDURL"
,irc_address = def &= argPos 1 &= opt ("" :: String) &= typ "IRCSERVER[:PORT]/CHANNEL/NICK"
}
&= program progname
&= groupname progname
&= summary progversion
data Opts = Opts {
ident :: String
,delay :: Int
,interval :: Int
,cache_control :: String
,idle :: Int
,max_items :: Int
,recent :: Int
,ignore_ids_and_times :: Bool
,allow_duplicates :: Bool
,use_actions :: Bool
,no_title :: Bool
,author :: Bool
,description :: Bool
,link_ :: Bool
,time :: Bool
,email :: Bool
,html :: Bool
,replace :: [String]
,num_iterations :: (Maybe Int)
,quiet :: Bool
,debug_irc :: Bool
,debug_feed :: Bool
,debug_xml :: Bool
,feed :: String
,irc_address :: String
} deriving (Show, Data, Typeable)
data Reader = Reader { httpManager :: !(Maybe Manager)
, iterationsleft :: !(Maybe Int)
} deriving (Show)
instance Show Manager where show = const "(Manager)"
data Bot = Bot { socket :: !Handle -- ^ the bot's active IRC connection, or stdout indicating none
, server :: !String -- ^ the IRC server's hostname or IP address, or "" indicating none
, port :: !Int -- ^ the IRC server's port number
, channel :: !String -- ^ the IRC channel to join
, botnick :: !String -- ^ the bot's IRC nickname
, announcequeue :: !(Chan String) -- ^ a shared queue of messages to be announced
, batchindex :: !Int -- ^ how many announcements have been made in the current batch
, lastmsgtime :: !UTCTime -- ^ the last time somebody spoke on the IRC channel
}
instance Show Bot where
show Bot{socket=s,server=srv,port=p,channel=c,botnick=n,lastmsgtime=t} =
printf "Bot{botnick=%s, socket=%s, server=%s, port=%d, channel=%s, lastmsgtime=%s}"
n (show s) srv p c (show t)
-- | rss2irc's application state, shared by all threads.
data App = App {aOpts :: !Opts -- ^ initial command-line options
,aReader :: !Reader -- ^ the feed reader's state
,aBot :: !Bot -- ^ the irc bot's state
} deriving (Show)
type FeedAddress = String
data FeedParseException = FeedParseException String deriving (Typeable)
instance Exception FeedParseException
instance Show FeedParseException where show (FeedParseException url) = printf "could not parse feed content from %s" url
data IrcAddress = IrcAddress {ircaddrServer :: !String,
ircaddrPort :: !(Maybe Int),
ircaddrChannel :: !String,
ircaddrNick :: !String
} deriving (Show)
data IrcException = IrcException String deriving (Typeable)
instance Exception IrcException
instance Show IrcException where show (IrcException msg) = printf "IRC error (%s)" msg
instance NFData Item
io :: MonadIO m => IO a -> m a
io = liftIO