Quellcode durchsuchen

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.
Abhinav Sarkar vor 7 Jahren
Ursprung
Commit
9960ae2d58

+ 4
- 4
hask-irc-core/Network/IRC/Bot.hs Datei anzeigen

@@ -7,7 +7,6 @@ module Network.IRC.Bot
7 7
   , messageProcessLoop )
8 8
 where
9 9
 
10
-import qualified Data.Configurator as CF
11 10
 import qualified Data.Text.Format  as TF
12 11
 import qualified System.Log.Logger as HSL
13 12
 
@@ -20,6 +19,7 @@ import System.IO                  (hIsEOF)
20 19
 import System.Timeout             (timeout)
21 20
 import System.Log.Logger.TH       (deriveLoggers)
22 21
 
22
+import qualified Network.IRC.Configuration as CF
23 23
 import Network.IRC.MessageBus
24 24
 import Network.IRC.Internal.Types
25 25
 import Network.IRC.Protocol
@@ -132,7 +132,7 @@ messageProcessLoop inChan messageChan = loop 0
132 132
       Bot { .. }   <- ask
133 133
       let nick     = botNick botConfig
134 134
       let origNick = botOrigNick botConfig
135
-      mpass        <- io $ CF.lookup (config botConfig) "password"
135
+      let mpass    = CF.lookup "password" (config botConfig)
136 136
 
137 137
       nStatus <- io . mask_ $
138 138
         if idleFor >= (oneSec * botTimeout botConfig)
@@ -143,12 +143,12 @@ messageProcessLoop inChan messageChan = loop 0
143 143
 
144 144
             mIn <- receiveMessage inChan
145 145
             case mIn of
146
-              Timeout -> do
146
+              Timeout                  -> do
147 147
                 idleMsg <- newMessage IdleMsg
148 148
                 sendMessage messageChan idleMsg
149 149
                 sendWhoisMessage nick origNick
150 150
                 return Idle
151
-              EOD     -> infoM "Connection closed" >> return Disconnected
151
+              EOD                      -> infoM "Connection closed" >> return Disconnected
152 152
               Msg (msg@Message { .. }) -> do
153 153
                 nStatus <- handleMsg nick origNick message mpass
154 154
                 sendMessage messageChan msg

+ 79
- 0
hask-irc-core/Network/IRC/Configuration.hs Datei anzeigen

@@ -0,0 +1,79 @@
1
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification, GADTs #-}
2
+
3
+module Network.IRC.Configuration
4
+  ( Name
5
+  , Value (..)
6
+  , Configuration
7
+  , Configurable (..)
8
+  , fromMap
9
+  , lookup
10
+  , require
11
+  , lookupDefault
12
+  ) where
13
+
14
+import qualified ClassyPrelude as P
15
+
16
+import ClassyPrelude hiding (lookup)
17
+import Data.Maybe (fromJust)
18
+
19
+type Name = Text
20
+
21
+class Configurable a where
22
+  fromValue :: Value -> Maybe a
23
+
24
+  valueToList :: Value -> Maybe [a]
25
+  valueToList (List xs) = mapM fromValue xs
26
+  valueToList _         = Nothing
27
+
28
+  toValue :: a -> Value
29
+
30
+  listToValue :: [a] -> Value
31
+  listToValue = List . map toValue
32
+
33
+valueToNum :: (Num a) => Value -> Maybe a
34
+valueToNum (Number n) = Just . fromInteger $ n
35
+valueToNum _          = Nothing
36
+
37
+instance Configurable Integer where
38
+  fromValue   = valueToNum
39
+  toValue = Number
40
+
41
+instance Configurable Int where
42
+  fromValue   = valueToNum
43
+  toValue = Number . toInteger
44
+
45
+instance Configurable Text where
46
+  fromValue (String s) = Just s
47
+  fromValue _          = Nothing
48
+
49
+  toValue = String
50
+
51
+instance Configurable Bool where
52
+  fromValue (Boolean b) = Just b
53
+  fromValue _           = Nothing
54
+
55
+  toValue = Boolean
56
+
57
+instance Configurable a => Configurable [a] where
58
+  fromValue   = valueToList
59
+  toValue = listToValue
60
+
61
+data Value = String Text
62
+           | Number Integer
63
+           | Boolean Bool
64
+           | List [Value]
65
+           deriving (Eq, Show)
66
+
67
+newtype Configuration = Configuration { configMap :: (Map Name Value) } deriving (Show)
68
+
69
+fromMap :: Map Name Value -> Configuration
70
+fromMap = Configuration
71
+
72
+lookup :: (Configurable a) => Name -> Configuration -> Maybe a
73
+lookup name Configuration {..} = join . map fromValue $ P.lookup name configMap
74
+
75
+require :: (Configurable a) => Name -> Configuration -> a
76
+require n = fromJust . lookup n
77
+
78
+lookupDefault :: (Configurable a) => Name -> Configuration -> a -> a
79
+lookupDefault n c v = fromMaybe v $ lookup n c

+ 3
- 5
hask-irc-core/Network/IRC/Internal/Types.hs Datei anzeigen

@@ -5,13 +5,11 @@
5 5
 
6 6
 module Network.IRC.Internal.Types where
7 7
 
8
-import qualified Data.Configurator as CF
9
-
10 8
 import ClassyPrelude
11 9
 import Control.Monad.Base         (MonadBase)
12 10
 import Control.Monad.State.Strict (StateT, MonadState, execStateT)
13
-import Data.Configurator.Types    (Config)
14 11
 
12
+import qualified Network.IRC.Configuration as CF
15 13
 import Network.IRC.Message.Types
16 14
 import Network.IRC.MessageBus
17 15
 import Network.IRC.Util
@@ -76,7 +74,7 @@ data BotConfig = BotConfig
76 74
   -- | A list of extra command formatters. Note that these formatters will always be called after the built-in ones.
77 75
   , cmdFormatters    :: ![CommandFormatter]
78 76
   -- | All the bot configuration so that message handlers can lookup their own specific configs.
79
-  , config           :: !Config
77
+  , config           :: !(CF.Configuration)
80 78
   }
81 79
 
82 80
 instance Show BotConfig where
@@ -96,7 +94,7 @@ newBotConfig :: Text       -- ^ server
96 94
              -> Int        -- ^ botTimeout
97 95
              -> BotConfig
98 96
 newBotConfig server port channel botNick botTimeout =
99
-  BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] CF.empty
97
+  BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] (CF.fromMap mempty)
100 98
 
101 99
 -- | The bot.
102 100
 data Bot = Bot

+ 1
- 1
hask-irc-core/hask-irc-core.cabal Datei anzeigen

@@ -55,7 +55,6 @@ library
55 55
 
56 56
   build-depends:       base                 >=4.5     && <4.8,
57 57
                        classy-prelude       >=0.10    && <1.0,
58
-                       configurator         >=0.2     && <0.3,
59 58
                        convertible          >=1.1     && <1.2,
60 59
                        hslogger             >=1.2     && <1.3,
61 60
                        hslogger-template    >=2.0     && <2.1,
@@ -72,6 +71,7 @@ library
72 71
   exposed-modules:     Network.IRC,
73 72
                        Network.IRC.Types,
74 73
                        Network.IRC.Client,
74
+                       Network.IRC.Configuration,
75 75
                        Network.IRC.Util
76 76
 
77 77
   other-modules:       Network.IRC.Internal.Types,

+ 4
- 4
hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs Datei anzeigen

@@ -2,7 +2,6 @@
2 2
 
3 3
 module Network.IRC.Handlers.MessageLogger (messageLoggerMsgHandlerMaker) where
4 4
 
5
-import qualified Data.Configurator       as CF
6 5
 import qualified Data.Text.Format        as TF
7 6
 import qualified Data.Text.Format.Params as TF
8 7
 
@@ -12,6 +11,7 @@ import System.Directory         (createDirectoryIfMissing, getModificationTime,
12 11
 import System.FilePath          (FilePath, (</>), (<.>))
13 12
 import System.IO                (openFile, IOMode(..), hSetBuffering, BufferMode(..))
14 13
 
14
+import qualified Network.IRC.Configuration as CF
15 15
 import Network.IRC
16 16
 import Network.IRC.Util
17 17
 
@@ -28,9 +28,9 @@ messageLoggerMsgHandlerMaker = MsgHandlerMaker "messagelogger" go
28 28
 
29 29
 getLogFilePath :: BotConfig -> IO FilePath
30 30
 getLogFilePath BotConfig { .. } = do
31
-  logFileDir <- CF.require config "messagelogger.logdir"
32
-  createDirectoryIfMissing True logFileDir
33
-  return $ logFileDir </> unpack (botChannel ++ "-" ++ nickToText botNick) <.> "log"
31
+  let logFileDir = CF.require "messagelogger.logdir" config :: Text
32
+  createDirectoryIfMissing True (unpack logFileDir)
33
+  return $ (unpack logFileDir) </> unpack (botChannel ++ "-" ++ nickToText botNick) <.> "log"
34 34
 
35 35
 openLogFile :: FilePath -> IO Handle
36 36
 openLogFile logFilePath = do

+ 4
- 4
hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs Datei anzeigen

@@ -3,7 +3,6 @@
3 3
 
4 4
 module Network.IRC.Handlers.NickTracker (nickTrackerMsgHandlerMaker) where
5 5
 
6
-import qualified Data.Configurator as CF
7 6
 import qualified Data.IxSet        as IS
8 7
 import qualified Data.UUID         as U
9 8
 import qualified Data.UUID.V4      as U
@@ -17,6 +16,7 @@ import Data.Convertible           (convert)
17 16
 import Data.IxSet                 (getOne, (@=))
18 17
 import Data.Time                  (addUTCTime, NominalDiffTime)
19 18
 
19
+import qualified Network.IRC.Configuration as CF
20 20
 import Network.IRC
21 21
 import Network.IRC.Handlers.NickTracker.Internal.Types
22 22
 import Network.IRC.Util
@@ -193,9 +193,9 @@ nickTrackerMsgHandlerMaker = MsgHandlerMaker "nicktracker" go
193 193
 
194 194
     go BotConfig { .. } _ = do
195 195
       state <- io $ do
196
-        now             <- getCurrentTime
197
-        refreshInterval <- map convert (CF.lookupDefault 60 config "nicktracker.refresh_interval" :: IO Int)
198
-        acid            <- openLocalState emptyNickTracking
196
+        now                 <- getCurrentTime
197
+        let refreshInterval = convert (CF.lookupDefault "nicktracker.refresh_interval" config 60 :: Int)
198
+        acid                <- openLocalState emptyNickTracking
199 199
         newIORef (NickTrackingState acid refreshInterval mempty now)
200 200
       return $ newMsgHandler { onMessage   = nickTrackerMsg state
201 201
                              , onStop      = stopNickTracker state

+ 6
- 6
hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs Datei anzeigen

@@ -3,7 +3,6 @@
3 3
 
4 4
 module Network.IRC.Handlers.SongSearch (songSearchMsgHandlerMaker) where
5 5
 
6
-import qualified Data.Configurator as CF
7 6
 import qualified System.Log.Logger as HSL
8 7
 
9 8
 import ClassyPrelude
@@ -15,6 +14,7 @@ import Network.Curl.Aeson       (curlAesonGet, CurlAesonException)
15 14
 import Network.HTTP.Base        (urlEncode)
16 15
 import System.Log.Logger.TH     (deriveLoggers)
17 16
 
17
+import qualified Network.IRC.Configuration as CF
18 18
 import Network.IRC
19 19
 
20 20
 $(deriveLoggers "HSL" [HSL.ERROR])
@@ -42,15 +42,15 @@ songSearch Message { .. }
42 42
   , "!m " `isPrefixOf` msg = do
43 43
       BotConfig { .. } <- ask
44 44
       liftIO $ do
45
-        let query = strip . drop 3 $ msg
46
-        mApiKey   <- CF.lookup config "songsearch.tinysong_apikey"
47
-        reply     <- map ChannelMsgReply $ case mApiKey of
45
+        let query   = strip . drop 3 $ msg
46
+        let mApiKey = CF.lookup "songsearch.tinysong_apikey" config
47
+        reply       <- map ChannelMsgReply $ case mApiKey of
48 48
           Nothing     -> do
49 49
             errorM "tinysong api key not found in config"
50 50
             return $ "Error while searching for " ++ query
51
-          Just apiKey -> do
51
+          Just (apiKey :: Text) -> do
52 52
             let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query)
53
-                          ++ "?format=json&key=" ++ apiKey
53
+                          ++ "?format=json&key=" ++ unpack apiKey
54 54
 
55 55
             result <- try $ curlAesonGet apiUrl >>= evaluate
56 56
             case result of

+ 0
- 1
hask-irc-handlers/hask-irc-handlers.cabal Datei anzeigen

@@ -58,7 +58,6 @@ library
58 58
                        acid-state           >=0.12    && <0.13,
59 59
                        aeson                >=0.7     && <0.8,
60 60
                        classy-prelude       >=0.10    && <1.0,
61
-                       configurator         >=0.2     && <0.3,
62 61
                        convertible          >=1.1     && <1.2,
63 62
                        curl-aeson           >=0.0.3   && <0.1,
64 63
                        directory            >=1.2     && <1.3,

+ 25
- 3
hask-irc-runner/Network/IRC/Config.hs Datei anzeigen

@@ -3,17 +3,38 @@
3 3
 module Network.IRC.Config (loadBotConfig) where
4 4
 
5 5
 import qualified Data.Configurator as CF
6
+import qualified Data.Configurator.Types as CFT
7
+import qualified Data.Ratio as R
6 8
 
7 9
 import ClassyPrelude
8
-import Data.Configurator.Types (Configured (..), Value (List), ConfigError (..), KeyError (..))
10
+import Data.Configurator.Types (Configured (..), ConfigError (..), KeyError (..))
9 11
 
10 12
 import Network.IRC
13
+import Network.IRC.Configuration
11 14
 import Network.IRC.Handlers
12 15
 
13 16
 instance Configured a => Configured [a] where
14
-  convert (List xs) = Just . mapMaybe convert $ xs
17
+  convert (CFT.List xs) = Just . mapMaybe convert $ xs
15 18
   convert _ = Nothing
16 19
 
20
+instance Configurable CFT.Value where
21
+  fromValue (String a)  = Just $ CFT.String a
22
+  fromValue (Number a)  = Just $ CFT.Number (a R.% 1)
23
+  fromValue (Boolean a) = Just $ CFT.Bool a
24
+  fromValue (List a)    = Just $ CFT.List (mapMaybe fromValue a)
25
+
26
+  toValue (CFT.String a) = toValue a
27
+  toValue (CFT.Number r) = toValue (R.numerator r `div` R.denominator r)
28
+  toValue (CFT.Bool a)   = toValue a
29
+  toValue (CFT.List vs)  = toValue vs
30
+
31
+fromConfiguratorConfig :: CFT.Config -> IO Configuration
32
+fromConfiguratorConfig config =
33
+  fromMap
34
+  . foldl' (\m (k, v) -> insertMap k (toValue v) m) mempty
35
+  . mapToList
36
+  <$> CF.getMap config
37
+
17 38
 loadBotConfig :: String -> IO BotConfig
18 39
 loadBotConfig configFile = do
19 40
   eConfig <- try $ CF.load [CF.Required configFile]
@@ -33,9 +54,10 @@ loadBotConfig configFile = do
33 54
                        CF.require config "channel"         <*>
34 55
                        (Nick <$> CF.require config "nick") <*>
35 56
                        CF.require config "timeout"
57
+        configMap <- fromConfiguratorConfig config
36 58
         return botConfig { msgHandlerInfo   = handlerInfo
37 59
                          , msgHandlerMakers = handlerMakers
38
-                         , config           = config
60
+                         , config           = configMap
39 61
                          }
40 62
 
41 63
       case eBotConfig of

Laden…
Abbrechen
Speichern