Wrote a dynamic compilation stuff that works (unable to test reboot yet)
This commit is contained in:
parent
ea607ba1b1
commit
1f6c64749d
7 changed files with 183 additions and 0 deletions
26
Config.hs
Normal file
26
Config.hs
Normal file
|
@ -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]
|
||||
}
|
||||
|
12
Hsbot.hs
Normal file
12
Hsbot.hs
Normal file
|
@ -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
|
||||
|
36
Hsbot/Core.hs
Normal file
36
Hsbot/Core.hs
Normal file
|
@ -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)
|
||||
|
34
Hsbot/IRC.hs
Normal file
34
Hsbot/IRC.hs
Normal file
|
@ -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"
|
||||
|
23
Hsbot/Main.hs
Normal file
23
Hsbot/Main.hs
Normal file
|
@ -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
|
||||
|
44
Main.hs
Normal file
44
Main.hs
Normal file
|
@ -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
|
||||
|
8
Makefile
Normal file
8
Makefile
Normal file
|
@ -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 {} +
|
||||
|
Reference in a new issue