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

@@ -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

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

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

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,

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

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

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

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,

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