Added the cli parser and a config file handler for hsbot-irc.

4 files changed, 216 insertions, 4 deletions

diff --git a/HsbotIrcBot/Hsbot/Irc/Config.hs b/HsbotIrcBot/Hsbot/Irc/Config.hs
index 0d1e5a2..e0b8c64 100644
--- a/HsbotIrcBot/Hsbot/Irc/Config.hs
+++ b/HsbotIrcBot/Hsbot/Irc/Config.hs
@@ -1,14 +1,18 @@
 module Hsbot.Irc.Config
     ( IrcConfig(..)
     , ircDefaultConfig
+    , getIrcConfig
     ) where
 
+import qualified Data.ConfigFile as C
+import Data.Either.Utils
 import Network
+import System.Exit
+import System.Posix.Files
 
 -- | Configuration data type
 data IrcConfig = IrcConfig
-    { ircConfigName          :: String   -- The configuration name
-    , ircConfigAddress       :: String   -- the server's address
+    { ircConfigAddress       :: String   -- the server's address
     , ircConfigPort          :: PortID   -- the server's port
     , ircConfigChannels      :: [String] -- the Channels to join on start
     , ircConfigNickname      :: String   -- the hsbot's nickname
@@ -21,8 +25,7 @@ data IrcConfig = IrcConfig
 -- | User configuration
 ircDefaultConfig :: IrcConfig
 ircDefaultConfig = IrcConfig
-    { ircConfigName          = "irc-alocalhost"
-    , ircConfigAddress       = "localhost"
+    { ircConfigAddress       = "localhost"
     , ircConfigPort          = PortNumber 6667
     , ircConfigChannels      = ["#hsbot"]
     , ircConfigNickname      = "hsbot"
@@ -32,3 +35,70 @@ ircDefaultConfig = IrcConfig
     , ircConfigPlugins       = ["Ping"]
     }
 
+-- | config file retrieving
+getIrcConfig :: Maybe String -> IO (IrcConfig)
+getIrcConfig maybePath =
+    case maybePath of
+        Just path -> do
+            doesFileExists <- fileExist path
+            case doesFileExists of
+                True -> do
+                    fileStatus <- getFileStatus path
+                    case isRegularFile $ fileStatus of
+                        True -> compileIrcConfig ircDefaultConfig path
+                        False -> do
+                            putStrLn "Invalid configuration file path."
+                            exitWith $ ExitFailure 1
+                False -> do
+                    putStrLn "The specified configuration file does not exists."
+                    exitWith $ ExitFailure 1
+        Nothing -> return ircDefaultConfig  -- TODO : try defaults like $HOME/.hsbotrc, /etc/hsbotrc or /usr/local/etc/hsbotrc
+
+-- | config file parsing
+compileIrcConfig :: IrcConfig -> String -> IO (IrcConfig)
+compileIrcConfig ircConfig path = do
+    val <- C.readfile C.emptyCP path
+    let cp = forceEither val
+    let address = case C.get cp "IRC" "address" of
+         Right this -> this
+         Left _ -> ircConfigAddress ircConfig
+    let port = case C.get cp "IRC" "port" of
+         Right this -> PortNumber $ fromIntegral (read this :: Int) -- TODO error handling
+         Left _ -> ircConfigPort ircConfig
+    let channels = case C.get cp "IRC" "channels" of
+         Right this -> map (lstrip ' ') (split this ',')
+         Left _ -> ircConfigChannels ircConfig
+    let nickname = case C.get cp "IRC" "nickname" of
+         Right this -> this
+         Left _ -> ircConfigNickname ircConfig
+    let password = case C.get cp "IRC" "password" of
+         Right this -> this
+         Left _ -> ircConfigPassword ircConfig
+    let realname = case C.get cp "IRC" "realname" of
+         Right this -> this
+         Left _ -> ircConfigRealname ircConfig
+    let commandPrefix = case C.get cp "IRC" "commandPrefix" of
+         Right this -> head this -- TODO error handling
+         Left _ -> ircConfigCommandPrefix ircConfig
+    let plugins = case C.get cp "IRC" "plugins" of
+         Right this -> map (lstrip ' ') (split this ',')
+         Left _ -> ircConfigPlugins ircConfig
+    return ircConfig { ircConfigAddress       = address
+                     , ircConfigPort          = port
+                     , ircConfigChannels      = channels
+                     , ircConfigNickname      = nickname
+                     , ircConfigPassword      = password
+                     , ircConfigRealname      = realname
+                     , ircConfigCommandPrefix = commandPrefix
+                     , ircConfigPlugins       = plugins }
+  where
+    split :: String -> Char -> [String]
+    split [] _ = [""]
+    split (c:cs) delim
+       | c == delim = "" : rest
+       | otherwise = (c : head rest) : tail rest
+      where rest = split cs delim
+    lstrip :: Char -> String -> String
+    lstrip x (c:cs) = if (x == c) then (lstrip x cs) else c:(lstrip x cs)
+    lstrip _ [] = []
+
diff --git a/HsbotIrcBot/LICENSE b/HsbotIrcBot/LICENSE
new file mode 100644
index 0000000..a280988
--- /dev/null
+++ b/HsbotIrcBot/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Julien Dessaux
+
+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 Julien Dessaux 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.
diff --git a/HsbotIrcBot/Main.hs b/HsbotIrcBot/Main.hs
new file mode 100644
index 0000000..070b7b6
--- /dev/null
+++ b/HsbotIrcBot/Main.hs
@@ -0,0 +1,83 @@
+module Main (main) where
+
+import Control.Monad (when)
+import Prelude hiding (catch)
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.IO
+
+import Hsbot.Irc.Config
+
+-- | Main function
+main :: IO ()
+main = do
+    args <- getArgs
+    -- Parse options, getting a list of option actions
+    let (actions, nonOptions, errors) = getOpt RequireOrder options args
+    -- Here we thread startOptions through all supplied option actions
+    opts <- case (nonOptions, errors) of
+        ([], []) -> foldl (>>=) (return defaultOptions) actions
+        (_, _) -> do
+            hPutStrLn stderr $ concat errors ++ usageInfo header options
+            exitWith $ ExitFailure 1
+    -- From there the initialization code truly begins
+    when (optDebug opts) . putStrLn $ "Got options : " ++ (show opts)
+    -- We find and parse the config file
+    ircConfig <- getIrcConfig $ optConfigFile opts
+    print $ ircConfigChannels ircConfig
+    print $ ircConfigPlugins ircConfig
+
+-- CLI argument parting stuff {{{
+-- | CLI options
+data Options = Options
+    { optDebug      :: Bool
+    , optConfigFile :: Maybe String
+    , optGroup      :: Maybe String
+    , optUser       :: Maybe String
+    , optVerbose    :: Bool
+    } deriving (Show)
+
+-- | CLI default options
+defaultOptions :: Options
+defaultOptions = Options { optDebug      = False
+                         , optConfigFile = Nothing
+                         , optGroup      = Nothing
+                         , optUser       = Nothing
+                         , optVerbose    = False }
+
+-- | CLI options logic
+options :: [ OptDescr (Options -> IO Options) ]
+options =
+    [ Option "d" ["debug"]
+        (NoArg (\opt -> return opt { optDebug = True, optVerbose = True }))
+        "Enter verbose debug mode and prevents Hsbot from forking in background"
+    , Option "f" ["file"]
+        (ReqArg (\arg opt -> return opt { optConfigFile = return arg }) "<config_file>")
+        "The config file to use"
+    , Option "g" ["group"]
+        (ReqArg (\arg opt -> return opt { optGroup = return arg }) "<group>")
+        "The group hsbot will run as"
+    , Option "h" ["help"]
+        (NoArg (\_ -> do
+                    putStrLn $ usageInfo header options
+                    exitWith ExitSuccess))
+        "Print this help message"
+    , Option "u" ["user"]
+        (ReqArg (\arg opt -> return opt { optUser = return arg }) "<user>")
+        "The user hsbot will run as"
+    , Option "v" ["verbose"]
+        (NoArg (\opt -> return opt { optVerbose = True }))
+        "Enable verbose messages"
+    , Option "V" ["version"]
+        (NoArg (\_ -> do
+                    putStrLn "hsbot-irc version 0.3"
+                    exitWith ExitSuccess))
+        "Show version"
+    ]
+
+-- | Usage header
+header :: String
+header = "Usage: hsbot-irc [-dhvV] [-f config_file] [-u user] [-g group]"
+-- }}}
+
diff --git a/HsbotIrcBot/hsbot-irc.cabal b/HsbotIrcBot/hsbot-irc.cabal
new file mode 100644
index 0000000..c19038f
--- /dev/null
+++ b/HsbotIrcBot/hsbot-irc.cabal
@@ -0,0 +1,29 @@
+Name:               hsbot-irc
+Version:            0.3
+Cabal-version:      >=1.2
+Synopsis:           The irc part of a multi-purposes bot.
+Description:
+  hsbot is a multi-purpose bot, written slowly, as long as I learned more
+  haskell. It features IRC integration and some plugins. I tried to design
+  a bot architecture as modular and as flexible as possible.
+Homepage:           http://hsbot.adyxax.org/
+License:            BSD3
+License-file:       LICENSE
+Author:             Julien Dessaux
+Maintainer:         judessaux@gmail.com
+Copyright:          Copyright (c) 2010 Julien Dessaux
+Category:           Hsbot
+Build-type:         Simple
+
+
+Executable hsbot-irc
+  Main-is:          Main.hs
+  Ghc-options:      -Wall
+  Extensions:       DeriveDataTypeable ScopedTypeVariables
+  Build-depends:    base >= 4.1 && < 5,
+                    ConfigFile,
+                    MissingH,
+                    mtl,
+                    network,
+                    unix
+