clckwrks-plugin-ircbot (empty) → 0.3.0
raw patch · 17 files changed
+809/−0 lines, 17 filesdep +acid-statedep +attoparsecdep +basebuild-type:Customsetup-changed
Dependencies added: acid-state, attoparsec, base, blaze-html, clckwrks, containers, directory, filepath, happstack-hsp, happstack-server, hsp, ircbot, ixset, mtl, network, reform, reform-happstack, reform-hsp, safecopy, text, web-plugins, web-routes, web-routes-th
Files
- Clckwrks/IrcBot.hs +11/−0
- Clckwrks/IrcBot/Acid.hs +38/−0
- Clckwrks/IrcBot/Monad.hs +118/−0
- Clckwrks/IrcBot/Page/IrcLog.hs +31/−0
- Clckwrks/IrcBot/Page/IrcLogs.hs +26/−0
- Clckwrks/IrcBot/Page/Reconnect.hs +38/−0
- Clckwrks/IrcBot/Page/Settings.hs +88/−0
- Clckwrks/IrcBot/Page/Template.hs +64/−0
- Clckwrks/IrcBot/Plugin.hs +123/−0
- Clckwrks/IrcBot/PreProcess.hs +50/−0
- Clckwrks/IrcBot/Route.hs +31/−0
- Clckwrks/IrcBot/Types.hs +54/−0
- Clckwrks/IrcBot/URL.hs +18/−0
- LICENSE +30/−0
- Setup.hs +13/−0
- clckwrks-plugin-ircbot.cabal +66/−0
- data/style.css +10/−0
+ Clckwrks/IrcBot.hs view
@@ -0,0 +1,11 @@+module Clckwrks.IrcBot+ ( module Clckwrks.IrcBot.URL+ , module Clckwrks.IrcBot.Monad+ , module Clckwrks.IrcBot.Route+ , module Clckwrks.IrcBot.Types+ ) where++import Clckwrks.IrcBot.URL+import Clckwrks.IrcBot.Monad+import Clckwrks.IrcBot.Route+import Clckwrks.IrcBot.Types
+ Clckwrks/IrcBot/Acid.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, TypeFamilies #-}+module Clckwrks.IrcBot.Acid where++import Clckwrks.IrcBot.Types (IrcConfig(..))+import Control.Applicative ((<$>))+import Control.Monad.Reader (ask)+import Control.Monad.State (modify)+import Data.Acid (Query, Update, makeAcidic)+import Data.Data (Data, Typeable)+import Data.IxSet (IxSet, (@=), getOne, empty, toList, updateIx)+import Data.SafeCopy (base, deriveSafeCopy)+++data IrcBotState = IrcBotState+ { ircConfig :: IrcConfig+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''IrcBotState)++initialIrcBotState :: IrcConfig -> IrcBotState+initialIrcBotState initConfig+ = IrcBotState+ { ircConfig = initConfig+ }++getIrcConfig :: Query IrcBotState IrcConfig+getIrcConfig = ircConfig <$> ask++setIrcConfig :: IrcConfig -> Update IrcBotState ()+setIrcConfig newConfig =+ modify $ \s -> s { ircConfig = newConfig }+++$(makeAcidic ''IrcBotState+ [ 'getIrcConfig+ , 'setIrcConfig+ ]+ )
+ Clckwrks/IrcBot/Monad.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, OverloadedStrings, RecordWildCards, RankNTypes, FlexibleContexts, TypeFamilies #-}+module Clckwrks.IrcBot.Monad where++import Clckwrks (Clck(..), ClckT(..), ClckFormT, ClckState(..), ClckURL(..), mapClckT)+import Clckwrks.Acid+import Clckwrks.IrcBot.Acid+import Clckwrks.IrcBot.PreProcess (ircBotCmd)+import Clckwrks.IrcBot.Types+import Clckwrks.IrcBot.URL+import Control.Applicative ((<$>))+import Control.Exception (bracket, finally)+import Control.Monad.Reader (ReaderT(..), MonadReader(..))+import Data.Acid (AcidState, query)+import Data.Acid.Local (createCheckpointAndClose, openLocalStateFrom)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.Set (Set, insert)+import qualified Data.Text as T+import Happstack.Server (ServerPartT, Input)+import Happstack.Server.Internal.Monads (FilterFun)+import HSP (Attr((:=)), Attribute(MkAttr), EmbedAsChild(..), EmbedAsAttr(..), IsName(toName), XMLGenT(..), pAttrVal, XML)+import Network (PortID(PortNumber))+import Network.IRC.Bot.BotMonad (BotMonad(..))+import Network.IRC.Bot.Core (BotConf(..), User(..), nullBotConf, simpleBot)+import Network.IRC.Bot.Log (LogLevel(..), nullLogger, stdoutLogger)+import Network.IRC.Bot.Part.Dice (dicePart)+import Network.IRC.Bot.Part.Hello (helloPart)+import Network.IRC.Bot.Part.Ping (pingPart)+import Network.IRC.Bot.Part.NickUser (nickUserPart)+import Network.IRC.Bot.Part.Channels (initChannelsPart)+import Network.IRC.Bot.PosixLogger (posixLogger)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import Text.Reform (CommonFormError, FormError(..))+import Web.Routes (showURL)++data IrcBotConfig = IrcBotConfig+ { ircBotLogDirectory :: FilePath -- ^ directory in which to store irc logs+ , ircBotState :: AcidState IrcBotState+ , ircBotClckURL :: ClckURL -> [(T.Text, Maybe T.Text)] -> T.Text+ , ircReconnect :: IO ()+ }++type IrcBotT m = ClckT IrcBotURL (ReaderT IrcBotConfig m)+type IrcBotM = ClckT IrcBotURL (ReaderT IrcBotConfig (ServerPartT IO))++data IrcFormError+ = IrcCFE (CommonFormError [Input])+ | CouldNotParsePort String+ deriving (Show)++instance FormError IrcFormError where+ type ErrorInputType IrcFormError = [Input]+ commonFormError = IrcCFE++type IrcBotForm = ClckFormT IrcFormError IrcBotM++instance (Functor m, Monad m) => EmbedAsChild (IrcBotT m) IrcFormError where+ asChild e = asChild (show e)++instance (IsName n) => EmbedAsAttr IrcBotM (Attr n IrcBotURL) where+ asAttr (n := u) =+ do url <- showURL u+ asAttr $ MkAttr (toName n, pAttrVal (T.unpack url))++instance (IsName n) => EmbedAsAttr IrcBotM (Attr n ClckURL) where+ asAttr (n := url) =+ do showFn <- ircBotClckURL <$> ask+ asAttr $ MkAttr (toName n, pAttrVal (T.unpack $ showFn url []))++runIrcBotT :: IrcBotConfig -> IrcBotT m a -> ClckT IrcBotURL m a+runIrcBotT mc m = mapClckT f m+ where+ f r = runReaderT r mc++instance (Monad m) => MonadReader IrcBotConfig (IrcBotT m) where+ ask = ClckT $ ask+ local f (ClckT m) = ClckT $ local f m++instance (Functor m, Monad m) => GetAcidState (IrcBotT m) IrcBotState where+ getAcidState =+ ircBotState <$> ask+{-+withIrcBotConfig :: Maybe FilePath -- ^ base path to state dir+ -> IrcConfig -- ^ initial 'IrcConfig' to use when creating database for the first time+ -> (forall headers body.+ ( EmbedAsChild (Clck ClckURL) headers+ , EmbedAsChild (Clck ClckURL) body+ ) =>+ String+ -> headers+ -> body+ -> XMLGenT (Clck IrcBotURL) XML)+ -> FilePath -- ^ directory where irc log files are storted+ -> (IrcBotConfig -> IO a) -- ^ function that uses the 'IrcBotConfig'+ -> IO a+withIrcBotConfig mBasePath initIrcConfig pageTemplate' ircBotLogDir f =+ do let basePath = fromMaybe "_state" mBasePath+ bracket (openLocalStateFrom (basePath </> "ircBot") (initialIrcBotState initIrcConfig)) (createCheckpointAndClose) $ \ircBot ->+ do ic@IrcConfig{..} <- query ircBot GetIrcConfig+ let botConf = nullBotConf { channelLogger = Just $ posixLogger (Just ircBotLogDir) "#happs"+ , host = ircHost+ , port = PortNumber $ fromIntegral ircPort+ , nick = ircNick+ , commandPrefix = ircCommandPrefix+ , user = ircUser+ , channels = ircChannels+ , limits = Just (5, 2000000)+ }+ ircParts <- initParts (channels botConf)+ (tids, reconnect) <- simpleBot botConf ircParts+ (f (IrcBotConfig { ircBotLogDirectory = ircBotLogDir+ , ircBotState = ircBot+-- , ircBotClckURL = undefined+-- , ircBotPageTemplate = pageTemplate'+ , ircReconnect = reconnect+ })) `finally` (mapM_ killThread tids)+-}
+ Clckwrks/IrcBot/Page/IrcLog.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.IrcBot.Page.IrcLog where++import Control.Applicative ((<$>))+import Control.Monad.Reader (ask)+import Clckwrks+import Clckwrks.IrcBot.Monad+import Clckwrks.IrcBot.Page.Template (template)+import Data.List (sort)+import Data.Text (pack)+import Data.Text.IO as T (readFile)+import Happstack.Server.FileServe.BuildingBlocks (isSafePath)+import System.Directory+import System.FilePath+import HSP+import Happstack.Server+import Happstack.Server.HSP.HTML++ircLog :: FilePath -> IrcBotM Response+ircLog logFile =+ if isSafePath (splitDirectories logFile)+ then case takeExtension logFile of+ ".txt" ->+ do logDir <- ircBotLogDirectory <$> ask+ c <- liftIO $ T.readFile (logDir </> logFile)+ template (pack logFile) () <pre><% c %></pre>+ ".html" ->+ do logDir <- ircBotLogDirectory <$> ask+ serveFile (asContentType "text/html; charset=UTF-8") (logDir </> logFile)+ _ -> notFound $ toResponse $ "not sure what to do with " ++ logFile+ else do unauthorized $ toResponse $ "Access Denied to file " ++ logFile
+ Clckwrks/IrcBot/Page/IrcLogs.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.IrcBot.Page.IrcLogs where++import Control.Applicative ((<$>))+import Control.Monad.Reader (ask)+import Clckwrks+import Clckwrks.IrcBot.Monad+import Clckwrks.IrcBot.Page.Template (template)+import Clckwrks.IrcBot.URL+import Data.List (sort)+import System.Directory+import System.FilePath+import HSP+import Happstack.Server.HSP.HTML++ircLogs :: IrcBotM Response+ircLogs =+ do logDir <- ircBotLogDirectory <$> ask+ logFiles <- liftIO $ (reverse . sort . filter ((\ext -> (ext == ".html") || (ext == ".txt")) . takeExtension)) <$> getDirectoryContents logDir+ urls <- mapM (showURL . IrcLog) logFiles+ let logs = zip urls logFiles+ template "irc logs" ()+ <ul>+ <% mapM (\(url, logFile) -> <li><a href=url><% logFile %></a></li>) logs %>+ </ul>
+ Clckwrks/IrcBot/Page/Reconnect.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.IrcBot.Page.Reconnect where++import Control.Applicative ((<$>), (<*))+import Control.Monad.Reader (ask)+import Control.Monad.Trans (liftIO)+import Clckwrks (update, seeOtherURL)+import Clckwrks.Admin.Template (template)+import Clckwrks.IrcBot.Monad (IrcBotM(..), IrcBotForm, IrcBotConfig(..))+import Clckwrks.IrcBot.URL (IrcBotURL)+import Data.Map (Map)+import qualified Data.Map as Map+import Happstack.Server (Response, ok, setResponseCode, toResponse)+import HSP+import Text.Reform ((++>))+import Text.Reform.Happstack (reform)+import Text.Reform.HSP.String (inputSubmit, form)+import Web.Routes (showURL)++ircReconnectPage :: IrcBotURL -> IrcBotM Response+ircReconnectPage here =+ do action <- showURL here+ template "Force Reconnect" () $+ <%>+ <% reform (form action) "ir" forceReconnect Nothing forceReconnectForm %>+ </%>+ where+ forceReconnect :: Maybe String -> IrcBotM Response+ forceReconnect _ =+ do fr <- ircReconnect <$> ask+ liftIO $ putStrLn "attempting reconnect"+ liftIO $ fr+ template "forced reconnect" () $+ <p>forced bot to reconnect</p>++forceReconnectForm :: IrcBotForm (Maybe String)+forceReconnectForm =+ inputSubmit "Force Reconnect"
+ Clckwrks/IrcBot/Page/Settings.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.IrcBot.Page.Settings where++import Control.Applicative ((<$>), (<*>), (<*))+import Control.Monad.Reader (ask)+import Control.Monad.Trans (liftIO)+import Clckwrks (ClckFormT, query, update, seeOtherURL)+import Clckwrks.Admin.Template (template)+import Clckwrks.IrcBot.Acid (GetIrcConfig(..), SetIrcConfig(..))+import Clckwrks.IrcBot.Monad (IrcBotM(..), IrcBotConfig(..), IrcBotForm, IrcFormError(..))+import Clckwrks.IrcBot.Types (IrcConfig(..))+import Clckwrks.IrcBot.URL (IrcBotURL)+import Data.Char (isSpace)+import Data.List (intercalate)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Word (Word16)+import Happstack.Server (Response, ok, setResponseCode, toResponse)+import HSP+import Network.IRC.Bot (User(..))+import Numeric (readDec)+import Text.Reform ((++>), mapView, transformEither)+import Text.Reform.Happstack (reform)+import Text.Reform.HSP.String (inputCheckbox, inputText, label, inputSubmit, form)+import Web.Routes (showURL)++ircBotSettings :: IrcBotURL -> IrcBotM Response+ircBotSettings here =+ do action <- showURL here+ oldConfig <- query GetIrcConfig+ template "IrcBot Settings" () $+ <%>+ <% reform (form action) "ibs" updateSettings Nothing (ircBotSettingsForm oldConfig) %>+ </%>+ where+ updateSettings :: IrcConfig -> IrcBotM Response+ updateSettings newConfig =+ do update (SetIrcConfig newConfig)+ template "IrcConfig updated" () $+ <p>IrcConfig updated</p>++ircBotSettingsForm :: IrcConfig -> IrcBotForm IrcConfig+ircBotSettingsForm IrcConfig{..} =+ ul ((IrcConfig <$> host <*> port <*> nick <*> cp <*> user <*> channels <*> enabled) <* inputSubmit "update")+ where+ host = li $ label "irc server" ++> inputText (ircHost)+ port = li $ label "irc port" ++> inputText (show ircPort) `transformEither` toWord16+ nick = li $ label "nickname" ++> inputText (ircNick)+ cp = li $ label "cmd prefix" ++> inputText (ircCommandPrefix)+ usrnm = li $ label "username" ++> inputText (username ircUser)+ hstnm = li $ label "hostname" ++> inputText (hostname ircUser)+ srvrnm = li $ label "servername" ++> inputText (servername ircUser)+ rlnm = li $ label "realname" ++> inputText (realname ircUser)+ user = User <$> usrnm <*> hstnm <*> srvrnm <*> rlnm+ channels = li $ label "channels (comma separated)" ++> inputText (fromSet ircChannels) `transformEither` toSet+ enabled = li $ label "enable bot" ++> inputCheckbox ircEnabled++ -- markup+ li :: IrcBotForm a -> IrcBotForm a+ li = mapView (\xml -> [<li><% xml %></li>])+ ul :: IrcBotForm a -> IrcBotForm a+ ul = mapView (\xml -> [<ul><% xml %></ul>])++ -- transformers+ toWord16 :: String -> Either IrcFormError Word16+ toWord16 str =+ case readDec str of+ [(n,[])] -> Right n+ _ -> (Left (CouldNotParsePort str))++ fromSet :: Set String -> String+ fromSet s = intercalate "," (Set.toList s)++ toSet :: String -> Either IrcFormError (Set String)+ toSet str =+ Right (Set.fromList $ words' str)++ words' :: String -> [String]+ words' s = case dropWhile isSep s of+ "" -> []+ s' -> w : words' s''+ where (w, s'') =+ break isSep s'+ where+ isSep c = isSpace c || c == ','
+ Clckwrks/IrcBot/Page/Template.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.IrcBot.Page.Template where++import Clckwrks+import Clckwrks.Plugin+import Control.Monad.State (get)+import Clckwrks.IrcBot.Monad+import Control.Monad.Reader+import Data.Text (Text)+import HSP hiding (escape)+import Happstack.Server.HSP.HTML ()+import Web.Plugins.Core (Plugin(..), getPluginRouteFn, getTheme)++template :: ( EmbedAsChild IrcBotM headers+ , EmbedAsChild IrcBotM body+ ) =>+ Text+ -> headers+ -> body+ -> IrcBotM Response+template ttl hdrs bdy =+ do p <- plugins <$> get+ mTheme <- getTheme p+ (Just clckShowFn) <- getPluginRouteFn p (pluginName clckPlugin)+ case mTheme of+ Nothing -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: Text)+ (Just theme) ->+ do hdrXml <- fmap (map unClckChild) $ unXMLGenT $ asChild hdrs -- <%> <link rel="stylesheet" type="text/css" href=(IrcBotData "style.css") /> <% hdrs %></%>+ bdyXml <- fmap (map unClckChild) $ unXMLGenT $ asChild bdy+ fmap toResponse $ mapClckT f $ ClckT $ withRouteT (\f -> clckShowFn) $ unClckT $ unXMLGenT $ (_themeTemplate theme ttl hdrXml bdyXml)+ where+ f :: ServerPartT IO (a, ClckState) -> ReaderT IrcBotConfig (ServerPartT IO) (a, ClckState)+ f m = ReaderT $ \_ -> m++{-++template :: ( EmbedAsChild IrcBotM headers+ , EmbedAsChild IrcBotM body+ ) =>+ String+ -> headers+ -> body+ -> IrcBotM Response+template ttl hdrs bdy =+ do pageTemplate <- ircBotPageTemplate <$> ask+ fmap toResponse $ unXMLGenT $+ pageTemplate ttl <%> <link rel="stylesheet" type="text/css" href=(DarcsData "style.css") /> <% hdrs %></%> bdy+-}+{-++template :: ( EmbedAsChild (Clck ClckURL) headers+ , EmbedAsChild (Clck ClckURL) body+ ) =>+ String+ -> headers+ -> body+ -> IrcBotM Response+template ttl hdrs bdy =+ do pageTemplate <- ircBotPageTemplate <$> ask+ fmap toResponse $ mapClckT lift $ unXMLGenT $+ pageTemplate ttl hdrs bdy++-}
+ Clckwrks/IrcBot/Plugin.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE RecordWildCards, FlexibleContexts, OverloadedStrings #-}+module Clckwrks.IrcBot.Plugin where++import Clckwrks+import Clckwrks.Plugin (clckPlugin)+import Clckwrks.IrcBot.URL (IrcBotURL(..), IrcBotAdminURL(..))+import Clckwrks.IrcBot.Acid (GetIrcConfig(..), initialIrcBotState)+import Clckwrks.IrcBot.Monad (IrcBotConfig(..), runIrcBotT)+import Clckwrks.IrcBot.Route (routeIrcBot)+import Clckwrks.IrcBot.Types (IrcConfig(..), emptyIrcConfig)+import Control.Concurrent (ThreadId, killThread)+import Control.Monad.State (get)+import Data.Acid as Acid+import Data.Acid.Local (createCheckpointAndClose, openLocalStateFrom)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import Network (PortID(PortNumber))+import Network.IRC.Bot.BotMonad (BotMonad(..))+import Network.IRC.Bot.Core as IRC (BotConf(..), User(..), nullBotConf, simpleBot)+import Network.IRC.Bot.Log (LogLevel(..), nullLogger, stdoutLogger)+import Network.IRC.Bot.Part.Dice (dicePart)+import Network.IRC.Bot.Part.Hello (helloPart)+import Network.IRC.Bot.Part.Ping (pingPart)+import Network.IRC.Bot.Part.NickUser (nickUserPart)+import Network.IRC.Bot.Part.Channels (initChannelsPart)+import Network.IRC.Bot.PosixLogger (posixLogger)+import System.FilePath ((</>))+import Web.Plugins.Core (Plugin(..), Plugins(..), When(..), addCleanup, addHandler, initPlugin, getConfig, getPluginRouteFn)+import Paths_clckwrks_plugin_ircbot (getDataDir)++ircBotHandler :: (IrcBotURL -> [(Text, Maybe Text)] -> Text)+ -> IrcBotConfig+ -> ClckPlugins+ -> [Text]+ -> ClckT ClckURL (ServerPartT IO) Response+ircBotHandler showIrcBotURL ircBotConfig plugins paths =+ case parseSegments fromPathSegments paths of+ (Left e) -> notFound $ toResponse (show e)+ (Right u) ->+ ClckT $ withRouteT flattenURL $ unClckT $ runIrcBotT ircBotConfig $ routeIrcBot u+ where+ flattenURL :: ((url' -> [(Text, Maybe Text)] -> Text) -> (IrcBotURL -> [(Text, Maybe Text)] -> Text))+ flattenURL _ u p = showIrcBotURL u p++ircBotInit :: ClckPlugins+ -> IO (Maybe Text)+ircBotInit plugins =+ do (Just ircBotShowFn) <- getPluginRouteFn plugins (pluginName ircBotPlugin)+ (Just clckShowFn) <- getPluginRouteFn plugins (pluginName clckPlugin)+ mTopDir <- clckTopDir <$> getConfig plugins+ let basePath = maybe "_state" (\td -> td </> "_state") mTopDir -- FIXME+ ircLogDir = maybe "_irclogs" (\td -> td </> "_irclogs") mTopDir+ acid <- openLocalStateFrom (basePath </> "ircBot") (initialIrcBotState emptyIrcConfig)+ addCleanup plugins Always (createCheckpointAndClose acid)+ reconnect <- botConnect plugins acid ircLogDir+ let ircBotConfig = IrcBotConfig { ircBotLogDirectory = ircLogDir+ , ircBotState = acid+ , ircBotClckURL = clckShowFn+ , ircReconnect = reconnect+ }++-- addPreProc plugins (ircBotCmd ircBotShowFn)+ addHandler plugins (pluginName ircBotPlugin) (ircBotHandler ircBotShowFn ircBotConfig)+ return Nothing++botConnect :: Plugins theme n hook config st+ -> Acid.AcidState (Acid.EventState GetIrcConfig)+ -> FilePath+ -> IO (IO ())+botConnect plugins ircBot ircBotLogDir =+ do ic@IrcConfig{..} <- Acid.query ircBot GetIrcConfig+ let botConf = nullBotConf { channelLogger = Just $ posixLogger (Just ircBotLogDir) "#happs"+ , IRC.host = ircHost+ , IRC.port = PortNumber $ fromIntegral ircPort+ , nick = ircNick+ , commandPrefix = ircCommandPrefix+ , user = ircUser+ , channels = ircChannels+ , limits = Just (5, 2000000)+ }+ ircParts <- initParts (channels botConf)+ (tids, reconnect) <- simpleBot botConf ircParts+ addCleanup plugins Always (mapM_ killThread tids)+ return reconnect++initParts :: (BotMonad m) =>+ Set String -- ^ set of channels to join+ -> IO [m ()]+initParts chans =+ do (_, channelsPart) <- initChannelsPart chans+ return [ pingPart+ , nickUserPart+ , channelsPart+ , dicePart+ , helloPart+ ]++addIrcBotAdminMenu :: ClckT url IO ()+addIrcBotAdminMenu =+ do p <- plugins <$> get+ (Just showIrcBotURL) <- getPluginRouteFn p (pluginName ircBotPlugin)+ let reconnectURL = showIrcBotURL (IrcBotAdmin IrcBotReconnect) []+ settingsURL = showIrcBotURL (IrcBotAdmin IrcBotSettings) []+ addAdminMenu ("IrcBot", [ ("Reconnect", reconnectURL)+ , ("Settings", settingsURL)+ ])++ircBotPlugin :: Plugin IrcBotURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig [TL.Text -> ClckT ClckURL IO TL.Text]+ircBotPlugin = Plugin+ { pluginName = "ircBot"+ , pluginInit = ircBotInit+ , pluginDepends = []+ , pluginToPathInfo = toPathInfo+ , pluginPostHook = addIrcBotAdminMenu+ }++plugin :: ClckPlugins -- ^ plugins+ -> Text -- ^ baseURI+ -> IO (Maybe Text)+plugin plugins baseURI =+ initPlugin plugins baseURI ircBotPlugin
+ Clckwrks/IrcBot/PreProcess.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module Clckwrks.IrcBot.PreProcess where++import Control.Monad.Trans+import Control.Applicative+import Clckwrks (ClckT, ClckState)+import Clckwrks.IrcBot.URL+import Data.Attoparsec.Text+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import Text.Blaze.Html ((!), toValue)+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Web.Routes (showURL)++parseAttr :: Text -> Parser ()+parseAttr name =+ do skipMany space+ stringCI name+ skipMany space+ char '='+ skipMany space++width :: Parser H.Attribute+width =+ A.width . H.toValue <$> (parseAttr "width" *> (decimal :: Parser Integer))++height :: Parser H.Attribute+height =+ A.height . H.toValue <$> (parseAttr "height" *> (decimal :: Parser Integer))+{-+parseCmd :: Parser (MediumId, [H.Attribute])+parseCmd =+ (,) <$> (parseAttr "id" *> (MediumId <$> decimal))+ <*> (many $ choice [ width, height ])+-} +ircBotCmd :: (Monad m) => (IrcBotURL -> [(Text, Maybe Text)] -> Text) -> Text -> ClckT url m Builder+ircBotCmd showURLFn txt =+ return $ B.fromString "ircBot does not currently support any markup commands."+{-+ do let mi = parseOnly parseCmd txt+ case mi of+ (Left e) ->+ return $ B.fromString e -- FIXME: format the error more nicely or something?+ (Right (mid, attrs)) ->+ do let u = toValue $ showURLFn (GetMedium mid) []+ return $ B.fromLazyText $ renderHtml $ foldr (\attr tag -> tag ! attr) H.img (A.src u : attrs)+-}
+ Clckwrks/IrcBot/Route.hs view
@@ -0,0 +1,31 @@+module Clckwrks.IrcBot.Route where++import Control.Applicative ((<$>))+import Control.Monad.Reader (ask)+import Clckwrks (Clck, Role(..), requiresRole_)+import Clckwrks.IrcBot.Monad (IrcBotM, IrcBotConfig(..))+import Clckwrks.IrcBot.Page.IrcLog (ircLog)+import Clckwrks.IrcBot.Page.IrcLogs (ircLogs)+import Clckwrks.IrcBot.Page.Reconnect (ircReconnectPage)+import Clckwrks.IrcBot.Page.Settings (ircBotSettings)+import Clckwrks.IrcBot.URL (IrcBotURL(..), IrcBotAdminURL(..))+import qualified Data.Set as Set+import Happstack.Server (Response, toResponse, notFound)++checkAuth :: IrcBotURL -> IrcBotM IrcBotURL+checkAuth url =+ case url of+ IrcBotAdmin {} ->+ do showFn <- ircBotClckURL <$> ask+ requiresRole_ showFn (Set.singleton Administrator) url+ _ -> return url+++routeIrcBot :: IrcBotURL -> IrcBotM Response+routeIrcBot unsecureURL =+ do url <- checkAuth unsecureURL+ case url of+ IrcLogs -> ircLogs+ IrcLog fp -> ircLog fp+ (IrcBotAdmin IrcBotReconnect) -> ircReconnectPage url+ (IrcBotAdmin IrcBotSettings) -> ircBotSettings url
+ Clckwrks/IrcBot/Types.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell, TypeFamilies #-}+module Clckwrks.IrcBot.Types+ ( IrcConfig(..)+ , User(..)+ , emptyIrcConfig+ ) where++import Data.Data (Data, Typeable)+import Data.Word (Word16)+import Data.IxSet (Indexable(..), ixSet, ixFun)+import Data.SafeCopy (Migrate(..), SafeCopy, base, deriveSafeCopy, extension)+import Data.Set (Set, empty)+import Data.Text (Text)+import Network.IRC.Bot.Types (User(..))+import Web.Routes (PathInfo(..))++data IrcConfig_0 = IrcConfig_0+ { ircHost_0 :: String+ , ircPort_0 :: Word16+ , ircNick_0 :: String+ , ircCommandPrefix_0 :: String+ , ircUser_0 :: User+ , ircChannels_0 :: Set String+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''User)+$(deriveSafeCopy 0 'base ''IrcConfig_0)++data IrcConfig = IrcConfig+ { ircHost :: String -- ^ IRC server+ , ircPort :: Word16 -- ^ port (usually 6667)+ , ircNick :: String -- ^ irc nick+ , ircCommandPrefix :: String -- ^ prefix for bot commands+ , ircUser :: User -- ^ irc 'User'+ , ircChannels :: Set String -- ^ channels to join on connect+ , ircEnabled :: Bool -- ^ enable the bot+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 1 'extension ''IrcConfig)++instance Migrate IrcConfig where+ type MigrateFrom IrcConfig = IrcConfig_0+ migrate (IrcConfig_0 h p n cp u cs) = (IrcConfig h p n cp u cs True)++emptyIrcConfig :: IrcConfig+emptyIrcConfig = IrcConfig+ { ircHost = ""+ , ircPort = 0+ , ircNick = ""+ , ircCommandPrefix = ""+ , ircUser = User "" "" "" ""+ , ircChannels = Data.Set.empty+ , ircEnabled = False+ }
+ Clckwrks/IrcBot/URL.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}+module Clckwrks.IrcBot.URL where++import Data.Data (Data, Typeable)+import Web.Routes.TH (derivePathInfo)++data IrcBotAdminURL+ = IrcBotReconnect+ | IrcBotSettings+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''IrcBotAdminURL)++data IrcBotURL+ = IrcLogs+ | IrcLog FilePath+ | IrcBotAdmin IrcBotAdminURL+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''IrcBotURL)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Jeremy Shaw, SeeReason Partners LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jeremy Shaw nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,13 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple+import Distribution.Simple.Program++trhsxProgram = simpleProgram "trhsx"++main :: IO ()+main = defaultMainWithHooks simpleUserHooks {+ hookedPrograms = [trhsxProgram]+ }
+ clckwrks-plugin-ircbot.cabal view
@@ -0,0 +1,66 @@+Name: clckwrks-plugin-ircbot+Version: 0.3.0+Synopsis: ircbot plugin for clckwrks+Homepage: http://clckwrks.com/+License: BSD3+License-file: LICENSE+Author: Jeremy Shaw+Maintainer: Jeremy Shaw <jeremy@n-heptane.com>+Copyright: 2012 Jeremy Shaw, SeeReason Partners LLC+Category: Clckwrks+Build-type: Custom+Cabal-version: >=1.6+Data-Files:+ data/style.css++source-repository head+ type: darcs+ subdir: clckwrks-plugin-ircbot+ location: http://hub.darcs.net/stepcut/clckwrks++Library+ Build-tools:+ trhsx++ Exposed-modules:+ Clckwrks.IrcBot+ Clckwrks.IrcBot.Acid+ Clckwrks.IrcBot.Monad+ Clckwrks.IrcBot.Page.IrcLog+ Clckwrks.IrcBot.Page.IrcLogs+ Clckwrks.IrcBot.Page.Reconnect+ Clckwrks.IrcBot.Page.Settings+ Clckwrks.IrcBot.Page.Template+ Clckwrks.IrcBot.Plugin+ Clckwrks.IrcBot.PreProcess+ Clckwrks.IrcBot.Route+ Clckwrks.IrcBot.Types+ Clckwrks.IrcBot.URL+ Paths_clckwrks_plugin_ircbot++ Build-depends:+ base < 5,+ acid-state >= 0.7,+ attoparsec == 0.10.*,+ blaze-html == 0.5.*,+ clckwrks == 0.13.*,+ containers >= 0.4 && < 0.6,+ directory >= 1.1 && < 1.3,+ filepath >= 1.2 && < 1.4,+ happstack-server >= 7.0 && < 7.2,+ happstack-hsp == 7.1.*,+ hsp == 0.7.*,+ ircbot >= 0.5.2 && < 0.6,+ ixset == 1.0.*,+-- magic == 1.0.*,+ mtl >= 2.0 && < 2.3,+ network >= 2.3 && < 2.5,+ reform == 0.1.*,+ reform-happstack == 0.1.*,+ reform-hsp >= 0.1.1 && < 0.2,+ safecopy >= 0.6,+ text == 0.11.*,+ web-plugins == 0.1.*,+ web-routes == 0.27.*,+ web-routes-th >= 0.21+
+ data/style.css view
@@ -0,0 +1,10 @@+ul#media-gallery+{+ list-style-type: none;+}++#media-gallery li+{+ display: inline;+ padding-right: 1em;+}