Wrote a dynamic compilation stuff that works (unable to test reboot yet)

7 files changed, 183 insertions, 0 deletions

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 {} +
+