abhin4v/hask-irc
1
0
Forka 0
Codice Problemi Pull Requests Rilasci Wiki Attività

Removes core's and handler's dependency on configurator.

Sfoglia il codice sorgente 
by using core's own configuration module.
Also changes runner to convert between configurator's config and
core's config.
This commit is contained in:
Abhinav Sarkar 2015-06-25 02:48:49 +05:30
parent 53a28f6c06
commit 9960ae2d58
9 ha cambiato i file con 126 aggiunte e 28 eliminazioni
Mostra statistiche Scarica il file Patch Scarica il file Diff Expand all files Collapse all files

8
hask-irc-core/Network/IRC/Bot.hs
Vedi File

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

79
hask-irc-core/Network/IRC/Configuration.hs Normal file
Vedi File

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

8
hask-irc-core/Network/IRC/Internal/Types.hs
Vedi File

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

2
hask-irc-core/hask-irc-core.cabal
Vedi File

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

8
hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs
Vedi File

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

8
hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs
Vedi File

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

12
hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs
Vedi File

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

1
hask-irc-handlers/hask-irc-handlers.cabal
Vedi File

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

28
hask-irc-runner/Network/IRC/Config.hs
Vedi File

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