From 1f6c64749d39eb31f171b7fa3a44cbe396bbf071 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Wed, 5 Aug 2009 01:01:47 +0200 Subject: Wrote a dynamic compilation stuff that works (unable to test reboot yet) --- Config.hs | 26 ++++++++++++++++++++++++++ Hsbot.hs | 12 ++++++++++++ Hsbot/Core.hs | 36 ++++++++++++++++++++++++++++++++++++ Hsbot/IRC.hs | 34 ++++++++++++++++++++++++++++++++++ Hsbot/Main.hs | 23 +++++++++++++++++++++++ Main.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ Makefile | 8 ++++++++ 7 files changed, 183 insertions(+) create mode 100644 Config.hs create mode 100644 Hsbot.hs create mode 100644 Hsbot/Core.hs create mode 100644 Hsbot/IRC.hs create mode 100644 Hsbot/Main.hs create mode 100644 Main.hs create mode 100644 Makefile diff --git a/Config.hs b/Config.hs new file mode 100644 index 0000000..44278f6 --- /dev/null +++ b/Config.hs @@ -0,0 +1,26 @@ +module Config + ( config + ) where + +import Hsbot.Core + +-- | Imported plugins goes there + +-- | User server +kro = Server + { address = "kro.corp" + , port = 6667 + , channels = ["#geek"] + , nickname = "hsbot" + , password = "" + , realname = "The One True bot, with it's haskell soul." + , administrators = ["julien"] + } + +-- | User configuration +config :: Config +config = Config + { commandPrefixes = ['@'] + , servers = [kro] + } + diff --git a/Hsbot.hs b/Hsbot.hs new file mode 100644 index 0000000..5b423ec --- /dev/null +++ b/Hsbot.hs @@ -0,0 +1,12 @@ +module Hsbot + ( module Config + , module Hsbot.Core + , module Hsbot.IRC + , module Hsbot.Main + ) where + +import Config +import Hsbot.Core +import Hsbot.IRC +import Hsbot.Main + diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs new file mode 100644 index 0000000..153ce77 --- /dev/null +++ b/Hsbot/Core.hs @@ -0,0 +1,36 @@ +module Hsbot.Core + ( Bot(..) + , Config(..) + , Server(..) + , newbot + ) where + +import qualified Data.Map as M +import System.IO (Handle) + +-- | An IRC Bot server state (socket handles) +data Bot = Bot + { joinedServers :: M.Map Server Handle -- servers we are connected to + } deriving (Eq, Show) + +-- | Configuration data type +data Config = Config { + commandPrefixes :: String, -- command prefixes, for example @[\'>\',\'@\',\'?\']@ + servers :: [Server] -- list of 'Server's to connect to +} deriving (Eq,Show) + +-- | An IRC server +data Server = Server + { address :: String -- the server's address + , port :: Int -- the server's port + , channels :: [String] -- a list of channels to join + , nickname :: String -- the hsbot's nickname + , password :: String -- the hsbot's password, optional + , realname :: String -- the hsbot's real name, optional + , administrators :: [String] -- bot admins nicknames + } deriving (Eq, Show) + +-- | Returns a new, empty bot +newbot :: Bot +newbot = Bot (M.empty) + diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs new file mode 100644 index 0000000..094cb3f --- /dev/null +++ b/Hsbot/IRC.hs @@ -0,0 +1,34 @@ +module Hsbot.IRC + ( IrcInput(..) + , IrcOutput(..) + , parseIrcMsg + )where + +import qualified Network.IRC as Irc +import System.IO (Handle) + +import Hsbot.Core + +type User = String +type Channel = String +type Command = String +type Args = [String] + +-- | Information from IRC +data IrcInput = Cmd User Channel (Command, Maybe String) -- a regular command + | Line User Channel String -- a normal line of little significance + | Err String -- an error occured in parsing + deriving (Eq,Show) + +-- | Data that can go over the remote channel +data IrcOutput = Str String -- a regular string + | Quit (Server, Handle) -- a quit message from a server + | Join (Server, Channel) -- joined a channel + | Part (Server, Channel) -- parted the channel + | Reboot -- reboot message sent + | Nil -- signifies thread death, only happens after reboot + deriving (Eq,Show) + +parseIrcMsg :: String -> IrcInput +parseIrcMsg _ = Err "Parsing not yet implemented" + diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs new file mode 100644 index 0000000..129d2bd --- /dev/null +++ b/Hsbot/Main.hs @@ -0,0 +1,23 @@ +module Hsbot.Main + (imain + ) where + +import Network +import System.IO +import System.Plugins + +import qualified Config as C +import Hsbot.Core +import Hsbot.IRC + +type Reboot = (Module -> Bot -> IO ()) + +-- | Bot's first main entry point +imain :: Module -> Reboot -> IO () +imain modul' reboot = imain' modul' reboot newbot + +-- | Bot's main entry point +imain' :: Module -> Reboot -> Bot -> IO () +imain' modul' reboot bot = do + print C.config + diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..0a72e62 --- /dev/null +++ b/Main.hs @@ -0,0 +1,44 @@ +module Main where +import System.Exit +import System.Plugins + +-- | Dynamic launching function +main :: IO () +main = do + putStrLn "hsbot starting..." + m <- makeAll "Hsbot.hs" [] -- ghcargs + (modul', imain) <- case m of + MakeSuccess _ _ -> do + ldstat <- load_ "Hsbot/Main.o" [".","Hsbot","Hsbot/Plugins"] "imain" + case ldstat of + LoadSuccess v m' -> return (v,m') + LoadFailure e -> do + putStrLn "Couldn't load Hsbot.Main.imain:" + mapM_ putStrLn e + exitWith $ ExitFailure 127 + MakeFailure e -> do + putStrLn "FATAL: Couldn't compile Hsbot.hs:" + mapM_ putStrLn e + exitWith $ ExitFailure 127 + putStrLn "Compiled & Loaded Hsbot.Main.imain..." + imain modul' reboot + +-- | Dynamic rebooting function +reboot :: Module -> a -> IO () +reboot modul' st = do + mkstat <- makeAll "Hsbot.hs" [] --ghcargs + case mkstat of + MakeSuccess _ _ -> do + unloadAll modul' + ldstat <- load_ "Hsbot/Main.o" [".","Hsbot","Hsbot/Plugins"] "imain'" + case ldstat of + LoadSuccess v imain' -> do + putStrLn "REBOOT: Successful recompilation & reloading, rebooting..." + imain' v reboot st + LoadFailure e -> fatality e + MakeFailure e -> fatality e + where + fatality errs = do + putStrLn $ "REBOOT: FATAL: Couldn't reboot thread, err:" + mapM_ putStrLn errs + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d778930 --- /dev/null +++ b/Makefile @@ -0,0 +1,8 @@ +all: + ghc --make -Wall -O2 Main.hs -o hsbot + +clean: + - rm hsbot + - find ./ -name \*.o -exec rm {} + + - find ./ -name \*.hi -exec rm {} + + -- cgit v1.2.3