A simple IRC bot written in Haskell
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Config.hs 2.5KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. {-# LANGUAGE OverlappingInstances #-}
  2. module Network.IRC.Config (loadBotConfig) where
  3. import qualified Data.Configurator as CF
  4. import qualified Data.Configurator.Types as CFT
  5. import qualified Data.Ratio as R
  6. import ClassyPrelude
  7. import Data.Configurator.Types (Configured (..), ConfigError (..), KeyError (..))
  8. import Network.IRC
  9. import Network.IRC.Configuration
  10. import Network.IRC.Handlers
  11. instance Configured a => Configured [a] where
  12. convert (CFT.List xs) = Just . mapMaybe convert $ xs
  13. convert _ = Nothing
  14. instance Configurable CFT.Value where
  15. fromValue (String a) = Just $ CFT.String a
  16. fromValue (Number a) = Just $ CFT.Number (a R.% 1)
  17. fromValue (Boolean a) = Just $ CFT.Bool a
  18. fromValue (List a) = Just $ CFT.List (mapMaybe fromValue a)
  19. toValue (CFT.String a) = toValue a
  20. toValue (CFT.Number r) = toValue (R.numerator r `div` R.denominator r)
  21. toValue (CFT.Bool a) = toValue a
  22. toValue (CFT.List vs) = toValue vs
  23. fromConfiguratorConfig :: CFT.Config -> IO Configuration
  24. fromConfiguratorConfig config =
  25. fromMap
  26. . foldl' (\m (k, v) -> insertMap k (toValue v) m) mempty
  27. . mapToList
  28. <$> CF.getMap config
  29. loadBotConfig :: String -> IO BotConfig
  30. loadBotConfig configFile = do
  31. eConfig <- try $ CF.load [CF.Required configFile]
  32. case eConfig of
  33. Left (ParseError _ _) -> error "Error while loading config"
  34. Right config -> do
  35. eBotConfig <- try $ do
  36. handlers :: [Text] <- CF.require config "msghandlers"
  37. let handlerInfo = foldl' (\m h -> insertMap h mempty m) mempty handlers
  38. let handlerMakers = foldl' (\m maker -> insertMap (msgHandlerName maker) maker m) mempty
  39. . filter (\MsgHandlerMaker { .. } -> msgHandlerName `member` handlerInfo)
  40. $ allMsgHandlerMakers
  41. botConfig <- newBotConfig <$>
  42. CF.require config "server" <*>
  43. CF.require config "port" <*>
  44. CF.require config "channel" <*>
  45. (Nick <$> CF.require config "nick") <*>
  46. CF.require config "timeout"
  47. configMap <- fromConfiguratorConfig config
  48. return botConfig { msgHandlerInfo = handlerInfo
  49. , msgHandlerMakers = handlerMakers
  50. , config = configMap
  51. }
  52. case eBotConfig of
  53. Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k
  54. Right botConf -> return botConf