Moved files around as a preliminary for architectural changes.

5 files changed, 0 insertions, 366 deletions

diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs
deleted file mode 100644
index 114ced8..0000000
--- a/Hsbot/Irc/Plugin/Core.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-module Hsbot.Irc.Plugin.Core
-    ( ircBotPluginCore
-    ) where
-
-import Control.Concurrent (Chan)
-import Control.Exception
-import Control.Monad.State
-import Prelude hiding (catch)
-
-import Hsbot.Irc.Message
-import Hsbot.Irc.Plugin.Utils
-
--- | The plugin's main entry point
-ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO ()
-ircBotPluginCore myChan masterChan = do
-    let plugin = IrcPluginState { ircPluginName       = "Core"
-                                , ircPluginChan       = myChan
-                                , ircPluginMasterChan = masterChan }
-    evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin
-    plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
-    evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin'
-
--- | The IrcPlugin monad main function
-run :: IrcPlugin ()
-run = forever $ do
-    msg <- readMsg
-    eval msg
-  where
-    eval :: IrcBotMsg -> IrcPlugin ()
-    eval (IntIrcCmd intCmd) = do
-        let request = ircCmdBotMsg intCmd
-        case ircCmdCmd intCmd of
-            "RUN"    -> let stuff = words $ ircCmdMsg intCmd
-                        in case head stuff of
-                            "list"   -> listPlugins request
-                            "load"   -> loadPlugin $ tail stuff
-                            "reload" -> reloadPlugin $ tail stuff
-                            "unload" -> unloadPlugin $ tail stuff
-                            "reboot" -> rebootBot $ tail stuff
-                            _        -> return () -- TODO : help message
-            "ANSWER" -> let stuff = ircCmdMsg intCmd
-                        in answerMsg request ("Loaded plugins : " ++ stuff)
-            _        -> return ()
-    eval _ = return ()
-
--- | The list command
-listPlugins :: IrcMsg -> IrcPlugin ()
-listPlugins request = do
-    sendCommandWithRequest "LIST" "CORE" (unwords []) request
-
--- | The load command
-loadPlugin :: [String] -> IrcPlugin ()
-loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames
-
--- | The reload command
-reloadPlugin :: [String] -> IrcPlugin ()
-reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames
-
--- | The unload command
-unloadPlugin :: [String] -> IrcPlugin ()
-unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames
-
--- | The reboot command
-rebootBot :: [String] -> IrcPlugin ()
-rebootBot stuff = sendCommand "REBOOT" "CORE" $ unwords stuff
-
diff --git a/Hsbot/Irc/Plugin/Dummy.hs b/Hsbot/Irc/Plugin/Dummy.hs
deleted file mode 100644
index 4e10644..0000000
--- a/Hsbot/Irc/Plugin/Dummy.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Hsbot.Irc.Plugin.Dummy
-    ( ircBotPluginDummy
-    ) where
-
-import Control.Concurrent.Chan
-import Control.Exception
-import Control.Monad.State
-import Prelude hiding (catch)
-
-import Hsbot.Irc.Message
-import Hsbot.Irc.Plugin.Utils
-
--- | The plugin's main entry point
-ircBotPluginDummy :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO ()
-ircBotPluginDummy myChan masterChan = do
-    let plugin = IrcPluginState { ircPluginName       = "Dummy"
-                                , ircPluginChan       = myChan
-                                , ircPluginMasterChan = masterChan }
-    _ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
-    return ()
-
--- | The IrcPlugin monad main function
-run :: IrcPlugin ()
-run = forever $ do
-    _ <- readMsg
-    return ()
-
diff --git a/Hsbot/Irc/Plugin/Ping.hs b/Hsbot/Irc/Plugin/Ping.hs
deleted file mode 100644
index 57418b3..0000000
--- a/Hsbot/Irc/Plugin/Ping.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Hsbot.Irc.Plugin.Ping
-    ( ircBotPluginPing
-    ) where
-
-import Control.Concurrent.Chan
-import Control.Exception
-import Control.Monad.State
-import Prelude hiding (catch)
-
-import Hsbot.Irc.Message
-import Hsbot.Irc.Plugin.Utils
-
--- | The plugin's main entry point
-ircBotPluginPing :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO ()
-ircBotPluginPing myChan masterChan = do
-    let plugin = IrcPluginState { ircPluginName       = "Ping"
-                                , ircPluginChan       = myChan
-                                , ircPluginMasterChan = masterChan }
-    _ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
-    return ()
-
--- | The IrcPlugin monad main function
-run :: IrcPlugin ()
-run = forever $ do
-    msg <- readMsg
-    eval msg
-  where
-    eval :: IrcBotMsg -> IrcPlugin ()
-    eval (InIrcMsg msg)
-        | (ircMsgCommand msg) == "PING" = writeMsg . OutIrcMsg $ IrcMsg Nothing "PONG" (ircMsgParameters msg)
-        | otherwise = return ()
-    eval _ = return ()
-
diff --git a/Hsbot/Irc/Plugin/Quote.hs b/Hsbot/Irc/Plugin/Quote.hs
deleted file mode 100644
index 0335d8b..0000000
--- a/Hsbot/Irc/Plugin/Quote.hs
+++ /dev/null
@@ -1,174 +0,0 @@
-module Hsbot.Irc.Plugin.Quote
-    ( ircBotPluginQuote
-    ) where
-
-import Control.Concurrent.Chan
-import Control.Exception
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Maybe(fromMaybe)
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import Data.Time
-import System.Directory
-import IO hiding (catch)
-import Prelude hiding (catch)
-import System.FilePath
-import System.Posix.Files
-import System.Random(randomRIO)
-
-import Hsbot.Irc.Message
-import Hsbot.Irc.Plugin.Utils
-
--- | A quote element
-data QuoteElt = QuoteElt
-    { eltQuoter :: String
-    , eltQuote  :: String
-    } deriving (Read, Show)
-
--- | A quote object
-data Quote = Quote
-    { quoter    :: String
-    , quote     :: [QuoteElt]
-    , quoteTime :: UTCTime
-    , votes     :: Int
-    } deriving (Read, Show)
-
--- | A QuoteBot state
-data QuoteBotState = QuoteBotState
-    { nextQuoteId      :: Integer
-    , quoteBotDB       :: M.Map Integer Quote
-    , quotesInProgress :: M.Map Integer Quote
-    } deriving (Read, Show)
-
--- | The QuoteBot monad
-type QuoteBot a = StateT QuoteBotState (StateT IrcPluginState IO) a
-
--- | The plugin's main entry point
-ircBotPluginQuote :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO ()
-ircBotPluginQuote myChan masterChan = do
-    -- First of all we restore the database
-    dir <- getAppUserDataDirectory "hsbot"
-    let dbfile = dir </> "quotedb.txt"
-    dbfileExists <- fileExist dbfile
-    if not dbfileExists
-      then
-        let quoteBot = QuoteBotState 0 M.empty M.empty
-        in TIO.writeFile dbfile (T.pack $ show quoteBot)
-      else
-        return ()
-    txtQuoteBot <- TIO.readFile $ dbfile
-    let quoteBot = read (T.unpack txtQuoteBot) :: QuoteBotState
-    -- The plugin main loop
-    let plugin = IrcPluginState { ircPluginName       = "Quote"
-                                , ircPluginChan       = myChan
-                                , ircPluginMasterChan = masterChan }
-    evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin
-    _ <- (evalStateT (run quoteBot) plugin) `catch` (\(_ :: AsyncException) -> return quoteBot)
-    evalStateT (mapM_ sendUnregisterCommand ["quote"]) plugin
-
--- | The IrcPlugin monad main function
-run :: QuoteBotState -> IrcPlugin (QuoteBotState)
-run quoteBot = do
-    msg <- readMsg
-    quoteBot' <- eval msg
-    run quoteBot'
-  where
-    -- | evaluate what we just received
-    eval :: IrcBotMsg -> IrcPlugin (QuoteBotState)
-    eval (IntIrcCmd intCmd)
-      | ircCmdCmd intCmd == "RUN" = do
-          quoteBot' <- execStateT (runCommand intCmd) quoteBot
-          return quoteBot'
-      | otherwise = return quoteBot
-    eval (InIrcMsg _) = return (quoteBot)
-    eval (OutIrcMsg _) = return (quoteBot)
-
--- | run a command we received
-runCommand :: IrcCmd -> QuoteBot ()
-runCommand intCmd
-  | theCommand == "quote" = runQuoteCommand
-  | otherwise = return ()
-  where
-    -- | the message is a quote command
-    runQuoteCommand :: QuoteBot ()
-      | length args == 0 = do
-          quoteDB <- gets quoteBotDB
-          x <- liftIO $ randomRIO (0, (length $ M.keys quoteDB) - 1)
-          if (length $ M.keys quoteDB) > 0
-            then
-              mapM_ (lift . answerMsg request) (formatQuote (M.keys quoteDB !! x) (M.elems quoteDB !! x))
-            else
-              lift $ answerMsg request "The quote database is empty."
-      | otherwise = do
-          dispatchQuoteCmd $ head args
-    -- | quote command dispatcher
-    dispatchQuoteCmd :: String -> QuoteBot ()
-    dispatchQuoteCmd cmd
-      | cmd == "start"  = do
-          quoteBot <- get
-          now <- liftIO $ getCurrentTime
-          let sender   = takeWhile (/= '!') $ fromMaybe "ARGH" (ircMsgPrefix request)
-              newQuote = Quote sender [(quoteElt stuff)] now 0
-              quoteId     = nextQuoteId quoteBot
-              quotesInProgress' = M.insert quoteId  newQuote (quotesInProgress quoteBot)
-          put $ quoteBot { nextQuoteId = quoteId + 1, quotesInProgress = quotesInProgress' }
-          lift $ answerMsg request ("New quoteId : " ++ show quoteId)
-          syncQuoteBot
-      | cmd == "append" = do
-          quoteBot <- get
-          case reads (head stuff) of
-              [(quoteId :: Integer,"")] -> do
-                  case M.lookup quoteId (quotesInProgress quoteBot) of
-                      Just theQuote -> do
-                          let newQuote = theQuote { quote = (quoteElt $ tail stuff) : (quote theQuote) }
-                              quotesInProgress'  = M.insert quoteId newQuote (quotesInProgress quoteBot)
-                          put $ quoteBot { quotesInProgress = quotesInProgress' }
-                          syncQuoteBot
-                      Nothing       -> lift $ answerMsg request ("quoteId not found : " ++ (show quoteId))
-              _ -> lift $ answerMsg request ("Invalid quoteId : " ++ (head stuff))
-      | cmd == "commit" = do
-          quoteBot <- get
-          case reads (head stuff) of
-              [(quoteId :: Integer,"")] -> do
-                  case M.lookup quoteId (quotesInProgress quoteBot) of
-                      Just theQuote -> do
-                          let quoteBotDB'       = M.insert quoteId theQuote (quoteBotDB quoteBot)
-                              quotesInProgress' = M.delete quoteId (quotesInProgress quoteBot)
-                          put $ quoteBot { quoteBotDB = quoteBotDB', quotesInProgress = quotesInProgress' }
-                          syncQuoteBot
-                      Nothing       -> lift $ answerMsg request ("quoteId not found : " ++ (show quoteId))
-              _ -> lift $ answerMsg request ("Invalid quoteId : " ++ (head stuff))
-      -- | cmd == "abort"  = 
-      | otherwise = lift $ answerMsg request ("Invalid command : " ++ cmd)
-    -- | Gets the new QuoteElt
-    quoteElt :: [String] -> QuoteElt
-    quoteElt msg = do
-        let budy   = head $ msg
-            theQuote  = unwords . tail $ msg
-        QuoteElt budy theQuote
-    -- | utilities
-    params  = words . ircCmdMsg $ intCmd
-    theCommand = head params
-    args    = tail params
-    stuff   = tail args
-    request = ircCmdBotMsg intCmd
-
--- | The function that sync the quoteDB on disk
-syncQuoteBot :: QuoteBot ()
-syncQuoteBot = do
-    dir <- liftIO $ getAppUserDataDirectory "hsbot"
-    let dbfile = dir </> "quotedb.txt"
-    file' <- liftIO $ openFile dbfile WriteMode
-    quoteBot <- get
-    liftIO . hPutStr file' $ show quoteBot
-    liftIO $ hClose file'
-
-formatQuote :: Integer -> Quote -> [String]
-formatQuote quoteId theQuote =
-    ("+---| " ++ (show quoteId) ++ " |-- Reported by " ++ (quoter theQuote) ++ " on " ++ (show $ quoteTime theQuote)) :
-    foldl (\acc x -> formatQuoteElt x : acc) ["`------------------------------------------"] (quote theQuote)
-  where
-    formatQuoteElt :: QuoteElt -> String
-    formatQuoteElt quoteElt = "| <" ++ (eltQuoter quoteElt) ++ "> " ++ (eltQuote quoteElt)
-
diff --git a/Hsbot/Irc/Plugin/Utils.hs b/Hsbot/Irc/Plugin/Utils.hs
deleted file mode 100644
index 1e54d3a..0000000
--- a/Hsbot/Irc/Plugin/Utils.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-module Hsbot.Irc.Plugin.Utils
-    ( IrcPlugin
-    , IrcPluginState (..)
-    , answerMsg
-    , readMsg
-    , sendCommand
-    , sendCommandWithRequest
-    , sendRegisterCommand
-    , sendUnregisterCommand
-    , writeMsg
-    ) where
-
-import Control.Concurrent
-import Control.Concurrent.Chan ()
-import Control.Monad.State
-import Data.Maybe (fromMaybe)
-
-import Hsbot.Irc.Message
-
--- | The IrcPlugin monad
-type IrcPlugin = StateT IrcPluginState IO
-
--- | A plugin state
-data IrcPluginState = IrcPluginState
-    { ircPluginName       :: String         -- The plugin's name
-    , ircPluginChan       :: Chan IrcBotMsg -- The plugin chan
-    , ircPluginMasterChan :: Chan IrcBotMsg -- The master's chan
-    }
-
---- | Basic input output for IrcPlugins
-readMsg :: IrcPlugin (IrcBotMsg)
-readMsg = do
-   chan  <- gets ircPluginChan
-   input <- liftIO $ readChan chan
-   return input
-
-writeMsg :: IrcBotMsg -> IrcPlugin ()
-writeMsg (OutIrcMsg msg) = do
-   chan <- gets ircPluginMasterChan
-   liftIO $ writeChan chan (OutIrcMsg msg)
-writeMsg _ = return ()
-
-answerMsg :: IrcMsg -> String -> IrcPlugin ()
-answerMsg request msg = do
-    let chanOrigin = head $ ircMsgParameters request
-        sender     = takeWhile (/= '!') $ fromMaybe "" (ircMsgPrefix request)
-    case head chanOrigin of
-        '#' -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
-        _   -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
-
--- | Command management
-sendCommand :: String -> String -> String -> IrcPlugin ()
-sendCommand cmd to params = sendCommandWithRequest cmd to params emptyIrcMsg
-
-sendCommandWithRequest :: String -> String -> String -> IrcMsg -> IrcPlugin ()
-sendCommandWithRequest cmd to params originalRequest = do
-    masterChan <- gets ircPluginMasterChan
-    from       <- gets ircPluginName
-    liftIO . writeChan masterChan . IntIrcCmd $ IrcCmd cmd from to params originalRequest
-
-sendRegisterCommand :: String -> IrcPlugin ()
-sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd
-
-sendUnregisterCommand :: String -> IrcPlugin ()
-sendUnregisterCommand cmd = sendCommand "UNREGISTER" "CORE" cmd
-