From 9960ae2d58daf50be6863628a76e0948b66c11a3 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Thu, 25 Jun 2015 02:48:49 +0530 Subject: [PATCH] Removes core's and handler's dependency on configurator. by using core's own configuration module. Also changes runner to convert between configurator's config and core's config. --- hask-irc-core/Network/IRC/Bot.hs | 8 +- hask-irc-core/Network/IRC/Configuration.hs | 79 +++++++++++++++++++ hask-irc-core/Network/IRC/Internal/Types.hs | 8 +- hask-irc-core/hask-irc-core.cabal | 2 +- .../Network/IRC/Handlers/MessageLogger.hs | 8 +- .../Network/IRC/Handlers/NickTracker.hs | 8 +- .../Network/IRC/Handlers/SongSearch.hs | 12 +-- hask-irc-handlers/hask-irc-handlers.cabal | 1 - hask-irc-runner/Network/IRC/Config.hs | 28 ++++++- 9 files changed, 126 insertions(+), 28 deletions(-) create mode 100644 hask-irc-core/Network/IRC/Configuration.hs diff --git a/hask-irc-core/Network/IRC/Bot.hs b/hask-irc-core/Network/IRC/Bot.hs index 824c1a8..2ad735c 100644 --- a/hask-irc-core/Network/IRC/Bot.hs +++ b/hask-irc-core/Network/IRC/Bot.hs @@ -7,7 +7,6 @@ module Network.IRC.Bot , messageProcessLoop ) where -import qualified Data.Configurator as CF import qualified Data.Text.Format as TF import qualified System.Log.Logger as HSL @@ -20,6 +19,7 @@ import System.IO (hIsEOF) import System.Timeout (timeout) import System.Log.Logger.TH (deriveLoggers) +import qualified Network.IRC.Configuration as CF import Network.IRC.MessageBus import Network.IRC.Internal.Types import Network.IRC.Protocol @@ -132,7 +132,7 @@ messageProcessLoop inChan messageChan = loop 0 Bot { .. } <- ask let nick = botNick botConfig let origNick = botOrigNick botConfig - mpass <- io $ CF.lookup (config botConfig) "password" + let mpass = CF.lookup "password" (config botConfig) nStatus <- io . mask_ $ if idleFor >= (oneSec * botTimeout botConfig) @@ -143,12 +143,12 @@ messageProcessLoop inChan messageChan = loop 0 mIn <- receiveMessage inChan case mIn of - Timeout -> do + Timeout -> do idleMsg <- newMessage IdleMsg sendMessage messageChan idleMsg sendWhoisMessage nick origNick return Idle - EOD -> infoM "Connection closed" >> return Disconnected + EOD -> infoM "Connection closed" >> return Disconnected Msg (msg@Message { .. }) -> do nStatus <- handleMsg nick origNick message mpass sendMessage messageChan msg diff --git a/hask-irc-core/Network/IRC/Configuration.hs b/hask-irc-core/Network/IRC/Configuration.hs new file mode 100644 index 0000000..66d54e0 --- /dev/null +++ b/hask-irc-core/Network/IRC/Configuration.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification, GADTs #-} + +module Network.IRC.Configuration + ( Name + , Value (..) + , Configuration + , Configurable (..) + , fromMap + , lookup + , require + , lookupDefault + ) where + +import qualified ClassyPrelude as P + +import ClassyPrelude hiding (lookup) +import Data.Maybe (fromJust) + +type Name = Text + +class Configurable a where + fromValue :: Value -> Maybe a + + valueToList :: Value -> Maybe [a] + valueToList (List xs) = mapM fromValue xs + valueToList _ = Nothing + + toValue :: a -> Value + + listToValue :: [a] -> Value + listToValue = List . map toValue + +valueToNum :: (Num a) => Value -> Maybe a +valueToNum (Number n) = Just . fromInteger $ n +valueToNum _ = Nothing + +instance Configurable Integer where + fromValue = valueToNum + toValue = Number + +instance Configurable Int where + fromValue = valueToNum + toValue = Number . toInteger + +instance Configurable Text where + fromValue (String s) = Just s + fromValue _ = Nothing + + toValue = String + +instance Configurable Bool where + fromValue (Boolean b) = Just b + fromValue _ = Nothing + + toValue = Boolean + +instance Configurable a => Configurable [a] where + fromValue = valueToList + toValue = listToValue + +data Value = String Text + | Number Integer + | Boolean Bool + | List [Value] + deriving (Eq, Show) + +newtype Configuration = Configuration { configMap :: (Map Name Value) } deriving (Show) + +fromMap :: Map Name Value -> Configuration +fromMap = Configuration + +lookup :: (Configurable a) => Name -> Configuration -> Maybe a +lookup name Configuration {..} = join . map fromValue $ P.lookup name configMap + +require :: (Configurable a) => Name -> Configuration -> a +require n = fromJust . lookup n + +lookupDefault :: (Configurable a) => Name -> Configuration -> a -> a +lookupDefault n c v = fromMaybe v $ lookup n c diff --git a/hask-irc-core/Network/IRC/Internal/Types.hs b/hask-irc-core/Network/IRC/Internal/Types.hs index 07e9165..b143d69 100644 --- a/hask-irc-core/Network/IRC/Internal/Types.hs +++ b/hask-irc-core/Network/IRC/Internal/Types.hs @@ -5,13 +5,11 @@ module Network.IRC.Internal.Types where -import qualified Data.Configurator as CF - import ClassyPrelude import Control.Monad.Base (MonadBase) import Control.Monad.State.Strict (StateT, MonadState, execStateT) -import Data.Configurator.Types (Config) +import qualified Network.IRC.Configuration as CF import Network.IRC.Message.Types import Network.IRC.MessageBus import Network.IRC.Util @@ -76,7 +74,7 @@ data BotConfig = BotConfig -- | A list of extra command formatters. Note that these formatters will always be called after the built-in ones. , cmdFormatters :: ![CommandFormatter] -- | All the bot configuration so that message handlers can lookup their own specific configs. - , config :: !Config + , config :: !(CF.Configuration) } instance Show BotConfig where @@ -96,7 +94,7 @@ newBotConfig :: Text -- ^ server -> Int -- ^ botTimeout -> BotConfig newBotConfig server port channel botNick botTimeout = - BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] CF.empty + BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] (CF.fromMap mempty) -- | The bot. data Bot = Bot diff --git a/hask-irc-core/hask-irc-core.cabal b/hask-irc-core/hask-irc-core.cabal index 377cdec..185d351 100644 --- a/hask-irc-core/hask-irc-core.cabal +++ b/hask-irc-core/hask-irc-core.cabal @@ -55,7 +55,6 @@ library build-depends: base >=4.5 && <4.8, classy-prelude >=0.10 && <1.0, - configurator >=0.2 && <0.3, convertible >=1.1 && <1.2, hslogger >=1.2 && <1.3, hslogger-template >=2.0 && <2.1, @@ -72,6 +71,7 @@ library exposed-modules: Network.IRC, Network.IRC.Types, Network.IRC.Client, + Network.IRC.Configuration, Network.IRC.Util other-modules: Network.IRC.Internal.Types, diff --git a/hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs b/hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs index 601cd21..9abe386 100644 --- a/hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs +++ b/hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs @@ -2,7 +2,6 @@ module Network.IRC.Handlers.MessageLogger (messageLoggerMsgHandlerMaker) where -import qualified Data.Configurator as CF import qualified Data.Text.Format as TF import qualified Data.Text.Format.Params as TF @@ -12,6 +11,7 @@ import System.Directory (createDirectoryIfMissing, getModificationTime, import System.FilePath (FilePath, (), (<.>)) import System.IO (openFile, IOMode(..), hSetBuffering, BufferMode(..)) +import qualified Network.IRC.Configuration as CF import Network.IRC import Network.IRC.Util @@ -28,9 +28,9 @@ messageLoggerMsgHandlerMaker = MsgHandlerMaker "messagelogger" go getLogFilePath :: BotConfig -> IO FilePath getLogFilePath BotConfig { .. } = do - logFileDir <- CF.require config "messagelogger.logdir" - createDirectoryIfMissing True logFileDir - return $ logFileDir unpack (botChannel ++ "-" ++ nickToText botNick) <.> "log" + let logFileDir = CF.require "messagelogger.logdir" config :: Text + createDirectoryIfMissing True (unpack logFileDir) + return $ (unpack logFileDir) unpack (botChannel ++ "-" ++ nickToText botNick) <.> "log" openLogFile :: FilePath -> IO Handle openLogFile logFilePath = do diff --git a/hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs b/hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs index 8fba4fd..4c6dbfb 100644 --- a/hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs +++ b/hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs @@ -3,7 +3,6 @@ module Network.IRC.Handlers.NickTracker (nickTrackerMsgHandlerMaker) where -import qualified Data.Configurator as CF import qualified Data.IxSet as IS import qualified Data.UUID as U import qualified Data.UUID.V4 as U @@ -17,6 +16,7 @@ import Data.Convertible (convert) import Data.IxSet (getOne, (@=)) import Data.Time (addUTCTime, NominalDiffTime) +import qualified Network.IRC.Configuration as CF import Network.IRC import Network.IRC.Handlers.NickTracker.Internal.Types import Network.IRC.Util @@ -193,9 +193,9 @@ nickTrackerMsgHandlerMaker = MsgHandlerMaker "nicktracker" go go BotConfig { .. } _ = do state <- io $ do - now <- getCurrentTime - refreshInterval <- map convert (CF.lookupDefault 60 config "nicktracker.refresh_interval" :: IO Int) - acid <- openLocalState emptyNickTracking + now <- getCurrentTime + let refreshInterval = convert (CF.lookupDefault "nicktracker.refresh_interval" config 60 :: Int) + acid <- openLocalState emptyNickTracking newIORef (NickTrackingState acid refreshInterval mempty now) return $ newMsgHandler { onMessage = nickTrackerMsg state , onStop = stopNickTracker state diff --git a/hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs b/hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs index d9a3442..e6c99c9 100644 --- a/hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs +++ b/hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs @@ -3,7 +3,6 @@ module Network.IRC.Handlers.SongSearch (songSearchMsgHandlerMaker) where -import qualified Data.Configurator as CF import qualified System.Log.Logger as HSL import ClassyPrelude @@ -15,6 +14,7 @@ import Network.Curl.Aeson (curlAesonGet, CurlAesonException) import Network.HTTP.Base (urlEncode) import System.Log.Logger.TH (deriveLoggers) +import qualified Network.IRC.Configuration as CF import Network.IRC $(deriveLoggers "HSL" [HSL.ERROR]) @@ -42,15 +42,15 @@ songSearch Message { .. } , "!m " `isPrefixOf` msg = do BotConfig { .. } <- ask liftIO $ do - let query = strip . drop 3 $ msg - mApiKey <- CF.lookup config "songsearch.tinysong_apikey" - reply <- map ChannelMsgReply $ case mApiKey of + let query = strip . drop 3 $ msg + let mApiKey = CF.lookup "songsearch.tinysong_apikey" config + reply <- map ChannelMsgReply $ case mApiKey of Nothing -> do errorM "tinysong api key not found in config" return $ "Error while searching for " ++ query - Just apiKey -> do + Just (apiKey :: Text) -> do let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query) - ++ "?format=json&key=" ++ apiKey + ++ "?format=json&key=" ++ unpack apiKey result <- try $ curlAesonGet apiUrl >>= evaluate case result of diff --git a/hask-irc-handlers/hask-irc-handlers.cabal b/hask-irc-handlers/hask-irc-handlers.cabal index 18b81e6..12d7879 100644 --- a/hask-irc-handlers/hask-irc-handlers.cabal +++ b/hask-irc-handlers/hask-irc-handlers.cabal @@ -58,7 +58,6 @@ library acid-state >=0.12 && <0.13, aeson >=0.7 && <0.8, classy-prelude >=0.10 && <1.0, - configurator >=0.2 && <0.3, convertible >=1.1 && <1.2, curl-aeson >=0.0.3 && <0.1, directory >=1.2 && <1.3, diff --git a/hask-irc-runner/Network/IRC/Config.hs b/hask-irc-runner/Network/IRC/Config.hs index 99b7eeb..fcb387a 100644 --- a/hask-irc-runner/Network/IRC/Config.hs +++ b/hask-irc-runner/Network/IRC/Config.hs @@ -3,17 +3,38 @@ module Network.IRC.Config (loadBotConfig) where import qualified Data.Configurator as CF +import qualified Data.Configurator.Types as CFT +import qualified Data.Ratio as R import ClassyPrelude -import Data.Configurator.Types (Configured (..), Value (List), ConfigError (..), KeyError (..)) +import Data.Configurator.Types (Configured (..), ConfigError (..), KeyError (..)) import Network.IRC +import Network.IRC.Configuration import Network.IRC.Handlers instance Configured a => Configured [a] where - convert (List xs) = Just . mapMaybe convert $ xs + convert (CFT.List xs) = Just . mapMaybe convert $ xs convert _ = Nothing +instance Configurable CFT.Value where + fromValue (String a) = Just $ CFT.String a + fromValue (Number a) = Just $ CFT.Number (a R.% 1) + fromValue (Boolean a) = Just $ CFT.Bool a + fromValue (List a) = Just $ CFT.List (mapMaybe fromValue a) + + toValue (CFT.String a) = toValue a + toValue (CFT.Number r) = toValue (R.numerator r `div` R.denominator r) + toValue (CFT.Bool a) = toValue a + toValue (CFT.List vs) = toValue vs + +fromConfiguratorConfig :: CFT.Config -> IO Configuration +fromConfiguratorConfig config = + fromMap + . foldl' (\m (k, v) -> insertMap k (toValue v) m) mempty + . mapToList + <$> CF.getMap config + loadBotConfig :: String -> IO BotConfig loadBotConfig configFile = do eConfig <- try $ CF.load [CF.Required configFile] @@ -33,9 +54,10 @@ loadBotConfig configFile = do CF.require config "channel" <*> (Nick <$> CF.require config "nick") <*> CF.require config "timeout" + configMap <- fromConfiguratorConfig config return botConfig { msgHandlerInfo = handlerInfo , msgHandlerMakers = handlerMakers - , config = config + , config = configMap } case eBotConfig of